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 f09837fbcf..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) @@ -158,7 +162,9 @@ endmacro(set_fast_intel_fortran) # arch # macro(set_fast_intel_fortran_posix) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fpic -fpp") + # Set size where temporary are stored on heap instead of stack + # 1000: size in kB (1 MB) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fpic -fpp -heap-arrays 1000") # debug flags if(CMAKE_BUILD_TYPE MATCHES Debug) @@ -201,7 +207,9 @@ macro(set_fast_intel_fortran_windows) # Turn off specific warnings # - 5199: too many continuation lines # - 5268: 132 column limit - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} /Qdiag-disable:5199,5268 /fpp") + # Set size where temporary are stored on heap instead of stack + # 1000: size in kB (1 MB) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} /Qdiag-disable:5199,5268 /fpp /heap-arrays:1000") # If double precision, make constants double precision if (DOUBLE_PRECISION) diff --git a/docs/changelogs/v3.5.4.md b/docs/changelogs/v3.5.4.md new file mode 100644 index 0000000000..e099bfab56 --- /dev/null +++ b/docs/changelogs/v3.5.4.md @@ -0,0 +1,96 @@ +**Feature or improvement description** +Pull request to merge `rc-3.5.4` into `main` and create a tagged release for v3.5.4. + +See the milestone and project pages for additional information + + https://github.com/OpenFAST/openfast/milestone/14 + +Test results, if applicable +See GitHub Actions + +### Release checklist: +- [ ] Update the documentation version in docs/conf.py +- [ ] Update the versions in docs/source/user/api_change.rst +- [ ] Verify readthedocs builds correctly +- [ ] Create a tag in OpenFAST +- [ ] Create a merge commit in r-test and add a corresponding annotated tag +- [ ] Compile executables for Windows builds + - [ ] AeroDyn_Driver_x64.exe + - [ ] AeroDyn_Driver_x64_OpenMP.exe + - [ ] AeroDyn_Inflow_C_Binding_x64.dll + - [ ] AeroDyn_Inflow_C_Binding_x64_OpenMP.dll + - [ ] BeamDyn_Driver_x64.exe + - [ ] DISCON.dll (x64) + - [ ] DISCON_ITIBarge.dll (x64) + - [ ] DISCON_OC3Hywind.dll (x64) + - [ ] DISCON_SC.dll (x64) + - [ ] FAST.Farm_x64.exe + - [ ] FAST.Farm_x64_OMP.exe + - [ ] FAST_SFunc.mexw64 + - [ ] HydroDynDriver_x64.exe + - [ ] HydroDyn_C_Binding_x64.dll + - [ ] IfW_C_Binding_x64.dll + - [ ] InflowWind_Driver_x64.exe + - [ ] InflowWind_Driver_x64_OpenMP.exe + - [ ] MoorDyn_Driver_x64.exe + - [ ] MoorDyn_C_Binding_x64.dll + - [ ] OpenFAST-Simulink_x64.dll + - [ ] openfast_x64.exe + - [ ] Turbsim_x64.exe + +# Changelog + +## Overview + +This release includes performance improvements for BeamDyn (up to 30% speed increase), python file readers and writers from WEIS, and a fix for stack overflows with FAST.Farm (Intel compilation). A few other minor updates are included as outlined below. + +Anyone using BeamDyn will want to update to this version. + + +## General + +### Build systems + +#2311 Always build `openfastcpplib` as shared. Use `BUILD_OPENFAST_CPP_DRIVER` to disable `openfastcpp` executable (@deslaughter) +#2173 Fix crash in `MAP_End` when using Intel's new icx compiler and disable caching in setup-python GH action (@deslaughter) + + +### Python file readers/writers + +#2188 Add WEIS file readers and writers (@cortadocodes and @mayankchetan) + + +## Solvers + +### FAST.Farm + +#2452 Fix for some stack overflow issues with FAST.Farm when copying large amounts of wind data (closes #2053) (@andrew-platt) +#2340 Add `!$ OMP critical` around file opening for VTK to prevent file collision (@andrew-platt) + + +## Module changes + +### BeamDyn + +#2399 BeamDyn performance improvements (@deslaughter) + + +### ElastoDyn + +#2321 Backport of #2317: Explicitly initialize `ED` `RtHS` to zero -- corrects issue with inccorect linearization results (@andrew-platt) + + +### HydroDyn +#2397 HD bug fix: prevent array index out-of-bound error in `HDOut_MapOutputs` when more than 9 potential-flow bodies are present (@luwang00) + +### NWTC-Library +#2389 FileInfoType: increase line length allowed (@andrew-platt) + +## Input file changes + +No input files change with this release, as this only includes minor bugfixes. + +Full list of changes: https://openfast.readthedocs.io/en/main/source/user/api_change.html + +Full input file sets: https://github.com/OpenFAST/r-test/tree/v3.5.4 (example input files from the regression testing) + diff --git a/docs/conf.py b/docs/conf.py index c0432bfcaf..38764e4a10 100644 --- a/docs/conf.py +++ b/docs/conf.py @@ -138,7 +138,7 @@ def runDoxygen(sourcfile, doxyfileIn, doxyfileOut): # The short X.Y version. version = u'3.5' # The full version, including alpha/beta/rc tags. -release = u'v3.5.3' +release = u'v3.5.4' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. diff --git a/docs/source/install/index.rst b/docs/source/install/index.rst index ee7951a100..b394ed808d 100644 --- a/docs/source/install/index.rst +++ b/docs/source/install/index.rst @@ -162,7 +162,7 @@ containing the executables, and running a simple test command: Running OpenFAST with docker ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -OpenFAST is avilable to be run on docker starting with version 3.5.3. Three approaches are shared below. +OpenFAST is available to be run on docker starting with version 3.5.3. Three approaches are shared below. Using a docker image from Docker hub ------------------------------------ diff --git a/docs/source/user/aerodyn-aeroacoustics/02-noise-models.rst b/docs/source/user/aerodyn-aeroacoustics/02-noise-models.rst index 56f7faf9e5..8422a63b62 100644 --- a/docs/source/user/aerodyn-aeroacoustics/02-noise-models.rst +++ b/docs/source/user/aerodyn-aeroacoustics/02-noise-models.rst @@ -151,8 +151,8 @@ The formulations of :math:`{\overline{D}}_{h}\ `\ and :math:`{\overline{D}}_{l}` are presented in :numref:`aa-directivity`. The current implementation offers two approaches to estimate -:math:`I_{1}`. The first one is through a user-defined grid of -:math:`I_{1}`; see :numref:`aa-sec-TIgrid`. The second option is to have the code +:math:`I_{1}`. The first one is through a user-defined :math:`I_{1}`. +The second option is to have the code reconstructing :math:`I_{1}` from the turbulent wind grid, where the code computes the airfoil relative position of each blade section, :math:`i`, at every time instant and, given the rotor speed, diff --git a/docs/source/user/aerodyn-aeroacoustics/App-usage.rst b/docs/source/user/aerodyn-aeroacoustics/App-usage.rst index f83c773acb..7d9394bed5 100644 --- a/docs/source/user/aerodyn-aeroacoustics/App-usage.rst +++ b/docs/source/user/aerodyn-aeroacoustics/App-usage.rst @@ -56,12 +56,14 @@ models: - **TICalcMeth** – Integer 1/2: flag to set the calculation method for the incident turbulence intensity. When set to 1, incident turbulence intensity is - defined in a user-defined grid; see :numref:`aa-sec-TIgrid`. When set to - 2, incident turbulence intensity is estimated from the time history of the - incident flow. + user-defined. When set to 2, incident turbulence intensity is + estimated from the time history of the incident flow. -- **TICalcTabFile** – String: name of the text file with the user-defined - turbulence intensity grid; see :numref:`aa-sec-TIgrid`. +- **TI** – Float: user-defined value of :math:`TI`, which is the rotor-incident + turbulence intensity used in the Amiet model. + +- **avgV** – Float: value of the average wind speed used to scale :math:`TI` + and convert it to a blade section incident turbulence intensity. - **Lturb** – Float: value of :math:`L_{turb}` used to estimate the turbulent lengthscale used in the Amiet model. @@ -255,32 +257,5 @@ is shown here: :language: none -.. _aa-sec-TIgrid: - -Turbulence Grid ---------------- - -When the flag **TICalcMeth** is set equal to 1, the grid of turbulence -intensity of the wind :math:`TI` must be defined by the user. This is -done by creating a file called **TIGrid_In.txt**, which mimics a TurbSim -output file and contains a grid of turbulence intensity, which is -defined as a fraction value. The file defines a grid centered at hub -height and oriented with the OpenFAST global inertial frame coordinate -system; see :numref:`aa-fig:ObsRefSys`. A user-defined number of lateral and vertical -points equally spaced by a user-defined number of meters must be -specified. Note that an average wind speed must be defined to convert -the turbulence intensity of the wind to the incident turbulent intensity :math:`I_{1}`. -An example file for a 160 (lateral) by 180 (vertical) meters -grid looks like the following: - - -.. container:: - :name: aa-tab:TIgrid - - .. literalinclude:: example/TIGrid.txt - :linenos: - :language: none - - .. [4] https://github.com/OpenFAST/python-toolbox diff --git a/docs/source/user/aerodyn-aeroacoustics/example/AeroAcousticsInput.dat b/docs/source/user/aerodyn-aeroacoustics/example/AeroAcousticsInput.dat index eebaa51625..4a2bae7582 100644 --- a/docs/source/user/aerodyn-aeroacoustics/example/AeroAcousticsInput.dat +++ b/docs/source/user/aerodyn-aeroacoustics/example/AeroAcousticsInput.dat @@ -8,8 +8,9 @@ False Echo - Echo the input to ".AD.NN.ech"? (flag) ====== Aeroacoustic Models ============================================================================ 2 TIMod - Turbulent Inflow noise model {0: none, 1: Amiet 2: Amiet + Simplified Guidati} (switch) 1 TICalcMeth - Method to estimate turbulence intensity incident to the profile {1: given table, 2: computed on the fly} (switch) [Only used if TIMod!=0] -"TIGrid_InVerify.txt" TICalcTabFile - Name of the file containing the table for incident turbulence intensity (-) [Only used if TiCalcMeth == 1] -0.5 SurfRoughness- Surface roughness value used to estimate the turbulent length scale in Amiet model (m) +0.1 TI - Rotor-incident wind turbulence intensity (-) [Only used if TiCalcMeth == 1] +8 avgV - Average wind speed used to compute the section-incident turbulence intensity (m/s) [Only used if TiCalcMeth == 1] +40 Lturb - Turbulent length scale in Amiet model (m) [Only used if TIMod!=0] 1 TBLTEMod - Turbulent Boundary Layer-Trailing Edge noise calculation {0: none, 1:BPM, 2: TNO} (switch) 1 BLMod - Calculation method for boundary layer properties, {1: BPM, 2: Pretabulated} (switch) 1 TripMod - Boundary layer trip model {0:no trip, 1: heavy trip, 2: light trip} (switch) [Only used if BLMod=1] @@ -18,9 +19,6 @@ False Echo - Echo the input to ".AD.NN.ech"? (flag) True RoundedTip - Logical indicating rounded tip (flag) [Only used if TipMod=1] 1.0 Alprat - Tip lift curve slope (Default = 1.0) [Only used if TipMod=1] 0 BluntMod - Trailing-edge-bluntness – Vortex-shedding model {0:none, 1: BPM} (switch) -"AABlade1.dat" AABlFile(1) - Name of file containing distributed aerodynamic properties for Blade #1 (-) -"AABlade1.dat" AABlFile(2) - Name of file containing distributed aerodynamic properties for Blade #2 (-) -"AABlade1.dat" AABlFile(3) - Name of file containing distributed aerodynamic properties for Blade #3 (-) ====== Observer Input =================================================================== "AA_ObserverLocations.dat" ObserverLocations - Name of file containing all observer locations X Y Z (-) ====== Outputs ==================================================================================== diff --git a/docs/source/user/aerodyn-aeroacoustics/example/TIGrid.txt b/docs/source/user/aerodyn-aeroacoustics/example/TIGrid.txt deleted file mode 100644 index 4f01c54833..0000000000 --- a/docs/source/user/aerodyn-aeroacoustics/example/TIGrid.txt +++ /dev/null @@ -1,13 +0,0 @@ -Average Inflow Wind Speed -8.0 -Total Grid points In Y (lateral), Starts from - radius goes to + radius+ -4 -Total Grid points In Z (vertical), Starts from bottom tip (hub-radius) -3 -Grid spacing In Y (lateral) -40 -Grid spacing In Z (vertical) -60 -0.1200 0.1200 0.1200 0.1200 -0.1100 0.1100 0.1100 0.1100 -0.1000 0.1000 0.1000 0.1000 diff --git a/docs/source/user/api_change.rst b/docs/source/user/api_change.rst index f995d20766..30d3a351f0 100644 --- a/docs/source/user/api_change.rst +++ b/docs/source/user/api_change.rst @@ -11,7 +11,7 @@ Thus, be sure to implement each in order so that subsequent line numbers are cor -OpenFAST v3.5.3 to OpenFAST dev +OpenFAST v3.5.4 to OpenFAST dev ---------------------------------- The HydroDyn module was split into HydroDyn and SeaState. This results in a @@ -29,6 +29,8 @@ OpenFAST 15 CompAero\** 2 C OpenFAST 13 CompElast 3 CompElast - Compute structural dynamics (switch) {1=ElastoDyn; 2=ElastoDyn + BeamDyn for blades; 3=Simplified ElastoDyn} AeroDyn 40 IntegrationMethod 3 IntegrationMethod - Switch to indicate which integration method UA uses (1=RK4, 2=AB4, 3=ABM4, 4=BDF2) AeroDyn 140\* BldNd_BlOutNd "All" BldNd_BlOutNd - Specify a portion of the nodes to output. {"ALL", "Tip", "Root", or a list of node numbers} (-) +AeroDyn Aeroacoustics 11\* TI 0.1 TI - Rotor-incident wind turbulence intensity (-) [Only used if TiCalcMeth == 1] +AeroDyn Aeroacoustics 12\* avgV 8 avgV - Average wind speed used to compute the section-incident turbulence intensity (m/s) [Only used if TiCalcMeth == 1] ElastoDyn blade file 15 Removal of the `PitchAxis` input column HydroDyn all Complete restructuring of input file SeaState all New module (split from HydroDyn, so contains some inputs previously found in HydroDyn) @@ -104,6 +106,10 @@ Old inputs Corresponding new inputs +OpenFAST v3.5.3 to OpenFAST v3.5.4 +---------------------------------- + +No input file changes were made. OpenFAST v3.5.2 to OpenFAST v3.5.3 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/hydrodyn/appendix.rst b/docs/source/user/hydrodyn/appendix.rst index 24a2e1b352..b58c4717b9 100644 --- a/docs/source/user/hydrodyn/appendix.rst +++ b/docs/source/user/hydrodyn/appendix.rst @@ -12,9 +12,13 @@ structure:: False Echo - Echo the input file data (flag) ---------------------- FLOATING PLATFORM --------------------------------------- [unused with WaveMod=6] 1 PotMod - Potential-flow model {0: none=no potential flow, 1: frequency-to-time-domain transforms based on WAMIT output, 2: fluid-impulse theory (FIT)} (switch) - 1 ExctnMod - Wave-excitation model {0: no wave-excitation calculation, 1: DFT, 2: state-space} (switch) [only used when PotMod=1; STATE-SPACE REQUIRES *.ssexctn INPUT FILE] + 1 ExctnMod - Wave-excitation model {0: no wave-excitation calculation, 1: DFT, 2: state-space} (switch) [only used when PotMod=1; STATE-SPACE REQUIRES *.ssexctn INPUT FILE; if PtfmYMod=1, need ExctnMod=0 or 1] 0 ExctnDisp - Method of computing Wave Excitation {0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0 and SeaState's WaveMod>0]} (switch) 10 ExctnCutOff - Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [used only when PotMod=1, ExctnMod>0, and ExctnDisp=2]) [only used when PotMod=1 and ExctnMod>0 and SeaState's WaveMod>0]} (switch) + 0 PtfmYMod - Model for large platform yaw offset {0: Static reference yaw offset based on PtfmRefY, 1: dynamic reference yaw offset based on low-pass filtering the PRP yaw motion with cutoff frequency PtfmYCutOff} (switch) + 0 PtfmRefY - Constant (if PtfmYMod=0) or initial (if PtfmYMod=1) platform reference yaw offset (deg) + 0.01 PtfmYCutOff - Cutoff frequency for the low-pass filtering of PRP yaw motion when PtfmYMod=1 [>0.0; unused when PtfmYMod=0] (Hz) + 36 NExctnHdg - Number of evenly distributed platform yaw/heading angles over the range of [-180, 180) deg for which the wave excitation shall be computed [>=2; unused when PtfmYMod=0] (-) 1 RdtnMod - Radiation memory-effect model {0: no memory-effect calculation, 1: convolution, 2: state-space} (switch) [only used when PotMod=1; STATE-SPACE REQUIRES *.ss INPUT FILE] 60 RdtnTMax - Analysis time for wave radiation kernel calculations (sec) [only used when PotMod=1 and RdtnMod>0; determines RdtnDOmega=Pi/RdtnTMax in the cosine transform; MAKE SURE THIS IS LONG ENOUGH FOR THE RADIATION IMPULSE RESPONSE FUNCTIONS TO DECAY TO NEAR-ZERO FOR THE GIVEN PLATFORM!] 0.0125 RdtnDT - Time step for wave radiation kernel calculations (sec) [only used when PotMod=1 and ExctnMod>0 or RdtnMod>0; DT<=RdtnDT<=0.1 recommended; determines RdtnOmegaMax=Pi/RdtnDT in the cosine transform] @@ -32,8 +36,8 @@ structure:: ---------------------- 2ND-ORDER FLOATING PLATFORM FORCES ---------------------- [unused with WaveMod=0 or 6, or PotMod=0 or 2] 0 MnDrift - Mean-drift 2nd-order forces computed {0: None; [7, 8, 9, 10, 11, or 12]: WAMIT file to use} [Only one of MnDrift, NewmanApp, or DiffQTF can be non-zero. If NBody>1, MnDrift /=8] 0 NewmanApp - Mean- and slow-drift 2nd-order forces computed with Newman's approximation {0: None; [7, 8, 9, 10, 11, or 12]: WAMIT file to use} [Only one of MnDrift, NewmanApp, or DiffQTF can be non-zero. If NBody>1, NewmanApp/=8. Used only when WaveDirMod=0] - 0 DiffQTF - Full difference-frequency 2nd-order forces computed with full QTF {0: None; [10, 11, or 12]: WAMIT file to use} [Only one of MnDrift, NewmanApp, or DiffQTF can be non-zero] - 0 SumQTF - Full summation -frequency 2nd-order forces computed with full QTF {0: None; [10, 11, or 12]: WAMIT file to use} + 0 DiffQTF - Full difference-frequency 2nd-order forces computed with full QTF {0: None; [10, 11, or 12]: WAMIT file to use} [Only one of MnDrift, NewmanApp, or DiffQTF can be non-zero. If PtfmYMod=1, need DiffQTF=0] + 0 SumQTF - Full summation -frequency 2nd-order forces computed with full QTF {0: None; [10, 11, or 12]: WAMIT file to use} [If PtfmYMod=1, need SumQTF=0] ---------------------- PLATFORM ADDITIONAL STIFFNESS AND DAMPING -------------- [unused with PotMod=0 or 2] 0 AddF0 - Additional preload (N, N-m) [If NBodyMod=1, one size 6*NBody x 1 vector; if NBodyMod>1, NBody size 6 x 1 vectors] 0 @@ -60,7 +64,7 @@ structure:: 0 0 0 0 0 0 0 0 0 0 0 0 ---------------------- STRIP THEORY OPTIONS -------------------------------------- - 0 WaveDisp - Method of computing Wave Kinematics {0: use undisplaced position, 1: use displaced position) } (switch) + 0 WaveDisp - Method of computing Wave Kinematics {0: use undisplaced position, 1: use displaced position) } (switch) [If PtfmYMod=1, need WaveDisp=1] 0 AMMod - Method of computing distributed added-mass force. (0: Only and always on nodes below SWL at the undisplaced position. 2: Up to the instantaneous free surface) [overwrite to 0 when WaveMod = 0 or 6 or when WaveStMod = 0 in SeaState] ---------------------- AXIAL COEFFICIENTS -------------------------------------- 2 NAxCoef - Number of axial coefficients (-) diff --git a/docs/source/user/hydrodyn/input_files.rst b/docs/source/user/hydrodyn/input_files.rst index df6d5fdc27..49c0593d60 100644 --- a/docs/source/user/hydrodyn/input_files.rst +++ b/docs/source/user/hydrodyn/input_files.rst @@ -58,6 +58,20 @@ computed and printed to the calling terminal. **NSteps** specifies the number of simulation time steps, and **TimeInterval** specifies the time between steps. +Motion of the structure can be specified in different ways according to +**PRPInputsMod**. Irrespective of the choice of **PRPInputsMod** (which +are explained below), the translational displacement, velocity, and +acceleration are always specified in the global inertial-frame coordinate +system. With OpenFAST now updated to support potentially large platform +rotation, the specification of rotation differs from previous versions. +HydroDyn now describes body rotation using Tait-Bryan roll, pitch, and +yaw angles with the convention of intrinsic (about body-fixed axis) yaw +rotation first, followed by pitch rotation, and roll last. Furthermore, +HydroDyn now expects the first and second time derivatives of the +Tait-Bryan roll, pitch, and yaw angles in place of angular velocity and +acceleration. The standalone HydroDyn driver will convert these inputs +to angular velocity and acceleration internally. + Setting **PRPInputsMod** = 0 forces all platform reference point (PRP) input motions to zero for all time. If you set **PRPInputsMod** = 1, then you must set the steady-state inputs in the PRP STEADY STATE @@ -67,25 +81,24 @@ time-series input file whose name is specified via the file. This file has no header lines. Each data row corresponds to a given time step, and the whitespace separated columns of floating point values represent the necessary motion inputs as shown in -:numref:`hd-prp_input_table`. All motions are specified in the global -inertial-frame coordinate system. +:numref:`hd-prp_input_table`. .. _hd-prp_input_table: .. table:: PRP Inputs Time-Series Data File Contents (**PRPInputsMod** = 2) :widths: auto - ============= ================================================================================ ====================================== - Column Number Input Units - ============= ================================================================================ ====================================== - 1 Time step value .. math:: s - 2-4 Translational displacements along *X*, *Y*, and *Z* .. math:: m - 5-7 Rotational displacements about *X*, *Y*, and *Z* (small angle assumptions apply) .. math:: \text{radians} - 8-10 Translational velocities along *X*, *Y*, and *Z* .. math:: \frac{m}{s} - 11-13 Rotational velocities about *X*, *Y*, and *Z* .. math:: \frac{\text{radians}}{s} - 14-16 Translational accelerations along *X*, *Y*, and *Z* .. math:: \frac{m}{s^{2}} - 17-19 Rotational accelerations about *X*, *Y*, and *Z* .. math:: \frac{\text{radians}}{s^{2}} - ============= ================================================================================ ====================================== + ============= ====================================================================== ====================================== + Column Number Input Units + ============= ====================================================================== ====================================== + 1 Time step value .. math:: s + 2-4 Translational displacements along *X*, *Y*, and *Z* .. math:: m + 5-7 Tait-Bryan roll, pitch, and yaw angles .. math:: \text{radians} + 8-10 Translational velocities along *X*, *Y*, and *Z* .. math:: \frac{m}{s} + 11-13 First time derivatives of the Tait-Bryan roll, pitch, and yaw angles .. math:: \frac{\text{radians}}{s} + 14-16 Translational accelerations along *X*, *Y*, and *Z* .. math:: \frac{m}{s^{2}} + 17-19 Second time derivatives of the Tait-Bryan roll, pitch, and yaw angles .. math:: \frac{\text{radians}}{s^{2}} + ============= ====================================================================== ====================================== With **PRPInputsMod** = 1 or 2, any potential-flow bodies and strip-theory members defined in the primary HydroDyn input file will follow the prescribed @@ -110,18 +123,18 @@ with respect to time. .. table:: PRP Inputs Time-Series Data File Contents (**PRPInputsMod** < 0) :widths: auto - ============= ================================================================================================================ ======================== - Column Number Input Units - ============= ================================================================================================================ ======================== - 1 Time step value .. math:: s - 2-4 Translational displacements of the PRP along *X*, *Y*, and *Z* .. math:: m - 5-7 Rotational displacements of the PRP about *X*, *Y*, and *Z* (small angle assumptions apply) .. math:: \text{radians} - 8-10 Translational displacements of the 1st potential-flow body along *X*, *Y*, and *Z* .. math:: m - 11-13 Rotational displacements of the 1st potential-flow body about *X*, *Y*, and *Z* (small angle assumptions apply) .. math:: \text{radians} - 14-16 Translational displacements of the 2nd potential-flow body along *X*, *Y*, and *Z* .. math:: m - 17-19 Rotational displacements of the 2nd potential-flow body about *X*, *Y*, and *Z* (small angle assumptions apply) .. math:: \text{radians} - ... ... ... - ============= ================================================================================================================ ======================== + ============= =================================================================================== ======================== + Column Number Input Units + ============= =================================================================================== ======================== + 1 Time step value .. math:: s + 2-4 Translational displacements of the PRP along *X*, *Y*, and *Z* .. math:: m + 5-7 Tait-Bryan roll, pitch, and yaw angles of the PRP .. math:: \text{radians} + 8-10 Translational displacements of the 1st potential-flow body along *X*, *Y*, and *Z* .. math:: m + 11-13 Tait-Bryan roll, pitch, and yaw angles of the 1st potential-flow body .. math:: \text{radians} + 14-16 Translational displacements of the 2nd potential-flow body along *X*, *Y*, and *Z* .. math:: m + 17-19 Tait-Bryan roll, pitch, and yaw angles of the 2nd potential-flow body .. math:: \text{radians} + ... ... ... + ============= =================================================================================== ======================== .. _hd-primary-input: @@ -200,6 +213,83 @@ motion to prevent double counting the contributions from first-order structural motion already included in the second-order potential-flow wave excitation. +HydroDyn now supports large but slow (well below wave frequencies) +transient platform yaw motion with both strip-theory only and hybrid +potential-flow models. To enable this capability, the inputs +**PtfmYMod**, **PtfmRefY**, **PtfmYCutoff**, and **NExctnHdg** must +be set appropriately. Note that HydroDyn still requires the platform +roll and pitch angles to be small, i.e., within +/-15 deg. + +To conform with the first- and second-order potential-flow theory, +which limits the structure to small displacement about a reference +mean position, a constant or slowly varying reference platform yaw +orientation must be established. + +Setting **PtfmYMod** = 0 lets HydroDyn use a constant reference yaw +angle given by **PtfmRefY** in degrees. In this case, the platform +yaw rotation during the simulation, as given by the **PRPYaw** +output channel, must stay within +/-15 deg of **PtfmRefY** specified +by the user. A severe warning will be displayed if this requirement +is not met at any point during the simulation, while still allowing +the simulation to continue if possible. With a hybrid potential-flow +model, the potential-flow wave excitation input file needs to cover +a suitable range of wave headings relative to the platform after a +yaw offset of **PtfmRefY** is applied. + +Alternatively, **PtfmYMod** = 1 lets HydroDyn update the reference +yaw position **PtfmRefY** dynamically based on the low-pass-filtered +platform yaw rotation, analogous to the modeling of slow-drift motion +with **ExctnDisp** = 2 above. In this case, the **PtfmRefY** input +allows the user to specify the initial reference yaw position at +**t** = 0. The cutoff frequency of the first-order low-pass filter +for platform yaw rotation can be set with **PtfmYCutoff** in Hz. +Ideally, **PtfmYCutoff** should be placed between the wave frequency +region and the characteristic frequency of any slow but large change +in platform heading to filter out as much wave-frequency platform +motion as possible while minimizing the phase shift in the low-frequency +heading change. Throughout the simulation, the instantaneous +platform yaw rotation should stay within +/-15 deg of the now +time-dependent **PtfmRefY**. A severe warning will be displayed if +this requirement is not met at any point during the simulation, while +still allowing the simulation to continue if possible. + +With **PtfmYMod** = 1, HydroDyn requires the first- and second-order +(mean- or slow-drift loads from Newman's approximation only) +potential-flow wave excitation input file(s) to cover the full range +of possible wave headings with the first (smallest) wave heading being +exactly -180 deg and the last (largest) wave heading being exactly ++180 deg (the duplicated wave headings of +/-180 deg are intentional). +HydroDyn will error out if this requirement is not met by the input files. +HydroDyn uses this information to precompute the wave excitation on +the platform for **NExctnHdg** evenly distributed platform yaw/heading +angles over the range of [-180,+180) deg. For instance, with +**NExctnHdg** = 36, HydroDyn will precomupte the wave excitation for 0, +10, 20, ..., 350 deg platform heading. The instantaneous wave excitation +applied on the platform during the time-domain simulation is interpolated +from this data based on the instantaneous **PtfmRefY**. **NExctnHdg** +should be set appropriately to ensure adequate angular resolution in +platform heading. However, a high **NExctnHdg** can increase memory use +by OpenFAST substantially. + +Additional constraints on HydroDyn inputs apply when **PtfmYMod** = 1. +The strip-theory hydrodynamic load must be evaluated using the wave +kinematics and dynamic pressure at the displaced structure position +by setting **WaveDisp** = 1. State-space wave excitation cannot be used. +**ExctnMod** must be either 0 (no wave excitation) or 1 (frequency-to-time +domain transform using inverse discrete Fourier transform). Lastly, +full difference- and sum-frequency QTFs are not supported, requiring +both **DiffQTF** and **SumQTF** to be set to 0. However, mean- or +slow-drift loads based on Newman's approximation can be included through +the **MnDrift** or **NewmanApp** inputs explained below. + +Note that the inputs **PtfmYMod** and **PtfmRefY** also affect the +strip-theory hydrodynamic load. This is because the orientation of +the strip-theory members is updated based on **PtfmRefY** instead +of the instantaneous platform yaw rotation. Behavior of previous +versions of HydroDyn can be approximately recovered by setting +**PtfmYMod** = 0 and **PtfmRefY** = 0 deg, in which case, the +inputs **PtfmYCutoff** and **NExctnHdg** are not used. + HydroDyn has two methods for calculating the radiation memory effect. Set **RdtnMod** to 1 for the convolution method, 2 for the linear state-space model, or 0 to disable the memory effect calculation. For diff --git a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 index 87b334f83a..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 @@ -133,7 +148,7 @@ subroutine FWrap_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FWrap_CopyInitInput' ErrStat = ErrID_None @@ -160,8 +175,8 @@ subroutine FWrap_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC DstInitInputData%UseSC = SrcInitInputData%UseSC if (allocated(SrcInitInputData%fromSCGlob)) then - LB(1:1) = lbound(SrcInitInputData%fromSCGlob, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%fromSCGlob, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%fromSCGlob) + UB(1:1) = ubound(SrcInitInputData%fromSCGlob) if (.not. allocated(DstInitInputData%fromSCGlob)) then allocate(DstInitInputData%fromSCGlob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -172,8 +187,8 @@ subroutine FWrap_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%fromSCGlob = SrcInitInputData%fromSCGlob end if if (allocated(SrcInitInputData%fromSC)) then - LB(1:1) = lbound(SrcInitInputData%fromSC, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%fromSC, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%fromSC) + UB(1:1) = ubound(SrcInitInputData%fromSC) if (.not. allocated(DstInitInputData%fromSC)) then allocate(DstInitInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -239,7 +254,7 @@ subroutine FWrap_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(FWrap_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackInitInput' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -478,8 +493,8 @@ subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FWrap_CopyMisc' @@ -489,8 +504,8 @@ subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%TempDisp)) then - LB(1:1) = lbound(SrcMiscData%TempDisp, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%TempDisp, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%TempDisp) + UB(1:1) = ubound(SrcMiscData%TempDisp) if (.not. allocated(DstMiscData%TempDisp)) then allocate(DstMiscData%TempDisp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -505,8 +520,8 @@ subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%TempLoads)) then - LB(1:1) = lbound(SrcMiscData%TempLoads, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%TempLoads, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%TempLoads) + UB(1:1) = ubound(SrcMiscData%TempLoads) if (.not. allocated(DstMiscData%TempLoads)) then allocate(DstMiscData%TempLoads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -521,8 +536,8 @@ subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%ADRotorDisk)) then - LB(1:1) = lbound(SrcMiscData%ADRotorDisk, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%ADRotorDisk, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%ADRotorDisk) + UB(1:1) = ubound(SrcMiscData%ADRotorDisk) if (.not. allocated(DstMiscData%ADRotorDisk)) then allocate(DstMiscData%ADRotorDisk(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -537,8 +552,8 @@ subroutine FWrap_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%AD_L2L)) then - LB(1:1) = lbound(SrcMiscData%AD_L2L, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AD_L2L, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%AD_L2L) + UB(1:1) = ubound(SrcMiscData%AD_L2L) if (.not. allocated(DstMiscData%AD_L2L)) then allocate(DstMiscData%AD_L2L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -558,8 +573,8 @@ subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) type(FWrap_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FWrap_DestroyMisc' @@ -568,8 +583,8 @@ subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) call FAST_DestroyTurbineType(MiscData%Turbine, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%TempDisp)) then - LB(1:1) = lbound(MiscData%TempDisp, kind=B8Ki) - UB(1:1) = ubound(MiscData%TempDisp, kind=B8Ki) + LB(1:1) = lbound(MiscData%TempDisp) + UB(1:1) = ubound(MiscData%TempDisp) do i1 = LB(1), UB(1) call MeshDestroy( MiscData%TempDisp(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -577,8 +592,8 @@ subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%TempDisp) end if if (allocated(MiscData%TempLoads)) then - LB(1:1) = lbound(MiscData%TempLoads, kind=B8Ki) - UB(1:1) = ubound(MiscData%TempLoads, kind=B8Ki) + LB(1:1) = lbound(MiscData%TempLoads) + UB(1:1) = ubound(MiscData%TempLoads) do i1 = LB(1), UB(1) call MeshDestroy( MiscData%TempLoads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -586,8 +601,8 @@ subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%TempLoads) end if if (allocated(MiscData%ADRotorDisk)) then - LB(1:1) = lbound(MiscData%ADRotorDisk, kind=B8Ki) - UB(1:1) = ubound(MiscData%ADRotorDisk, kind=B8Ki) + LB(1:1) = lbound(MiscData%ADRotorDisk) + UB(1:1) = ubound(MiscData%ADRotorDisk) do i1 = LB(1), UB(1) call MeshDestroy( MiscData%ADRotorDisk(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -595,8 +610,8 @@ subroutine FWrap_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%ADRotorDisk) end if if (allocated(MiscData%AD_L2L)) then - LB(1:1) = lbound(MiscData%AD_L2L, kind=B8Ki) - UB(1:1) = ubound(MiscData%AD_L2L, kind=B8Ki) + LB(1:1) = lbound(MiscData%AD_L2L) + UB(1:1) = ubound(MiscData%AD_L2L) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(MiscData%AD_L2L(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -609,42 +624,42 @@ subroutine FWrap_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(FWrap_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FWrap_PackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call FAST_PackTurbineType(RF, InData%Turbine) call RegPack(RF, allocated(InData%TempDisp)) if (allocated(InData%TempDisp)) then - call RegPackBounds(RF, 1, lbound(InData%TempDisp, kind=B8Ki), ubound(InData%TempDisp, kind=B8Ki)) - LB(1:1) = lbound(InData%TempDisp, kind=B8Ki) - UB(1:1) = ubound(InData%TempDisp, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%TempDisp), ubound(InData%TempDisp)) + LB(1:1) = lbound(InData%TempDisp) + UB(1:1) = ubound(InData%TempDisp) do i1 = LB(1), UB(1) call MeshPack(RF, InData%TempDisp(i1)) end do end if call RegPack(RF, allocated(InData%TempLoads)) if (allocated(InData%TempLoads)) then - call RegPackBounds(RF, 1, lbound(InData%TempLoads, kind=B8Ki), ubound(InData%TempLoads, kind=B8Ki)) - LB(1:1) = lbound(InData%TempLoads, kind=B8Ki) - UB(1:1) = ubound(InData%TempLoads, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%TempLoads), ubound(InData%TempLoads)) + LB(1:1) = lbound(InData%TempLoads) + UB(1:1) = ubound(InData%TempLoads) do i1 = LB(1), UB(1) call MeshPack(RF, InData%TempLoads(i1)) end do end if call RegPack(RF, allocated(InData%ADRotorDisk)) if (allocated(InData%ADRotorDisk)) then - call RegPackBounds(RF, 1, lbound(InData%ADRotorDisk, kind=B8Ki), ubound(InData%ADRotorDisk, kind=B8Ki)) - LB(1:1) = lbound(InData%ADRotorDisk, kind=B8Ki) - UB(1:1) = ubound(InData%ADRotorDisk, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ADRotorDisk), ubound(InData%ADRotorDisk)) + LB(1:1) = lbound(InData%ADRotorDisk) + UB(1:1) = ubound(InData%ADRotorDisk) do i1 = LB(1), UB(1) call MeshPack(RF, InData%ADRotorDisk(i1)) end do end if call RegPack(RF, allocated(InData%AD_L2L)) if (allocated(InData%AD_L2L)) then - call RegPackBounds(RF, 1, lbound(InData%AD_L2L, kind=B8Ki), ubound(InData%AD_L2L, kind=B8Ki)) - LB(1:1) = lbound(InData%AD_L2L, kind=B8Ki) - UB(1:1) = ubound(InData%AD_L2L, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%AD_L2L), ubound(InData%AD_L2L)) + LB(1:1) = lbound(InData%AD_L2L) + UB(1:1) = ubound(InData%AD_L2L) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%AD_L2L(i1)) end do @@ -656,8 +671,8 @@ subroutine FWrap_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(FWrap_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -722,15 +737,15 @@ subroutine FWrap_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FWrap_CopyParam' ErrStat = ErrID_None ErrMsg = '' DstParamData%nr = SrcParamData%nr if (allocated(SrcParamData%r)) then - LB(1:1) = lbound(SrcParamData%r, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%r, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%r) + UB(1:1) = ubound(SrcParamData%r) if (.not. allocated(DstParamData%r)) then allocate(DstParamData%r(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -772,7 +787,7 @@ subroutine FWrap_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(FWrap_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackParam' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -788,14 +803,14 @@ subroutine FWrap_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FWrap_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%fromSCglob)) then - LB(1:1) = lbound(SrcInputData%fromSCglob, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%fromSCglob, kind=B8Ki) + 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 @@ -806,8 +821,8 @@ subroutine FWrap_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg DstInputData%fromSCglob = SrcInputData%fromSCglob end if if (allocated(SrcInputData%fromSC)) then - LB(1:1) = lbound(SrcInputData%fromSC, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%fromSC, kind=B8Ki) + 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 @@ -848,7 +863,7 @@ subroutine FWrap_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(FWrap_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -862,14 +877,14 @@ subroutine FWrap_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FWrap_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%toSC)) then - LB(1:1) = lbound(SrcOutputData%toSC, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%toSC, kind=B8Ki) + 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 @@ -887,8 +902,8 @@ subroutine FWrap_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%D_rotor = SrcOutputData%D_rotor DstOutputData%DiskAvg_Vx_Rel = SrcOutputData%DiskAvg_Vx_Rel if (allocated(SrcOutputData%AzimAvg_Ct)) then - LB(1:1) = lbound(SrcOutputData%AzimAvg_Ct, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%AzimAvg_Ct, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%AzimAvg_Ct) + UB(1:1) = ubound(SrcOutputData%AzimAvg_Ct) if (.not. allocated(DstOutputData%AzimAvg_Ct)) then allocate(DstOutputData%AzimAvg_Ct(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -899,8 +914,8 @@ subroutine FWrap_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%AzimAvg_Ct = SrcOutputData%AzimAvg_Ct end if if (allocated(SrcOutputData%AzimAvg_Cq)) then - LB(1:1) = lbound(SrcOutputData%AzimAvg_Cq, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%AzimAvg_Cq, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%AzimAvg_Cq) + UB(1:1) = ubound(SrcOutputData%AzimAvg_Cq) if (.not. allocated(DstOutputData%AzimAvg_Cq)) then allocate(DstOutputData%AzimAvg_Cq(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -952,7 +967,7 @@ subroutine FWrap_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(FWrap_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FWrap_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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_Types.f90 b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 index cafbfa0d2f..3597c121b0 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] @@ -212,7 +212,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 @@ -220,8 +221,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_CopyParam' @@ -236,8 +237,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%SC_FileName = SrcParamData%SC_FileName DstParamData%UseSC = SrcParamData%UseSC if (allocated(SrcParamData%WT_Position)) then - LB(1:2) = lbound(SrcParamData%WT_Position, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%WT_Position, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%WT_Position) + UB(1:2) = ubound(SrcParamData%WT_Position) if (.not. allocated(DstParamData%WT_Position)) then allocate(DstParamData%WT_Position(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -253,8 +254,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%DT_mooring = SrcParamData%DT_mooring DstParamData%n_mooring = SrcParamData%n_mooring if (allocated(SrcParamData%WT_FASTInFile)) then - LB(1:1) = lbound(SrcParamData%WT_FASTInFile, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WT_FASTInFile, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WT_FASTInFile) + UB(1:1) = ubound(SrcParamData%WT_FASTInFile) if (.not. allocated(DstParamData%WT_FASTInFile)) then allocate(DstParamData%WT_FASTInFile(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -281,8 +282,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NOutTurb = SrcParamData%NOutTurb DstParamData%NOutRadii = SrcParamData%NOutRadii if (allocated(SrcParamData%OutRadii)) then - LB(1:1) = lbound(SrcParamData%OutRadii, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutRadii, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutRadii) + UB(1:1) = ubound(SrcParamData%OutRadii) if (.not. allocated(DstParamData%OutRadii)) then allocate(DstParamData%OutRadii(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -294,8 +295,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NOutDist = SrcParamData%NOutDist if (allocated(SrcParamData%OutDist)) then - LB(1:1) = lbound(SrcParamData%OutDist, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutDist, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutDist) + UB(1:1) = ubound(SrcParamData%OutDist) if (.not. allocated(DstParamData%OutDist)) then allocate(DstParamData%OutDist(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -307,8 +308,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NWindVel = SrcParamData%NWindVel if (allocated(SrcParamData%WindVelX)) then - LB(1:1) = lbound(SrcParamData%WindVelX, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WindVelX, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WindVelX) + UB(1:1) = ubound(SrcParamData%WindVelX) if (.not. allocated(DstParamData%WindVelX)) then allocate(DstParamData%WindVelX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -319,8 +320,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WindVelX = SrcParamData%WindVelX end if if (allocated(SrcParamData%WindVelY)) then - LB(1:1) = lbound(SrcParamData%WindVelY, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WindVelY, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WindVelY) + UB(1:1) = ubound(SrcParamData%WindVelY) if (.not. allocated(DstParamData%WindVelY)) then allocate(DstParamData%WindVelY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -331,8 +332,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WindVelY = SrcParamData%WindVelY end if if (allocated(SrcParamData%WindVelZ)) then - LB(1:1) = lbound(SrcParamData%WindVelZ, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WindVelZ, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WindVelZ) + UB(1:1) = ubound(SrcParamData%WindVelZ) if (.not. allocated(DstParamData%WindVelZ)) then allocate(DstParamData%WindVelZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -343,8 +344,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WindVelZ = SrcParamData%WindVelZ end if if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + 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 @@ -361,8 +362,8 @@ subroutine Farm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumOuts = SrcParamData%NumOuts DstParamData%NOutSteps = SrcParamData%NOutSteps DstParamData%FileDescLines = SrcParamData%FileDescLines - LB(1:1) = lbound(SrcParamData%Module_Ver, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Module_Ver, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Module_Ver) + UB(1:1) = ubound(SrcParamData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_CopyProgDesc(SrcParamData%Module_Ver(i1), DstParamData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -389,8 +390,8 @@ subroutine Farm_DestroyParam(ParamData, ErrStat, ErrMsg) type(Farm_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_DestroyParam' @@ -418,16 +419,16 @@ subroutine Farm_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%WindVelZ) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(ParamData%OutParam) end if - LB(1:1) = lbound(ParamData%Module_Ver, kind=B8Ki) - UB(1:1) = ubound(ParamData%Module_Ver, kind=B8Ki) + LB(1:1) = lbound(ParamData%Module_Ver) + UB(1:1) = ubound(ParamData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_DestroyProgDesc(ParamData%Module_Ver(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -438,8 +439,8 @@ subroutine Farm_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(Farm_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DT_low) call RegPack(RF, InData%DT_high) @@ -481,9 +482,9 @@ subroutine Farm_PackParam(RF, Indata) call RegPackAlloc(RF, InData%WindVelZ) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + 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 @@ -491,8 +492,8 @@ subroutine Farm_PackParam(RF, Indata) call RegPack(RF, InData%NumOuts) call RegPack(RF, InData%NOutSteps) call RegPack(RF, InData%FileDescLines) - LB(1:1) = lbound(InData%Module_Ver, kind=B8Ki) - UB(1:1) = ubound(InData%Module_Ver, kind=B8Ki) + LB(1:1) = lbound(InData%Module_Ver) + UB(1:1) = ubound(InData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_PackProgDesc(RF, InData%Module_Ver(i1)) end do @@ -518,8 +519,8 @@ subroutine Farm_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(Farm_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -577,8 +578,8 @@ subroutine Farm_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NOutSteps); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%FileDescLines); if (RegCheckErr(RF, RoutineName)) return - LB(1:1) = lbound(OutData%Module_Ver, kind=B8Ki) - UB(1:1) = ubound(OutData%Module_Ver, kind=B8Ki) + LB(1:1) = lbound(OutData%Module_Ver) + UB(1:1) = ubound(OutData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_UnpackProgDesc(RF, OutData%Module_Ver(i1)) ! Module_Ver end do @@ -605,16 +606,16 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) + 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 @@ -625,8 +626,8 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AllOuts = SrcMiscData%AllOuts end if if (allocated(SrcMiscData%TimeData)) then - LB(1:1) = lbound(SrcMiscData%TimeData, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%TimeData, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%TimeData) + UB(1:1) = ubound(SrcMiscData%TimeData) if (.not. allocated(DstMiscData%TimeData)) then allocate(DstMiscData%TimeData(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -637,8 +638,8 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%TimeData = SrcMiscData%TimeData end if if (allocated(SrcMiscData%AllOutData)) then - LB(1:2) = lbound(SrcMiscData%AllOutData, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%AllOutData, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%AllOutData) + UB(1:2) = ubound(SrcMiscData%AllOutData) if (.not. allocated(DstMiscData%AllOutData)) then allocate(DstMiscData%AllOutData(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -650,8 +651,8 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%n_Out = SrcMiscData%n_Out if (allocated(SrcMiscData%FWrap_2_MD)) then - LB(1:1) = lbound(SrcMiscData%FWrap_2_MD, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FWrap_2_MD, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%FWrap_2_MD) + UB(1:1) = ubound(SrcMiscData%FWrap_2_MD) if (.not. allocated(DstMiscData%FWrap_2_MD)) then allocate(DstMiscData%FWrap_2_MD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -666,8 +667,8 @@ subroutine Farm_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%MD_2_FWrap)) then - LB(1:1) = lbound(SrcMiscData%MD_2_FWrap, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%MD_2_FWrap, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%MD_2_FWrap) + UB(1:1) = ubound(SrcMiscData%MD_2_FWrap) if (.not. allocated(DstMiscData%MD_2_FWrap)) then allocate(DstMiscData%MD_2_FWrap(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -687,8 +688,8 @@ subroutine Farm_DestroyMisc(MiscData, ErrStat, ErrMsg) type(Farm_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_DestroyMisc' @@ -704,8 +705,8 @@ subroutine Farm_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%AllOutData) end if if (allocated(MiscData%FWrap_2_MD)) then - LB(1:1) = lbound(MiscData%FWrap_2_MD, kind=B8Ki) - UB(1:1) = ubound(MiscData%FWrap_2_MD, kind=B8Ki) + LB(1:1) = lbound(MiscData%FWrap_2_MD) + UB(1:1) = ubound(MiscData%FWrap_2_MD) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(MiscData%FWrap_2_MD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -713,8 +714,8 @@ subroutine Farm_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%FWrap_2_MD) end if if (allocated(MiscData%MD_2_FWrap)) then - LB(1:1) = lbound(MiscData%MD_2_FWrap, kind=B8Ki) - UB(1:1) = ubound(MiscData%MD_2_FWrap, kind=B8Ki) + LB(1:1) = lbound(MiscData%MD_2_FWrap) + UB(1:1) = ubound(MiscData%MD_2_FWrap) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(MiscData%MD_2_FWrap(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -727,8 +728,8 @@ subroutine Farm_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(Farm_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%AllOuts) call RegPackAlloc(RF, InData%TimeData) @@ -736,18 +737,18 @@ subroutine Farm_PackMisc(RF, Indata) call RegPack(RF, InData%n_Out) call RegPack(RF, allocated(InData%FWrap_2_MD)) if (allocated(InData%FWrap_2_MD)) then - call RegPackBounds(RF, 1, lbound(InData%FWrap_2_MD, kind=B8Ki), ubound(InData%FWrap_2_MD, kind=B8Ki)) - LB(1:1) = lbound(InData%FWrap_2_MD, kind=B8Ki) - UB(1:1) = ubound(InData%FWrap_2_MD, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%FWrap_2_MD), ubound(InData%FWrap_2_MD)) + LB(1:1) = lbound(InData%FWrap_2_MD) + UB(1:1) = ubound(InData%FWrap_2_MD) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%FWrap_2_MD(i1)) end do end if call RegPack(RF, allocated(InData%MD_2_FWrap)) if (allocated(InData%MD_2_FWrap)) then - call RegPackBounds(RF, 1, lbound(InData%MD_2_FWrap, kind=B8Ki), ubound(InData%MD_2_FWrap, kind=B8Ki)) - LB(1:1) = lbound(InData%MD_2_FWrap, kind=B8Ki) - UB(1:1) = ubound(InData%MD_2_FWrap, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MD_2_FWrap), ubound(InData%MD_2_FWrap)) + LB(1:1) = lbound(InData%MD_2_FWrap) + UB(1:1) = ubound(InData%MD_2_FWrap) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%MD_2_FWrap(i1)) end do @@ -759,8 +760,8 @@ subroutine Farm_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(Farm_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1197,8 +1198,8 @@ subroutine Farm_CopyMD_Data(SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_CopyMD_Data' @@ -1223,8 +1224,8 @@ subroutine Farm_CopyMD_Data(SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMD_DataData%Input)) then - LB(1:1) = lbound(SrcMD_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcMD_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcMD_DataData%Input) + UB(1:1) = ubound(SrcMD_DataData%Input) if (.not. allocated(DstMD_DataData%Input)) then allocate(DstMD_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1239,8 +1240,8 @@ subroutine Farm_CopyMD_Data(SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, E end do end if if (allocated(SrcMD_DataData%InputTimes)) then - LB(1:1) = lbound(SrcMD_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcMD_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcMD_DataData%InputTimes) + UB(1:1) = ubound(SrcMD_DataData%InputTimes) if (.not. allocated(DstMD_DataData%InputTimes)) then allocate(DstMD_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1263,8 +1264,8 @@ subroutine Farm_DestroyMD_Data(MD_DataData, ErrStat, ErrMsg) type(MD_Data), intent(inout) :: MD_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_DestroyMD_Data' @@ -1283,8 +1284,8 @@ subroutine Farm_DestroyMD_Data(MD_DataData, ErrStat, ErrMsg) call MD_DestroyInput(MD_DataData%u, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MD_DataData%Input)) then - LB(1:1) = lbound(MD_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(MD_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(MD_DataData%Input) + UB(1:1) = ubound(MD_DataData%Input) do i1 = LB(1), UB(1) call MD_DestroyInput(MD_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1304,8 +1305,8 @@ subroutine Farm_PackMD_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(MD_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackMD_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call MD_PackContState(RF, InData%x) call MD_PackDiscState(RF, InData%xd) @@ -1315,9 +1316,9 @@ subroutine Farm_PackMD_Data(RF, Indata) call MD_PackInput(RF, InData%u) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + 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 MD_PackInput(RF, InData%Input(i1)) end do @@ -1333,8 +1334,8 @@ subroutine Farm_UnPackMD_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(MD_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackMD_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1467,8 +1468,8 @@ subroutine Farm_CopyAll_FastFarm_Data(SrcAll_FastFarm_DataData, DstAll_FastFarm_ integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_CopyAll_FastFarm_Data' @@ -1481,8 +1482,8 @@ subroutine Farm_CopyAll_FastFarm_Data(SrcAll_FastFarm_DataData, DstAll_FastFarm_ call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcAll_FastFarm_DataData%FWrap)) then - LB(1:1) = lbound(SrcAll_FastFarm_DataData%FWrap, kind=B8Ki) - UB(1:1) = ubound(SrcAll_FastFarm_DataData%FWrap, kind=B8Ki) + LB(1:1) = lbound(SrcAll_FastFarm_DataData%FWrap) + UB(1:1) = ubound(SrcAll_FastFarm_DataData%FWrap) if (.not. allocated(DstAll_FastFarm_DataData%FWrap)) then allocate(DstAll_FastFarm_DataData%FWrap(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1497,8 +1498,8 @@ subroutine Farm_CopyAll_FastFarm_Data(SrcAll_FastFarm_DataData, DstAll_FastFarm_ end do end if if (allocated(SrcAll_FastFarm_DataData%WD)) then - LB(1:1) = lbound(SrcAll_FastFarm_DataData%WD, kind=B8Ki) - UB(1:1) = ubound(SrcAll_FastFarm_DataData%WD, kind=B8Ki) + LB(1:1) = lbound(SrcAll_FastFarm_DataData%WD) + UB(1:1) = ubound(SrcAll_FastFarm_DataData%WD) if (.not. allocated(DstAll_FastFarm_DataData%WD)) then allocate(DstAll_FastFarm_DataData%WD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1530,8 +1531,8 @@ subroutine Farm_DestroyAll_FastFarm_Data(All_FastFarm_DataData, ErrStat, ErrMsg) type(All_FastFarm_Data), intent(inout) :: All_FastFarm_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Farm_DestroyAll_FastFarm_Data' @@ -1542,8 +1543,8 @@ subroutine Farm_DestroyAll_FastFarm_Data(All_FastFarm_DataData, ErrStat, ErrMsg) call Farm_DestroyMisc(All_FastFarm_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(All_FastFarm_DataData%FWrap)) then - LB(1:1) = lbound(All_FastFarm_DataData%FWrap, kind=B8Ki) - UB(1:1) = ubound(All_FastFarm_DataData%FWrap, kind=B8Ki) + LB(1:1) = lbound(All_FastFarm_DataData%FWrap) + UB(1:1) = ubound(All_FastFarm_DataData%FWrap) do i1 = LB(1), UB(1) call Farm_DestroyFASTWrapper_Data(All_FastFarm_DataData%FWrap(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1551,8 +1552,8 @@ subroutine Farm_DestroyAll_FastFarm_Data(All_FastFarm_DataData, ErrStat, ErrMsg) deallocate(All_FastFarm_DataData%FWrap) end if if (allocated(All_FastFarm_DataData%WD)) then - LB(1:1) = lbound(All_FastFarm_DataData%WD, kind=B8Ki) - UB(1:1) = ubound(All_FastFarm_DataData%WD, kind=B8Ki) + LB(1:1) = lbound(All_FastFarm_DataData%WD) + UB(1:1) = ubound(All_FastFarm_DataData%WD) do i1 = LB(1), UB(1) call Farm_DestroyWakeDynamics_Data(All_FastFarm_DataData%WD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1573,25 +1574,25 @@ subroutine Farm_PackAll_FastFarm_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(All_FastFarm_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'Farm_PackAll_FastFarm_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call Farm_PackParam(RF, InData%p) call Farm_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%FWrap)) if (allocated(InData%FWrap)) then - call RegPackBounds(RF, 1, lbound(InData%FWrap, kind=B8Ki), ubound(InData%FWrap, kind=B8Ki)) - LB(1:1) = lbound(InData%FWrap, kind=B8Ki) - UB(1:1) = ubound(InData%FWrap, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%FWrap), ubound(InData%FWrap)) + LB(1:1) = lbound(InData%FWrap) + UB(1:1) = ubound(InData%FWrap) do i1 = LB(1), UB(1) call Farm_PackFASTWrapper_Data(RF, InData%FWrap(i1)) end do end if call RegPack(RF, allocated(InData%WD)) if (allocated(InData%WD)) then - call RegPackBounds(RF, 1, lbound(InData%WD, kind=B8Ki), ubound(InData%WD, kind=B8Ki)) - LB(1:1) = lbound(InData%WD, kind=B8Ki) - UB(1:1) = ubound(InData%WD, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%WD), ubound(InData%WD)) + LB(1:1) = lbound(InData%WD) + UB(1:1) = ubound(InData%WD) do i1 = LB(1), UB(1) call Farm_PackWakeDynamics_Data(RF, InData%WD(i1)) end do @@ -1607,8 +1608,8 @@ subroutine Farm_UnPackAll_FastFarm_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(All_FastFarm_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Farm_UnPackAll_FastFarm_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1645,5 +1646,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-cpp/src/OpenFAST.cpp b/glue-codes/openfast-cpp/src/OpenFAST.cpp index 7303f2c3d3..33a534f8dc 100644 --- a/glue-codes/openfast-cpp/src/OpenFAST.cpp +++ b/glue-codes/openfast-cpp/src/OpenFAST.cpp @@ -452,7 +452,7 @@ void fast::OpenFAST::prepareOutputFile(int iTurbLoc) { ncOutVarIDs_["bld_ld"] = tmpVarID; ierr = nc_def_var(ncid, "bld_ld_loc", NC_DOUBLE, 4, bldDataDims.data(), &tmpVarID); ncOutVarIDs_["bld_ld_loc"] = tmpVarID; - ierr = nc_def_var(ncid, "hub_ref_pos", NC_DOUBLE, 2, ptRefDataDims.data(), &tmpVarID); + ierr = nc_def_var(ncid, "hub_ref_pos", NC_DOUBLE, 1, ptRefDataDims.data(), &tmpVarID); ncOutVarIDs_["hub_ref_pos"] = tmpVarID; ierr = nc_def_var(ncid, "hub_disp", NC_DOUBLE, 2, ptDataDims.data(), &tmpVarID); ncOutVarIDs_["hub_disp"] = tmpVarID; @@ -461,7 +461,7 @@ void fast::OpenFAST::prepareOutputFile(int iTurbLoc) { ierr = nc_def_var(ncid, "hub_rotvel", NC_DOUBLE, 2, ptDataDims.data(), &tmpVarID); ncOutVarIDs_["hub_rotvel"] = tmpVarID; - ierr = nc_def_var(ncid, "nac_ref_pos", NC_DOUBLE, 2, ptRefDataDims.data(), &tmpVarID); + ierr = nc_def_var(ncid, "nac_ref_pos", NC_DOUBLE, 1, ptRefDataDims.data(), &tmpVarID); ncOutVarIDs_["nac_ref_pos"] = tmpVarID; ierr = nc_def_var(ncid, "nac_disp", NC_DOUBLE, 2, ptDataDims.data(), &tmpVarID); ncOutVarIDs_["nac_disp"] = tmpVarID; @@ -611,17 +611,6 @@ void fast::OpenFAST::prepareOutputFile(int iTurbLoc) { param_count_dim.data(), tmpArray.data()); } } - - ierr = nc_put_var_double(ncid, ncOutVarIDs_["nac_ref_pos"], - &brFSIData[iTurbLoc][3].nac_ref_pos[0]); - ierr = nc_put_var_double(ncid, ncOutVarIDs_["nac_ref_orient"], - &brFSIData[iTurbLoc][3].nac_ref_pos[3]); - - ierr = nc_put_var_double(ncid, ncOutVarIDs_["hub_ref_pos"], - &brFSIData[iTurbLoc][3].hub_ref_pos[0]); - ierr = nc_put_var_double(ncid, ncOutVarIDs_["hub_ref_orient"], - &brFSIData[iTurbLoc][3].hub_ref_pos[3]); - } ierr = nc_close(ncid); @@ -2378,8 +2367,8 @@ void fast::OpenFAST::get_data_from_openfast(timeStep t) { if (turbineData[iTurb].inflowType == 2) { int nvelpts = get_numVelPtsLoc(iTurb); int nfpts = get_numForcePtsLoc(iTurb); - std::cerr << "nvelpts = " << nvelpts << std::endl; - std::cerr << "nfpts = " << nfpts << " " << get_numForcePtsBladeLoc(iTurb) << " " << get_numForcePtsTwrLoc(iTurb) << std::endl; + // std::cerr << "nvelpts = " << nvelpts << std::endl; + // std::cerr << "nfpts = " << nfpts << " " << get_numForcePtsBladeLoc(iTurb) << " " << get_numForcePtsTwrLoc(iTurb) << std::endl; for (int i=0; i 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 efd0e40ac8..fdb4f5cce9 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) @@ -261,10 +265,69 @@ subroutine Init_InitY(ErrStat3,ErrMsg3) InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units end do ! Version - InitOut%Ver = ADsk_Ver + InitOut%Ver = ADsk_Ver + InitOut%AirDens = p%AirDens 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 786bd089bd..990dfbaafd 100644 --- a/modules/aerodisk/src/AeroDisk_Registry.txt +++ b/modules/aerodisk/src/AeroDisk_Registry.txt @@ -65,7 +65,8 @@ typedef ^ InitInputType FlowFieldType *FlowField - - 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 ReKi AirDens - - - "Air density" "kg/m^3" +typedef ^ InitOutputType ModVarsType Vars - - - "Module variables" - # ..... Inputs .................................................................................................................... # inputs on meshes: NONE @@ -135,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 ecdb52bbe1..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 [-] @@ -86,6 +86,8 @@ MODULE AeroDisk_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 [-] + REAL(ReKi) :: AirDens = 0.0_ReKi !< Air density [kg/m^3] + TYPE(ModVarsType) :: Vars !< Module variables [-] END TYPE ADsk_InitOutputType ! ======================= ! ========= ADsk_InputType ======= @@ -160,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 @@ -170,7 +191,7 @@ subroutine ADsk_CopyAeroTable(SrcAeroTableData, DstAeroTableData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ADsk_CopyAeroTable' ErrStat = ErrID_None @@ -181,8 +202,8 @@ subroutine ADsk_CopyAeroTable(SrcAeroTableData, DstAeroTableData, CtrlCode, ErrS DstAeroTableData%N_Pitch = SrcAeroTableData%N_Pitch DstAeroTableData%N_Skew = SrcAeroTableData%N_Skew if (allocated(SrcAeroTableData%TSR)) then - LB(1:1) = lbound(SrcAeroTableData%TSR, kind=B8Ki) - UB(1:1) = ubound(SrcAeroTableData%TSR, kind=B8Ki) + LB(1:1) = lbound(SrcAeroTableData%TSR) + UB(1:1) = ubound(SrcAeroTableData%TSR) if (.not. allocated(DstAeroTableData%TSR)) then allocate(DstAeroTableData%TSR(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -193,8 +214,8 @@ subroutine ADsk_CopyAeroTable(SrcAeroTableData, DstAeroTableData, CtrlCode, ErrS DstAeroTableData%TSR = SrcAeroTableData%TSR end if if (allocated(SrcAeroTableData%RtSpd)) then - LB(1:1) = lbound(SrcAeroTableData%RtSpd, kind=B8Ki) - UB(1:1) = ubound(SrcAeroTableData%RtSpd, kind=B8Ki) + LB(1:1) = lbound(SrcAeroTableData%RtSpd) + UB(1:1) = ubound(SrcAeroTableData%RtSpd) if (.not. allocated(DstAeroTableData%RtSpd)) then allocate(DstAeroTableData%RtSpd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -205,8 +226,8 @@ subroutine ADsk_CopyAeroTable(SrcAeroTableData, DstAeroTableData, CtrlCode, ErrS DstAeroTableData%RtSpd = SrcAeroTableData%RtSpd end if if (allocated(SrcAeroTableData%VRel)) then - LB(1:1) = lbound(SrcAeroTableData%VRel, kind=B8Ki) - UB(1:1) = ubound(SrcAeroTableData%VRel, kind=B8Ki) + LB(1:1) = lbound(SrcAeroTableData%VRel) + UB(1:1) = ubound(SrcAeroTableData%VRel) if (.not. allocated(DstAeroTableData%VRel)) then allocate(DstAeroTableData%VRel(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -217,8 +238,8 @@ subroutine ADsk_CopyAeroTable(SrcAeroTableData, DstAeroTableData, CtrlCode, ErrS DstAeroTableData%VRel = SrcAeroTableData%VRel end if if (allocated(SrcAeroTableData%Pitch)) then - LB(1:1) = lbound(SrcAeroTableData%Pitch, kind=B8Ki) - UB(1:1) = ubound(SrcAeroTableData%Pitch, kind=B8Ki) + LB(1:1) = lbound(SrcAeroTableData%Pitch) + UB(1:1) = ubound(SrcAeroTableData%Pitch) if (.not. allocated(DstAeroTableData%Pitch)) then allocate(DstAeroTableData%Pitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -229,8 +250,8 @@ subroutine ADsk_CopyAeroTable(SrcAeroTableData, DstAeroTableData, CtrlCode, ErrS DstAeroTableData%Pitch = SrcAeroTableData%Pitch end if if (allocated(SrcAeroTableData%Skew)) then - LB(1:1) = lbound(SrcAeroTableData%Skew, kind=B8Ki) - UB(1:1) = ubound(SrcAeroTableData%Skew, kind=B8Ki) + LB(1:1) = lbound(SrcAeroTableData%Skew) + UB(1:1) = ubound(SrcAeroTableData%Skew) if (.not. allocated(DstAeroTableData%Skew)) then allocate(DstAeroTableData%Skew(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -241,8 +262,8 @@ subroutine ADsk_CopyAeroTable(SrcAeroTableData, DstAeroTableData, CtrlCode, ErrS DstAeroTableData%Skew = SrcAeroTableData%Skew end if if (allocated(SrcAeroTableData%C_Fx)) then - LB(1:5) = lbound(SrcAeroTableData%C_Fx, kind=B8Ki) - UB(1:5) = ubound(SrcAeroTableData%C_Fx, kind=B8Ki) + LB(1:5) = lbound(SrcAeroTableData%C_Fx) + UB(1:5) = ubound(SrcAeroTableData%C_Fx) if (.not. allocated(DstAeroTableData%C_Fx)) then allocate(DstAeroTableData%C_Fx(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -253,8 +274,8 @@ subroutine ADsk_CopyAeroTable(SrcAeroTableData, DstAeroTableData, CtrlCode, ErrS DstAeroTableData%C_Fx = SrcAeroTableData%C_Fx end if if (allocated(SrcAeroTableData%C_Fy)) then - LB(1:5) = lbound(SrcAeroTableData%C_Fy, kind=B8Ki) - UB(1:5) = ubound(SrcAeroTableData%C_Fy, kind=B8Ki) + LB(1:5) = lbound(SrcAeroTableData%C_Fy) + UB(1:5) = ubound(SrcAeroTableData%C_Fy) if (.not. allocated(DstAeroTableData%C_Fy)) then allocate(DstAeroTableData%C_Fy(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -265,8 +286,8 @@ subroutine ADsk_CopyAeroTable(SrcAeroTableData, DstAeroTableData, CtrlCode, ErrS DstAeroTableData%C_Fy = SrcAeroTableData%C_Fy end if if (allocated(SrcAeroTableData%C_Fz)) then - LB(1:5) = lbound(SrcAeroTableData%C_Fz, kind=B8Ki) - UB(1:5) = ubound(SrcAeroTableData%C_Fz, kind=B8Ki) + LB(1:5) = lbound(SrcAeroTableData%C_Fz) + UB(1:5) = ubound(SrcAeroTableData%C_Fz) if (.not. allocated(DstAeroTableData%C_Fz)) then allocate(DstAeroTableData%C_Fz(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -277,8 +298,8 @@ subroutine ADsk_CopyAeroTable(SrcAeroTableData, DstAeroTableData, CtrlCode, ErrS DstAeroTableData%C_Fz = SrcAeroTableData%C_Fz end if if (allocated(SrcAeroTableData%C_Mx)) then - LB(1:5) = lbound(SrcAeroTableData%C_Mx, kind=B8Ki) - UB(1:5) = ubound(SrcAeroTableData%C_Mx, kind=B8Ki) + LB(1:5) = lbound(SrcAeroTableData%C_Mx) + UB(1:5) = ubound(SrcAeroTableData%C_Mx) if (.not. allocated(DstAeroTableData%C_Mx)) then allocate(DstAeroTableData%C_Mx(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -289,8 +310,8 @@ subroutine ADsk_CopyAeroTable(SrcAeroTableData, DstAeroTableData, CtrlCode, ErrS DstAeroTableData%C_Mx = SrcAeroTableData%C_Mx end if if (allocated(SrcAeroTableData%C_My)) then - LB(1:5) = lbound(SrcAeroTableData%C_My, kind=B8Ki) - UB(1:5) = ubound(SrcAeroTableData%C_My, kind=B8Ki) + LB(1:5) = lbound(SrcAeroTableData%C_My) + UB(1:5) = ubound(SrcAeroTableData%C_My) if (.not. allocated(DstAeroTableData%C_My)) then allocate(DstAeroTableData%C_My(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -301,8 +322,8 @@ subroutine ADsk_CopyAeroTable(SrcAeroTableData, DstAeroTableData, CtrlCode, ErrS DstAeroTableData%C_My = SrcAeroTableData%C_My end if if (allocated(SrcAeroTableData%C_Mz)) then - LB(1:5) = lbound(SrcAeroTableData%C_Mz, kind=B8Ki) - UB(1:5) = ubound(SrcAeroTableData%C_Mz, kind=B8Ki) + LB(1:5) = lbound(SrcAeroTableData%C_Mz) + UB(1:5) = ubound(SrcAeroTableData%C_Mz) if (.not. allocated(DstAeroTableData%C_Mz)) then allocate(DstAeroTableData%C_Mz(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -384,7 +405,7 @@ subroutine ADsk_UnPackAeroTable(RF, OutData) type(RegFile), intent(inout) :: RF type(ADsk_AeroTable), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADsk_UnPackAeroTable' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -412,7 +433,7 @@ subroutine ADsk_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADsk_CopyInputFile' @@ -425,8 +446,8 @@ subroutine ADsk_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%SumPrint = SrcInputFileData%SumPrint DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -477,7 +498,7 @@ subroutine ADsk_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(ADsk_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADsk_UnPackInputFile' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -497,7 +518,7 @@ subroutine ADsk_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADsk_CopyInitInput' @@ -560,7 +581,7 @@ subroutine ADsk_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(ADsk_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADsk_UnPackInitInput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -601,15 +622,15 @@ subroutine ADsk_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADsk_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -620,8 +641,8 @@ subroutine ADsk_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -634,6 +655,10 @@ subroutine ADsk_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%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) @@ -653,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) @@ -663,6 +690,8 @@ subroutine ADsk_PackInitOutput(RF, Indata) call RegPackAlloc(RF, InData%WriteOutputHdr) 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 @@ -670,13 +699,15 @@ subroutine ADsk_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ADsk_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADsk_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc 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 + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine ADsk_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) @@ -737,7 +768,7 @@ subroutine ADsk_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADsk_CopyOutput' @@ -753,8 +784,8 @@ subroutine ADsk_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Ct = SrcOutputData%Ct DstOutputData%Cq = SrcOutputData%Cq if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -802,7 +833,7 @@ subroutine ADsk_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ADsk_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADsk_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -974,8 +1005,8 @@ subroutine ADsk_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADsk_CopyParam' @@ -992,8 +1023,8 @@ subroutine ADsk_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return DstParamData%UseTSR = SrcParamData%UseTSR if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + 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 @@ -1009,8 +1040,8 @@ subroutine ADsk_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%FlowField => SrcParamData%FlowField if (allocated(SrcParamData%DiskWindPosRel)) then - LB(1:2) = lbound(SrcParamData%DiskWindPosRel, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%DiskWindPosRel, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%DiskWindPosRel) + UB(1:2) = ubound(SrcParamData%DiskWindPosRel) if (.not. allocated(DstParamData%DiskWindPosRel)) then allocate(DstParamData%DiskWindPosRel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1026,8 +1057,8 @@ subroutine ADsk_DestroyParam(ParamData, ErrStat, ErrMsg) type(ADsk_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADsk_DestroyParam' @@ -1036,8 +1067,8 @@ subroutine ADsk_DestroyParam(ParamData, ErrStat, ErrMsg) call ADsk_DestroyAeroTable(ParamData%AeroTable, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + 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) @@ -1054,8 +1085,8 @@ subroutine ADsk_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(ADsk_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADsk_PackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%RootName) @@ -1068,9 +1099,9 @@ subroutine ADsk_PackParam(RF, Indata) call RegPack(RF, InData%UseTSR) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + 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 @@ -1090,8 +1121,8 @@ subroutine ADsk_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(ADsk_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADsk_UnPackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1140,20 +1171,21 @@ 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(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADsk_CopyMisc' ErrStat = ErrID_None ErrMsg = '' DstMiscData%idx_last = SrcMiscData%idx_last if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) + 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 @@ -1175,8 +1207,8 @@ subroutine ADsk_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Force = SrcMiscData%Force DstMiscData%Moment = SrcMiscData%Moment if (allocated(SrcMiscData%DiskWindPosAbs)) then - LB(1:2) = lbound(SrcMiscData%DiskWindPosAbs, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%DiskWindPosAbs, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%DiskWindPosAbs) + UB(1:2) = ubound(SrcMiscData%DiskWindPosAbs) if (.not. allocated(DstMiscData%DiskWindPosAbs)) then allocate(DstMiscData%DiskWindPosAbs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1187,8 +1219,8 @@ subroutine ADsk_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DiskWindPosAbs = SrcMiscData%DiskWindPosAbs end if if (allocated(SrcMiscData%DiskWindVel)) then - LB(1:2) = lbound(SrcMiscData%DiskWindVel, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%DiskWindVel, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%DiskWindVel) + UB(1:2) = ubound(SrcMiscData%DiskWindVel) if (.not. allocated(DstMiscData%DiskWindVel)) then allocate(DstMiscData%DiskWindVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1199,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 = '' @@ -1217,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) @@ -1240,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 @@ -1247,7 +1311,7 @@ subroutine ADsk_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(ADsk_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADsk_UnPackMisc' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1267,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) @@ -1606,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/python-lib/aerodyn_inflow_library.py b/modules/aerodyn/python-lib/aerodyn_inflow_library.py index add1bcf5ac..fe3cf33d9d 100644 --- a/modules/aerodyn/python-lib/aerodyn_inflow_library.py +++ b/modules/aerodyn/python-lib/aerodyn_inflow_library.py @@ -2,7 +2,7 @@ # LICENSING # Copyright (C) 2021 National Renewable Energy Laboratory # -# This file is part of InflowWind. +# 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. @@ -101,6 +101,7 @@ def __init__(self, library_path): # flags self.storeHHVel = 1 # 0=false, 1=true self.transposeDCM= 1 # 0=false, 1=true + self.pointLoadOut= 1 # 0=false, 1=true self.debuglevel = 0 # 0-4 levels # VTK @@ -162,6 +163,7 @@ def _initialize_routines(self): self.ADI_C_PreInit.argtypes = [ POINTER(c_int), # numTurbines POINTER(c_int), # transposeDCM + POINTER(c_int), # pointLoadOutput POINTER(c_int), # debuglevel POINTER(c_int), # ErrStat_C POINTER(c_char) # ErrMsg_C @@ -258,6 +260,7 @@ def _initialize_routines(self): POINTER(c_int), # iturb POINTER(c_int), # numMeshPts POINTER(c_float), # meshFrc -- mesh forces/moments in flat array of 6*numMeshPts + POINTER(c_float), # hhVel -- wind speed at hub height in flat array of 3 POINTER(c_int), # ErrStat_C POINTER(c_char) # ErrMsg_C ] @@ -295,6 +298,7 @@ def adi_preinit(self): self.ADI_C_PreInit( byref(c_int(self.numTurbines)), # IN: numTurbines byref(c_int(self.transposeDCM)), # IN: transposeDCM + byref(c_int(self.pointLoadOut)), # IN: pointLoadOut byref(c_int(self.debuglevel)), # IN: debuglevel byref(self.error_status_c), # OUT: ErrStat_C self.error_message_c # OUT: ErrMsg_C @@ -487,15 +491,17 @@ def adi_setrotormotion(self, iturb, \ # adi_calcOutput ------------------------------------------------------------------------------------------------------------ - def adi_getrotorloads(self, iturb, meshFrcMom): + def adi_getrotorloads(self, iturb, meshFrcMom, hhVel=None): # Resulting Forces/moments -- [Fx1,Fy1,Fz1,Mx1,My1,Mz1, Fx2,Fy2,Fz2,Mx2,My2,Mz2 ...] _meshFrc_flat_c = (c_float * (6 * self.numMeshPts))(0.0,) + _hhVel_flat_c = (c_float * 3)(0.0,) # Run ADI_C_GetRotorLoads self.ADI_C_GetRotorLoads( c_int(iturb), # IN: iturb -- current turbine number byref(c_int(self.numMeshPts)), # IN: number of attachment points expected (where motions are transferred into HD) _meshFrc_flat_c, # OUT: resulting forces/moments array + _hhVel_flat_c, # OUT: hub height velocity [Vx, Vy, Vz] byref(self.error_status_c), # OUT: ErrStat_C self.error_message_c # OUT: ErrMsg_C ) @@ -513,6 +519,11 @@ def adi_getrotorloads(self, iturb, meshFrcMom): meshFrcMom[j,5] = _meshFrc_flat_c[count+5] count = count + 6 + ## Hub height wind speed + if self.storeHHVel and hhVel != None: + hhVel[0] = _hhVel_flat_c[0] + hhVel[1] = _hhVel_flat_c[1] + hhVel[2] = _hhVel_flat_c[2] # adi_calcOutput ------------------------------------------------------------------------------------------------------------ def adi_calcOutput(self, time, outputChannelValues): diff --git a/modules/aerodyn/src/AeroAcoustics.f90 b/modules/aerodyn/src/AeroAcoustics.f90 index bd2650d49a..968693f6a1 100644 --- a/modules/aerodyn/src/AeroAcoustics.f90 +++ b/modules/aerodyn/src/AeroAcoustics.f90 @@ -177,17 +177,10 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) p%SpdSound = InitInp%SpdSound p%HubHeight = InitInp%HubHeight p%Lturb = InputFileData%Lturb - p%dy_turb_in = InputFileData%dy_turb_in - p%dz_turb_in = InputFileData%dz_turb_in p%NrObsLoc = InputFileData%NrObsLoc p%FTitle = InputFileData%FTitle - - IF ((InputFileData%TICalcMeth==1)) THEN - call AllocAry(p%TI_Grid_In,size(InputFileData%TI_Grid_In,1), size(InputFileData%TI_Grid_In,2), 'p%TI_Grid_In', errStat2, errMsg2); if(Failed()) return - p%TI_Grid_In=InputFileData%TI_Grid_In - ENDIF - - p%AvgV=InputFileData%AvgV + p%TI = InputFileData%TI + p%avgV = InputFileData%avgV ! Copy AFInfo into AA module ! TODO Allocate AFInfo and AFindx variables (DONE AND DONE) @@ -733,30 +726,9 @@ subroutine AA_UpdateStates( t, n, m, u, p, xd, errStat, errMsg ) ELSE! interpolate from the user given ti values do i=1,p%NumBlades do j=1,p%NumBlNds - zi_a=ABS(m%LE_Location(3,j,i) - (FLOOR(p%HubHeight-maxval(p%BlSpn(:,1)))) ) /p%dz_turb_in - z0_a=floor(zi_a) - z1_a=ceiling(zi_a) - zd_a=zi_a-z0_a - yi_a=ABS(m%LE_Location(2,j,i) + maxval(p%BlSpn(:,1)) ) /p%dy_turb_in - y0_a=floor(yi_a) - y1_a=ceiling(yi_a) - yd_a=yi_a-y0_a - c00_a=(1.0_ReKi-yd_a)*p%TI_Grid_In(z0_a+1,y0_a+1)+yd_a*p%TI_Grid_In(z0_a+1,y1_a+1) - c10_a=(1.0_ReKi-yd_a)*p%TI_Grid_In(z1_a+1,y0_a+1)+yd_a*p%TI_Grid_In(z1_a+1,y1_a+1) - - ! This is the turbulence intensity of the wind at the location of the blade i at node j - ti_vx = (1.0_ReKi-zd_a)*c00_a+zd_a*c10_a - ! With some velocity triangles, we convert it into the incident turbulence intensity, i.e. the TI used by the Amiet model - U1 = u%Vrel(J,I) - U2 = SQRT((p%AvgV*(1.+ti_vx))**2 + U1**2 - p%AvgV**2) - ! xd%TIVx(j,i)=(U2-U1)/U1 - xd%TIVx(j,i)=p%AvgV*ti_vx/U1 - - - if (i.eq.p%NumBlades) then - if (j.eq.p%NumBlNds) then - endif - endif + ! We scale the incident turbulence intensity by the ratio of average to incident wind speed + ! The scaled TI is used by the Amiet model + xd%TIVx(j,i)=p%TI*p%avgV/u%Vrel(J,I) enddo enddo endif diff --git a/modules/aerodyn/src/AeroAcoustics_IO.f90 b/modules/aerodyn/src/AeroAcoustics_IO.f90 index 28679b5992..7e6affa37e 100644 --- a/modules/aerodyn/src/AeroAcoustics_IO.f90 +++ b/modules/aerodyn/src/AeroAcoustics_IO.f90 @@ -94,10 +94,6 @@ SUBROUTINE ReadInputFiles( InputFileName, AFI, InputFileData, Default_DT, OutFil if (Failed())return endif - IF( (InputFileData%TICalcMeth==1) ) THEN - CALL REadTICalcTables(InputFileName,InputFileData, ErrStat2, ErrMsg2); if(Failed()) return - ENDIF - CONTAINS logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -203,7 +199,8 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, Default_DT, OutFileRoot, U CALL ReadCom( UnIn, InputFile, 'Section Header: Aeroacoustic Models', ErrStat2, ErrMsg2, UnEc ); call check() CALL ReadVar(UnIn,InputFile,InputFileData%IInflow ,"InflowMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() CALL ReadVar(UnIn,InputFile,InputFileData%TICalcMeth ,"TICalcMeth" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() - CALL ReadVAr(UnIn,InputFile,InputFileData%TICalcTabFile,"TICalcTabFile","" ,ErrStat2,ErrMsg2,UnEc); call check() + CALL ReadVAr(UnIn,InputFile,InputFileData%TI ,"TI" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() + CALL ReadVAr(UnIn,InputFile,InputFileData%avgV ,"avgV" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() CALL ReadVar(UnIn,InputFile,InputFileData%Lturb ,"Lturb" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() CALL ReadVar(UnIn,InputFile,InputFileData%ITURB ,"TurbMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() ! ITURB - TBLTE NOISE CALL ReadVar(UnIn,InputFile,InputFileData%X_BLMethod ,"BLMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check() @@ -423,66 +420,6 @@ SUBROUTINE Cleanup() END SUBROUTINE Cleanup END SUBROUTINE ReadBLTables !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadTICalcTables(InputFile, InputFileData, ErrStat, ErrMsg) - ! Passed variables - integer(IntKi), intent(out) :: ErrStat ! Error status - character(*), intent(out) :: ErrMsg ! Error message - type(AA_InputFile), intent(inout) :: InputFileData ! All the data in the Noise input file - character(*), intent(in) :: InputFile ! Name of the file containing the primary input data - ! Local variables: - integer(IntKi) :: UnIn ! Unit number for reading file - character(1024) :: FileName ! name of the files containing obesever location - integer(IntKi) :: ErrStat2 ! Temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message - character(1024) :: PriPath ! Path name of the primary file - character(*), parameter :: RoutineName = 'REadTICalcTables' - integer(IntKi) :: GridY ! - integer(IntKi) :: GridZ ! - integer(IntKi) :: cou1 - ! Initialize some variables: - ErrStat = ErrID_None - ErrMsg = "" - - CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - FileName = TRIM(PriPath)//InputFileData%TICalcTabFile - - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2); call check() - CALL OpenFInpFile ( UnIn, FileName, ErrStat2, ErrMsg2 ); if(Failed()) return - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check() - CALL ReadVar(UnIn, FileName, InputFileData%AvgV, 'AvgV', 'Echo flag', ErrStat2, ErrMsg2); call check() - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check() - CALL ReadVar(UnIn, FileName, GridY, 'GridY', 'Echo flag', ErrStat2, ErrMsg2); call check() - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2);call check() - CALL ReadVar(UnIn, FileName, GridZ, 'GridZ', 'Echo flag', ErrStat2, ErrMsg2); call check() - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check() - CALL ReadVar(UnIn, FileName, InputFileData%dy_turb_in, 'InputFileData%dy_turb_in', 'Echo flag', ErrStat2, ErrMsg2); call check() - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check() - CALL ReadVar(UnIn, FileName, InputFileData%dz_turb_in, 'InputFileData%dz_turb_in', 'Echo flag', ErrStat2, ErrMsg2); call check() - if(Failed()) return - - CALL AllocAry( InputFileData%TI_Grid_In,GridZ,GridY,'InputFileData%TI_Grid_In', ErrStat2, ErrMsg2); - if(Failed()) return - DO cou1=1,size(InputFileData%TI_Grid_In,1) - read(UnIn,*) InputFileData%TI_Grid_In(cou1,:) - ENDDO - !---------------------- END OF FILE ----------------------------------------- - CALL Cleanup( ) - -CONTAINS - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - if(Failed) call cleanup() - end function Failed - SUBROUTINE Check() - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Check - SUBROUTINE Cleanup() - IF (UnIn > 0) CLOSE ( UnIn ) - END SUBROUTINE Cleanup -END SUBROUTINE REadTICalcTables -!---------------------------------------------------------------------------------------------------------------------------------- !> This routine validates the inputs from the AeroDyn input files. SUBROUTINE ValidateInputData( InputFileData, NumBl, ErrStat, ErrMsg ) type(AA_InputFile), intent(in) :: InputFileData !< All the data in the AeroDyn input file diff --git a/modules/aerodyn/src/AeroAcoustics_Registry.txt b/modules/aerodyn/src/AeroAcoustics_Registry.txt index a0c314e776..b01f3061dc 100644 --- a/modules/aerodyn/src/AeroAcoustics_Registry.txt +++ b/modules/aerodyn/src/AeroAcoustics_Registry.txt @@ -74,11 +74,11 @@ typedef ^ AA_InputFile ReKi ObsZ typedef ^ AA_InputFile AA_BladePropsType BladeProps {:} - - "blade property information from blade input files" - typedef ^ AA_InputFile IntKi NrOutFile - - - "Nr of output files" - typedef ^ AA_InputFile CHARACTER(1024) AAoutfile {:} - - "AAoutfile for writing output files" - -typedef ^ AA_InputFile CHARACTER(1024) TICalcTabFile - - - "Name of the file containing the table for incident turbulence intensity" - typedef ^ AA_InputFile CHARACTER(1024) FTitle - - - "File Title: the 2nd line of the input file, which contains a description of its contents" - typedef ^ AA_InputFile DBKi AAStart - - - "Time after which to calculate AA" s +typedef ^ AA_InputFile ReKi TI - - - "Average rotor incident turbulence intensity" - +typedef ^ AA_InputFile ReKi avgV - - - "Average wind speed" - typedef ^ AA_InputFile ReKi Lturb - - - "Turbulent lengthscale in Amiet model" - -typedef ^ AA_InputFile ReKi AvgV - - - "Average wind speed to compute incident turbulence intensity" m typedef ^ AA_InputFile ReKi ReListBL {:} - - "" typedef ^ AA_InputFile ReKi AoAListBL {:} - - "" deg typedef ^ AA_InputFile ReKi Pres_DispThick {:}{:}{:} - - "" @@ -89,9 +89,6 @@ typedef ^ AA_InputFile ReKi Pres_Cf typedef ^ AA_InputFile ReKi Suct_Cf {:}{:}{:} - - "" typedef ^ AA_InputFile ReKi Pres_EdgeVelRat {:}{:}{:} - - "" typedef ^ AA_InputFile ReKi Suct_EdgeVelRat {:}{:}{:} - - "" -typedef ^ AA_InputFile ReKi TI_Grid_In {:}{:} - - "" -typedef ^ AA_InputFile ReKi dz_turb_in - - - "" m -typedef ^ AA_InputFile ReKi dy_turb_in - - - "" m # ..... States .................................................................................................................... # Define continuous (differentiable) states here: @@ -184,10 +181,8 @@ typedef ^ ParameterType IntKi total_s typedef ^ ParameterType IntKi AA_Bl_Prcntge - - - "The Percentage of the Blade which the noise is calculated" % typedef ^ ParameterType IntKi startnode - - - "Corersponding node to the noise calculation percentage of the blade" - typedef ^ ParameterType ReKi Lturb - - - "Turbulent lengthscale in Amiet model" m -typedef ^ ParameterType ReKi AvgV - - - "Average wind speed to compute incident turbulence intensity" m -typedef ^ ParameterType ReKi dz_turb_in - - - "" m -typedef ^ ParameterType ReKi dy_turb_in - - - "" m -typedef ^ ParameterType ReKi TI_Grid_In {:}{:} - - "" +typedef ^ ParameterType ReKi avgV - - - "Average wind speed to compute incident turbulence intensity" m +typedef ^ ParameterType ReKi TI - - - "Rotor incident turbulent intensity" typedef ^ ParameterType CHARACTER(1024) FTitle - - - "File Title: the 2nd line of the input file, which contains a description of its contents" - # parameters for output diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 5829bb13f3..fe8bb54fcf 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -94,11 +94,11 @@ MODULE AeroAcoustics_Types TYPE(AA_BladePropsType) , DIMENSION(:), ALLOCATABLE :: BladeProps !< blade property information from blade input files [-] INTEGER(IntKi) :: NrOutFile = 0_IntKi !< Nr of output files [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: AAoutfile !< AAoutfile for writing output files [-] - CHARACTER(1024) :: TICalcTabFile !< Name of the file containing the table for incident turbulence intensity [-] CHARACTER(1024) :: FTitle !< File Title: the 2nd line of the input file, which contains a description of its contents [-] REAL(DbKi) :: AAStart = 0.0_R8Ki !< Time after which to calculate AA [s] + REAL(ReKi) :: TI = 0.0_ReKi !< Average rotor incident turbulence intensity [-] + REAL(ReKi) :: avgV = 0.0_ReKi !< Average wind speed [-] REAL(ReKi) :: Lturb = 0.0_ReKi !< Turbulent lengthscale in Amiet model [-] - REAL(ReKi) :: AvgV = 0.0_ReKi !< Average wind speed to compute incident turbulence intensity [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ReListBL !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AoAListBL !< [deg] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Pres_DispThick !< [-] @@ -109,9 +109,6 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Suct_Cf !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Pres_EdgeVelRat !< [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Suct_EdgeVelRat !< [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI_Grid_In !< [-] - REAL(ReKi) :: dz_turb_in = 0.0_ReKi !< [m] - REAL(ReKi) :: dy_turb_in = 0.0_ReKi !< [m] END TYPE AA_InputFile ! ======================= ! ========= AA_ContinuousStateType ======= @@ -212,10 +209,8 @@ MODULE AeroAcoustics_Types INTEGER(IntKi) :: AA_Bl_Prcntge = 0_IntKi !< The Percentage of the Blade which the noise is calculated [%] INTEGER(IntKi) :: startnode = 0_IntKi !< Corersponding node to the noise calculation percentage of the blade [-] REAL(ReKi) :: Lturb = 0.0_ReKi !< Turbulent lengthscale in Amiet model [m] - REAL(ReKi) :: AvgV = 0.0_ReKi !< Average wind speed to compute incident turbulence intensity [m] - REAL(ReKi) :: dz_turb_in = 0.0_ReKi !< [m] - REAL(ReKi) :: dy_turb_in = 0.0_ReKi !< [m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI_Grid_In !< [-] + REAL(ReKi) :: avgV = 0.0_ReKi !< Average wind speed to compute incident turbulence intensity [m] + REAL(ReKi) :: TI = 0.0_ReKi !< Rotor incident turbulent intensity [-] CHARACTER(1024) :: FTitle !< File Title: the 2nd line of the input file, which contains a description of its contents [-] character(20) :: outFmt !< Format specifier [-] INTEGER(IntKi) :: NrOutFile = 0_IntKi !< Nr of output files [-] @@ -277,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 @@ -326,8 +340,8 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_CopyInitInput' @@ -338,8 +352,8 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%NumBlNds = SrcInitInputData%NumBlNds DstInitInputData%RootName = SrcInitInputData%RootName if (allocated(SrcInitInputData%BlSpn)) then - LB(1:2) = lbound(SrcInitInputData%BlSpn, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%BlSpn, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%BlSpn) + UB(1:2) = ubound(SrcInitInputData%BlSpn) if (.not. allocated(DstInitInputData%BlSpn)) then allocate(DstInitInputData%BlSpn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -350,8 +364,8 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%BlSpn = SrcInitInputData%BlSpn end if if (allocated(SrcInitInputData%BlChord)) then - LB(1:2) = lbound(SrcInitInputData%BlChord, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%BlChord, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%BlChord) + UB(1:2) = ubound(SrcInitInputData%BlChord) if (.not. allocated(DstInitInputData%BlChord)) then allocate(DstInitInputData%BlChord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -366,8 +380,8 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%SpdSound = SrcInitInputData%SpdSound DstInitInputData%HubHeight = SrcInitInputData%HubHeight if (allocated(SrcInitInputData%BlAFID)) then - LB(1:2) = lbound(SrcInitInputData%BlAFID, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%BlAFID, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%BlAFID) + UB(1:2) = ubound(SrcInitInputData%BlAFID) if (.not. allocated(DstInitInputData%BlAFID)) then allocate(DstInitInputData%BlAFID(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -378,8 +392,8 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%BlAFID = SrcInitInputData%BlAFID end if if (allocated(SrcInitInputData%AFInfo)) then - LB(1:1) = lbound(SrcInitInputData%AFInfo, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%AFInfo, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%AFInfo) + UB(1:1) = ubound(SrcInitInputData%AFInfo) if (.not. allocated(DstInitInputData%AFInfo)) then allocate(DstInitInputData%AFInfo(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -399,8 +413,8 @@ subroutine AA_DestroyInitInput(InitInputData, ErrStat, ErrMsg) type(AA_InitInputType), intent(inout) :: InitInputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_DestroyInitInput' @@ -416,8 +430,8 @@ subroutine AA_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%BlAFID) end if if (allocated(InitInputData%AFInfo)) then - LB(1:1) = lbound(InitInputData%AFInfo, kind=B8Ki) - UB(1:1) = ubound(InitInputData%AFInfo, kind=B8Ki) + LB(1:1) = lbound(InitInputData%AFInfo) + UB(1:1) = ubound(InitInputData%AFInfo) do i1 = LB(1), UB(1) call AFI_DestroyParam(InitInputData%AFInfo(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -430,8 +444,8 @@ subroutine AA_PackInitInput(RF, Indata) type(RegFile), intent(inout) :: RF type(AA_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackInitInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%InputFile) call RegPack(RF, InData%NumBlades) @@ -446,9 +460,9 @@ subroutine AA_PackInitInput(RF, Indata) call RegPackAlloc(RF, InData%BlAFID) call RegPack(RF, allocated(InData%AFInfo)) if (allocated(InData%AFInfo)) then - call RegPackBounds(RF, 1, lbound(InData%AFInfo, kind=B8Ki), ubound(InData%AFInfo, kind=B8Ki)) - LB(1:1) = lbound(InData%AFInfo, kind=B8Ki) - UB(1:1) = ubound(InData%AFInfo, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) + LB(1:1) = lbound(InData%AFInfo) + UB(1:1) = ubound(InData%AFInfo) do i1 = LB(1), UB(1) call AFI_PackParam(RF, InData%AFInfo(i1)) end do @@ -460,8 +474,8 @@ subroutine AA_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackInitInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -497,15 +511,15 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -516,8 +530,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -528,8 +542,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt end if if (allocated(SrcInitOutputData%WriteOutputHdrforPE)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrforPE, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrforPE, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrforPE) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrforPE) if (.not. allocated(DstInitOutputData%WriteOutputHdrforPE)) then allocate(DstInitOutputData%WriteOutputHdrforPE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -540,8 +554,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdrforPE = SrcInitOutputData%WriteOutputHdrforPE end if if (allocated(SrcInitOutputData%WriteOutputUntforPE)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntforPE, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntforPE, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntforPE) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntforPE) if (.not. allocated(DstInitOutputData%WriteOutputUntforPE)) then allocate(DstInitOutputData%WriteOutputUntforPE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -552,8 +566,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputUntforPE = SrcInitOutputData%WriteOutputUntforPE end if if (allocated(SrcInitOutputData%WriteOutputHdrSep)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrSep, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrSep, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrSep) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrSep) if (.not. allocated(DstInitOutputData%WriteOutputHdrSep)) then allocate(DstInitOutputData%WriteOutputHdrSep(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -564,8 +578,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdrSep = SrcInitOutputData%WriteOutputHdrSep end if if (allocated(SrcInitOutputData%WriteOutputUntSep)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntSep, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntSep, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntSep) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntSep) if (.not. allocated(DstInitOutputData%WriteOutputUntSep)) then allocate(DstInitOutputData%WriteOutputUntSep(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -576,8 +590,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputUntSep = SrcInitOutputData%WriteOutputUntSep end if if (allocated(SrcInitOutputData%WriteOutputHdrNodes)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrNodes, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrNodes, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdrNodes) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdrNodes) if (.not. allocated(DstInitOutputData%WriteOutputHdrNodes)) then allocate(DstInitOutputData%WriteOutputHdrNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -588,8 +602,8 @@ subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdrNodes = SrcInitOutputData%WriteOutputHdrNodes end if if (allocated(SrcInitOutputData%WriteOutputUntNodes)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntNodes, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntNodes, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUntNodes) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUntNodes) if (.not. allocated(DstInitOutputData%WriteOutputUntNodes)) then allocate(DstInitOutputData%WriteOutputUntNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -666,7 +680,7 @@ subroutine AA_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -689,8 +703,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_CopyInputFile' @@ -712,8 +726,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%AA_Bl_Prcntge = SrcInputFileData%AA_Bl_Prcntge DstInputFileData%NrObsLoc = SrcInputFileData%NrObsLoc if (allocated(SrcInputFileData%ObsX)) then - LB(1:1) = lbound(SrcInputFileData%ObsX, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%ObsX, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%ObsX) + UB(1:1) = ubound(SrcInputFileData%ObsX) if (.not. allocated(DstInputFileData%ObsX)) then allocate(DstInputFileData%ObsX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -724,8 +738,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%ObsX = SrcInputFileData%ObsX end if if (allocated(SrcInputFileData%ObsY)) then - LB(1:1) = lbound(SrcInputFileData%ObsY, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%ObsY, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%ObsY) + UB(1:1) = ubound(SrcInputFileData%ObsY) if (.not. allocated(DstInputFileData%ObsY)) then allocate(DstInputFileData%ObsY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -736,8 +750,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%ObsY = SrcInputFileData%ObsY end if if (allocated(SrcInputFileData%ObsZ)) then - LB(1:1) = lbound(SrcInputFileData%ObsZ, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%ObsZ, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%ObsZ) + UB(1:1) = ubound(SrcInputFileData%ObsZ) if (.not. allocated(DstInputFileData%ObsZ)) then allocate(DstInputFileData%ObsZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -748,8 +762,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%ObsZ = SrcInputFileData%ObsZ end if if (allocated(SrcInputFileData%BladeProps)) then - LB(1:1) = lbound(SrcInputFileData%BladeProps, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%BladeProps, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%BladeProps) + UB(1:1) = ubound(SrcInputFileData%BladeProps) if (.not. allocated(DstInputFileData%BladeProps)) then allocate(DstInputFileData%BladeProps(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -765,8 +779,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if DstInputFileData%NrOutFile = SrcInputFileData%NrOutFile if (allocated(SrcInputFileData%AAoutfile)) then - LB(1:1) = lbound(SrcInputFileData%AAoutfile, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%AAoutfile, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%AAoutfile) + UB(1:1) = ubound(SrcInputFileData%AAoutfile) if (.not. allocated(DstInputFileData%AAoutfile)) then allocate(DstInputFileData%AAoutfile(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -776,14 +790,14 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if DstInputFileData%AAoutfile = SrcInputFileData%AAoutfile end if - DstInputFileData%TICalcTabFile = SrcInputFileData%TICalcTabFile DstInputFileData%FTitle = SrcInputFileData%FTitle DstInputFileData%AAStart = SrcInputFileData%AAStart + DstInputFileData%TI = SrcInputFileData%TI + DstInputFileData%avgV = SrcInputFileData%avgV DstInputFileData%Lturb = SrcInputFileData%Lturb - DstInputFileData%AvgV = SrcInputFileData%AvgV if (allocated(SrcInputFileData%ReListBL)) then - LB(1:1) = lbound(SrcInputFileData%ReListBL, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%ReListBL, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%ReListBL) + UB(1:1) = ubound(SrcInputFileData%ReListBL) if (.not. allocated(DstInputFileData%ReListBL)) then allocate(DstInputFileData%ReListBL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -794,8 +808,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%ReListBL = SrcInputFileData%ReListBL end if if (allocated(SrcInputFileData%AoAListBL)) then - LB(1:1) = lbound(SrcInputFileData%AoAListBL, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%AoAListBL, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%AoAListBL) + UB(1:1) = ubound(SrcInputFileData%AoAListBL) if (.not. allocated(DstInputFileData%AoAListBL)) then allocate(DstInputFileData%AoAListBL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -806,8 +820,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%AoAListBL = SrcInputFileData%AoAListBL end if if (allocated(SrcInputFileData%Pres_DispThick)) then - LB(1:3) = lbound(SrcInputFileData%Pres_DispThick, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%Pres_DispThick, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%Pres_DispThick) + UB(1:3) = ubound(SrcInputFileData%Pres_DispThick) if (.not. allocated(DstInputFileData%Pres_DispThick)) then allocate(DstInputFileData%Pres_DispThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -818,8 +832,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Pres_DispThick = SrcInputFileData%Pres_DispThick end if if (allocated(SrcInputFileData%Suct_DispThick)) then - LB(1:3) = lbound(SrcInputFileData%Suct_DispThick, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%Suct_DispThick, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%Suct_DispThick) + UB(1:3) = ubound(SrcInputFileData%Suct_DispThick) if (.not. allocated(DstInputFileData%Suct_DispThick)) then allocate(DstInputFileData%Suct_DispThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -830,8 +844,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Suct_DispThick = SrcInputFileData%Suct_DispThick end if if (allocated(SrcInputFileData%Pres_BLThick)) then - LB(1:3) = lbound(SrcInputFileData%Pres_BLThick, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%Pres_BLThick, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%Pres_BLThick) + UB(1:3) = ubound(SrcInputFileData%Pres_BLThick) if (.not. allocated(DstInputFileData%Pres_BLThick)) then allocate(DstInputFileData%Pres_BLThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -842,8 +856,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Pres_BLThick = SrcInputFileData%Pres_BLThick end if if (allocated(SrcInputFileData%Suct_BLThick)) then - LB(1:3) = lbound(SrcInputFileData%Suct_BLThick, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%Suct_BLThick, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%Suct_BLThick) + UB(1:3) = ubound(SrcInputFileData%Suct_BLThick) if (.not. allocated(DstInputFileData%Suct_BLThick)) then allocate(DstInputFileData%Suct_BLThick(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -854,8 +868,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Suct_BLThick = SrcInputFileData%Suct_BLThick end if if (allocated(SrcInputFileData%Pres_Cf)) then - LB(1:3) = lbound(SrcInputFileData%Pres_Cf, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%Pres_Cf, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%Pres_Cf) + UB(1:3) = ubound(SrcInputFileData%Pres_Cf) if (.not. allocated(DstInputFileData%Pres_Cf)) then allocate(DstInputFileData%Pres_Cf(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -866,8 +880,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Pres_Cf = SrcInputFileData%Pres_Cf end if if (allocated(SrcInputFileData%Suct_Cf)) then - LB(1:3) = lbound(SrcInputFileData%Suct_Cf, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%Suct_Cf, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%Suct_Cf) + UB(1:3) = ubound(SrcInputFileData%Suct_Cf) if (.not. allocated(DstInputFileData%Suct_Cf)) then allocate(DstInputFileData%Suct_Cf(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -878,8 +892,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Suct_Cf = SrcInputFileData%Suct_Cf end if if (allocated(SrcInputFileData%Pres_EdgeVelRat)) then - LB(1:3) = lbound(SrcInputFileData%Pres_EdgeVelRat, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%Pres_EdgeVelRat, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%Pres_EdgeVelRat) + UB(1:3) = ubound(SrcInputFileData%Pres_EdgeVelRat) if (.not. allocated(DstInputFileData%Pres_EdgeVelRat)) then allocate(DstInputFileData%Pres_EdgeVelRat(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -890,8 +904,8 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Pres_EdgeVelRat = SrcInputFileData%Pres_EdgeVelRat end if if (allocated(SrcInputFileData%Suct_EdgeVelRat)) then - LB(1:3) = lbound(SrcInputFileData%Suct_EdgeVelRat, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%Suct_EdgeVelRat, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%Suct_EdgeVelRat) + UB(1:3) = ubound(SrcInputFileData%Suct_EdgeVelRat) if (.not. allocated(DstInputFileData%Suct_EdgeVelRat)) then allocate(DstInputFileData%Suct_EdgeVelRat(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -901,28 +915,14 @@ subroutine AA_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end if DstInputFileData%Suct_EdgeVelRat = SrcInputFileData%Suct_EdgeVelRat end if - if (allocated(SrcInputFileData%TI_Grid_In)) then - LB(1:2) = lbound(SrcInputFileData%TI_Grid_In, kind=B8Ki) - UB(1:2) = ubound(SrcInputFileData%TI_Grid_In, kind=B8Ki) - if (.not. allocated(DstInputFileData%TI_Grid_In)) then - allocate(DstInputFileData%TI_Grid_In(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%TI_Grid_In.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInputFileData%TI_Grid_In = SrcInputFileData%TI_Grid_In - end if - DstInputFileData%dz_turb_in = SrcInputFileData%dz_turb_in - DstInputFileData%dy_turb_in = SrcInputFileData%dy_turb_in end subroutine subroutine AA_DestroyInputFile(InputFileData, ErrStat, ErrMsg) type(AA_InputFile), intent(inout) :: InputFileData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_DestroyInputFile' @@ -938,8 +938,8 @@ subroutine AA_DestroyInputFile(InputFileData, ErrStat, ErrMsg) deallocate(InputFileData%ObsZ) end if if (allocated(InputFileData%BladeProps)) then - LB(1:1) = lbound(InputFileData%BladeProps, kind=B8Ki) - UB(1:1) = ubound(InputFileData%BladeProps, kind=B8Ki) + LB(1:1) = lbound(InputFileData%BladeProps) + UB(1:1) = ubound(InputFileData%BladeProps) do i1 = LB(1), UB(1) call AA_DestroyBladePropsType(InputFileData%BladeProps(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -979,17 +979,14 @@ subroutine AA_DestroyInputFile(InputFileData, ErrStat, ErrMsg) if (allocated(InputFileData%Suct_EdgeVelRat)) then deallocate(InputFileData%Suct_EdgeVelRat) end if - if (allocated(InputFileData%TI_Grid_In)) then - deallocate(InputFileData%TI_Grid_In) - end if end subroutine subroutine AA_PackInputFile(RF, Indata) type(RegFile), intent(inout) :: RF type(AA_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackInputFile' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DT_AA) call RegPack(RF, InData%IBLUNT) @@ -1011,20 +1008,20 @@ subroutine AA_PackInputFile(RF, Indata) call RegPackAlloc(RF, InData%ObsZ) call RegPack(RF, allocated(InData%BladeProps)) if (allocated(InData%BladeProps)) then - call RegPackBounds(RF, 1, lbound(InData%BladeProps, kind=B8Ki), ubound(InData%BladeProps, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeProps, kind=B8Ki) - UB(1:1) = ubound(InData%BladeProps, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) + LB(1:1) = lbound(InData%BladeProps) + UB(1:1) = ubound(InData%BladeProps) do i1 = LB(1), UB(1) call AA_PackBladePropsType(RF, InData%BladeProps(i1)) end do end if call RegPack(RF, InData%NrOutFile) call RegPackAlloc(RF, InData%AAoutfile) - call RegPack(RF, InData%TICalcTabFile) call RegPack(RF, InData%FTitle) call RegPack(RF, InData%AAStart) + call RegPack(RF, InData%TI) + call RegPack(RF, InData%avgV) call RegPack(RF, InData%Lturb) - call RegPack(RF, InData%AvgV) call RegPackAlloc(RF, InData%ReListBL) call RegPackAlloc(RF, InData%AoAListBL) call RegPackAlloc(RF, InData%Pres_DispThick) @@ -1035,9 +1032,6 @@ subroutine AA_PackInputFile(RF, Indata) call RegPackAlloc(RF, InData%Suct_Cf) call RegPackAlloc(RF, InData%Pres_EdgeVelRat) call RegPackAlloc(RF, InData%Suct_EdgeVelRat) - call RegPackAlloc(RF, InData%TI_Grid_In) - call RegPack(RF, InData%dz_turb_in) - call RegPack(RF, InData%dy_turb_in) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1045,8 +1039,8 @@ subroutine AA_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackInputFile' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1083,11 +1077,11 @@ subroutine AA_UnPackInputFile(RF, OutData) end if call RegUnpack(RF, OutData%NrOutFile); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%AAoutfile); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%TICalcTabFile); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%FTitle); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%AAStart); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%avgV); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Lturb); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AvgV); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%ReListBL); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%AoAListBL); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%Pres_DispThick); if (RegCheckErr(RF, RoutineName)) return @@ -1098,9 +1092,6 @@ subroutine AA_UnPackInputFile(RF, OutData) call RegUnpackAlloc(RF, OutData%Suct_Cf); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%Pres_EdgeVelRat); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%Suct_EdgeVelRat); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TI_Grid_In); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dz_turb_in); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dy_turb_in); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AA_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -1147,14 +1138,14 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AA_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%MeanVrel)) then - LB(1:2) = lbound(SrcDiscStateData%MeanVrel, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%MeanVrel, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%MeanVrel) + UB(1:2) = ubound(SrcDiscStateData%MeanVrel) if (.not. allocated(DstDiscStateData%MeanVrel)) then allocate(DstDiscStateData%MeanVrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1165,8 +1156,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%MeanVrel = SrcDiscStateData%MeanVrel end if if (allocated(SrcDiscStateData%VrelSq)) then - LB(1:2) = lbound(SrcDiscStateData%VrelSq, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%VrelSq, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%VrelSq) + UB(1:2) = ubound(SrcDiscStateData%VrelSq) if (.not. allocated(DstDiscStateData%VrelSq)) then allocate(DstDiscStateData%VrelSq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1177,8 +1168,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%VrelSq = SrcDiscStateData%VrelSq end if if (allocated(SrcDiscStateData%TIVrel)) then - LB(1:2) = lbound(SrcDiscStateData%TIVrel, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%TIVrel, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%TIVrel) + UB(1:2) = ubound(SrcDiscStateData%TIVrel) if (.not. allocated(DstDiscStateData%TIVrel)) then allocate(DstDiscStateData%TIVrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1189,8 +1180,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%TIVrel = SrcDiscStateData%TIVrel end if if (allocated(SrcDiscStateData%VrelStore)) then - LB(1:3) = lbound(SrcDiscStateData%VrelStore, kind=B8Ki) - UB(1:3) = ubound(SrcDiscStateData%VrelStore, kind=B8Ki) + LB(1:3) = lbound(SrcDiscStateData%VrelStore) + UB(1:3) = ubound(SrcDiscStateData%VrelStore) if (.not. allocated(DstDiscStateData%VrelStore)) then allocate(DstDiscStateData%VrelStore(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1201,8 +1192,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%VrelStore = SrcDiscStateData%VrelStore end if if (allocated(SrcDiscStateData%TIVx)) then - LB(1:2) = lbound(SrcDiscStateData%TIVx, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%TIVx, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%TIVx) + UB(1:2) = ubound(SrcDiscStateData%TIVx) if (.not. allocated(DstDiscStateData%TIVx)) then allocate(DstDiscStateData%TIVx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1213,8 +1204,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%TIVx = SrcDiscStateData%TIVx end if if (allocated(SrcDiscStateData%MeanVxVyVz)) then - LB(1:2) = lbound(SrcDiscStateData%MeanVxVyVz, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%MeanVxVyVz, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%MeanVxVyVz) + UB(1:2) = ubound(SrcDiscStateData%MeanVxVyVz) if (.not. allocated(DstDiscStateData%MeanVxVyVz)) then allocate(DstDiscStateData%MeanVxVyVz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1225,8 +1216,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%MeanVxVyVz = SrcDiscStateData%MeanVxVyVz end if if (allocated(SrcDiscStateData%VxSq)) then - LB(1:2) = lbound(SrcDiscStateData%VxSq, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%VxSq, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%VxSq) + UB(1:2) = ubound(SrcDiscStateData%VxSq) if (.not. allocated(DstDiscStateData%VxSq)) then allocate(DstDiscStateData%VxSq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1237,8 +1228,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%VxSq = SrcDiscStateData%VxSq end if if (allocated(SrcDiscStateData%allregcounter)) then - LB(1:2) = lbound(SrcDiscStateData%allregcounter, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%allregcounter, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%allregcounter) + UB(1:2) = ubound(SrcDiscStateData%allregcounter) if (.not. allocated(DstDiscStateData%allregcounter)) then allocate(DstDiscStateData%allregcounter(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1249,8 +1240,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%allregcounter = SrcDiscStateData%allregcounter end if if (allocated(SrcDiscStateData%VxSqRegion)) then - LB(1:2) = lbound(SrcDiscStateData%VxSqRegion, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%VxSqRegion, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%VxSqRegion) + UB(1:2) = ubound(SrcDiscStateData%VxSqRegion) if (.not. allocated(DstDiscStateData%VxSqRegion)) then allocate(DstDiscStateData%VxSqRegion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1261,8 +1252,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%VxSqRegion = SrcDiscStateData%VxSqRegion end if if (allocated(SrcDiscStateData%RegVxStor)) then - LB(1:3) = lbound(SrcDiscStateData%RegVxStor, kind=B8Ki) - UB(1:3) = ubound(SrcDiscStateData%RegVxStor, kind=B8Ki) + LB(1:3) = lbound(SrcDiscStateData%RegVxStor) + UB(1:3) = ubound(SrcDiscStateData%RegVxStor) if (.not. allocated(DstDiscStateData%RegVxStor)) then allocate(DstDiscStateData%RegVxStor(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1273,8 +1264,8 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%RegVxStor = SrcDiscStateData%RegVxStor end if if (allocated(SrcDiscStateData%RegionTIDelete)) then - LB(1:2) = lbound(SrcDiscStateData%RegionTIDelete, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%RegionTIDelete, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%RegionTIDelete) + UB(1:2) = ubound(SrcDiscStateData%RegionTIDelete) if (.not. allocated(DstDiscStateData%RegionTIDelete)) then allocate(DstDiscStateData%RegionTIDelete(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1351,7 +1342,7 @@ subroutine AA_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackDiscState' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1450,14 +1441,14 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AA_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) + 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 @@ -1468,8 +1459,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AllOuts = SrcMiscData%AllOuts end if if (allocated(SrcMiscData%ChordAngleTE)) then - LB(1:3) = lbound(SrcMiscData%ChordAngleTE, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%ChordAngleTE, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%ChordAngleTE) + UB(1:3) = ubound(SrcMiscData%ChordAngleTE) if (.not. allocated(DstMiscData%ChordAngleTE)) then allocate(DstMiscData%ChordAngleTE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1480,8 +1471,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%ChordAngleTE = SrcMiscData%ChordAngleTE end if if (allocated(SrcMiscData%SpanAngleTE)) then - LB(1:3) = lbound(SrcMiscData%SpanAngleTE, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%SpanAngleTE, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%SpanAngleTE) + UB(1:3) = ubound(SrcMiscData%SpanAngleTE) if (.not. allocated(DstMiscData%SpanAngleTE)) then allocate(DstMiscData%SpanAngleTE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1492,8 +1483,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SpanAngleTE = SrcMiscData%SpanAngleTE end if if (allocated(SrcMiscData%ChordAngleLE)) then - LB(1:3) = lbound(SrcMiscData%ChordAngleLE, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%ChordAngleLE, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%ChordAngleLE) + UB(1:3) = ubound(SrcMiscData%ChordAngleLE) if (.not. allocated(DstMiscData%ChordAngleLE)) then allocate(DstMiscData%ChordAngleLE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1504,8 +1495,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%ChordAngleLE = SrcMiscData%ChordAngleLE end if if (allocated(SrcMiscData%SpanAngleLE)) then - LB(1:3) = lbound(SrcMiscData%SpanAngleLE, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%SpanAngleLE, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%SpanAngleLE) + UB(1:3) = ubound(SrcMiscData%SpanAngleLE) if (.not. allocated(DstMiscData%SpanAngleLE)) then allocate(DstMiscData%SpanAngleLE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1516,8 +1507,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SpanAngleLE = SrcMiscData%SpanAngleLE end if if (allocated(SrcMiscData%rTEtoObserve)) then - LB(1:3) = lbound(SrcMiscData%rTEtoObserve, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%rTEtoObserve, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%rTEtoObserve) + UB(1:3) = ubound(SrcMiscData%rTEtoObserve) if (.not. allocated(DstMiscData%rTEtoObserve)) then allocate(DstMiscData%rTEtoObserve(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1528,8 +1519,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rTEtoObserve = SrcMiscData%rTEtoObserve end if if (allocated(SrcMiscData%rLEtoObserve)) then - LB(1:3) = lbound(SrcMiscData%rLEtoObserve, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%rLEtoObserve, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%rLEtoObserve) + UB(1:3) = ubound(SrcMiscData%rLEtoObserve) if (.not. allocated(DstMiscData%rLEtoObserve)) then allocate(DstMiscData%rLEtoObserve(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1540,8 +1531,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rLEtoObserve = SrcMiscData%rLEtoObserve end if if (allocated(SrcMiscData%LE_Location)) then - LB(1:3) = lbound(SrcMiscData%LE_Location, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%LE_Location, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%LE_Location) + UB(1:3) = ubound(SrcMiscData%LE_Location) if (.not. allocated(DstMiscData%LE_Location)) then allocate(DstMiscData%LE_Location(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1553,8 +1544,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%RotSpeedAoA = SrcMiscData%RotSpeedAoA if (allocated(SrcMiscData%SPLLBL)) then - LB(1:1) = lbound(SrcMiscData%SPLLBL, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SPLLBL, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SPLLBL) + UB(1:1) = ubound(SrcMiscData%SPLLBL) if (.not. allocated(DstMiscData%SPLLBL)) then allocate(DstMiscData%SPLLBL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1565,8 +1556,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLLBL = SrcMiscData%SPLLBL end if if (allocated(SrcMiscData%SPLP)) then - LB(1:1) = lbound(SrcMiscData%SPLP, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SPLP, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SPLP) + UB(1:1) = ubound(SrcMiscData%SPLP) if (.not. allocated(DstMiscData%SPLP)) then allocate(DstMiscData%SPLP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1577,8 +1568,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLP = SrcMiscData%SPLP end if if (allocated(SrcMiscData%SPLS)) then - LB(1:1) = lbound(SrcMiscData%SPLS, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SPLS, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SPLS) + UB(1:1) = ubound(SrcMiscData%SPLS) if (.not. allocated(DstMiscData%SPLS)) then allocate(DstMiscData%SPLS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1589,8 +1580,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLS = SrcMiscData%SPLS end if if (allocated(SrcMiscData%SPLALPH)) then - LB(1:1) = lbound(SrcMiscData%SPLALPH, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SPLALPH, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SPLALPH) + UB(1:1) = ubound(SrcMiscData%SPLALPH) if (.not. allocated(DstMiscData%SPLALPH)) then allocate(DstMiscData%SPLALPH(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1601,8 +1592,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLALPH = SrcMiscData%SPLALPH end if if (allocated(SrcMiscData%SPLTBL)) then - LB(1:1) = lbound(SrcMiscData%SPLTBL, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SPLTBL, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SPLTBL) + UB(1:1) = ubound(SrcMiscData%SPLTBL) if (.not. allocated(DstMiscData%SPLTBL)) then allocate(DstMiscData%SPLTBL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1613,8 +1604,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLTBL = SrcMiscData%SPLTBL end if if (allocated(SrcMiscData%SPLTIP)) then - LB(1:1) = lbound(SrcMiscData%SPLTIP, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SPLTIP, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SPLTIP) + UB(1:1) = ubound(SrcMiscData%SPLTIP) if (.not. allocated(DstMiscData%SPLTIP)) then allocate(DstMiscData%SPLTIP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1625,8 +1616,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLTIP = SrcMiscData%SPLTIP end if if (allocated(SrcMiscData%SPLTI)) then - LB(1:1) = lbound(SrcMiscData%SPLTI, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SPLTI, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SPLTI) + UB(1:1) = ubound(SrcMiscData%SPLTI) if (.not. allocated(DstMiscData%SPLTI)) then allocate(DstMiscData%SPLTI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1637,8 +1628,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLTI = SrcMiscData%SPLTI end if if (allocated(SrcMiscData%SPLTIGui)) then - LB(1:1) = lbound(SrcMiscData%SPLTIGui, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SPLTIGui, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SPLTIGui) + UB(1:1) = ubound(SrcMiscData%SPLTIGui) if (.not. allocated(DstMiscData%SPLTIGui)) then allocate(DstMiscData%SPLTIGui(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1649,8 +1640,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLTIGui = SrcMiscData%SPLTIGui end if if (allocated(SrcMiscData%SPLBLUNT)) then - LB(1:1) = lbound(SrcMiscData%SPLBLUNT, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SPLBLUNT, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%SPLBLUNT) + UB(1:1) = ubound(SrcMiscData%SPLBLUNT) if (.not. allocated(DstMiscData%SPLBLUNT)) then allocate(DstMiscData%SPLBLUNT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1661,8 +1652,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SPLBLUNT = SrcMiscData%SPLBLUNT end if if (allocated(SrcMiscData%CfVar)) then - LB(1:1) = lbound(SrcMiscData%CfVar, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%CfVar, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%CfVar) + UB(1:1) = ubound(SrcMiscData%CfVar) if (.not. allocated(DstMiscData%CfVar)) then allocate(DstMiscData%CfVar(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1673,8 +1664,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%CfVar = SrcMiscData%CfVar end if if (allocated(SrcMiscData%d99Var)) then - LB(1:1) = lbound(SrcMiscData%d99Var, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%d99Var, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%d99Var) + UB(1:1) = ubound(SrcMiscData%d99Var) if (.not. allocated(DstMiscData%d99Var)) then allocate(DstMiscData%d99Var(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1685,8 +1676,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%d99Var = SrcMiscData%d99Var end if if (allocated(SrcMiscData%dStarVar)) then - LB(1:1) = lbound(SrcMiscData%dStarVar, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%dStarVar, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%dStarVar) + UB(1:1) = ubound(SrcMiscData%dStarVar) if (.not. allocated(DstMiscData%dStarVar)) then allocate(DstMiscData%dStarVar(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1697,8 +1688,8 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%dStarVar = SrcMiscData%dStarVar end if if (allocated(SrcMiscData%EdgeVelVar)) then - LB(1:1) = lbound(SrcMiscData%EdgeVelVar, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%EdgeVelVar, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%EdgeVelVar) + UB(1:1) = ubound(SrcMiscData%EdgeVelVar) if (.not. allocated(DstMiscData%EdgeVelVar)) then allocate(DstMiscData%EdgeVelVar(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1820,7 +1811,7 @@ subroutine AA_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackMisc' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1856,8 +1847,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_CopyParam' @@ -1883,8 +1874,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%toptip = SrcParamData%toptip DstParamData%bottip = SrcParamData%bottip if (allocated(SrcParamData%rotorregionlimitsVert)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsVert, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsVert, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rotorregionlimitsVert) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsVert) if (.not. allocated(DstParamData%rotorregionlimitsVert)) then allocate(DstParamData%rotorregionlimitsVert(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1895,8 +1886,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rotorregionlimitsVert = SrcParamData%rotorregionlimitsVert end if if (allocated(SrcParamData%rotorregionlimitsHorz)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsHorz, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsHorz, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rotorregionlimitsHorz) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsHorz) if (.not. allocated(DstParamData%rotorregionlimitsHorz)) then allocate(DstParamData%rotorregionlimitsHorz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1907,8 +1898,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rotorregionlimitsHorz = SrcParamData%rotorregionlimitsHorz end if if (allocated(SrcParamData%rotorregionlimitsalph)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsalph, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsalph, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rotorregionlimitsalph) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsalph) if (.not. allocated(DstParamData%rotorregionlimitsalph)) then allocate(DstParamData%rotorregionlimitsalph(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1919,8 +1910,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rotorregionlimitsalph = SrcParamData%rotorregionlimitsalph end if if (allocated(SrcParamData%rotorregionlimitsrad)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsrad, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsrad, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rotorregionlimitsrad) + UB(1:1) = ubound(SrcParamData%rotorregionlimitsrad) if (.not. allocated(DstParamData%rotorregionlimitsrad)) then allocate(DstParamData%rotorregionlimitsrad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1935,8 +1926,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TxtFileOutput = SrcParamData%TxtFileOutput DstParamData%AAStart = SrcParamData%AAStart if (allocated(SrcParamData%ObsX)) then - LB(1:1) = lbound(SrcParamData%ObsX, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ObsX, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ObsX) + UB(1:1) = ubound(SrcParamData%ObsX) if (.not. allocated(DstParamData%ObsX)) then allocate(DstParamData%ObsX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1947,8 +1938,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ObsX = SrcParamData%ObsX end if if (allocated(SrcParamData%ObsY)) then - LB(1:1) = lbound(SrcParamData%ObsY, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ObsY, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ObsY) + UB(1:1) = ubound(SrcParamData%ObsY) if (.not. allocated(DstParamData%ObsY)) then allocate(DstParamData%ObsY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1959,8 +1950,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ObsY = SrcParamData%ObsY end if if (allocated(SrcParamData%ObsZ)) then - LB(1:1) = lbound(SrcParamData%ObsZ, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ObsZ, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ObsZ) + UB(1:1) = ubound(SrcParamData%ObsZ) if (.not. allocated(DstParamData%ObsZ)) then allocate(DstParamData%ObsZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1971,8 +1962,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ObsZ = SrcParamData%ObsZ end if if (allocated(SrcParamData%FreqList)) then - LB(1:1) = lbound(SrcParamData%FreqList, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%FreqList, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%FreqList) + UB(1:1) = ubound(SrcParamData%FreqList) if (.not. allocated(DstParamData%FreqList)) then allocate(DstParamData%FreqList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1983,8 +1974,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%FreqList = SrcParamData%FreqList end if if (allocated(SrcParamData%Aweight)) then - LB(1:1) = lbound(SrcParamData%Aweight, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Aweight, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Aweight) + UB(1:1) = ubound(SrcParamData%Aweight) if (.not. allocated(DstParamData%Aweight)) then allocate(DstParamData%Aweight(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2000,21 +1991,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AA_Bl_Prcntge = SrcParamData%AA_Bl_Prcntge DstParamData%startnode = SrcParamData%startnode DstParamData%Lturb = SrcParamData%Lturb - DstParamData%AvgV = SrcParamData%AvgV - DstParamData%dz_turb_in = SrcParamData%dz_turb_in - DstParamData%dy_turb_in = SrcParamData%dy_turb_in - if (allocated(SrcParamData%TI_Grid_In)) then - LB(1:2) = lbound(SrcParamData%TI_Grid_In, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%TI_Grid_In, kind=B8Ki) - if (.not. allocated(DstParamData%TI_Grid_In)) then - allocate(DstParamData%TI_Grid_In(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI_Grid_In.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%TI_Grid_In = SrcParamData%TI_Grid_In - end if + DstParamData%avgV = SrcParamData%avgV + DstParamData%TI = SrcParamData%TI DstParamData%FTitle = SrcParamData%FTitle DstParamData%outFmt = SrcParamData%outFmt DstParamData%NrOutFile = SrcParamData%NrOutFile @@ -2029,8 +2007,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%unOutFile4 = SrcParamData%unOutFile4 DstParamData%RootName = SrcParamData%RootName if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + 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 @@ -2045,8 +2023,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%StallStart)) then - LB(1:2) = lbound(SrcParamData%StallStart, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%StallStart, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%StallStart) + UB(1:2) = ubound(SrcParamData%StallStart) if (.not. allocated(DstParamData%StallStart)) then allocate(DstParamData%StallStart(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2057,8 +2035,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%StallStart = SrcParamData%StallStart end if if (allocated(SrcParamData%TEThick)) then - LB(1:2) = lbound(SrcParamData%TEThick, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%TEThick, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%TEThick) + UB(1:2) = ubound(SrcParamData%TEThick) if (.not. allocated(DstParamData%TEThick)) then allocate(DstParamData%TEThick(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2069,8 +2047,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TEThick = SrcParamData%TEThick end if if (allocated(SrcParamData%TEAngle)) then - LB(1:2) = lbound(SrcParamData%TEAngle, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%TEAngle, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%TEAngle) + UB(1:2) = ubound(SrcParamData%TEAngle) if (.not. allocated(DstParamData%TEAngle)) then allocate(DstParamData%TEAngle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2081,8 +2059,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TEAngle = SrcParamData%TEAngle end if if (allocated(SrcParamData%AerCent)) then - LB(1:3) = lbound(SrcParamData%AerCent, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AerCent, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%AerCent) + UB(1:3) = ubound(SrcParamData%AerCent) if (.not. allocated(DstParamData%AerCent)) then allocate(DstParamData%AerCent(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2093,8 +2071,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AerCent = SrcParamData%AerCent end if if (allocated(SrcParamData%BlAFID)) then - LB(1:2) = lbound(SrcParamData%BlAFID, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BlAFID, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BlAFID) + UB(1:2) = ubound(SrcParamData%BlAFID) if (.not. allocated(DstParamData%BlAFID)) then allocate(DstParamData%BlAFID(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2105,8 +2083,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BlAFID = SrcParamData%BlAFID end if if (allocated(SrcParamData%AFInfo)) then - LB(1:1) = lbound(SrcParamData%AFInfo, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%AFInfo, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%AFInfo) + UB(1:1) = ubound(SrcParamData%AFInfo) if (.not. allocated(DstParamData%AFInfo)) then allocate(DstParamData%AFInfo(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2121,8 +2099,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%AFLECo)) then - LB(1:3) = lbound(SrcParamData%AFLECo, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AFLECo, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%AFLECo) + UB(1:3) = ubound(SrcParamData%AFLECo) if (.not. allocated(DstParamData%AFLECo)) then allocate(DstParamData%AFLECo(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2133,8 +2111,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AFLECo = SrcParamData%AFLECo end if if (allocated(SrcParamData%AFTECo)) then - LB(1:3) = lbound(SrcParamData%AFTECo, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AFTECo, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%AFTECo) + UB(1:3) = ubound(SrcParamData%AFTECo) if (.not. allocated(DstParamData%AFTECo)) then allocate(DstParamData%AFTECo(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2145,8 +2123,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AFTECo = SrcParamData%AFTECo end if if (allocated(SrcParamData%BlSpn)) then - LB(1:2) = lbound(SrcParamData%BlSpn, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BlSpn, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BlSpn) + UB(1:2) = ubound(SrcParamData%BlSpn) if (.not. allocated(DstParamData%BlSpn)) then allocate(DstParamData%BlSpn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2157,8 +2135,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BlSpn = SrcParamData%BlSpn end if if (allocated(SrcParamData%BlChord)) then - LB(1:2) = lbound(SrcParamData%BlChord, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BlChord, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BlChord) + UB(1:2) = ubound(SrcParamData%BlChord) if (.not. allocated(DstParamData%BlChord)) then allocate(DstParamData%BlChord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2169,8 +2147,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BlChord = SrcParamData%BlChord end if if (allocated(SrcParamData%ReListBL)) then - LB(1:1) = lbound(SrcParamData%ReListBL, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ReListBL, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ReListBL) + UB(1:1) = ubound(SrcParamData%ReListBL) if (.not. allocated(DstParamData%ReListBL)) then allocate(DstParamData%ReListBL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2181,8 +2159,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ReListBL = SrcParamData%ReListBL end if if (allocated(SrcParamData%AOAListBL)) then - LB(1:1) = lbound(SrcParamData%AOAListBL, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%AOAListBL, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%AOAListBL) + UB(1:1) = ubound(SrcParamData%AOAListBL) if (.not. allocated(DstParamData%AOAListBL)) then allocate(DstParamData%AOAListBL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2193,8 +2171,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AOAListBL = SrcParamData%AOAListBL end if if (allocated(SrcParamData%dStarAll1)) then - LB(1:3) = lbound(SrcParamData%dStarAll1, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%dStarAll1, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%dStarAll1) + UB(1:3) = ubound(SrcParamData%dStarAll1) if (.not. allocated(DstParamData%dStarAll1)) then allocate(DstParamData%dStarAll1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2205,8 +2183,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%dStarAll1 = SrcParamData%dStarAll1 end if if (allocated(SrcParamData%dStarAll2)) then - LB(1:3) = lbound(SrcParamData%dStarAll2, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%dStarAll2, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%dStarAll2) + UB(1:3) = ubound(SrcParamData%dStarAll2) if (.not. allocated(DstParamData%dStarAll2)) then allocate(DstParamData%dStarAll2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2217,8 +2195,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%dStarAll2 = SrcParamData%dStarAll2 end if if (allocated(SrcParamData%d99All1)) then - LB(1:3) = lbound(SrcParamData%d99All1, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%d99All1, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%d99All1) + UB(1:3) = ubound(SrcParamData%d99All1) if (.not. allocated(DstParamData%d99All1)) then allocate(DstParamData%d99All1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2229,8 +2207,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%d99All1 = SrcParamData%d99All1 end if if (allocated(SrcParamData%d99All2)) then - LB(1:3) = lbound(SrcParamData%d99All2, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%d99All2, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%d99All2) + UB(1:3) = ubound(SrcParamData%d99All2) if (.not. allocated(DstParamData%d99All2)) then allocate(DstParamData%d99All2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2241,8 +2219,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%d99All2 = SrcParamData%d99All2 end if if (allocated(SrcParamData%CfAll1)) then - LB(1:3) = lbound(SrcParamData%CfAll1, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%CfAll1, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%CfAll1) + UB(1:3) = ubound(SrcParamData%CfAll1) if (.not. allocated(DstParamData%CfAll1)) then allocate(DstParamData%CfAll1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2253,8 +2231,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CfAll1 = SrcParamData%CfAll1 end if if (allocated(SrcParamData%CfAll2)) then - LB(1:3) = lbound(SrcParamData%CfAll2, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%CfAll2, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%CfAll2) + UB(1:3) = ubound(SrcParamData%CfAll2) if (.not. allocated(DstParamData%CfAll2)) then allocate(DstParamData%CfAll2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2265,8 +2243,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CfAll2 = SrcParamData%CfAll2 end if if (allocated(SrcParamData%EdgeVelRat1)) then - LB(1:3) = lbound(SrcParamData%EdgeVelRat1, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%EdgeVelRat1, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%EdgeVelRat1) + UB(1:3) = ubound(SrcParamData%EdgeVelRat1) if (.not. allocated(DstParamData%EdgeVelRat1)) then allocate(DstParamData%EdgeVelRat1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2277,8 +2255,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%EdgeVelRat1 = SrcParamData%EdgeVelRat1 end if if (allocated(SrcParamData%EdgeVelRat2)) then - LB(1:3) = lbound(SrcParamData%EdgeVelRat2, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%EdgeVelRat2, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%EdgeVelRat2) + UB(1:3) = ubound(SrcParamData%EdgeVelRat2) if (.not. allocated(DstParamData%EdgeVelRat2)) then allocate(DstParamData%EdgeVelRat2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2289,8 +2267,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%EdgeVelRat2 = SrcParamData%EdgeVelRat2 end if if (allocated(SrcParamData%AFThickGuida)) then - LB(1:2) = lbound(SrcParamData%AFThickGuida, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%AFThickGuida, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%AFThickGuida) + UB(1:2) = ubound(SrcParamData%AFThickGuida) if (.not. allocated(DstParamData%AFThickGuida)) then allocate(DstParamData%AFThickGuida(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2306,8 +2284,8 @@ subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) type(AA_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_DestroyParam' @@ -2340,12 +2318,9 @@ subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%Aweight)) then deallocate(ParamData%Aweight) end if - if (allocated(ParamData%TI_Grid_In)) then - deallocate(ParamData%TI_Grid_In) - end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + 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) @@ -2368,8 +2343,8 @@ subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%BlAFID) end if if (allocated(ParamData%AFInfo)) then - LB(1:1) = lbound(ParamData%AFInfo, kind=B8Ki) - UB(1:1) = ubound(ParamData%AFInfo, kind=B8Ki) + LB(1:1) = lbound(ParamData%AFInfo) + UB(1:1) = ubound(ParamData%AFInfo) do i1 = LB(1), UB(1) call AFI_DestroyParam(ParamData%AFInfo(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2427,8 +2402,8 @@ subroutine AA_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(AA_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DT) call RegPack(RF, InData%IBLUNT) @@ -2468,10 +2443,8 @@ subroutine AA_PackParam(RF, Indata) call RegPack(RF, InData%AA_Bl_Prcntge) call RegPack(RF, InData%startnode) call RegPack(RF, InData%Lturb) - call RegPack(RF, InData%AvgV) - call RegPack(RF, InData%dz_turb_in) - call RegPack(RF, InData%dy_turb_in) - call RegPackAlloc(RF, InData%TI_Grid_In) + call RegPack(RF, InData%avgV) + call RegPack(RF, InData%TI) call RegPack(RF, InData%FTitle) call RegPack(RF, InData%outFmt) call RegPack(RF, InData%NrOutFile) @@ -2487,9 +2460,9 @@ subroutine AA_PackParam(RF, Indata) call RegPack(RF, InData%RootName) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + 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 @@ -2501,9 +2474,9 @@ subroutine AA_PackParam(RF, Indata) call RegPackAlloc(RF, InData%BlAFID) call RegPack(RF, allocated(InData%AFInfo)) if (allocated(InData%AFInfo)) then - call RegPackBounds(RF, 1, lbound(InData%AFInfo, kind=B8Ki), ubound(InData%AFInfo, kind=B8Ki)) - LB(1:1) = lbound(InData%AFInfo, kind=B8Ki) - UB(1:1) = ubound(InData%AFInfo, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) + LB(1:1) = lbound(InData%AFInfo) + UB(1:1) = ubound(InData%AFInfo) do i1 = LB(1), UB(1) call AFI_PackParam(RF, InData%AFInfo(i1)) end do @@ -2530,8 +2503,8 @@ subroutine AA_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2573,10 +2546,8 @@ subroutine AA_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%AA_Bl_Prcntge); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%startnode); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Lturb); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AvgV); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dz_turb_in); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%dy_turb_in); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%TI_Grid_In); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%avgV); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TI); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%FTitle); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%outFmt); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NrOutFile); if (RegCheckErr(RF, RoutineName)) return @@ -2644,14 +2615,14 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AA_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%RotGtoL)) then - LB(1:4) = lbound(SrcInputData%RotGtoL, kind=B8Ki) - UB(1:4) = ubound(SrcInputData%RotGtoL, kind=B8Ki) + LB(1:4) = lbound(SrcInputData%RotGtoL) + UB(1:4) = ubound(SrcInputData%RotGtoL) if (.not. allocated(DstInputData%RotGtoL)) then allocate(DstInputData%RotGtoL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2662,8 +2633,8 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%RotGtoL = SrcInputData%RotGtoL end if if (allocated(SrcInputData%AeroCent_G)) then - LB(1:3) = lbound(SrcInputData%AeroCent_G, kind=B8Ki) - UB(1:3) = ubound(SrcInputData%AeroCent_G, kind=B8Ki) + LB(1:3) = lbound(SrcInputData%AeroCent_G) + UB(1:3) = ubound(SrcInputData%AeroCent_G) if (.not. allocated(DstInputData%AeroCent_G)) then allocate(DstInputData%AeroCent_G(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2674,8 +2645,8 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%AeroCent_G = SrcInputData%AeroCent_G end if if (allocated(SrcInputData%Vrel)) then - LB(1:2) = lbound(SrcInputData%Vrel, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%Vrel, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%Vrel) + UB(1:2) = ubound(SrcInputData%Vrel) if (.not. allocated(DstInputData%Vrel)) then allocate(DstInputData%Vrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2686,8 +2657,8 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vrel = SrcInputData%Vrel end if if (allocated(SrcInputData%AoANoise)) then - LB(1:2) = lbound(SrcInputData%AoANoise, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%AoANoise, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%AoANoise) + UB(1:2) = ubound(SrcInputData%AoANoise) if (.not. allocated(DstInputData%AoANoise)) then allocate(DstInputData%AoANoise(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2698,8 +2669,8 @@ subroutine AA_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%AoANoise = SrcInputData%AoANoise end if if (allocated(SrcInputData%Inflow)) then - LB(1:3) = lbound(SrcInputData%Inflow, kind=B8Ki) - UB(1:3) = ubound(SrcInputData%Inflow, kind=B8Ki) + LB(1:3) = lbound(SrcInputData%Inflow) + UB(1:3) = ubound(SrcInputData%Inflow) if (.not. allocated(DstInputData%Inflow)) then allocate(DstInputData%Inflow(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2752,7 +2723,7 @@ subroutine AA_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackInput' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2769,14 +2740,14 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AA_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%SumSpecNoise)) then - LB(1:3) = lbound(SrcOutputData%SumSpecNoise, kind=B8Ki) - UB(1:3) = ubound(SrcOutputData%SumSpecNoise, kind=B8Ki) + LB(1:3) = lbound(SrcOutputData%SumSpecNoise) + UB(1:3) = ubound(SrcOutputData%SumSpecNoise) if (.not. allocated(DstOutputData%SumSpecNoise)) then allocate(DstOutputData%SumSpecNoise(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2787,8 +2758,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%SumSpecNoise = SrcOutputData%SumSpecNoise end if if (allocated(SrcOutputData%SumSpecNoiseSep)) then - LB(1:3) = lbound(SrcOutputData%SumSpecNoiseSep, kind=B8Ki) - UB(1:3) = ubound(SrcOutputData%SumSpecNoiseSep, kind=B8Ki) + LB(1:3) = lbound(SrcOutputData%SumSpecNoiseSep) + UB(1:3) = ubound(SrcOutputData%SumSpecNoiseSep) if (.not. allocated(DstOutputData%SumSpecNoiseSep)) then allocate(DstOutputData%SumSpecNoiseSep(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2799,8 +2770,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%SumSpecNoiseSep = SrcOutputData%SumSpecNoiseSep end if if (allocated(SrcOutputData%OASPL)) then - LB(1:3) = lbound(SrcOutputData%OASPL, kind=B8Ki) - UB(1:3) = ubound(SrcOutputData%OASPL, kind=B8Ki) + LB(1:3) = lbound(SrcOutputData%OASPL) + UB(1:3) = ubound(SrcOutputData%OASPL) if (.not. allocated(DstOutputData%OASPL)) then allocate(DstOutputData%OASPL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2811,8 +2782,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%OASPL = SrcOutputData%OASPL end if if (allocated(SrcOutputData%OASPL_Mech)) then - LB(1:4) = lbound(SrcOutputData%OASPL_Mech, kind=B8Ki) - UB(1:4) = ubound(SrcOutputData%OASPL_Mech, kind=B8Ki) + LB(1:4) = lbound(SrcOutputData%OASPL_Mech) + UB(1:4) = ubound(SrcOutputData%OASPL_Mech) if (.not. allocated(DstOutputData%OASPL_Mech)) then allocate(DstOutputData%OASPL_Mech(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2823,8 +2794,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%OASPL_Mech = SrcOutputData%OASPL_Mech end if if (allocated(SrcOutputData%DirectiviOutput)) then - LB(1:1) = lbound(SrcOutputData%DirectiviOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%DirectiviOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%DirectiviOutput) + UB(1:1) = ubound(SrcOutputData%DirectiviOutput) if (.not. allocated(DstOutputData%DirectiviOutput)) then allocate(DstOutputData%DirectiviOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2835,8 +2806,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%DirectiviOutput = SrcOutputData%DirectiviOutput end if if (allocated(SrcOutputData%OutLECoords)) then - LB(1:4) = lbound(SrcOutputData%OutLECoords, kind=B8Ki) - UB(1:4) = ubound(SrcOutputData%OutLECoords, kind=B8Ki) + LB(1:4) = lbound(SrcOutputData%OutLECoords) + UB(1:4) = ubound(SrcOutputData%OutLECoords) if (.not. allocated(DstOutputData%OutLECoords)) then allocate(DstOutputData%OutLECoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2847,8 +2818,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%OutLECoords = SrcOutputData%OutLECoords end if if (allocated(SrcOutputData%PtotalFreq)) then - LB(1:2) = lbound(SrcOutputData%PtotalFreq, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%PtotalFreq, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%PtotalFreq) + UB(1:2) = ubound(SrcOutputData%PtotalFreq) if (.not. allocated(DstOutputData%PtotalFreq)) then allocate(DstOutputData%PtotalFreq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2859,8 +2830,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%PtotalFreq = SrcOutputData%PtotalFreq end if if (allocated(SrcOutputData%WriteOutputForPE)) then - LB(1:1) = lbound(SrcOutputData%WriteOutputForPE, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutputForPE, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutputForPE) + UB(1:1) = ubound(SrcOutputData%WriteOutputForPE) if (.not. allocated(DstOutputData%WriteOutputForPE)) then allocate(DstOutputData%WriteOutputForPE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2871,8 +2842,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%WriteOutputForPE = SrcOutputData%WriteOutputForPE end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -2883,8 +2854,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%WriteOutput = SrcOutputData%WriteOutput end if if (allocated(SrcOutputData%WriteOutputSep)) then - LB(1:1) = lbound(SrcOutputData%WriteOutputSep, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutputSep, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutputSep) + UB(1:1) = ubound(SrcOutputData%WriteOutputSep) if (.not. allocated(DstOutputData%WriteOutputSep)) then allocate(DstOutputData%WriteOutputSep(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2895,8 +2866,8 @@ subroutine AA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%WriteOutputSep = SrcOutputData%WriteOutputSep end if if (allocated(SrcOutputData%WriteOutputNode)) then - LB(1:1) = lbound(SrcOutputData%WriteOutputNode, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutputNode, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WriteOutputNode) + UB(1:1) = ubound(SrcOutputData%WriteOutputNode) if (.not. allocated(DstOutputData%WriteOutputNode)) then allocate(DstOutputData%WriteOutputNode(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2973,7 +2944,7 @@ subroutine AA_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackOutput' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2989,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 2e141064c5..c220b3f7b4 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -31,7 +31,8 @@ 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 implicit none private @@ -46,7 +47,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 +60,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 !---------------------------------------------------------------------------------------------------------------------------------- @@ -544,14 +546,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: @@ -2000,31 +2002,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: !------------------------------------------------------- @@ -2112,6 +2092,22 @@ 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%Buoyancy) 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 + ! --- Tail Fin if (p%TFinAero) then call TFin_CalcOutput(p, p_AD, u, RotInflow, m, y, ErrStat2, ErrMsg2) @@ -2159,7 +2155,7 @@ subroutine RotWriteOutputs( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'RotCalcOutput' + character(*), parameter :: RoutineName = 'RotWriteOutputs' real(R8Ki) :: x_hat_disk(3) ! LOGICAL :: CalcWriteOutput !------------------------------------------------------- @@ -2200,7 +2196,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 @@ -2249,10 +2245,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 @@ -2459,17 +2455,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 ) & + ! 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, 'CalcBuoyantLoads' ) 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 = -p%WtrDpth + end if ! Heading and inclination angles of tower element TwrheadAng = atan2( TwrtmpPosplus(2) - TwrtmpPos(2), TwrtmpPosplus(1) - TwrtmpPos(1) ) @@ -2650,7 +2659,7 @@ subroutine CalcBuoyantLoads( u, p, m, y, ErrStat, ErrMsg ) m%NacMi = y%NacelleLoad%Moment(:,1) -end subroutine CalcBuoyantLoads +end subroutine RotCalcBuoyantLoads !---------------------------------------------------------------------------------------------------------------------------------- !> 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 +3833,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 +3872,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) @@ -5627,13 +5636,308 @@ SUBROUTINE TwrInfl_NearestPoint(p, u, RotInflow, BladeNodePosition, r_TowerBlade END SUBROUTINE TwrInfl_NearestPoint !---------------------------------------------------------------------------------------------------------------------------------- +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 + + ErrStat = ErrID_None + ErrMsg = "" + + ! 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( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +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 @@ -5645,29 +5949,29 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM 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) :: 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), 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 - 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) + call AD_CalcWind_Rotor(t, u%rotors(iRotor), p%FlowField, p%rotors(iRotor), 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 +5984,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, 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, 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, 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, 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 +6224,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), 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 +6256,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) - end do - END IF + ! Loop through number of linearization perturbations in variable + do j = 1, Vars%x(i)%Num -! IF ( PRESENT( dXddx ) ) THEN -! END IF + ! 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) -! IF ( PRESENT( dZdx ) ) THEN -! END IF + ! 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 + + ! 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 +6393,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 +6415,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 +6432,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 +6451,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 +6459,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), 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 +6500,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 +6664,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 +6747,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 +6810,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 +6885,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_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index 7d2b77655f..10d706033e 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -197,7 +197,8 @@ MODULE AeroDyn_Driver_Types LOGICAL :: initialized = .false. !< [-] END TYPE AllData ! ======================= -CONTAINS + +contains subroutine AD_Dvr_CopyDvr_Case(SrcDvr_CaseData, DstDvr_CaseData, CtrlCode, ErrStat, ErrMsg) type(Dvr_Case), intent(in) :: SrcDvr_CaseData @@ -317,8 +318,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_Dvr_CopyDvr_Outputs' @@ -328,8 +329,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcDvr_OutputsData%unOutFile)) then - LB(1:1) = lbound(SrcDvr_OutputsData%unOutFile, kind=B8Ki) - UB(1:1) = ubound(SrcDvr_OutputsData%unOutFile, kind=B8Ki) + LB(1:1) = lbound(SrcDvr_OutputsData%unOutFile) + UB(1:1) = ubound(SrcDvr_OutputsData%unOutFile) if (.not. allocated(DstDvr_OutputsData%unOutFile)) then allocate(DstDvr_OutputsData%unOutFile(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -351,8 +352,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo DstDvr_OutputsData%Root = SrcDvr_OutputsData%Root DstDvr_OutputsData%VTK_OutFileRoot = SrcDvr_OutputsData%VTK_OutFileRoot if (allocated(SrcDvr_OutputsData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcDvr_OutputsData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcDvr_OutputsData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcDvr_OutputsData%WriteOutputHdr) + UB(1:1) = ubound(SrcDvr_OutputsData%WriteOutputHdr) if (.not. allocated(DstDvr_OutputsData%WriteOutputHdr)) then allocate(DstDvr_OutputsData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -363,8 +364,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo DstDvr_OutputsData%WriteOutputHdr = SrcDvr_OutputsData%WriteOutputHdr end if if (allocated(SrcDvr_OutputsData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcDvr_OutputsData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcDvr_OutputsData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcDvr_OutputsData%WriteOutputUnt) + UB(1:1) = ubound(SrcDvr_OutputsData%WriteOutputUnt) if (.not. allocated(DstDvr_OutputsData%WriteOutputUnt)) then allocate(DstDvr_OutputsData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -375,8 +376,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo DstDvr_OutputsData%WriteOutputUnt = SrcDvr_OutputsData%WriteOutputUnt end if if (allocated(SrcDvr_OutputsData%storage)) then - LB(1:3) = lbound(SrcDvr_OutputsData%storage, kind=B8Ki) - UB(1:3) = ubound(SrcDvr_OutputsData%storage, kind=B8Ki) + LB(1:3) = lbound(SrcDvr_OutputsData%storage) + UB(1:3) = ubound(SrcDvr_OutputsData%storage) if (.not. allocated(DstDvr_OutputsData%storage)) then allocate(DstDvr_OutputsData%storage(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -387,8 +388,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo DstDvr_OutputsData%storage = SrcDvr_OutputsData%storage end if if (allocated(SrcDvr_OutputsData%outLine)) then - LB(1:1) = lbound(SrcDvr_OutputsData%outLine, kind=B8Ki) - UB(1:1) = ubound(SrcDvr_OutputsData%outLine, kind=B8Ki) + LB(1:1) = lbound(SrcDvr_OutputsData%outLine) + UB(1:1) = ubound(SrcDvr_OutputsData%outLine) if (.not. allocated(DstDvr_OutputsData%outLine)) then allocate(DstDvr_OutputsData%outLine(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -399,8 +400,8 @@ subroutine AD_Dvr_CopyDvr_Outputs(SrcDvr_OutputsData, DstDvr_OutputsData, CtrlCo DstDvr_OutputsData%outLine = SrcDvr_OutputsData%outLine end if if (allocated(SrcDvr_OutputsData%VTK_surface)) then - LB(1:1) = lbound(SrcDvr_OutputsData%VTK_surface, kind=B8Ki) - UB(1:1) = ubound(SrcDvr_OutputsData%VTK_surface, kind=B8Ki) + LB(1:1) = lbound(SrcDvr_OutputsData%VTK_surface) + UB(1:1) = ubound(SrcDvr_OutputsData%VTK_surface) if (.not. allocated(DstDvr_OutputsData%VTK_surface)) then allocate(DstDvr_OutputsData%VTK_surface(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -427,8 +428,8 @@ subroutine AD_Dvr_DestroyDvr_Outputs(Dvr_OutputsData, ErrStat, ErrMsg) type(Dvr_Outputs), intent(inout) :: Dvr_OutputsData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_Dvr_DestroyDvr_Outputs' @@ -452,8 +453,8 @@ subroutine AD_Dvr_DestroyDvr_Outputs(Dvr_OutputsData, ErrStat, ErrMsg) deallocate(Dvr_OutputsData%outLine) end if if (allocated(Dvr_OutputsData%VTK_surface)) then - LB(1:1) = lbound(Dvr_OutputsData%VTK_surface, kind=B8Ki) - UB(1:1) = ubound(Dvr_OutputsData%VTK_surface, kind=B8Ki) + LB(1:1) = lbound(Dvr_OutputsData%VTK_surface) + UB(1:1) = ubound(Dvr_OutputsData%VTK_surface) do i1 = LB(1), UB(1) call AD_Dvr_DestroyDvrVTK_SurfaceType(Dvr_OutputsData%VTK_surface(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -466,8 +467,8 @@ subroutine AD_Dvr_PackDvr_Outputs(RF, Indata) type(RegFile), intent(inout) :: RF type(Dvr_Outputs), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_Outputs' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call NWTC_Library_PackProgDesc(RF, InData%AD_ver) call RegPackAlloc(RF, InData%unOutFile) @@ -488,9 +489,9 @@ subroutine AD_Dvr_PackDvr_Outputs(RF, Indata) call RegPackAlloc(RF, InData%outLine) call RegPack(RF, allocated(InData%VTK_surface)) if (allocated(InData%VTK_surface)) then - call RegPackBounds(RF, 1, lbound(InData%VTK_surface, kind=B8Ki), ubound(InData%VTK_surface, kind=B8Ki)) - LB(1:1) = lbound(InData%VTK_surface, kind=B8Ki) - UB(1:1) = ubound(InData%VTK_surface, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%VTK_surface), ubound(InData%VTK_surface)) + LB(1:1) = lbound(InData%VTK_surface) + UB(1:1) = ubound(InData%VTK_surface) do i1 = LB(1), UB(1) call AD_Dvr_PackDvrVTK_SurfaceType(RF, InData%VTK_surface(i1)) end do @@ -509,8 +510,8 @@ subroutine AD_Dvr_UnPackDvr_Outputs(RF, OutData) type(RegFile), intent(inout) :: RF type(Dvr_Outputs), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvr_Outputs' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -559,7 +560,7 @@ subroutine AD_Dvr_CopyBladeData(SrcBladeDataData, DstBladeDataData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_Dvr_CopyBladeData' ErrStat = ErrID_None @@ -574,8 +575,8 @@ subroutine AD_Dvr_CopyBladeData(SrcBladeDataData, DstBladeDataData, CtrlCode, Er DstBladeDataData%motionType = SrcBladeDataData%motionType DstBladeDataData%iMotion = SrcBladeDataData%iMotion if (allocated(SrcBladeDataData%motion)) then - LB(1:2) = lbound(SrcBladeDataData%motion, kind=B8Ki) - UB(1:2) = ubound(SrcBladeDataData%motion, kind=B8Ki) + LB(1:2) = lbound(SrcBladeDataData%motion) + UB(1:2) = ubound(SrcBladeDataData%motion) if (.not. allocated(DstBladeDataData%motion)) then allocate(DstBladeDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -623,7 +624,7 @@ subroutine AD_Dvr_UnPackBladeData(RF, OutData) type(RegFile), intent(inout) :: RF type(BladeData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackBladeData' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -646,7 +647,7 @@ subroutine AD_Dvr_CopyHubData(SrcHubDataData, DstHubDataData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_Dvr_CopyHubData' ErrStat = ErrID_None @@ -660,8 +661,8 @@ subroutine AD_Dvr_CopyHubData(SrcHubDataData, DstHubDataData, CtrlCode, ErrStat, DstHubDataData%rotAcc = SrcHubDataData%rotAcc DstHubDataData%motionFileName = SrcHubDataData%motionFileName if (allocated(SrcHubDataData%motion)) then - LB(1:2) = lbound(SrcHubDataData%motion, kind=B8Ki) - UB(1:2) = ubound(SrcHubDataData%motion, kind=B8Ki) + LB(1:2) = lbound(SrcHubDataData%motion) + UB(1:2) = ubound(SrcHubDataData%motion) if (.not. allocated(DstHubDataData%motion)) then allocate(DstHubDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -706,7 +707,7 @@ subroutine AD_Dvr_UnPackHubData(RF, OutData) type(RegFile), intent(inout) :: RF type(HubData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackHubData' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -727,7 +728,7 @@ subroutine AD_Dvr_CopyNacData(SrcNacDataData, DstNacDataData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_Dvr_CopyNacData' ErrStat = ErrID_None @@ -740,8 +741,8 @@ subroutine AD_Dvr_CopyNacData(SrcNacDataData, DstNacDataData, CtrlCode, ErrStat, DstNacDataData%yawAcc = SrcNacDataData%yawAcc DstNacDataData%motionFileName = SrcNacDataData%motionFileName if (allocated(SrcNacDataData%motion)) then - LB(1:2) = lbound(SrcNacDataData%motion, kind=B8Ki) - UB(1:2) = ubound(SrcNacDataData%motion, kind=B8Ki) + LB(1:2) = lbound(SrcNacDataData%motion) + UB(1:2) = ubound(SrcNacDataData%motion) if (.not. allocated(DstNacDataData%motion)) then allocate(DstNacDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -785,7 +786,7 @@ subroutine AD_Dvr_UnPackNacData(RF, OutData) type(RegFile), intent(inout) :: RF type(NacData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackNacData' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -843,8 +844,8 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_Dvr_CopyWTData' @@ -862,8 +863,8 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcWTDataData%map2BldPt)) then - LB(1:1) = lbound(SrcWTDataData%map2BldPt, kind=B8Ki) - UB(1:1) = ubound(SrcWTDataData%map2BldPt, kind=B8Ki) + LB(1:1) = lbound(SrcWTDataData%map2BldPt) + UB(1:1) = ubound(SrcWTDataData%map2BldPt) if (.not. allocated(DstWTDataData%map2BldPt)) then allocate(DstWTDataData%map2BldPt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -878,8 +879,8 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er end do end if if (allocated(SrcWTDataData%bld)) then - LB(1:1) = lbound(SrcWTDataData%bld, kind=B8Ki) - UB(1:1) = ubound(SrcWTDataData%bld, kind=B8Ki) + LB(1:1) = lbound(SrcWTDataData%bld) + UB(1:1) = ubound(SrcWTDataData%bld) if (.not. allocated(DstWTDataData%bld)) then allocate(DstWTDataData%bld(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -910,8 +911,8 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er DstWTDataData%HAWTprojection = SrcWTDataData%HAWTprojection DstWTDataData%motionType = SrcWTDataData%motionType if (allocated(SrcWTDataData%motion)) then - LB(1:2) = lbound(SrcWTDataData%motion, kind=B8Ki) - UB(1:2) = ubound(SrcWTDataData%motion, kind=B8Ki) + LB(1:2) = lbound(SrcWTDataData%motion) + UB(1:2) = ubound(SrcWTDataData%motion) if (.not. allocated(DstWTDataData%motion)) then allocate(DstWTDataData%motion(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -927,8 +928,8 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er DstWTDataData%frequency = SrcWTDataData%frequency DstWTDataData%motionFileName = SrcWTDataData%motionFileName if (allocated(SrcWTDataData%WriteOutput)) then - LB(1:1) = lbound(SrcWTDataData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcWTDataData%WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcWTDataData%WriteOutput) + UB(1:1) = ubound(SrcWTDataData%WriteOutput) if (.not. allocated(DstWTDataData%WriteOutput)) then allocate(DstWTDataData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -939,8 +940,8 @@ subroutine AD_Dvr_CopyWTData(SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, Er DstWTDataData%WriteOutput = SrcWTDataData%WriteOutput end if if (allocated(SrcWTDataData%userSwapArray)) then - LB(1:1) = lbound(SrcWTDataData%userSwapArray, kind=B8Ki) - UB(1:1) = ubound(SrcWTDataData%userSwapArray, kind=B8Ki) + LB(1:1) = lbound(SrcWTDataData%userSwapArray) + UB(1:1) = ubound(SrcWTDataData%userSwapArray) if (.not. allocated(DstWTDataData%userSwapArray)) then allocate(DstWTDataData%userSwapArray(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -956,8 +957,8 @@ subroutine AD_Dvr_DestroyWTData(WTDataData, ErrStat, ErrMsg) type(WTData), intent(inout) :: WTDataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_Dvr_DestroyWTData' @@ -970,8 +971,8 @@ subroutine AD_Dvr_DestroyWTData(WTDataData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(WTDataData%map2hubPt, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(WTDataData%map2BldPt)) then - LB(1:1) = lbound(WTDataData%map2BldPt, kind=B8Ki) - UB(1:1) = ubound(WTDataData%map2BldPt, kind=B8Ki) + LB(1:1) = lbound(WTDataData%map2BldPt) + UB(1:1) = ubound(WTDataData%map2BldPt) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(WTDataData%map2BldPt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -979,8 +980,8 @@ subroutine AD_Dvr_DestroyWTData(WTDataData, ErrStat, ErrMsg) deallocate(WTDataData%map2BldPt) end if if (allocated(WTDataData%bld)) then - LB(1:1) = lbound(WTDataData%bld, kind=B8Ki) - UB(1:1) = ubound(WTDataData%bld, kind=B8Ki) + LB(1:1) = lbound(WTDataData%bld) + UB(1:1) = ubound(WTDataData%bld) do i1 = LB(1), UB(1) call AD_Dvr_DestroyBladeData(WTDataData%bld(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1008,8 +1009,8 @@ subroutine AD_Dvr_PackWTData(RF, Indata) type(RegFile), intent(inout) :: RF type(WTData), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackWTData' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%originInit) call RegPack(RF, InData%orientationInit) @@ -1018,18 +1019,18 @@ subroutine AD_Dvr_PackWTData(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%map2hubPt) call RegPack(RF, allocated(InData%map2BldPt)) if (allocated(InData%map2BldPt)) then - call RegPackBounds(RF, 1, lbound(InData%map2BldPt, kind=B8Ki), ubound(InData%map2BldPt, kind=B8Ki)) - LB(1:1) = lbound(InData%map2BldPt, kind=B8Ki) - UB(1:1) = ubound(InData%map2BldPt, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%map2BldPt), ubound(InData%map2BldPt)) + LB(1:1) = lbound(InData%map2BldPt) + UB(1:1) = ubound(InData%map2BldPt) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%map2BldPt(i1)) end do end if call RegPack(RF, allocated(InData%bld)) if (allocated(InData%bld)) then - call RegPackBounds(RF, 1, lbound(InData%bld, kind=B8Ki), ubound(InData%bld, kind=B8Ki)) - LB(1:1) = lbound(InData%bld, kind=B8Ki) - UB(1:1) = ubound(InData%bld, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%bld), ubound(InData%bld)) + LB(1:1) = lbound(InData%bld) + UB(1:1) = ubound(InData%bld) do i1 = LB(1), UB(1) call AD_Dvr_PackBladeData(RF, InData%bld(i1)) end do @@ -1059,8 +1060,8 @@ subroutine AD_Dvr_UnPackWTData(RF, OutData) type(RegFile), intent(inout) :: RF type(WTData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackWTData' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1121,8 +1122,8 @@ subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCo integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_Dvr_CopyDvr_SimData' @@ -1140,8 +1141,8 @@ subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCo DstDvr_SimDataData%MSL2SWL = SrcDvr_SimDataData%MSL2SWL DstDvr_SimDataData%numTurbines = SrcDvr_SimDataData%numTurbines if (allocated(SrcDvr_SimDataData%WT)) then - LB(1:1) = lbound(SrcDvr_SimDataData%WT, kind=B8Ki) - UB(1:1) = ubound(SrcDvr_SimDataData%WT, kind=B8Ki) + LB(1:1) = lbound(SrcDvr_SimDataData%WT) + UB(1:1) = ubound(SrcDvr_SimDataData%WT) if (.not. allocated(DstDvr_SimDataData%WT)) then allocate(DstDvr_SimDataData%WT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1160,8 +1161,8 @@ subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCo DstDvr_SimDataData%numSteps = SrcDvr_SimDataData%numSteps DstDvr_SimDataData%numCases = SrcDvr_SimDataData%numCases if (allocated(SrcDvr_SimDataData%Cases)) then - LB(1:1) = lbound(SrcDvr_SimDataData%Cases, kind=B8Ki) - UB(1:1) = ubound(SrcDvr_SimDataData%Cases, kind=B8Ki) + LB(1:1) = lbound(SrcDvr_SimDataData%Cases) + UB(1:1) = ubound(SrcDvr_SimDataData%Cases) if (.not. allocated(DstDvr_SimDataData%Cases)) then allocate(DstDvr_SimDataData%Cases(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1177,8 +1178,8 @@ subroutine AD_Dvr_CopyDvr_SimData(SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCo end if DstDvr_SimDataData%iCase = SrcDvr_SimDataData%iCase if (allocated(SrcDvr_SimDataData%timeSeries)) then - LB(1:2) = lbound(SrcDvr_SimDataData%timeSeries, kind=B8Ki) - UB(1:2) = ubound(SrcDvr_SimDataData%timeSeries, kind=B8Ki) + LB(1:2) = lbound(SrcDvr_SimDataData%timeSeries) + UB(1:2) = ubound(SrcDvr_SimDataData%timeSeries) if (.not. allocated(DstDvr_SimDataData%timeSeries)) then allocate(DstDvr_SimDataData%timeSeries(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1202,16 +1203,16 @@ subroutine AD_Dvr_DestroyDvr_SimData(Dvr_SimDataData, ErrStat, ErrMsg) type(Dvr_SimData), intent(inout) :: Dvr_SimDataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_Dvr_DestroyDvr_SimData' ErrStat = ErrID_None ErrMsg = '' if (allocated(Dvr_SimDataData%WT)) then - LB(1:1) = lbound(Dvr_SimDataData%WT, kind=B8Ki) - UB(1:1) = ubound(Dvr_SimDataData%WT, kind=B8Ki) + LB(1:1) = lbound(Dvr_SimDataData%WT) + UB(1:1) = ubound(Dvr_SimDataData%WT) do i1 = LB(1), UB(1) call AD_Dvr_DestroyWTData(Dvr_SimDataData%WT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1219,8 +1220,8 @@ subroutine AD_Dvr_DestroyDvr_SimData(Dvr_SimDataData, ErrStat, ErrMsg) deallocate(Dvr_SimDataData%WT) end if if (allocated(Dvr_SimDataData%Cases)) then - LB(1:1) = lbound(Dvr_SimDataData%Cases, kind=B8Ki) - UB(1:1) = ubound(Dvr_SimDataData%Cases, kind=B8Ki) + LB(1:1) = lbound(Dvr_SimDataData%Cases) + UB(1:1) = ubound(Dvr_SimDataData%Cases) do i1 = LB(1), UB(1) call AD_Dvr_DestroyDvr_Case(Dvr_SimDataData%Cases(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1240,8 +1241,8 @@ subroutine AD_Dvr_PackDvr_SimData(RF, Indata) type(RegFile), intent(inout) :: RF type(Dvr_SimData), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_Dvr_PackDvr_SimData' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%AD_InputFile) call RegPack(RF, InData%MHK) @@ -1256,9 +1257,9 @@ subroutine AD_Dvr_PackDvr_SimData(RF, Indata) call RegPack(RF, InData%numTurbines) call RegPack(RF, allocated(InData%WT)) if (allocated(InData%WT)) then - call RegPackBounds(RF, 1, lbound(InData%WT, kind=B8Ki), ubound(InData%WT, kind=B8Ki)) - LB(1:1) = lbound(InData%WT, kind=B8Ki) - UB(1:1) = ubound(InData%WT, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%WT), ubound(InData%WT)) + LB(1:1) = lbound(InData%WT) + UB(1:1) = ubound(InData%WT) do i1 = LB(1), UB(1) call AD_Dvr_PackWTData(RF, InData%WT(i1)) end do @@ -1269,9 +1270,9 @@ subroutine AD_Dvr_PackDvr_SimData(RF, Indata) call RegPack(RF, InData%numCases) call RegPack(RF, allocated(InData%Cases)) if (allocated(InData%Cases)) then - call RegPackBounds(RF, 1, lbound(InData%Cases, kind=B8Ki), ubound(InData%Cases, kind=B8Ki)) - LB(1:1) = lbound(InData%Cases, kind=B8Ki) - UB(1:1) = ubound(InData%Cases, kind=B8Ki) + 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 AD_Dvr_PackDvr_Case(RF, InData%Cases(i1)) end do @@ -1289,8 +1290,8 @@ subroutine AD_Dvr_UnPackDvr_SimData(RF, OutData) type(RegFile), intent(inout) :: RF type(Dvr_SimData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_Dvr_UnPackDvr_SimData' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1411,5 +1412,7 @@ subroutine AD_Dvr_UnPackAllData(RF, OutData) call RegUnpack(RF, OutData%errMsg); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%initialized); if (RegCheckErr(RF, RoutineName)) return end subroutine + END MODULE AeroDyn_Driver_Types + !ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroDyn_Inflow.f90 b/modules/aerodyn/src/AeroDyn_Inflow.f90 index 99e6abbfd6..5da3f6b8d6 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow.f90 @@ -299,9 +299,10 @@ subroutine ADI_CalcOutput(t, u, p, x, xd, z, OtherState, y, m, errStat, errMsg) ! --- Set outputs !TODO: this assumes one rotor!!! - associate(AD_NumOuts => p%AD%rotors(1)%NumOuts + p%AD%rotors(1)%BldNd_TotNumOuts) - y%WriteOutput(1:AD_NumOuts) = y%AD%rotors(1)%WriteOutput(1:AD_NumOuts) - y%WriteOutput(AD_NumOuts+1:p%NumOuts) = y%IW_WriteOutput(1:m%IW%p%NumOuts) + associate(AD_NumOuts => p%AD%rotors(1)%NumOuts + p%AD%rotors(1)%BldNd_TotNumOuts, & + IW_NumOuts => m%IW%p%NumOuts) + y%WriteOutput(1:IW_NumOuts) = y%IW_WriteOutput(1:IW_NumOuts) + y%WriteOutput(IW_NumOuts+1:p%NumOuts) = y%AD%rotors(1)%WriteOutput(1:AD_NumOuts) end associate !---------------------------------------------------------------------------- diff --git a/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 index 31889a853a..b2523e14c4 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_C_Binding.f90 @@ -45,13 +45,19 @@ MODULE AeroDyn_Inflow_C_BINDING type(ProgDesc), parameter :: version = ProgDesc( 'AeroDyn-Inflow library', '', '' ) !------------------------------------------------------------------------------------ - ! Debugging: debugverbose -- passed at PreInit + ! Debugging: DebugLevel -- passed at PreInit ! 0 - none ! 1 - some summary info ! 2 - above + all position/orientation info ! 3 - above + input files (if direct passed) ! 4 - above + meshes - integer(IntKi) :: debugverbose = 0 + integer(IntKi) :: DebugLevel = 0 + + !------------------------------------------------------------------------------------ + ! Point Load Output: flag indicating library returns point loads -- passed at PreInit + ! true - loads returned by ADI_C_GetRotorLoads are point loads (N, N-m) at mesh points + ! false - loads returned by ADI_C_GetRotorLoads are distributed (N/m, N-m/m) loads at mesh points + logical :: PointLoadOutput = .true. !------------------------------------------------------------------------------------ ! Error handling @@ -144,14 +150,14 @@ MODULE AeroDyn_Inflow_C_BINDING INTEGER(IntKi), ALLOCATABLE :: BladeNodeToMeshPoint(:) !< Blade node -> structural mesh point mapping (sized by the number of nodes on the blade) END TYPE BladeNodeToMeshPointMapType ! ======================= - ! ========= BladePtMeshCoordsType ======= - TYPE, PUBLIC :: BladePtMeshCoordsType + ! ========= BladeStrMeshCoordsType ======= + TYPE, PUBLIC :: BladeStrMeshCoordsType REAL(ReKi), DIMENSION(:,:), ALLOCATABLE :: Position !< Position of all blade points (sized by 3 x number of mesh points on the blade [x,y,z]) REAL(ReKi), DIMENSION(:,:,:), ALLOCATABLE :: Orient !< Orientation of all blade points (sized by 3 x 3 x number of mesh points on the blade [r11,r12,r13,r21,r22,r23,r31,r32,r33]) REAL(ReKi), DIMENSION(:,:), ALLOCATABLE :: Velocity !< Velocity of all blade points (sized by 6 x number of mesh points on the blade [u,v,w,p,q,r]) REAL(ReKi), DIMENSION(:,:), ALLOCATABLE :: Accln !< Acceleration of all blade points (sized by 6 x number of mesh points on the blade [udot,vdot,wdot,pdot,qdot,rdot]) REAL(ReKi), DIMENSION(:,:), ALLOCATABLE :: Force !< Force of all blade points (sized by 6 x number of mesh points on the blade [Fx,Fy,Fz,Mx,My,Mz]) - END TYPE BladePtMeshCoordsType + END TYPE BladeStrMeshCoordsType ! ======================= ! ========= StrucPtsToBladeMapType ======= TYPE, PUBLIC :: StrucPtsToBladeMapType @@ -159,7 +165,7 @@ MODULE AeroDyn_Inflow_C_BINDING INTEGER(IntKi), ALLOCATABLE :: NumMeshPtsPerBlade(:) ! Number of structural mesh points on each blade (sized by the number of blades) INTEGER(IntKi), ALLOCATABLE :: MeshPt_2_BladeNum(:) ! Structural mesh point -> which blade on the rotor it is on (sized by the number of mesh points on the rotor) TYPE(BladeNodeToMeshPointMapType),ALLOCATABLE:: BladeNode_2_MeshPt(:) ! Blade node on blade -> structural mesh point (sized by the number of mesh points on the blade) - TYPE(BladePtMeshCoordsType), ALLOCATABLE :: BladePtMeshCoords(:) ! Mesh point coordinates for each blade (sized by the number of blades) + TYPE(BladeStrMeshCoordsType), ALLOCATABLE :: BladeStrMeshCoords(:) ! Mesh point coordinates for each blade (sized by the number of blades) END TYPE StrucPtsToBladeMapType ! ======================= ! ========= MeshByBladeType ======= @@ -176,25 +182,25 @@ MODULE AeroDyn_Inflow_C_BINDING ! one or multiple points. ! - 1 point -- rigid floating body assumption ! - N points -- flexible structure (either floating or fixed bottom) - ! TODO: for clarity, sometime it might be worth renaming BldPt* here to RtrPt* instead + ! TODO: for clarity, sometime it might be worth renaming BldStr* here to RtrPt* instead logical :: TransposeDCM !< Transpose DCMs as passed in -- test the vtk outputs to see if needed integer(IntKi), allocatable :: NumMeshPts(:) ! Number of mesh points we are interfacing motions/loads to/from AD for each rotor - type(MeshByBladeType), allocatable :: BldPtMotionMesh(:) ! Mesh for motions of external nodes (sized by number of rotors) - type(MeshByBladeType), allocatable :: BldPtLoadMesh(:) ! Mesh for loads for external nodes (sized by number of rotors) - type(MeshByBladeType), allocatable :: BldPtLoadMesh_tmp(:) ! Mesh for loads for external nodes -- temporary storage for loads (sized by number of rotors) + type(MeshByBladeType), allocatable :: BldStrMotionMesh(:) ! Mesh for motions of external nodes (sized by number of rotors) + type(MeshByBladeType), allocatable :: BldStrLoadMesh(:) ! Mesh for loads for external nodes (sized by number of rotors) + type(MeshByBladeType), allocatable :: BldStrLoadMesh_tmp(:) ! Mesh for loads for external nodes -- temporary storage for loads (sized by number of rotors) ! type(MeshType), allocatable :: NacMotionMesh(:) ! mesh for motion of nacelle -- TODO: add this mesh for nacelle load transfers ! type(MeshType), allocatable :: NacLoadMesh(:) ! mesh for loads for nacelle loads -- TODO: add this mesh for nacelle load transfers !------------------------------ ! Mesh mapping: motions ! The mapping of motions from the nodes passed in to the corresponding AD meshes - ! TODO: sometime restructure the Map_BldPtMotion_2_AD_Blade and Map_AD_BldLoad_P_2_BldPtLoad to 1D and place inside a rotor structure - type(MeshMapType), allocatable :: Map_BldPtMotion_2_AD_Blade(:,:) ! Mesh mapping between input motion mesh for blade (sized by the number of blades and number of rotors) + ! TODO: sometime restructure the Map_BldStrMotion_2_AD_Blade and Map_AD_BldLoad_P_2_BldStrLoad to 1D and place inside a rotor structure + type(MeshMapType), allocatable :: Map_BldStrMotion_2_AD_Blade(:,:) ! Mesh mapping between input motion mesh for blade (sized by the number of blades and number of rotors) type(MeshMapType), allocatable :: Map_AD_Nac_2_NacPtLoad(:) ! Mesh mapping between input motion mesh for nacelle !------------------------------ ! Mesh mapping: loads ! The mapping of loads from the AD meshes to the corresponding external nodes type(StrucPtsToBladeMapType), allocatable :: StrucPts_2_Bld_Map(:) ! Array mapping info for structural mesh points to blades, and back (sized by the number of rotors/turbines) - type(MeshMapType), allocatable :: Map_AD_BldLoad_P_2_BldPtLoad(:,:) ! Mesh mapping between AD output blade line2 load to BldPtLoad for return (sized by the number of blades and number of rotors) + type(MeshMapType), allocatable :: Map_AD_BldLoad_P_2_BldStrLoad(:,:) ! Mesh mapping between AD output blade line2 load to BldStrLoad for return (sized by the number of blades and number of rotors) ! NOTE on turbine origin ! The turbine origin is set by TurbOrigin_C during the ADI_C_SetupRotor routine. This is the tower base location. All @@ -229,7 +235,7 @@ end subroutine SetErr !--------------------------------------------- AeroDyn PreInit ------------------------------------------------- !=============================================================================================================== !> Allocate all the arrays for data storage for all turbine rotors -subroutine ADI_C_PreInit(NumTurbines_C,TransposeDCM_in,debuglevel,ErrStat_C,ErrMsg_C) BIND (C, NAME='ADI_C_PreInit') +subroutine ADI_C_PreInit(NumTurbines_C, TransposeDCM_in, PointLoadOutput_in, DebugLevel_in, ErrStat_C, ErrMsg_C) BIND (C, NAME='ADI_C_PreInit') implicit none #ifndef IMPLICIT_DLLEXPORT !DEC$ ATTRIBUTES DLLEXPORT :: ADI_C_PreInit @@ -237,7 +243,8 @@ subroutine ADI_C_PreInit(NumTurbines_C,TransposeDCM_in,debuglevel,ErrStat_C,ErrM #endif integer(c_int), intent(in ) :: NumTurbines_C integer(c_int), intent(in ) :: TransposeDCM_in !< Transpose DCMs as they are passed i - integer(c_int), intent(in ) :: debuglevel + integer(c_int), intent(in ) :: PointLoadOutput_in + integer(c_int), intent(in ) :: DebugLevel_in integer(c_int), intent( out) :: ErrStat_C character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) @@ -257,16 +264,19 @@ subroutine ADI_C_PreInit(NumTurbines_C,TransposeDCM_in,debuglevel,ErrStat_C,ErrM CALL DispCopyrightLicense( version%Name ) CALL DispCompileRuntimeInfo( version%Name ) + ! Save flag for outputting point or distributed loads + PointLoadOutput = PointLoadOutput_in /= 0 + ! interface debugging - debugverbose = int(debuglevel,IntKi) + DebugLevel = int(DebugLevel_in,IntKi) ! if non-zero, show all passed data here. Then check valid values - if (debugverbose /= 0_IntKi) then - call WrScr(" Interface debugging level "//trim(Num2Lstr(debugverbose))//" requested.") + if (DebugLevel /= 0_IntKi) then + call WrScr(" Interface debugging level "//trim(Num2Lstr(DebugLevel))//" requested.") call ShowPassedData() endif ! check valid debug level - if (debugverbose < 0_IntKi .or. debugverbose > 4_IntKi) then + if (DebugLevel < 0_IntKi .or. DebugLevel > 4_IntKi) then ErrStat2 = ErrID_Fatal ErrMsg2 = "Interface debug level must be between 0 and 4"//NewLine// & " 0 - none"//NewLine// & @@ -306,21 +316,21 @@ subroutine ADI_C_PreInit(NumTurbines_C,TransposeDCM_in,debuglevel,ErrStat_C,ErrM NumMeshPts = -999 ! Allocate meshes and mesh mappings - if (allocated(BldPtMotionMesh )) deallocate(BldPtMotionMesh ) - if (allocated(BldPtLoadMesh )) deallocate(BldPtLoadMesh ) - if (allocated(BldPtLoadMesh_tmp)) deallocate(BldPtLoadMesh_tmp) + if (allocated(BldStrMotionMesh )) deallocate(BldStrMotionMesh ) + if (allocated(BldStrLoadMesh )) deallocate(BldStrLoadMesh ) + if (allocated(BldStrLoadMesh_tmp)) deallocate(BldStrLoadMesh_tmp) ! if (allocated(NacMotionMesh )) deallocate(NacMotionMesh ) ! if (allocated(NacLoadMesh )) deallocate(NacLoadMesh ) - allocate(BldPtMotionMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('BldPtMotionMesh' )) return - allocate(BldPtLoadMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('BldPtLoadMesh' )) return - allocate(BldPtLoadMesh_tmp(Sim%NumTurbines), STAT=ErrStat2); if (Failed0('BldPtLoadMesh_tmp')) return + allocate(BldStrMotionMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('BldStrMotionMesh' )) return + allocate(BldStrLoadMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('BldStrLoadMesh' )) return + allocate(BldStrLoadMesh_tmp(Sim%NumTurbines), STAT=ErrStat2); if (Failed0('BldStrLoadMesh_tmp')) return ! allocate(NacMotionMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('NacMotionMesh' )) return ! allocate(NacLoadMesh( Sim%NumTurbines), STAT=ErrStat2); if (Failed0('NacLoadMesh' )) return - if (allocated(Map_BldPtMotion_2_AD_Blade )) deallocate(Map_BldPtMotion_2_AD_Blade ) - if (allocated(Map_AD_BldLoad_P_2_BldPtLoad )) deallocate(Map_AD_BldLoad_P_2_BldPtLoad) + if (allocated(Map_BldStrMotion_2_AD_Blade )) deallocate(Map_BldStrMotion_2_AD_Blade ) + if (allocated(Map_AD_BldLoad_P_2_BldStrLoad )) deallocate(Map_AD_BldLoad_P_2_BldStrLoad) ! if (allocated(Map_NacPtMotion_2_AD_Nac )) deallocate(Map_NacPtMotion_2_AD_Nac ) - ! allocate(Map_NacPtMotion_2_AD_Nac(Sim%NumTurbines),STAT=ErrStat2); if (Failed0('Map_AD_BldLoad_P_2_BldPtLoad')) returns + ! allocate(Map_NacPtMotion_2_AD_Nac(Sim%NumTurbines),STAT=ErrStat2); if (Failed0('Map_AD_BldLoad_P_2_BldStrLoad')) returns ! Allocate the StrucPtsToBladeMapType array used for mapping structural points to blades of the rotor if (allocated(StrucPts_2_Bld_Map)) deallocate(StrucPts_2_Bld_Map) @@ -362,7 +372,7 @@ subroutine ShowPassedData() call WrScr(" NumTurbines_C "//trim(Num2LStr( NumTurbines_C )) ) TmpFlag="F"; if (TransposeDCM_in==1_c_int) TmpFlag="T" call WrScr(" TransposeDCM_in "//TmpFlag ) - call WrScr(" debuglevel "//trim(Num2LStr( debuglevel )) ) + call WrScr(" debuglevel "//trim(Num2LStr( DebugLevel_in )) ) call WrScr("-----------------------------------------------------------") end subroutine ShowPassedData @@ -486,7 +496,7 @@ SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileString ! For debugging the interface: - if (debugverbose > 0) then + if (DebugLevel > 0) then call ShowPassedData() endif @@ -532,7 +542,7 @@ SUBROUTINE ADI_C_Init( ADinputFilePassed, ADinputFileString_C, ADinputFileString ! For diagnostic purposes, the following can be used to display the contents ! of the InFileInfo data structure. ! CU is the screen -- system dependent. - if (debugverbose >= 3) then + if (DebugLevel >= 3) then if (ADinputFilePassed==1_c_int) call Print_FileInfo_Struct( CU, InitInp%AD%PassedPrimaryInputData ) if (IfWinputFilePassed==1_c_int) call Print_FileInfo_Struct( CU, InitInp%IW_InitInp%PassedFileInfo ) endif @@ -883,8 +893,8 @@ subroutine SetupMotionLoadsInterfaceMeshes() ! NOTE: storing mappings in 2D this way may increase memory usage slightly if one turbine has many more blades than another. However ! the speed an memory penalties are negligible, so I don't see much reason to change that at this point. - allocate(Map_BldPtMotion_2_AD_Blade( maxBlades, Sim%NumTurbines), STAT=ErrStat2); if (Failed0('Map_BldPtMotion_2_AD_Blade' )) return - allocate(Map_AD_BldLoad_P_2_BldPtLoad(maxBlades, Sim%NumTurbines), STAT=ErrStat2); if (Failed0('Map_AD_BldLoad_P_2_BldPtLoad')) return + allocate(Map_BldStrMotion_2_AD_Blade( maxBlades, Sim%NumTurbines), STAT=ErrStat2); if (Failed0('Map_BldStrMotion_2_AD_Blade' )) return + allocate(Map_AD_BldLoad_P_2_BldStrLoad(maxBlades, Sim%NumTurbines), STAT=ErrStat2); if (Failed0('Map_AD_BldLoad_P_2_BldStrLoad')) return ! Step through all turbine rotors do iWT=1,Sim%NumTurbines @@ -894,8 +904,8 @@ subroutine SetupMotionLoadsInterfaceMeshes() do iBlade=1,Sim%WT(iWT)%NumBlades !------------------------------------------------------------- ! Load mesh for blades - CALL MeshCopy( SrcMesh = BldPtMotionMesh(iWT)%Mesh(iBlade) ,& - DestMesh = BldPtLoadMesh(iWT)%Mesh(iBlade) ,& + CALL MeshCopy( SrcMesh = BldStrMotionMesh(iWT)%Mesh(iBlade) ,& + DestMesh = BldStrLoadMesh(iWT)%Mesh(iBlade) ,& CtrlCode = MESH_SIBLING ,& IOS = COMPONENT_OUTPUT ,& ErrStat = ErrStat2 ,& @@ -903,11 +913,11 @@ subroutine SetupMotionLoadsInterfaceMeshes() Force = .TRUE. ,& Moment = .TRUE. ) if(Failed()) return - BldPtMotionMesh(iWT)%Mesh(iBlade)%RemapFlag = .FALSE. + BldStrMotionMesh(iWT)%Mesh(iBlade)%RemapFlag = .FALSE. ! Temp mesh for load transfer - CALL MeshCopy( SrcMesh = BldPtLoadMesh(iWT)%Mesh(iBlade) ,& - DestMesh = BldPtLoadMesh_tmp(iWT)%Mesh(iBlade) ,& + CALL MeshCopy( SrcMesh = BldStrLoadMesh(iWT)%Mesh(iBlade) ,& + DestMesh = BldStrLoadMesh_tmp(iWT)%Mesh(iBlade) ,& CtrlCode = MESH_COUSIN ,& IOS = COMPONENT_OUTPUT ,& ErrStat = ErrStat2 ,& @@ -915,17 +925,17 @@ subroutine SetupMotionLoadsInterfaceMeshes() Force = .TRUE. ,& Moment = .TRUE. ) if(Failed()) return - BldPtLoadMesh_tmp(iWT)%Mesh(iBlade)%RemapFlag = .FALSE. + BldStrLoadMesh_tmp(iWT)%Mesh(iBlade)%RemapFlag = .FALSE. ! For checking the mesh ! Note: CU is is output unit (platform dependent). - if (debugverbose >= 4) call MeshPrintInfo( CU, BldPtLoadMesh(iWT)%Mesh(iBlade), MeshName='BldPtLoadMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) + if (DebugLevel >= 4) call MeshPrintInfo( CU, BldStrLoadMesh(iWT)%Mesh(iBlade), MeshName='BldStrLoadMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) !------------------------------------------------------------- ! Set the mapping meshes ! blades - call MeshMapCreate( BldPtMotionMesh(iWT)%Mesh(iBlade), ADI%u(1)%AD%rotors(iWT)%BladeMotion(iBlade), Map_BldPtMotion_2_AD_Blade(iBlade, iWT), ErrStat2, ErrMsg2 ); if(Failed()) return - call MeshMapCreate( ADI%y%AD%rotors(iWT)%BladeLoad(iBlade), BldPtLoadMesh(iWT)%Mesh(iBlade), Map_AD_BldLoad_P_2_BldPtLoad(iBlade, iWT), ErrStat2, ErrMsg2 ); if(Failed()) return + call MeshMapCreate( BldStrMotionMesh(iWT)%Mesh(iBlade), ADI%u(1)%AD%rotors(iWT)%BladeMotion(iBlade), Map_BldStrMotion_2_AD_Blade(iBlade, iWT), ErrStat2, ErrMsg2 ); if(Failed()) return + call MeshMapCreate( ADI%y%AD%rotors(iWT)%BladeLoad(iBlade), BldStrLoadMesh(iWT)%Mesh(iBlade), Map_AD_BldLoad_P_2_BldStrLoad(iBlade, iWT), ErrStat2, ErrMsg2 ); if(Failed()) return enddo ! iBlade enddo ! iWT @@ -1337,7 +1347,7 @@ subroutine ADI_C_SetupRotor(iWT_c, TurbineIsHAWT_c, TurbOrigin_C, & ! For debugging the interface: - if (debugverbose > 0) then + if (DebugLevel > 0) then call ShowPassedData() endif @@ -1447,7 +1457,7 @@ subroutine ShowPassedData() call WrNR(" Nacelle Orientation ") call WrMatrix(NacOri_C,CU,'(9(ES23.15e2))') call WrScr(" NumBlades_C "//trim(Num2LStr(NumBlades_C)) ) - if (debugverbose > 1) then + if (DebugLevel > 1) then call WrScr(" Root Positions") do i=1,NumBlades_C j=3*(i-1) @@ -1460,7 +1470,7 @@ subroutine ShowPassedData() enddo endif call WrScr(" NumMeshPts_C "//trim(Num2LStr( NumMeshPts_C )) ) - if (debugverbose > 1) then + if (DebugLevel > 1) then call WrScr(" Mesh Positions") do i=1,NumMeshPts_C j=3*(i-1) @@ -1518,34 +1528,34 @@ subroutine SetupMotionMesh() enddo enddo - ! Allocate and define the components of BladePtMeshCoords - allocate(StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(Sim%WT(iWT)%NumBlades), STAT=ErrStat2); if (Failed0('StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords')) return + ! Allocate and define the components of BladeStrMeshCoords + allocate(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(Sim%WT(iWT)%NumBlades), STAT=ErrStat2); if (Failed0('StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords')) return do i=1,Sim%WT(iWT)%NumBlades - call AllocAry(StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Position, 3, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladePtMeshCoords(i)%Position", ErrStat2, ErrMsg2 ); if (Failed()) return - call AllocAry(StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Orient, 3, 3, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladePtMeshCoords(i)%Orient", ErrStat2, ErrMsg2 ); if (Failed()) return - call AllocAry(StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Velocity, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladePtMeshCoords(i)%Velocity", ErrStat2, ErrMsg2 ); if (Failed()) return - call AllocAry(StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Accln, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladePtMeshCoords(i)%Accln", ErrStat2, ErrMsg2 ); if (Failed()) return - call AllocAry(StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Force, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladePtMeshCoords(i)%Force", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Position, 3, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Position", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Orient, 3, 3, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Orient", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Velocity, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Velocity", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Accln, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Accln", ErrStat2, ErrMsg2 ); if (Failed()) return + call AllocAry(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Force, 6, StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i), "BladeStrMeshCoords(i)%Force", ErrStat2, ErrMsg2 ); if (Failed()) return enddo do i=1,Sim%WT(iWT)%NumBlades do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i) - StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Position(1:3,j) = reshape( real(InitMeshPos_C(3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 2 : 3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/3/) ) - StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Orient(1:3,1:3,j) = reshape( real(InitMeshOri_C(9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 8 : 9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),R8Ki), (/3,3/) ) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Position(1:3,j) = reshape( real(InitMeshPos_C(3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 2 : 3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/3/) ) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Orient(1:3,1:3,j) = reshape( real(InitMeshOri_C(9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 8 : 9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),R8Ki), (/3,3/) ) enddo enddo ! Allocate the meshes - allocate(BldPtMotionMesh(iWT)%Mesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('BldPtMotionMesh( iWT )%Mesh' )) return - allocate(BldPtLoadMesh(iWT)%Mesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('BldPtLoadMesh( iWT )%Mesh' )) return - allocate(BldPtLoadMesh_tmp(iWT)%Mesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('BldPtLoadMesh_tmp( iWT )%Mesh' )) return + allocate(BldStrMotionMesh(iWT)%Mesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('BldStrMotionMesh( iWT )%Mesh' )) return + allocate(BldStrLoadMesh(iWT)%Mesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('BldStrLoadMesh( iWT )%Mesh' )) return + allocate(BldStrLoadMesh_tmp(iWT)%Mesh( Sim%WT(iWT)%NumBlades ), STAT=ErrStat2); if (Failed0('BldStrLoadMesh_tmp( iWT )%Mesh' )) return !------------------------------------------------------------- ! Set the interface meshes for motion inputs and loads output !------------------------------------------------------------- ! Motion mesh for blades do iBlade=1,Sim%WT(iWT)%NumBlades - call MeshCreate( BldPtMotionMesh(iWT)%Mesh(iBlade) , & + call MeshCreate( BldStrMotionMesh(iWT)%Mesh(iBlade) , & IOS = COMPONENT_INPUT , & Nnodes = StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(iBlade) , & ErrStat = ErrStat2 , & @@ -1559,30 +1569,37 @@ subroutine SetupMotionMesh() do iBlade=1,Sim%WT(iWT)%NumBlades do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(iBlade) ! Initial position and orientation of node - InitPos = StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Position(1:3,j) + Sim%WT(iWT)%OriginInit(1:3) + InitPos = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Position(1:3,j) + Sim%WT(iWT)%OriginInit(1:3) if (TransposeDCM) then - Orient = transpose(StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Orient(1:3,1:3,j)) + Orient = transpose(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Orient(1:3,1:3,j)) else - Orient = StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Orient(1:3,1:3,j) + Orient = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Orient(1:3,1:3,j) endif call OrientRemap(Orient) - call MeshPositionNode( BldPtMotionMesh(iWT)%Mesh(iBlade) , & + call MeshPositionNode( BldStrMotionMesh(iWT)%Mesh(iBlade) , & j , & InitPos , & ! position ErrStat2, ErrMsg2 , & Orient ) ! orientation if(Failed()) return - call MeshConstructElement ( BldPtMotionMesh(iWT)%Mesh(iBlade), ELEMENT_POINT, ErrStat2, ErrMsg2, j ); if(Failed()) return + + ! Create point or line element based on flag + if (PointLoadOutput) then + call MeshConstructElement ( BldStrMotionMesh(iWT)%Mesh(iBlade), ELEMENT_POINT, ErrStat2, ErrMsg2, j ); if(Failed()) return + else if (j > 1) then + ! This assumes that the first point is the root + call MeshConstructElement ( BldStrMotionMesh(iWT)%Mesh(iBlade), ELEMENT_LINE2, ErrStat2, ErrMsg2, j-1, j ); if(Failed()) return + end if enddo enddo do iBlade=1,Sim%WT(iWT)%NumBlades - call MeshCommit ( BldPtMotionMesh(iWT)%Mesh(iBlade), ErrStat2, ErrMsg2 ); if(Failed()) return - BldPtMotionMesh(iWT)%Mesh(iBlade)%RemapFlag = .FALSE. + call MeshCommit ( BldStrMotionMesh(iWT)%Mesh(iBlade), ErrStat2, ErrMsg2 ); if(Failed()) return + BldStrMotionMesh(iWT)%Mesh(iBlade)%RemapFlag = .FALSE. ! For checking the mesh ! Note: CU is is output unit (platform dependent) - if (debugverbose >= 4) call MeshPrintInfo( CU, BldPtMotionMesh(iWT)%Mesh(iBlade), MeshName='BldPtMotionMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) + if (DebugLevel >= 4) call MeshPrintInfo( CU, BldStrMotionMesh(iWT)%Mesh(iBlade), MeshName='BldStrMotionMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) enddo ! !------------------------------------------------------------- @@ -1614,7 +1631,7 @@ subroutine SetupMotionMesh() ! ! ! For checking the mesh, uncomment this. ! ! note: CU is is output unit (platform dependent). -! if (debugverbose >= 4) call MeshPrintInfo( CU, NacMotionMesh(iWT), MeshName='NacMotionMesh'//trim(Num2LStr(iWT)) ) +! if (DebugLevel >= 4) call MeshPrintInfo( CU, NacMotionMesh(iWT), MeshName='NacMotionMesh'//trim(Num2LStr(iWT)) ) end subroutine SetupMotionMesh end subroutine ADI_C_SetupRotor @@ -1672,7 +1689,7 @@ subroutine ADI_C_SetRotorMotion( iWT_c, & ErrMsg = "" ! For debugging the interface: - if (debugverbose > 0) then + if (DebugLevel > 0) then call ShowPassedData() endif @@ -1689,10 +1706,10 @@ subroutine ADI_C_SetRotorMotion( iWT_c, & ! Reshape mesh position, orientation, velocity, acceleration do i=1,Sim%WT(iWT)%NumBlades do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i) - StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Position( 1:3,j) = reshape( real(MeshPos_C(3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 2 : 3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/3/) ) - StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Orient(1:3,1:3,j) = reshape( real(MeshOri_C(9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 8 : 9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),R8Ki), (/3,3/) ) - StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Velocity( 1:6,j) = reshape( real(MeshVel_C(6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 5 : 6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/6/) ) - StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Accln( 1:6,j) = reshape( real(MeshAcc_C(6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 5 : 6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/6/) ) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Position( 1:3,j) = reshape( real(MeshPos_C(3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 2 : 3 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/3/) ) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Orient(1:3,1:3,j) = reshape( real(MeshOri_C(9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 8 : 9 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),R8Ki), (/3,3/) ) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Velocity( 1:6,j) = reshape( real(MeshVel_C(6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 5 : 6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/6/) ) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Accln( 1:6,j) = reshape( real(MeshAcc_C(6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 5 : 6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)),ReKi), (/6/) ) enddo enddo @@ -1746,7 +1763,7 @@ subroutine ShowPassedData() call WrNR(" Nacelle Acceleration ") call WrMatrix(NacAcc_C,CU,'(6(ES15.7e2))') - if (debugverbose > 1) then + if (DebugLevel > 1) then call WrScr(" Root Positions (positions do not include Turbine origin offset)") do i=1,Sim%WT(iWT_c)%NumBlades j=3*(i-1) @@ -1769,7 +1786,7 @@ subroutine ShowPassedData() enddo endif call WrScr(" NumMeshPts_C "//trim(Num2LStr( NumMeshPts_C )) ) - if (debugverbose > 1) then + if (DebugLevel > 1) then call WrScr(" Mesh Positions (positions do not include Turbine origin offset)") do i=1,NumMeshPts_C j=3*(i-1) @@ -1801,7 +1818,7 @@ end subroutine ADI_C_SetRotorMotion !=============================================================================================================== !> Get the loads from a single rotor. This must be called after ADI_C_CalcOutput subroutine ADI_C_GetRotorLoads(iWT_C, & - NumMeshPts_C, MeshFrc_C, & + NumMeshPts_C, MeshFrc_C, HHVel_C, & ErrStat_C, ErrMsg_C) BIND (C, NAME='ADI_C_GetRotorLoads') implicit none #ifndef IMPLICIT_DLLEXPORT @@ -1811,6 +1828,7 @@ subroutine ADI_C_GetRotorLoads(iWT_C, & integer(c_int), intent(in ) :: iWT_C !< Wind turbine / rotor number integer(c_int), intent(in ) :: NumMeshPts_C !< Number of mesh points we are transfering motions to and output loads to real(c_float), intent( out) :: MeshFrc_C( 6*NumMeshPts_C ) !< A 6xNumMeshPts_C array [Fx,Fy,Fz,Mx,My,Mz] -- forces and moments (global) + real(c_float), intent( out) :: HHVel_C(3) !< Wind speed array [Vx,Vy,Vz] -- (m/s) (global) integer(c_int), intent( out) :: ErrStat_C character(kind=c_char), intent( out) :: ErrMsg_C(ErrMsgLen_C) @@ -1828,7 +1846,7 @@ subroutine ADI_C_GetRotorLoads(iWT_C, & ErrMsg = "" ! For debugging the interface: - if (debugverbose > 0) then + if (DebugLevel > 0) then call ShowPassedData() endif @@ -1850,10 +1868,17 @@ subroutine ADI_C_GetRotorLoads(iWT_C, & call Set_OutputLoadArray(iWT) do i=1,Sim%WT(iWT)%NumBlades do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(i) - MeshFrc_C(6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 5 : 6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)) = real(StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(i)%Force(1:6,j), c_float) + MeshFrc_C(6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j) - 5 : 6 * StrucPts_2_Bld_Map(iWT)%BladeNode_2_MeshPt(i)%BladeNodeToMeshPoint(j)) = real(StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(i)%Force(1:6,j), c_float) enddo enddo + ! Set hub height wind speed (m/s) + if (ADI%p%storeHHVel) then + HHVel_C = real(ADI%y%HHVel(:, iWT), c_float) + else + HHVel_C = 0.0_c_float + end if + ! Set error status call SetErr(ErrStat,ErrMsg,ErrStat_C,ErrMsg_C) @@ -1897,14 +1922,14 @@ subroutine Set_MotionMesh(iWT, ErrStat3, ErrMsg3) ! Set mesh corresponding to input motions do iBlade=1,Sim%WT(iWT)%NumBlades do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(iBlade) - BldPtMotionMesh(iWT)%Mesh(iBlade)%TranslationDisp(1:3,j) = StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Position(1:3,j) + Sim%WT(iWT)%OriginInit(1:3) - real(BldPtMotionMesh(iWT)%Mesh(iBlade)%Position(1:3,j), R8Ki) - BldPtMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j) = StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Orient(1:3,1:3,j) - BldPtMotionMesh(iWT)%Mesh(iBlade)%TranslationVel( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Velocity(1:3,j) - BldPtMotionMesh(iWT)%Mesh(iBlade)%RotationVel( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Velocity(4:6,j) - BldPtMotionMesh(iWT)%Mesh(iBlade)%TranslationAcc( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Accln(1:3,j) - call OrientRemap(BldPtMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j)) + BldStrMotionMesh(iWT)%Mesh(iBlade)%TranslationDisp(1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Position(1:3,j) + Sim%WT(iWT)%OriginInit(1:3) - real(BldStrMotionMesh(iWT)%Mesh(iBlade)%Position(1:3,j), R8Ki) + BldStrMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Orient(1:3,1:3,j) + BldStrMotionMesh(iWT)%Mesh(iBlade)%TranslationVel( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Velocity(1:3,j) + BldStrMotionMesh(iWT)%Mesh(iBlade)%RotationVel( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Velocity(4:6,j) + BldStrMotionMesh(iWT)%Mesh(iBlade)%TranslationAcc( 1:3,j) = StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Accln(1:3,j) + call OrientRemap(BldStrMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j)) if (TransposeDCM) then - BldPtMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j) = transpose(BldPtMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j)) + BldStrMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j) = transpose(BldStrMotionMesh(iWT)%Mesh(iBlade)%Orientation(1:3,1:3,j)) endif enddo enddo @@ -1983,9 +2008,14 @@ subroutine AD_SetInputMotion( iWT, u_local, & ! Blade mesh do iBlade=1,Sim%WT(iWT)%numBlades - n_elems = size(BldPtMotionMesh(iWT)%Mesh(iBlade)%Position, 2) + n_elems = size(BldStrMotionMesh(iWT)%Mesh(iBlade)%Position, 2) if (( u_local%AD%rotors(iWT)%BladeMotion(iBlade)%Committed ) .and. (n_elems > 0)) then - call Transfer_Point_to_Line2( BldPtMotionMesh(iWT)%Mesh(iBlade), u_local%AD%rotors(iWT)%BladeMotion(iBlade), Map_BldPtMotion_2_AD_Blade(i,iWT), ErrStat, ErrMsg ) + if (PointLoadOutput) then + call Transfer_Point_to_Line2(BldStrMotionMesh(iWT)%Mesh(iBlade), u_local%AD%rotors(iWT)%BladeMotion(iBlade), Map_BldStrMotion_2_AD_Blade(i,iWT), ErrStat, ErrMsg) + else + call Transfer_Line2_to_Line2(BldStrMotionMesh(iWT)%Mesh(iBlade), u_local%AD%rotors(iWT)%BladeMotion(iBlade), Map_BldStrMotion_2_AD_Blade(i,iWT), ErrStat, ErrMsg) + u_local%AD%rotors(iWT)%BladeMotion(iBlade)%RemapFlag = .false. + end if if (ErrStat >= AbortErrLev) return endif enddo @@ -2004,26 +2034,32 @@ subroutine AD_TransferLoads( iWT, u_local, y_local, ErrStat3, ErrMsg3 ) do iBlade=1,Sim%WT(iWT)%NumBlades - n_elems = size(BldPtMotionMesh(iWT)%Mesh(iBlade)%Position, 2) + n_elems = size(BldStrMotionMesh(iWT)%Mesh(iBlade)%Position, 2) if (n_elems > 0) then - BldPtLoadMesh(iWT)%Mesh(iBlade)%Force = 0.0_ReKi - BldPtLoadMesh(iWT)%Mesh(iBlade)%Moment = 0.0_ReKi + BldStrLoadMesh(iWT)%Mesh(iBlade)%Force = 0.0_ReKi + BldStrLoadMesh(iWT)%Mesh(iBlade)%Moment = 0.0_ReKi endif enddo do iBlade=1,Sim%WT(iWT)%NumBlades if ( y_local%AD%rotors(iWT)%BladeLoad(iBlade)%Committed ) then - if (debugverbose > 4) call MeshPrintInfo( CU, y_local%AD%rotors(iWT)%BladeLoad(iBlade), MeshName='AD%rotors('//trim(Num2LStr(iWT))//')%BladeLoad('//trim(Num2LStr(iBlade))//')' ) - n_elems = size(BldPtMotionMesh(iWT)%Mesh(iBlade)%Position, 2) + if (DebugLevel >= 4) call MeshPrintInfo( CU, y_local%AD%rotors(iWT)%BladeLoad(iBlade), MeshName='AD%rotors('//trim(Num2LStr(iWT))//')%BladeLoad('//trim(Num2LStr(iBlade))//')' ) + n_elems = size(BldStrMotionMesh(iWT)%Mesh(iBlade)%Position, 2) if (n_elems > 0) then - call Transfer_Line2_to_Point( ADI%y%AD%rotors(iWT)%BladeLoad(iBlade), BldPtLoadMesh_tmp(iWT)%Mesh(iBlade), Map_AD_BldLoad_P_2_BldPtLoad(iBlade,iWT), & - ErrStat3, ErrMsg3, u_local%AD%rotors(iWT)%BladeMotion(iBlade), BldPtMotionMesh(iWT)%Mesh(iBlade) ) + if (PointLoadOutput) then + call Transfer_Line2_to_Point(ADI%y%AD%rotors(iWT)%BladeLoad(iBlade), BldStrLoadMesh_tmp(iWT)%Mesh(iBlade), Map_AD_BldLoad_P_2_BldStrLoad(iBlade,iWT), & + ErrStat3, ErrMsg3, u_local%AD%rotors(iWT)%BladeMotion(iBlade), BldStrMotionMesh(iWT)%Mesh(iBlade)) + else + call Transfer_Line2_to_Line2(ADI%y%AD%rotors(iWT)%BladeLoad(iBlade), BldStrLoadMesh_tmp(iWT)%Mesh(iBlade), Map_AD_BldLoad_P_2_BldStrLoad(iBlade,iWT), & + ErrStat3, ErrMsg3, u_local%AD%rotors(iWT)%BladeMotion(iBlade), BldStrMotionMesh(iWT)%Mesh(iBlade)) + ADI%y%AD%rotors(iWT)%BladeLoad(iBlade)%RemapFlag = .false. + end if if (ErrStat3 >= AbortErrLev) return - BldPtLoadMesh(iWT)%Mesh(iBlade)%Force = BldPtLoadMesh(iWT)%Mesh(iBlade)%Force + BldPtLoadMesh_tmp(iWT)%Mesh(iBlade)%Force - BldPtLoadMesh(iWT)%Mesh(iBlade)%Moment = BldPtLoadMesh(iWT)%Mesh(iBlade)%Moment + BldPtLoadMesh_tmp(iWT)%Mesh(iBlade)%Moment + BldStrLoadMesh(iWT)%Mesh(iBlade)%Force = BldStrLoadMesh(iWT)%Mesh(iBlade)%Force + BldStrLoadMesh_tmp(iWT)%Mesh(iBlade)%Force + BldStrLoadMesh(iWT)%Mesh(iBlade)%Moment = BldStrLoadMesh(iWT)%Mesh(iBlade)%Moment + BldStrLoadMesh_tmp(iWT)%Mesh(iBlade)%Moment endif endif - if (debugverbose > 4) call MeshPrintInfo( CU, BldPtLoadMesh(iWT)%Mesh(iBlade), MeshName='BldPtLoadMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) + if (DebugLevel >= 4) call MeshPrintInfo( CU, BldStrLoadMesh(iWT)%Mesh(iBlade), MeshName='BldStrLoadMesh'//trim(Num2LStr(iWT))//'_'//trim(Num2LStr(iBlade)) ) enddo end subroutine AD_TransferLoads @@ -2036,8 +2072,8 @@ subroutine Set_OutputLoadArray(iWT) ! Set mesh corresponding to input motions do iBlade=1,Sim%WT(iWT)%NumBlades do j=1,StrucPts_2_Bld_Map(iWT)%NumMeshPtsPerBlade(iBlade) - StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Force(1:3,j) = BldPtLoadMesh(iWT)%Mesh(iBlade)%Force( 1:3,j) - StrucPts_2_Bld_Map(iWT)%BladePtMeshCoords(iBlade)%Force(4:6,j) = BldPtLoadMesh(iWT)%Mesh(iBlade)%Moment(1:3,j) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Force(1:3,j) = BldStrLoadMesh(iWT)%Mesh(iBlade)%Force( 1:3,j) + StrucPts_2_Bld_Map(iWT)%BladeStrMeshCoords(iBlade)%Force(4:6,j) = BldStrLoadMesh(iWT)%Mesh(iBlade)%Moment(1:3,j) enddo enddo end subroutine Set_OutputLoadArray @@ -2111,7 +2147,7 @@ subroutine WrVTK_PointsRef(ErrStat3,ErrMsg3) ! Blade point motion (structural mesh from driver) do iBlade=1,Sim%WT(iWT)%NumBlades - call MeshWrVTKreference(RefPoint, BldPtMotionMesh(iWT)%Mesh(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BldPtMotionMesh', ErrStat3, ErrMsg3) + call MeshWrVTKreference(RefPoint, BldStrMotionMesh(iWT)%Mesh(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BldStrMotionMesh', ErrStat3, ErrMsg3) if (ErrStat3 >= AbortErrLev) return enddo @@ -2218,7 +2254,7 @@ subroutine WrVTK_Points(ErrStat3,ErrMsg3) ! Blade point motion (structural mesh from driver) do iBlade=1,Sim%WT(iWT)%NumBlades - call MeshWrVTK(RefPoint, BldPtMotionMesh(iWT)%Mesh(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BldPtMotionMesh'//trim(num2lstr(iBlade)), n_Global, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) + call MeshWrVTK(RefPoint, BldStrMotionMesh(iWT)%Mesh(iBlade), trim(WrOutputsData%VTK_OutFileRoot)//trim(sWT)//'.BldStrMotionMesh'//trim(num2lstr(iBlade)), n_Global, .true., ErrStat3, ErrMsg3, WrOutputsData%VTK_tWidth) if (ErrStat3 >= AbortErrLev) return enddo @@ -2403,13 +2439,13 @@ subroutine ClearTmpStorage() CHARACTER(ErrMsgLen) :: errMsg2 ! Meshes do iWT=1,Sim%NumTurbines - if (allocated(BldPtMotionMesh(iWT)%Mesh)) call ClearMeshArr1(BldPtMotionMesh(iWT)%Mesh) - if (allocated(BldPtLoadMesh(iWT)%Mesh)) call ClearMeshArr1(BldPtLoadMesh(iWT)%Mesh) - if (allocated(BldPtLoadMesh_tmp(iWT)%Mesh)) call ClearMeshArr1(BldPtLoadMesh_tmp(iWT)%Mesh) + if (allocated(BldStrMotionMesh(iWT)%Mesh)) call ClearMeshArr1(BldStrMotionMesh(iWT)%Mesh) + if (allocated(BldStrLoadMesh(iWT)%Mesh)) call ClearMeshArr1(BldStrLoadMesh(iWT)%Mesh) + if (allocated(BldStrLoadMesh_tmp(iWT)%Mesh)) call ClearMeshArr1(BldStrLoadMesh_tmp(iWT)%Mesh) enddo ! if (allocated(NacMotionMesh )) call ClearMeshArr1(NacMotionMesh ) ! if (allocated(NacLoadMesh )) call ClearMeshArr1(NacLoadMesh ) - if (allocated(Map_BldPtMotion_2_AD_Blade )) call ClearMeshMapArr2(Map_BldPtMotion_2_AD_Blade ) + if (allocated(Map_BldStrMotion_2_AD_Blade )) call ClearMeshMapArr2(Map_BldStrMotion_2_AD_Blade ) contains subroutine ClearMeshArr1(MeshName) type(MeshType), allocatable :: MeshName(:) diff --git a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 index 83417c9152..0b09d54208 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow_Types.f90 @@ -34,7 +34,7 @@ MODULE AeroDyn_Inflow_Types USE AeroDyn_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 [-] @@ -175,7 +175,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 @@ -435,7 +469,7 @@ subroutine ADI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_CopyInitOutput' @@ -445,8 +479,8 @@ subroutine ADI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -457,8 +491,8 @@ subroutine ADI_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -504,7 +538,7 @@ subroutine ADI_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ADI_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -703,8 +737,8 @@ subroutine ADI_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_CopyMisc' @@ -717,8 +751,8 @@ subroutine ADI_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%VTK_surfaces)) then - LB(1:1) = lbound(SrcMiscData%VTK_surfaces, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%VTK_surfaces, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%VTK_surfaces) + UB(1:1) = ubound(SrcMiscData%VTK_surfaces) if (.not. allocated(DstMiscData%VTK_surfaces)) then allocate(DstMiscData%VTK_surfaces(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -738,8 +772,8 @@ subroutine ADI_DestroyMisc(MiscData, ErrStat, ErrMsg) type(ADI_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_DestroyMisc' @@ -750,8 +784,8 @@ subroutine ADI_DestroyMisc(MiscData, ErrStat, ErrMsg) call ADI_DestroyInflowWindData(MiscData%IW, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%VTK_surfaces)) then - LB(1:1) = lbound(MiscData%VTK_surfaces, kind=B8Ki) - UB(1:1) = ubound(MiscData%VTK_surfaces, kind=B8Ki) + LB(1:1) = lbound(MiscData%VTK_surfaces) + UB(1:1) = ubound(MiscData%VTK_surfaces) do i1 = LB(1), UB(1) call AD_DestroyVTK_RotSurfaceType(MiscData%VTK_surfaces(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -764,16 +798,16 @@ subroutine ADI_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(ADI_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call AD_PackMisc(RF, InData%AD) call ADI_PackInflowWindData(RF, InData%IW) call RegPack(RF, allocated(InData%VTK_surfaces)) if (allocated(InData%VTK_surfaces)) then - call RegPackBounds(RF, 1, lbound(InData%VTK_surfaces, kind=B8Ki), ubound(InData%VTK_surfaces, kind=B8Ki)) - LB(1:1) = lbound(InData%VTK_surfaces, kind=B8Ki) - UB(1:1) = ubound(InData%VTK_surfaces, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%VTK_surfaces), ubound(InData%VTK_surfaces)) + LB(1:1) = lbound(InData%VTK_surfaces) + UB(1:1) = ubound(InData%VTK_surfaces) do i1 = LB(1), UB(1) call AD_PackVTK_RotSurfaceType(RF, InData%VTK_surfaces(i1)) end do @@ -785,8 +819,8 @@ subroutine ADI_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(ADI_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -926,7 +960,7 @@ subroutine ADI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_CopyOutput' @@ -936,8 +970,8 @@ subroutine ADI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%HHVel)) then - LB(1:2) = lbound(SrcOutputData%HHVel, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%HHVel, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%HHVel) + UB(1:2) = ubound(SrcOutputData%HHVel) if (.not. allocated(DstOutputData%HHVel)) then allocate(DstOutputData%HHVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -949,8 +983,8 @@ subroutine ADI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end if DstOutputData%PLExp = SrcOutputData%PLExp if (allocated(SrcOutputData%IW_WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%IW_WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%IW_WriteOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%IW_WriteOutput) + UB(1:1) = ubound(SrcOutputData%IW_WriteOutput) if (.not. allocated(DstOutputData%IW_WriteOutput)) then allocate(DstOutputData%IW_WriteOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -961,8 +995,8 @@ subroutine ADI_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%IW_WriteOutput = SrcOutputData%IW_WriteOutput end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -1013,7 +1047,7 @@ subroutine ADI_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ADI_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackOutput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1030,16 +1064,16 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_CopyData' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDataData%x)) then - LB(1:1) = lbound(SrcDataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcDataData%x, kind=B8Ki) + LB(1:1) = lbound(SrcDataData%x) + UB(1:1) = ubound(SrcDataData%x) if (.not. allocated(DstDataData%x)) then allocate(DstDataData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1054,8 +1088,8 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcDataData%xd)) then - LB(1:1) = lbound(SrcDataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcDataData%xd, kind=B8Ki) + LB(1:1) = lbound(SrcDataData%xd) + UB(1:1) = ubound(SrcDataData%xd) if (.not. allocated(DstDataData%xd)) then allocate(DstDataData%xd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1070,8 +1104,8 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcDataData%z)) then - LB(1:1) = lbound(SrcDataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcDataData%z, kind=B8Ki) + LB(1:1) = lbound(SrcDataData%z) + UB(1:1) = ubound(SrcDataData%z) if (.not. allocated(DstDataData%z)) then allocate(DstDataData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1086,8 +1120,8 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcDataData%OtherState)) then - LB(1:1) = lbound(SrcDataData%OtherState, kind=B8Ki) - UB(1:1) = ubound(SrcDataData%OtherState, kind=B8Ki) + LB(1:1) = lbound(SrcDataData%OtherState) + UB(1:1) = ubound(SrcDataData%OtherState) if (.not. allocated(DstDataData%OtherState)) then allocate(DstDataData%OtherState(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1108,8 +1142,8 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcDataData%u)) then - LB(1:1) = lbound(SrcDataData%u, kind=B8Ki) - UB(1:1) = ubound(SrcDataData%u, kind=B8Ki) + LB(1:1) = lbound(SrcDataData%u) + UB(1:1) = ubound(SrcDataData%u) if (.not. allocated(DstDataData%u)) then allocate(DstDataData%u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1127,8 +1161,8 @@ subroutine ADI_CopyData(SrcDataData, DstDataData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcDataData%inputTimes)) then - LB(1:1) = lbound(SrcDataData%inputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcDataData%inputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcDataData%inputTimes) + UB(1:1) = ubound(SrcDataData%inputTimes) if (.not. allocated(DstDataData%inputTimes)) then allocate(DstDataData%inputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1144,16 +1178,16 @@ subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) type(ADI_Data), intent(inout) :: DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_DestroyData' ErrStat = ErrID_None ErrMsg = '' if (allocated(DataData%x)) then - LB(1:1) = lbound(DataData%x, kind=B8Ki) - UB(1:1) = ubound(DataData%x, kind=B8Ki) + LB(1:1) = lbound(DataData%x) + UB(1:1) = ubound(DataData%x) do i1 = LB(1), UB(1) call ADI_DestroyContState(DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1161,8 +1195,8 @@ subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) deallocate(DataData%x) end if if (allocated(DataData%xd)) then - LB(1:1) = lbound(DataData%xd, kind=B8Ki) - UB(1:1) = ubound(DataData%xd, kind=B8Ki) + LB(1:1) = lbound(DataData%xd) + UB(1:1) = ubound(DataData%xd) do i1 = LB(1), UB(1) call ADI_DestroyDiscState(DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1170,8 +1204,8 @@ subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) deallocate(DataData%xd) end if if (allocated(DataData%z)) then - LB(1:1) = lbound(DataData%z, kind=B8Ki) - UB(1:1) = ubound(DataData%z, kind=B8Ki) + LB(1:1) = lbound(DataData%z) + UB(1:1) = ubound(DataData%z) do i1 = LB(1), UB(1) call ADI_DestroyConstrState(DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1179,8 +1213,8 @@ subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) deallocate(DataData%z) end if if (allocated(DataData%OtherState)) then - LB(1:1) = lbound(DataData%OtherState, kind=B8Ki) - UB(1:1) = ubound(DataData%OtherState, kind=B8Ki) + LB(1:1) = lbound(DataData%OtherState) + UB(1:1) = ubound(DataData%OtherState) do i1 = LB(1), UB(1) call ADI_DestroyOtherState(DataData%OtherState(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1192,8 +1226,8 @@ subroutine ADI_DestroyData(DataData, ErrStat, ErrMsg) call ADI_DestroyMisc(DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(DataData%u)) then - LB(1:1) = lbound(DataData%u, kind=B8Ki) - UB(1:1) = ubound(DataData%u, kind=B8Ki) + LB(1:1) = lbound(DataData%u) + UB(1:1) = ubound(DataData%u) do i1 = LB(1), UB(1) call ADI_DestroyInput(DataData%u(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1211,41 +1245,41 @@ subroutine ADI_PackData(RF, Indata) type(RegFile), intent(inout) :: RF type(ADI_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackData' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 1, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + 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 ADI_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, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) + 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 ADI_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, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + 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 ADI_PackConstrState(RF, InData%z(i1)) end do end if call RegPack(RF, allocated(InData%OtherState)) if (allocated(InData%OtherState)) then - call RegPackBounds(RF, 1, lbound(InData%OtherState, kind=B8Ki), ubound(InData%OtherState, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherState, kind=B8Ki) - UB(1:1) = ubound(InData%OtherState, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OtherState), ubound(InData%OtherState)) + LB(1:1) = lbound(InData%OtherState) + UB(1:1) = ubound(InData%OtherState) do i1 = LB(1), UB(1) call ADI_PackOtherState(RF, InData%OtherState(i1)) end do @@ -1254,9 +1288,9 @@ subroutine ADI_PackData(RF, Indata) call ADI_PackMisc(RF, InData%m) call RegPack(RF, allocated(InData%u)) if (allocated(InData%u)) then - call RegPackBounds(RF, 1, lbound(InData%u, kind=B8Ki), ubound(InData%u, kind=B8Ki)) - LB(1:1) = lbound(InData%u, kind=B8Ki) - UB(1:1) = ubound(InData%u, kind=B8Ki) + 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 ADI_PackInput(RF, InData%u(i1)) end do @@ -1270,8 +1304,8 @@ subroutine ADI_UnPackData(RF, OutData) type(RegFile), intent(inout) :: RF type(ADI_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackData' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1352,8 +1386,8 @@ subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_CopyRotFED' @@ -1375,8 +1409,8 @@ subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotFEDData%BladeRootMotion)) then - LB(1:1) = lbound(SrcRotFEDData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(SrcRotFEDData%BladeRootMotion, kind=B8Ki) + LB(1:1) = lbound(SrcRotFEDData%BladeRootMotion) + UB(1:1) = ubound(SrcRotFEDData%BladeRootMotion) if (.not. allocated(DstRotFEDData%BladeRootMotion)) then allocate(DstRotFEDData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1391,8 +1425,8 @@ subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMs end do end if if (allocated(SrcRotFEDData%BladeLn2Mesh)) then - LB(1:1) = lbound(SrcRotFEDData%BladeLn2Mesh, kind=B8Ki) - UB(1:1) = ubound(SrcRotFEDData%BladeLn2Mesh, kind=B8Ki) + LB(1:1) = lbound(SrcRotFEDData%BladeLn2Mesh) + UB(1:1) = ubound(SrcRotFEDData%BladeLn2Mesh) if (.not. allocated(DstRotFEDData%BladeLn2Mesh)) then allocate(DstRotFEDData%BladeLn2Mesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1416,8 +1450,8 @@ subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotFEDData%AD_P_2_AD_L_B)) then - LB(1:1) = lbound(SrcRotFEDData%AD_P_2_AD_L_B, kind=B8Ki) - UB(1:1) = ubound(SrcRotFEDData%AD_P_2_AD_L_B, kind=B8Ki) + LB(1:1) = lbound(SrcRotFEDData%AD_P_2_AD_L_B) + UB(1:1) = ubound(SrcRotFEDData%AD_P_2_AD_L_B) if (.not. allocated(DstRotFEDData%AD_P_2_AD_L_B)) then allocate(DstRotFEDData%AD_P_2_AD_L_B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1435,8 +1469,8 @@ subroutine ADI_CopyRotFED(SrcRotFEDData, DstRotFEDData, CtrlCode, ErrStat, ErrMs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcRotFEDData%ED_P_2_AD_P_R)) then - LB(1:1) = lbound(SrcRotFEDData%ED_P_2_AD_P_R, kind=B8Ki) - UB(1:1) = ubound(SrcRotFEDData%ED_P_2_AD_P_R, kind=B8Ki) + LB(1:1) = lbound(SrcRotFEDData%ED_P_2_AD_P_R) + UB(1:1) = ubound(SrcRotFEDData%ED_P_2_AD_P_R) if (.not. allocated(DstRotFEDData%ED_P_2_AD_P_R)) then allocate(DstRotFEDData%ED_P_2_AD_P_R(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1462,8 +1496,8 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) type(RotFED), intent(inout) :: RotFEDData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_DestroyRotFED' @@ -1480,8 +1514,8 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) call MeshDestroy( RotFEDData%HubPtMotion, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotFEDData%BladeRootMotion)) then - LB(1:1) = lbound(RotFEDData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(RotFEDData%BladeRootMotion, kind=B8Ki) + LB(1:1) = lbound(RotFEDData%BladeRootMotion) + UB(1:1) = ubound(RotFEDData%BladeRootMotion) do i1 = LB(1), UB(1) call MeshDestroy( RotFEDData%BladeRootMotion(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1489,8 +1523,8 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) deallocate(RotFEDData%BladeRootMotion) end if if (allocated(RotFEDData%BladeLn2Mesh)) then - LB(1:1) = lbound(RotFEDData%BladeLn2Mesh, kind=B8Ki) - UB(1:1) = ubound(RotFEDData%BladeLn2Mesh, kind=B8Ki) + LB(1:1) = lbound(RotFEDData%BladeLn2Mesh) + UB(1:1) = ubound(RotFEDData%BladeLn2Mesh) do i1 = LB(1), UB(1) call MeshDestroy( RotFEDData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1502,8 +1536,8 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(RotFEDData%AD_P_2_AD_L_T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotFEDData%AD_P_2_AD_L_B)) then - LB(1:1) = lbound(RotFEDData%AD_P_2_AD_L_B, kind=B8Ki) - UB(1:1) = ubound(RotFEDData%AD_P_2_AD_L_B, kind=B8Ki) + LB(1:1) = lbound(RotFEDData%AD_P_2_AD_L_B) + UB(1:1) = ubound(RotFEDData%AD_P_2_AD_L_B) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(RotFEDData%AD_P_2_AD_L_B(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1513,8 +1547,8 @@ subroutine ADI_DestroyRotFED(RotFEDData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(RotFEDData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotFEDData%ED_P_2_AD_P_R)) then - LB(1:1) = lbound(RotFEDData%ED_P_2_AD_P_R, kind=B8Ki) - UB(1:1) = ubound(RotFEDData%ED_P_2_AD_P_R, kind=B8Ki) + LB(1:1) = lbound(RotFEDData%ED_P_2_AD_P_R) + UB(1:1) = ubound(RotFEDData%ED_P_2_AD_P_R) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(RotFEDData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1531,8 +1565,8 @@ subroutine ADI_PackRotFED(RF, Indata) type(RegFile), intent(inout) :: RF type(RotFED), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackRotFED' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call MeshPack(RF, InData%PlatformPtMesh) call MeshPack(RF, InData%TwrPtMesh) @@ -1541,18 +1575,18 @@ subroutine ADI_PackRotFED(RF, Indata) call MeshPack(RF, InData%HubPtMotion) call RegPack(RF, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then - call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(InData%BladeRootMotion, kind=B8Ki) + 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 RegPack(RF, allocated(InData%BladeLn2Mesh)) if (allocated(InData%BladeLn2Mesh)) then - call RegPackBounds(RF, 1, lbound(InData%BladeLn2Mesh, kind=B8Ki), ubound(InData%BladeLn2Mesh, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeLn2Mesh, kind=B8Ki) - UB(1:1) = ubound(InData%BladeLn2Mesh, kind=B8Ki) + 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 @@ -1564,9 +1598,9 @@ subroutine ADI_PackRotFED(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%AD_P_2_AD_L_T) call RegPack(RF, allocated(InData%AD_P_2_AD_L_B)) if (allocated(InData%AD_P_2_AD_L_B)) then - call RegPackBounds(RF, 1, lbound(InData%AD_P_2_AD_L_B, kind=B8Ki), ubound(InData%AD_P_2_AD_L_B, kind=B8Ki)) - LB(1:1) = lbound(InData%AD_P_2_AD_L_B, kind=B8Ki) - UB(1:1) = ubound(InData%AD_P_2_AD_L_B, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%AD_P_2_AD_L_B), ubound(InData%AD_P_2_AD_L_B)) + LB(1:1) = lbound(InData%AD_P_2_AD_L_B) + UB(1:1) = ubound(InData%AD_P_2_AD_L_B) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%AD_P_2_AD_L_B(i1)) end do @@ -1574,9 +1608,9 @@ subroutine ADI_PackRotFED(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_TF) call RegPack(RF, allocated(InData%ED_P_2_AD_P_R)) if (allocated(InData%ED_P_2_AD_P_R)) then - call RegPackBounds(RF, 1, lbound(InData%ED_P_2_AD_P_R, kind=B8Ki), ubound(InData%ED_P_2_AD_P_R, kind=B8Ki)) - LB(1:1) = lbound(InData%ED_P_2_AD_P_R, kind=B8Ki) - UB(1:1) = ubound(InData%ED_P_2_AD_P_R, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_AD_P_R), ubound(InData%ED_P_2_AD_P_R)) + LB(1:1) = lbound(InData%ED_P_2_AD_P_R) + UB(1:1) = ubound(InData%ED_P_2_AD_P_R) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_R(i1)) end do @@ -1590,8 +1624,8 @@ subroutine ADI_UnPackRotFED(RF, OutData) type(RegFile), intent(inout) :: RF type(RotFED), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackRotFED' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1668,16 +1702,16 @@ subroutine ADI_CopyFED_Data(SrcFED_DataData, DstFED_DataData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_CopyFED_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcFED_DataData%WT)) then - LB(1:1) = lbound(SrcFED_DataData%WT, kind=B8Ki) - UB(1:1) = ubound(SrcFED_DataData%WT, kind=B8Ki) + LB(1:1) = lbound(SrcFED_DataData%WT) + UB(1:1) = ubound(SrcFED_DataData%WT) if (.not. allocated(DstFED_DataData%WT)) then allocate(DstFED_DataData%WT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1697,16 +1731,16 @@ subroutine ADI_DestroyFED_Data(FED_DataData, ErrStat, ErrMsg) type(FED_Data), intent(inout) :: FED_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ADI_DestroyFED_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(FED_DataData%WT)) then - LB(1:1) = lbound(FED_DataData%WT, kind=B8Ki) - UB(1:1) = ubound(FED_DataData%WT, kind=B8Ki) + LB(1:1) = lbound(FED_DataData%WT) + UB(1:1) = ubound(FED_DataData%WT) do i1 = LB(1), UB(1) call ADI_DestroyRotFED(FED_DataData%WT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1719,14 +1753,14 @@ subroutine ADI_PackFED_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(FED_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'ADI_PackFED_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%WT)) if (allocated(InData%WT)) then - call RegPackBounds(RF, 1, lbound(InData%WT, kind=B8Ki), ubound(InData%WT, kind=B8Ki)) - LB(1:1) = lbound(InData%WT, kind=B8Ki) - UB(1:1) = ubound(InData%WT, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%WT), ubound(InData%WT)) + LB(1:1) = lbound(InData%WT) + UB(1:1) = ubound(InData%WT) do i1 = LB(1), UB(1) call ADI_PackRotFED(RF, InData%WT(i1)) end do @@ -1738,8 +1772,8 @@ subroutine ADI_UnPackFED_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(FED_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ADI_UnPackFED_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1757,5 +1791,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 662b3c1ed8..78ad76dd5b 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -52,6 +52,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) @@ -137,6 +140,7 @@ typedef ^ AD_BladePropsType ReKi BlCenBt {:} - - "Center of buoyancy 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" - @@ -281,84 +285,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" - -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" - - # 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 @@ -368,9 +294,9 @@ typedef ^ RotInflowType ReKi InflowOnHub {3}{1} - - "U,V,W at hub" m/s typedef ^ RotInflowType ReKi InflowOnNacelle {3}{1} - - "U,V,W at nacelle" m/s typedef ^ RotInflowType ReKi InflowOnTailFin {3}{1} - - "U,V,W at tailfin" m/s 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 AD_InflowType Inflow {:} - - "Inflow storage (size of u for history of inputs)" - # ..... Parameters ................................................................................................................ @@ -378,19 +304,7 @@ typedef ^ MiscVarType AD_InflowType Inflow {:} - - "Inflow storage (size of u fo # 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" - @@ -420,9 +334,6 @@ typedef ^ RotParameterType ReKi TwrTaper {:} - - "Array of tower element t typedef ^ RotParameterType ReKi TwrAxCent {:} - - "Array of tower element axial centroid, used in buoyancy calculation" - 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)" @@ -513,3 +424,91 @@ 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 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 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 1c79744070..9096b21483 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -38,29 +38,32 @@ MODULE AeroDyn_Types USE InflowWind_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)] @@ -159,6 +162,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 [-] @@ -319,87 +323,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 -! ======================= -! ========= 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 -! ======================= ! ========= 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] @@ -422,29 +345,9 @@ MODULE AeroDyn_Types TYPE(RotInflowType) , DIMENSION(:), ALLOCATABLE :: RotInflow !< Inflow on rotor [-] END TYPE AD_InflowType ! ======================= -! ========= 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 [-] @@ -474,9 +377,6 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrAxCent !< Array of tower element axial centroid, used in buoyancy calculation [-] 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) [-] @@ -568,7 +468,118 @@ 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] + 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(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 @@ -712,14 +723,14 @@ subroutine AD_CopyVTK_BLSurfaceType(SrcVTK_BLSurfaceTypeData, DstVTK_BLSurfaceTy integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_CopyVTK_BLSurfaceType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcVTK_BLSurfaceTypeData%AirfoilCoords)) then - LB(1:3) = lbound(SrcVTK_BLSurfaceTypeData%AirfoilCoords, kind=B8Ki) - UB(1:3) = ubound(SrcVTK_BLSurfaceTypeData%AirfoilCoords, kind=B8Ki) + LB(1:3) = lbound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) + UB(1:3) = ubound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) if (.not. allocated(DstVTK_BLSurfaceTypeData%AirfoilCoords)) then allocate(DstVTK_BLSurfaceTypeData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -756,7 +767,7 @@ subroutine AD_UnPackVTK_BLSurfaceType(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_VTK_BLSurfaceType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackVTK_BLSurfaceType' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -769,16 +780,16 @@ subroutine AD_CopyVTK_RotSurfaceType(SrcVTK_RotSurfaceTypeData, DstVTK_RotSurfac integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyVTK_RotSurfaceType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcVTK_RotSurfaceTypeData%BladeShape)) then - LB(1:1) = lbound(SrcVTK_RotSurfaceTypeData%BladeShape, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_RotSurfaceTypeData%BladeShape, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_RotSurfaceTypeData%BladeShape) + UB(1:1) = ubound(SrcVTK_RotSurfaceTypeData%BladeShape) if (.not. allocated(DstVTK_RotSurfaceTypeData%BladeShape)) then allocate(DstVTK_RotSurfaceTypeData%BladeShape(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -793,8 +804,8 @@ subroutine AD_CopyVTK_RotSurfaceType(SrcVTK_RotSurfaceTypeData, DstVTK_RotSurfac end do end if if (allocated(SrcVTK_RotSurfaceTypeData%TowerRad)) then - LB(1:1) = lbound(SrcVTK_RotSurfaceTypeData%TowerRad, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_RotSurfaceTypeData%TowerRad, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_RotSurfaceTypeData%TowerRad) + UB(1:1) = ubound(SrcVTK_RotSurfaceTypeData%TowerRad) if (.not. allocated(DstVTK_RotSurfaceTypeData%TowerRad)) then allocate(DstVTK_RotSurfaceTypeData%TowerRad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -810,16 +821,16 @@ subroutine AD_DestroyVTK_RotSurfaceType(VTK_RotSurfaceTypeData, ErrStat, ErrMsg) type(AD_VTK_RotSurfaceType), intent(inout) :: VTK_RotSurfaceTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyVTK_RotSurfaceType' ErrStat = ErrID_None ErrMsg = '' if (allocated(VTK_RotSurfaceTypeData%BladeShape)) then - LB(1:1) = lbound(VTK_RotSurfaceTypeData%BladeShape, kind=B8Ki) - UB(1:1) = ubound(VTK_RotSurfaceTypeData%BladeShape, kind=B8Ki) + LB(1:1) = lbound(VTK_RotSurfaceTypeData%BladeShape) + UB(1:1) = ubound(VTK_RotSurfaceTypeData%BladeShape) do i1 = LB(1), UB(1) call AD_DestroyVTK_BLSurfaceType(VTK_RotSurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -835,14 +846,14 @@ subroutine AD_PackVTK_RotSurfaceType(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_VTK_RotSurfaceType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackVTK_RotSurfaceType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%BladeShape)) if (allocated(InData%BladeShape)) then - call RegPackBounds(RF, 1, lbound(InData%BladeShape, kind=B8Ki), ubound(InData%BladeShape, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeShape, kind=B8Ki) - UB(1:1) = ubound(InData%BladeShape, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) + LB(1:1) = lbound(InData%BladeShape) + UB(1:1) = ubound(InData%BladeShape) do i1 = LB(1), UB(1) call AD_PackVTK_BLSurfaceType(RF, InData%BladeShape(i1)) end do @@ -855,8 +866,8 @@ subroutine AD_UnPackVTK_RotSurfaceType(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_VTK_RotSurfaceType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackVTK_RotSurfaceType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -882,7 +893,7 @@ subroutine AD_CopyRotInitInputType(SrcRotInitInputTypeData, DstRotInitInputTypeD integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_CopyRotInitInputType' ErrStat = ErrID_None @@ -892,8 +903,8 @@ subroutine AD_CopyRotInitInputType(SrcRotInitInputTypeData, DstRotInitInputTypeD DstRotInitInputTypeData%HubPosition = SrcRotInitInputTypeData%HubPosition DstRotInitInputTypeData%HubOrientation = SrcRotInitInputTypeData%HubOrientation if (allocated(SrcRotInitInputTypeData%BladeRootPosition)) then - LB(1:2) = lbound(SrcRotInitInputTypeData%BladeRootPosition, kind=B8Ki) - UB(1:2) = ubound(SrcRotInitInputTypeData%BladeRootPosition, kind=B8Ki) + LB(1:2) = lbound(SrcRotInitInputTypeData%BladeRootPosition) + UB(1:2) = ubound(SrcRotInitInputTypeData%BladeRootPosition) if (.not. allocated(DstRotInitInputTypeData%BladeRootPosition)) then allocate(DstRotInitInputTypeData%BladeRootPosition(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -904,8 +915,8 @@ subroutine AD_CopyRotInitInputType(SrcRotInitInputTypeData, DstRotInitInputTypeD DstRotInitInputTypeData%BladeRootPosition = SrcRotInitInputTypeData%BladeRootPosition end if if (allocated(SrcRotInitInputTypeData%BladeRootOrientation)) then - LB(1:3) = lbound(SrcRotInitInputTypeData%BladeRootOrientation, kind=B8Ki) - UB(1:3) = ubound(SrcRotInitInputTypeData%BladeRootOrientation, kind=B8Ki) + LB(1:3) = lbound(SrcRotInitInputTypeData%BladeRootOrientation) + UB(1:3) = ubound(SrcRotInitInputTypeData%BladeRootOrientation) if (.not. allocated(DstRotInitInputTypeData%BladeRootOrientation)) then allocate(DstRotInitInputTypeData%BladeRootOrientation(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -958,7 +969,7 @@ subroutine AD_UnPackRotInitInputType(RF, OutData) type(RegFile), intent(inout) :: RF type(RotInitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotInitInputType' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -980,16 +991,16 @@ subroutine AD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyInitInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitInputData%rotors)) then - LB(1:1) = lbound(SrcInitInputData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%rotors, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%rotors) + UB(1:1) = ubound(SrcInitInputData%rotors) if (.not. allocated(DstInitInputData%rotors)) then allocate(DstInitInputData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1027,16 +1038,16 @@ subroutine AD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) type(AD_InitInputType), intent(inout) :: InitInputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InitInputData%rotors)) then - LB(1:1) = lbound(InitInputData%rotors, kind=B8Ki) - UB(1:1) = ubound(InitInputData%rotors, kind=B8Ki) + LB(1:1) = lbound(InitInputData%rotors) + UB(1:1) = ubound(InitInputData%rotors) do i1 = LB(1), UB(1) call AD_DestroyRotInitInputType(InitInputData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1052,15 +1063,15 @@ subroutine AD_PackInitInput(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackInitInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + 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_PackRotInitInputType(RF, InData%rotors(i1)) end do @@ -1094,8 +1105,8 @@ subroutine AD_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackInitInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1155,15 +1166,15 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_CopyBladePropsType' ErrStat = ErrID_None ErrMsg = '' DstBladePropsTypeData%NumBlNds = SrcBladePropsTypeData%NumBlNds if (allocated(SrcBladePropsTypeData%BlSpn)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlSpn, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlSpn, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlSpn) + UB(1:1) = ubound(SrcBladePropsTypeData%BlSpn) if (.not. allocated(DstBladePropsTypeData%BlSpn)) then allocate(DstBladePropsTypeData%BlSpn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1174,8 +1185,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlSpn = SrcBladePropsTypeData%BlSpn end if if (allocated(SrcBladePropsTypeData%BlCrvAC)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAC, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCrvAC, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAC) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCrvAC) if (.not. allocated(DstBladePropsTypeData%BlCrvAC)) then allocate(DstBladePropsTypeData%BlCrvAC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1186,8 +1197,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlCrvAC = SrcBladePropsTypeData%BlCrvAC end if if (allocated(SrcBladePropsTypeData%BlSwpAC)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlSwpAC, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlSwpAC, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlSwpAC) + UB(1:1) = ubound(SrcBladePropsTypeData%BlSwpAC) if (.not. allocated(DstBladePropsTypeData%BlSwpAC)) then allocate(DstBladePropsTypeData%BlSwpAC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1198,8 +1209,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlSwpAC = SrcBladePropsTypeData%BlSwpAC end if if (allocated(SrcBladePropsTypeData%BlCrvAng)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAng, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCrvAng, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCrvAng) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCrvAng) if (.not. allocated(DstBladePropsTypeData%BlCrvAng)) then allocate(DstBladePropsTypeData%BlCrvAng(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1210,8 +1221,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlCrvAng = SrcBladePropsTypeData%BlCrvAng end if if (allocated(SrcBladePropsTypeData%BlTwist)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlTwist, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlTwist, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlTwist) + UB(1:1) = ubound(SrcBladePropsTypeData%BlTwist) if (.not. allocated(DstBladePropsTypeData%BlTwist)) then allocate(DstBladePropsTypeData%BlTwist(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1222,8 +1233,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlTwist = SrcBladePropsTypeData%BlTwist end if if (allocated(SrcBladePropsTypeData%BlChord)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlChord, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlChord, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlChord) + UB(1:1) = ubound(SrcBladePropsTypeData%BlChord) if (.not. allocated(DstBladePropsTypeData%BlChord)) then allocate(DstBladePropsTypeData%BlChord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1234,8 +1245,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlChord = SrcBladePropsTypeData%BlChord end if if (allocated(SrcBladePropsTypeData%BlAFID)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlAFID, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlAFID, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlAFID) + UB(1:1) = ubound(SrcBladePropsTypeData%BlAFID) if (.not. allocated(DstBladePropsTypeData%BlAFID)) then allocate(DstBladePropsTypeData%BlAFID(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1246,8 +1257,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlAFID = SrcBladePropsTypeData%BlAFID end if if (allocated(SrcBladePropsTypeData%BlCb)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCb, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCb, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCb) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCb) if (.not. allocated(DstBladePropsTypeData%BlCb)) then allocate(DstBladePropsTypeData%BlCb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1258,8 +1269,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlCb = SrcBladePropsTypeData%BlCb end if if (allocated(SrcBladePropsTypeData%BlCenBn)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBn, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCenBn, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBn) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCenBn) if (.not. allocated(DstBladePropsTypeData%BlCenBn)) then allocate(DstBladePropsTypeData%BlCenBn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1270,8 +1281,8 @@ subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, C DstBladePropsTypeData%BlCenBn = SrcBladePropsTypeData%BlCenBn end if if (allocated(SrcBladePropsTypeData%BlCenBt)) then - LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBt, kind=B8Ki) - UB(1:1) = ubound(SrcBladePropsTypeData%BlCenBt, kind=B8Ki) + LB(1:1) = lbound(SrcBladePropsTypeData%BlCenBt) + UB(1:1) = ubound(SrcBladePropsTypeData%BlCenBt) if (.not. allocated(DstBladePropsTypeData%BlCenBt)) then allocate(DstBladePropsTypeData%BlCenBt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1345,7 +1356,7 @@ subroutine AD_UnPackBladePropsType(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_BladePropsType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackBladePropsType' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1368,14 +1379,14 @@ subroutine AD_CopyBladeShape(SrcBladeShapeData, DstBladeShapeData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AD_CopyBladeShape' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcBladeShapeData%AirfoilCoords)) then - LB(1:3) = lbound(SrcBladeShapeData%AirfoilCoords, kind=B8Ki) - UB(1:3) = ubound(SrcBladeShapeData%AirfoilCoords, kind=B8Ki) + LB(1:3) = lbound(SrcBladeShapeData%AirfoilCoords) + UB(1:3) = ubound(SrcBladeShapeData%AirfoilCoords) if (.not. allocated(DstBladeShapeData%AirfoilCoords)) then allocate(DstBladeShapeData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1412,7 +1423,7 @@ subroutine AD_UnPackBladeShape(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_BladeShape), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackBladeShape' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1425,17 +1436,18 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 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, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputHdr) + UB(1:1) = ubound(SrcRotInitOutputTypeData%WriteOutputHdr) if (.not. allocated(DstRotInitOutputTypeData%WriteOutputHdr)) then allocate(DstRotInitOutputTypeData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1446,8 +1458,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%WriteOutputHdr = SrcRotInitOutputTypeData%WriteOutputHdr end if if (allocated(SrcRotInitOutputTypeData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%WriteOutputUnt) + UB(1:1) = ubound(SrcRotInitOutputTypeData%WriteOutputUnt) if (.not. allocated(DstRotInitOutputTypeData%WriteOutputUnt)) then allocate(DstRotInitOutputTypeData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1458,8 +1470,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%WriteOutputUnt = SrcRotInitOutputTypeData%WriteOutputUnt end if if (allocated(SrcRotInitOutputTypeData%BladeShape)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeShape, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%BladeShape, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeShape) + UB(1:1) = ubound(SrcRotInitOutputTypeData%BladeShape) if (.not. allocated(DstRotInitOutputTypeData%BladeShape)) then allocate(DstRotInitOutputTypeData%BladeShape(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1474,8 +1486,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy end do end if if (allocated(SrcRotInitOutputTypeData%LinNames_y)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_y, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_y) + UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_y) if (.not. allocated(DstRotInitOutputTypeData%LinNames_y)) then allocate(DstRotInitOutputTypeData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1486,8 +1498,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%LinNames_y = SrcRotInitOutputTypeData%LinNames_y end if if (allocated(SrcRotInitOutputTypeData%LinNames_x)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_x, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_x, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_x) + UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_x) if (.not. allocated(DstRotInitOutputTypeData%LinNames_x)) then allocate(DstRotInitOutputTypeData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1498,8 +1510,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%LinNames_x = SrcRotInitOutputTypeData%LinNames_x end if if (allocated(SrcRotInitOutputTypeData%LinNames_u)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_u, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%LinNames_u) + UB(1:1) = ubound(SrcRotInitOutputTypeData%LinNames_u) if (.not. allocated(DstRotInitOutputTypeData%LinNames_u)) then allocate(DstRotInitOutputTypeData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1510,8 +1522,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%LinNames_u = SrcRotInitOutputTypeData%LinNames_u end if if (allocated(SrcRotInitOutputTypeData%RotFrame_y)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_y, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_y) + UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_y) if (.not. allocated(DstRotInitOutputTypeData%RotFrame_y)) then allocate(DstRotInitOutputTypeData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1522,8 +1534,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%RotFrame_y = SrcRotInitOutputTypeData%RotFrame_y end if if (allocated(SrcRotInitOutputTypeData%RotFrame_x)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_x, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_x, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_x) + UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_x) if (.not. allocated(DstRotInitOutputTypeData%RotFrame_x)) then allocate(DstRotInitOutputTypeData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1534,8 +1546,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%RotFrame_x = SrcRotInitOutputTypeData%RotFrame_x end if if (allocated(SrcRotInitOutputTypeData%RotFrame_u)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_u, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%RotFrame_u) + UB(1:1) = ubound(SrcRotInitOutputTypeData%RotFrame_u) if (.not. allocated(DstRotInitOutputTypeData%RotFrame_u)) then allocate(DstRotInitOutputTypeData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1546,8 +1558,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%RotFrame_u = SrcRotInitOutputTypeData%RotFrame_u end if if (allocated(SrcRotInitOutputTypeData%IsLoad_u)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%IsLoad_u, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%IsLoad_u) + UB(1:1) = ubound(SrcRotInitOutputTypeData%IsLoad_u) if (.not. allocated(DstRotInitOutputTypeData%IsLoad_u)) then allocate(DstRotInitOutputTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1558,8 +1570,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%IsLoad_u = SrcRotInitOutputTypeData%IsLoad_u end if if (allocated(SrcRotInitOutputTypeData%BladeProps)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeProps, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%BladeProps, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%BladeProps) + UB(1:1) = ubound(SrcRotInitOutputTypeData%BladeProps) if (.not. allocated(DstRotInitOutputTypeData%BladeProps)) then allocate(DstRotInitOutputTypeData%BladeProps(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1574,8 +1586,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy end do end if if (allocated(SrcRotInitOutputTypeData%DerivOrder_x)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%DerivOrder_x, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%DerivOrder_x) + UB(1:1) = ubound(SrcRotInitOutputTypeData%DerivOrder_x) if (.not. allocated(DstRotInitOutputTypeData%DerivOrder_x)) then allocate(DstRotInitOutputTypeData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1586,8 +1598,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%DerivOrder_x = SrcRotInitOutputTypeData%DerivOrder_x end if if (allocated(SrcRotInitOutputTypeData%TwrElev)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrElev, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%TwrElev, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrElev) + UB(1:1) = ubound(SrcRotInitOutputTypeData%TwrElev) if (.not. allocated(DstRotInitOutputTypeData%TwrElev)) then allocate(DstRotInitOutputTypeData%TwrElev(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1598,8 +1610,8 @@ subroutine AD_CopyRotInitOutputType(SrcRotInitOutputTypeData, DstRotInitOutputTy DstRotInitOutputTypeData%TwrElev = SrcRotInitOutputTypeData%TwrElev end if if (allocated(SrcRotInitOutputTypeData%TwrDiam)) then - LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrDiam, kind=B8Ki) - UB(1:1) = ubound(SrcRotInitOutputTypeData%TwrDiam, kind=B8Ki) + LB(1:1) = lbound(SrcRotInitOutputTypeData%TwrDiam) + UB(1:1) = ubound(SrcRotInitOutputTypeData%TwrDiam) if (.not. allocated(DstRotInitOutputTypeData%TwrDiam)) then allocate(DstRotInitOutputTypeData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1615,13 +1627,14 @@ subroutine AD_DestroyRotInitOutputType(RotInitOutputTypeData, ErrStat, ErrMsg) type(RotInitOutputType), intent(inout) :: RotInitOutputTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyRotInitOutputType' ErrStat = ErrID_None ErrMsg = '' + nullify(RotInitOutputTypeData%Vars) if (allocated(RotInitOutputTypeData%WriteOutputHdr)) then deallocate(RotInitOutputTypeData%WriteOutputHdr) end if @@ -1629,8 +1642,8 @@ subroutine AD_DestroyRotInitOutputType(RotInitOutputTypeData, ErrStat, ErrMsg) deallocate(RotInitOutputTypeData%WriteOutputUnt) end if if (allocated(RotInitOutputTypeData%BladeShape)) then - LB(1:1) = lbound(RotInitOutputTypeData%BladeShape, kind=B8Ki) - UB(1:1) = ubound(RotInitOutputTypeData%BladeShape, kind=B8Ki) + LB(1:1) = lbound(RotInitOutputTypeData%BladeShape) + UB(1:1) = ubound(RotInitOutputTypeData%BladeShape) do i1 = LB(1), UB(1) call AD_DestroyBladeShape(RotInitOutputTypeData%BladeShape(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1659,8 +1672,8 @@ subroutine AD_DestroyRotInitOutputType(RotInitOutputTypeData, ErrStat, ErrMsg) deallocate(RotInitOutputTypeData%IsLoad_u) end if if (allocated(RotInitOutputTypeData%BladeProps)) then - LB(1:1) = lbound(RotInitOutputTypeData%BladeProps, kind=B8Ki) - UB(1:1) = ubound(RotInitOutputTypeData%BladeProps, kind=B8Ki) + LB(1:1) = lbound(RotInitOutputTypeData%BladeProps) + UB(1:1) = ubound(RotInitOutputTypeData%BladeProps) do i1 = LB(1), UB(1) call AD_DestroyBladePropsType(RotInitOutputTypeData%BladeProps(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1682,17 +1695,25 @@ subroutine AD_PackRotInitOutputType(RF, Indata) type(RegFile), intent(inout) :: RF type(RotInitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotInitOutputType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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) call RegPack(RF, allocated(InData%BladeShape)) if (allocated(InData%BladeShape)) then - call RegPackBounds(RF, 1, lbound(InData%BladeShape, kind=B8Ki), ubound(InData%BladeShape, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeShape, kind=B8Ki) - UB(1:1) = ubound(InData%BladeShape, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) + LB(1:1) = lbound(InData%BladeShape) + UB(1:1) = ubound(InData%BladeShape) do i1 = LB(1), UB(1) call AD_PackBladeShape(RF, InData%BladeShape(i1)) end do @@ -1706,9 +1727,9 @@ subroutine AD_PackRotInitOutputType(RF, Indata) call RegPackAlloc(RF, InData%IsLoad_u) call RegPack(RF, allocated(InData%BladeProps)) if (allocated(InData%BladeProps)) then - call RegPackBounds(RF, 1, lbound(InData%BladeProps, kind=B8Ki), ubound(InData%BladeProps, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeProps, kind=B8Ki) - UB(1:1) = ubound(InData%BladeProps, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) + LB(1:1) = lbound(InData%BladeProps) + UB(1:1) = ubound(InData%BladeProps) do i1 = LB(1), UB(1) call AD_PackBladePropsType(RF, InData%BladeProps(i1)) end do @@ -1723,11 +1744,31 @@ subroutine AD_UnPackRotInitOutputType(RF, OutData) type(RegFile), intent(inout) :: RF type(RotInitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotInitOutputType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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 (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 @@ -1775,16 +1816,16 @@ subroutine AD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%rotors)) then - LB(1:1) = lbound(SrcInitOutputData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%rotors, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%rotors) + UB(1:1) = ubound(SrcInitOutputData%rotors) if (.not. allocated(DstInitOutputData%rotors)) then allocate(DstInitOutputData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1808,16 +1849,16 @@ subroutine AD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) type(AD_InitOutputType), intent(inout) :: InitOutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InitOutputData%rotors)) then - LB(1:1) = lbound(InitOutputData%rotors, kind=B8Ki) - UB(1:1) = ubound(InitOutputData%rotors, kind=B8Ki) + LB(1:1) = lbound(InitOutputData%rotors) + UB(1:1) = ubound(InitOutputData%rotors) do i1 = LB(1), UB(1) call AD_DestroyRotInitOutputType(InitOutputData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1832,14 +1873,14 @@ subroutine AD_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackInitOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + 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_PackRotInitOutputType(RF, InData%rotors(i1)) end do @@ -1853,8 +1894,8 @@ subroutine AD_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackInitOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1881,16 +1922,16 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyRotInputFile' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcRotInputFileData%BladeProps)) then - LB(1:1) = lbound(SrcRotInputFileData%BladeProps, kind=B8Ki) - UB(1:1) = ubound(SrcRotInputFileData%BladeProps, kind=B8Ki) + LB(1:1) = lbound(SrcRotInputFileData%BladeProps) + UB(1:1) = ubound(SrcRotInputFileData%BladeProps) if (.not. allocated(DstRotInputFileData%BladeProps)) then allocate(DstRotInputFileData%BladeProps(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1906,8 +1947,8 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod end if DstRotInputFileData%NumTwrNds = SrcRotInputFileData%NumTwrNds if (allocated(SrcRotInputFileData%TwrElev)) then - LB(1:1) = lbound(SrcRotInputFileData%TwrElev, kind=B8Ki) - UB(1:1) = ubound(SrcRotInputFileData%TwrElev, kind=B8Ki) + LB(1:1) = lbound(SrcRotInputFileData%TwrElev) + UB(1:1) = ubound(SrcRotInputFileData%TwrElev) if (.not. allocated(DstRotInputFileData%TwrElev)) then allocate(DstRotInputFileData%TwrElev(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1918,8 +1959,8 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod DstRotInputFileData%TwrElev = SrcRotInputFileData%TwrElev end if if (allocated(SrcRotInputFileData%TwrDiam)) then - LB(1:1) = lbound(SrcRotInputFileData%TwrDiam, kind=B8Ki) - UB(1:1) = ubound(SrcRotInputFileData%TwrDiam, kind=B8Ki) + LB(1:1) = lbound(SrcRotInputFileData%TwrDiam) + UB(1:1) = ubound(SrcRotInputFileData%TwrDiam) if (.not. allocated(DstRotInputFileData%TwrDiam)) then allocate(DstRotInputFileData%TwrDiam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1930,8 +1971,8 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod DstRotInputFileData%TwrDiam = SrcRotInputFileData%TwrDiam end if if (allocated(SrcRotInputFileData%TwrCd)) then - LB(1:1) = lbound(SrcRotInputFileData%TwrCd, kind=B8Ki) - UB(1:1) = ubound(SrcRotInputFileData%TwrCd, kind=B8Ki) + LB(1:1) = lbound(SrcRotInputFileData%TwrCd) + UB(1:1) = ubound(SrcRotInputFileData%TwrCd) if (.not. allocated(DstRotInputFileData%TwrCd)) then allocate(DstRotInputFileData%TwrCd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1942,8 +1983,8 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod DstRotInputFileData%TwrCd = SrcRotInputFileData%TwrCd end if if (allocated(SrcRotInputFileData%TwrTI)) then - LB(1:1) = lbound(SrcRotInputFileData%TwrTI, kind=B8Ki) - UB(1:1) = ubound(SrcRotInputFileData%TwrTI, kind=B8Ki) + LB(1:1) = lbound(SrcRotInputFileData%TwrTI) + UB(1:1) = ubound(SrcRotInputFileData%TwrTI) if (.not. allocated(DstRotInputFileData%TwrTI)) then allocate(DstRotInputFileData%TwrTI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1954,8 +1995,8 @@ subroutine AD_CopyRotInputFile(SrcRotInputFileData, DstRotInputFileData, CtrlCod DstRotInputFileData%TwrTI = SrcRotInputFileData%TwrTI end if if (allocated(SrcRotInputFileData%TwrCb)) then - LB(1:1) = lbound(SrcRotInputFileData%TwrCb, kind=B8Ki) - UB(1:1) = ubound(SrcRotInputFileData%TwrCb, kind=B8Ki) + LB(1:1) = lbound(SrcRotInputFileData%TwrCb) + UB(1:1) = ubound(SrcRotInputFileData%TwrCb) if (.not. allocated(DstRotInputFileData%TwrCb)) then allocate(DstRotInputFileData%TwrCb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1983,16 +2024,16 @@ subroutine AD_DestroyRotInputFile(RotInputFileData, ErrStat, ErrMsg) type(RotInputFile), intent(inout) :: RotInputFileData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyRotInputFile' ErrStat = ErrID_None ErrMsg = '' if (allocated(RotInputFileData%BladeProps)) then - LB(1:1) = lbound(RotInputFileData%BladeProps, kind=B8Ki) - UB(1:1) = ubound(RotInputFileData%BladeProps, kind=B8Ki) + LB(1:1) = lbound(RotInputFileData%BladeProps) + UB(1:1) = ubound(RotInputFileData%BladeProps) do i1 = LB(1), UB(1) call AD_DestroyBladePropsType(RotInputFileData%BladeProps(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2022,14 +2063,14 @@ subroutine AD_PackRotInputFile(RF, Indata) type(RegFile), intent(inout) :: RF type(RotInputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackRotInputFile' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%BladeProps)) if (allocated(InData%BladeProps)) then - call RegPackBounds(RF, 1, lbound(InData%BladeProps, kind=B8Ki), ubound(InData%BladeProps, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeProps, kind=B8Ki) - UB(1:1) = ubound(InData%BladeProps, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeProps), ubound(InData%BladeProps)) + LB(1:1) = lbound(InData%BladeProps) + UB(1:1) = ubound(InData%BladeProps) do i1 = LB(1), UB(1) call AD_PackBladePropsType(RF, InData%BladeProps(i1)) end do @@ -2057,8 +2098,8 @@ subroutine AD_UnPackRotInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(RotInputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackRotInputFile' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2099,8 +2140,8 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyInputFile' @@ -2119,8 +2160,8 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%CompAA = SrcInputFileData%CompAA DstInputFileData%AA_InputFile = SrcInputFileData%AA_InputFile if (allocated(SrcInputFileData%ADBlFile)) then - LB(1:1) = lbound(SrcInputFileData%ADBlFile, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%ADBlFile, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%ADBlFile) + UB(1:1) = ubound(SrcInputFileData%ADBlFile) if (.not. allocated(DstInputFileData%ADBlFile)) then allocate(DstInputFileData%ADBlFile(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2164,8 +2205,8 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%NumAFfiles = SrcInputFileData%NumAFfiles DstInputFileData%FVWFileName = SrcInputFileData%FVWFileName if (allocated(SrcInputFileData%AFNames)) then - LB(1:1) = lbound(SrcInputFileData%AFNames, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%AFNames, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%AFNames) + UB(1:1) = ubound(SrcInputFileData%AFNames) if (.not. allocated(DstInputFileData%AFNames)) then allocate(DstInputFileData%AFNames(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2183,8 +2224,8 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TwOutNd = SrcInputFileData%TwOutNd DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2198,8 +2239,8 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%DBEMT_Mod = SrcInputFileData%DBEMT_Mod DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts if (allocated(SrcInputFileData%BldNd_OutList)) then - LB(1:1) = lbound(SrcInputFileData%BldNd_OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%BldNd_OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%BldNd_OutList) + UB(1:1) = ubound(SrcInputFileData%BldNd_OutList) if (.not. allocated(DstInputFileData%BldNd_OutList)) then allocate(DstInputFileData%BldNd_OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2214,8 +2255,8 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%UAStartRad = SrcInputFileData%UAStartRad DstInputFileData%UAEndRad = SrcInputFileData%UAEndRad if (allocated(SrcInputFileData%rotors)) then - LB(1:1) = lbound(SrcInputFileData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%rotors, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%rotors) + UB(1:1) = ubound(SrcInputFileData%rotors) if (.not. allocated(DstInputFileData%rotors)) then allocate(DstInputFileData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2235,8 +2276,8 @@ subroutine AD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) type(AD_InputFile), intent(inout) :: InputFileData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyInputFile' @@ -2257,8 +2298,8 @@ subroutine AD_DestroyInputFile(InputFileData, ErrStat, ErrMsg) deallocate(InputFileData%BldNd_OutList) end if if (allocated(InputFileData%rotors)) then - LB(1:1) = lbound(InputFileData%rotors, kind=B8Ki) - UB(1:1) = ubound(InputFileData%rotors, kind=B8Ki) + LB(1:1) = lbound(InputFileData%rotors) + UB(1:1) = ubound(InputFileData%rotors) do i1 = LB(1), UB(1) call AD_DestroyRotInputFile(InputFileData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2271,8 +2312,8 @@ subroutine AD_PackInputFile(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackInputFile' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%Echo) call RegPack(RF, InData%DTAero) @@ -2337,9 +2378,9 @@ subroutine AD_PackInputFile(RF, Indata) call RegPack(RF, InData%UAEndRad) call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then - call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + 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_PackRotInputFile(RF, InData%rotors(i1)) end do @@ -2351,8 +2392,8 @@ subroutine AD_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackInputFile' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2491,16 +2532,16 @@ subroutine AD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%rotors)) then - LB(1:1) = lbound(SrcContStateData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%rotors, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%rotors) + UB(1:1) = ubound(SrcContStateData%rotors) if (.not. allocated(DstContStateData%rotors)) then allocate(DstContStateData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2523,16 +2564,16 @@ subroutine AD_DestroyContState(ContStateData, ErrStat, ErrMsg) type(AD_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%rotors)) then - LB(1:1) = lbound(ContStateData%rotors, kind=B8Ki) - UB(1:1) = ubound(ContStateData%rotors, kind=B8Ki) + LB(1:1) = lbound(ContStateData%rotors) + UB(1:1) = ubound(ContStateData%rotors) do i1 = LB(1), UB(1) call AD_DestroyRotContinuousStateType(ContStateData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2547,14 +2588,14 @@ subroutine AD_PackContState(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + 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_PackRotContinuousStateType(RF, InData%rotors(i1)) end do @@ -2567,8 +2608,8 @@ subroutine AD_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2647,16 +2688,16 @@ subroutine AD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%rotors)) then - LB(1:1) = lbound(SrcDiscStateData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%rotors, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%rotors) + UB(1:1) = ubound(SrcDiscStateData%rotors) if (.not. allocated(DstDiscStateData%rotors)) then allocate(DstDiscStateData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2679,16 +2720,16 @@ subroutine AD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) type(AD_DiscreteStateType), intent(inout) :: DiscStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(DiscStateData%rotors)) then - LB(1:1) = lbound(DiscStateData%rotors, kind=B8Ki) - UB(1:1) = ubound(DiscStateData%rotors, kind=B8Ki) + LB(1:1) = lbound(DiscStateData%rotors) + UB(1:1) = ubound(DiscStateData%rotors) do i1 = LB(1), UB(1) call AD_DestroyRotDiscreteStateType(DiscStateData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2703,14 +2744,14 @@ subroutine AD_PackDiscState(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + 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_PackRotDiscreteStateType(RF, InData%rotors(i1)) end do @@ -2723,8 +2764,8 @@ subroutine AD_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2803,16 +2844,16 @@ subroutine AD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcConstrStateData%rotors)) then - LB(1:1) = lbound(SrcConstrStateData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%rotors, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%rotors) + UB(1:1) = ubound(SrcConstrStateData%rotors) if (.not. allocated(DstConstrStateData%rotors)) then allocate(DstConstrStateData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2835,16 +2876,16 @@ subroutine AD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) type(AD_ConstraintStateType), intent(inout) :: ConstrStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ConstrStateData%rotors)) then - LB(1:1) = lbound(ConstrStateData%rotors, kind=B8Ki) - UB(1:1) = ubound(ConstrStateData%rotors, kind=B8Ki) + LB(1:1) = lbound(ConstrStateData%rotors) + UB(1:1) = ubound(ConstrStateData%rotors) do i1 = LB(1), UB(1) call AD_DestroyRotConstraintStateType(ConstrStateData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2859,14 +2900,14 @@ subroutine AD_PackConstrState(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackConstrState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + 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_PackRotConstraintStateType(RF, InData%rotors(i1)) end do @@ -2879,8 +2920,8 @@ subroutine AD_UnPackConstrState(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackConstrState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2959,16 +3000,16 @@ subroutine AD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%rotors)) then - LB(1:1) = lbound(SrcOtherStateData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%rotors, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%rotors) + UB(1:1) = ubound(SrcOtherStateData%rotors) if (.not. allocated(DstOtherStateData%rotors)) then allocate(DstOtherStateData%rotors(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2986,8 +3027,8 @@ subroutine AD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOtherStateData%WakeLocationPoints)) then - LB(1:2) = lbound(SrcOtherStateData%WakeLocationPoints, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%WakeLocationPoints, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%WakeLocationPoints) + UB(1:2) = ubound(SrcOtherStateData%WakeLocationPoints) if (.not. allocated(DstOtherStateData%WakeLocationPoints)) then allocate(DstOtherStateData%WakeLocationPoints(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3003,16 +3044,16 @@ subroutine AD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(AD_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%rotors)) then - LB(1:1) = lbound(OtherStateData%rotors, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%rotors, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%rotors) + UB(1:1) = ubound(OtherStateData%rotors) do i1 = LB(1), UB(1) call AD_DestroyRotOtherStateType(OtherStateData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3030,14 +3071,14 @@ subroutine AD_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(AD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AD_PackOtherState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + 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 - call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + 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_PackRotOtherStateType(RF, InData%rotors(i1)) end do @@ -3051,8 +3092,8 @@ subroutine AD_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(AD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AD_UnPackOtherState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3073,1240 +3114,1113 @@ 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(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BEMT_u, kind=B8Ki) - 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, kind=B8Ki) - UB(1:3) = ubound(SrcRotMiscVarTypeData%DisturbedInflow, kind=B8Ki) - 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, kind=B8Ki) - UB(1:3) = ubound(SrcRotMiscVarTypeData%SectAvgInflow, kind=B8Ki) - 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, kind=B8Ki) - UB(1:4) = ubound(SrcRotMiscVarTypeData%orientationAnnulus, kind=B8Ki) - 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, kind=B8Ki) - UB(1:4) = ubound(SrcRotMiscVarTypeData%R_li, kind=B8Ki) - 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 DstRotMiscVarTypeData%R_li.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotMiscVarTypeData%R_li = SrcRotMiscVarTypeData%R_li + if (allocated(ElemInflowTypeData%InflowAcc)) then + deallocate(ElemInflowTypeData%InflowAcc) end if - if (allocated(SrcRotMiscVarTypeData%AllOuts)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%AllOuts, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%AllOuts)) then - allocate(DstRotMiscVarTypeData%AllOuts(LB(1):UB(1)), stat=ErrStat2) +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%AllOuts.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInflowTypeData%Blade.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%AllOuts = SrcRotMiscVarTypeData%AllOuts + 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%W_Twr)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%W_Twr, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%W_Twr, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%W_Twr)) then - allocate(DstRotMiscVarTypeData%W_Twr(LB(1):UB(1)), stat=ErrStat2) + 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 + do i1 = LB(1), UB(1) + call AD_UnpackElemInflowType(RF, OutData%Blade(i1)) ! Blade + 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 +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, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%X_Twr, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%Y_Twr, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%Y_Twr)) then - allocate(DstRotMiscVarTypeData%Y_Twr(LB(1):UB(1)), stat=ErrStat2) +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 + do i1 = LB(1), UB(1) + call AD_UnpackRotInflowType(RF, OutData%RotInflow(i1)) ! RotInflow + end do + end if +end subroutine + +subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeData, CtrlCode, ErrStat, ErrMsg) + type(RotParameterType), intent(in) :: SrcRotParameterTypeData + type(RotParameterType), intent(inout) :: DstRotParameterTypeData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(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%Y_Twr.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%Vars.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Y_Twr = SrcRotMiscVarTypeData%Y_Twr + 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%Cant)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Cant, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Cant, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%Cant)) then - allocate(DstRotMiscVarTypeData%Cant(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%Cant.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDiam.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Cant = SrcRotMiscVarTypeData%Cant + DstRotParameterTypeData%TwrDiam = SrcRotParameterTypeData%TwrDiam end if - if (allocated(SrcRotMiscVarTypeData%Toe)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Toe, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Toe, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%Toe)) then - allocate(DstRotMiscVarTypeData%Toe(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%Toe.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCd.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Toe = SrcRotMiscVarTypeData%Toe + DstRotParameterTypeData%TwrCd = SrcRotParameterTypeData%TwrCd end if - if (allocated(SrcRotMiscVarTypeData%TwrClrnc)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrClrnc, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrClrnc, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%TwrClrnc)) then - allocate(DstRotMiscVarTypeData%TwrClrnc(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%TwrClrnc.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTI.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%TwrClrnc = SrcRotMiscVarTypeData%TwrClrnc + DstRotParameterTypeData%TwrTI = SrcRotParameterTypeData%TwrTI end if - if (allocated(SrcRotMiscVarTypeData%X)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%X, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%X, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%X)) then - allocate(DstRotMiscVarTypeData%X(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%X.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTwist.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%X = SrcRotMiscVarTypeData%X + DstRotParameterTypeData%BlTwist = SrcRotParameterTypeData%BlTwist end if - if (allocated(SrcRotMiscVarTypeData%Y)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Y, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Y, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%Y)) then - allocate(DstRotMiscVarTypeData%Y(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%Y.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrCb.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Y = SrcRotMiscVarTypeData%Y + DstRotParameterTypeData%TwrCb = SrcRotParameterTypeData%TwrCb end if - if (allocated(SrcRotMiscVarTypeData%Z)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Z, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Z, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%Z)) then - allocate(DstRotMiscVarTypeData%Z(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%Z.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBn.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Z = SrcRotMiscVarTypeData%Z + DstRotParameterTypeData%BlCenBn = SrcRotParameterTypeData%BlCenBn end if - if (allocated(SrcRotMiscVarTypeData%M)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%M, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%M, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%M)) then - allocate(DstRotMiscVarTypeData%M(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%M.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlCenBt.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%M = SrcRotMiscVarTypeData%M + DstRotParameterTypeData%BlCenBt = SrcRotParameterTypeData%BlCenBt end if - if (allocated(SrcRotMiscVarTypeData%Mx)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Mx, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Mx, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%Mx)) then - allocate(DstRotMiscVarTypeData%Mx(LB(1):UB(1),LB(2):UB(2)), 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%Mx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlRad.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Mx = SrcRotMiscVarTypeData%Mx + DstRotParameterTypeData%BlRad = SrcRotParameterTypeData%BlRad end if - if (allocated(SrcRotMiscVarTypeData%My)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%My, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%My, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%My)) then - allocate(DstRotMiscVarTypeData%My(LB(1):UB(1),LB(2):UB(2)), 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%My.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlDL.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%My = SrcRotMiscVarTypeData%My + DstRotParameterTypeData%BlDL = SrcRotParameterTypeData%BlDL end if - if (allocated(SrcRotMiscVarTypeData%Mz)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%Mz, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%Mz, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%Mz)) then - allocate(DstRotMiscVarTypeData%Mz(LB(1):UB(1),LB(2):UB(2)), 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%Mz.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTaper.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Mz = SrcRotMiscVarTypeData%Mz + DstRotParameterTypeData%BlTaper = SrcRotParameterTypeData%BlTaper end if - if (allocated(SrcRotMiscVarTypeData%Vind_i)) then - LB(1:3) = lbound(SrcRotMiscVarTypeData%Vind_i, kind=B8Ki) - UB(1:3) = ubound(SrcRotMiscVarTypeData%Vind_i, kind=B8Ki) - 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 (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%Vind_i.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlAxCent.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%Vind_i = SrcRotMiscVarTypeData%Vind_i + DstRotParameterTypeData%BlAxCent = SrcRotParameterTypeData%BlAxCent 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, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%hub_theta_x_root, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%hub_theta_x_root)) then - allocate(DstRotMiscVarTypeData%hub_theta_x_root(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%hub_theta_x_root.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrRad.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%hub_theta_x_root = SrcRotMiscVarTypeData%hub_theta_x_root + DstRotParameterTypeData%TwrRad = SrcRotParameterTypeData%TwrRad 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, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_H_P, kind=B8Ki) - 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%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%B_L_2_H_P.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrDL.', 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%TwrDL = SrcRotParameterTypeData%TwrDL end if - if (allocated(SrcRotMiscVarTypeData%SigmaCavitCrit)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavitCrit, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavitCrit, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%SigmaCavitCrit)) then - allocate(DstRotMiscVarTypeData%SigmaCavitCrit(LB(1):UB(1),LB(2):UB(2)), 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%SigmaCavitCrit.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrTaper.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%SigmaCavitCrit = SrcRotMiscVarTypeData%SigmaCavitCrit + DstRotParameterTypeData%TwrTaper = SrcRotParameterTypeData%TwrTaper end if - if (allocated(SrcRotMiscVarTypeData%SigmaCavit)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%SigmaCavit, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%SigmaCavit, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%SigmaCavit)) then - allocate(DstRotMiscVarTypeData%SigmaCavit(LB(1):UB(1),LB(2):UB(2)), 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%SigmaCavit.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%TwrAxCent.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%SigmaCavit = SrcRotMiscVarTypeData%SigmaCavit + DstRotParameterTypeData%TwrAxCent = SrcRotParameterTypeData%TwrAxCent end if - if (allocated(SrcRotMiscVarTypeData%CavitWarnSet)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%CavitWarnSet, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%CavitWarnSet, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%CavitWarnSet)) then - allocate(DstRotMiscVarTypeData%CavitWarnSet(LB(1):UB(1),LB(2):UB(2)), 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%CavitWarnSet.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%du.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%CavitWarnSet = SrcRotMiscVarTypeData%CavitWarnSet + DstRotParameterTypeData%du = SrcRotParameterTypeData%du end if - if (allocated(SrcRotMiscVarTypeData%TwrFB)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrFB, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrFB, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%TwrFB)) then - allocate(DstRotMiscVarTypeData%TwrFB(LB(1):UB(1),LB(2):UB(2)), 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%TwrFB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%dx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%TwrFB = SrcRotMiscVarTypeData%TwrFB + DstRotParameterTypeData%dx = SrcRotParameterTypeData%dx end if - if (allocated(SrcRotMiscVarTypeData%TwrMB)) then - LB(1:2) = lbound(SrcRotMiscVarTypeData%TwrMB, kind=B8Ki) - UB(1:2) = ubound(SrcRotMiscVarTypeData%TwrMB, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%TwrMB)) then - allocate(DstRotMiscVarTypeData%TwrMB(LB(1):UB(1),LB(2):UB(2)), 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%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 (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%TwrMB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%OutParam.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%TwrMB = SrcRotMiscVarTypeData%TwrMB + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcRotParameterTypeData%OutParam(i1), DstRotParameterTypeData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcRotMiscVarTypeData%HubFB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%HubFB, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%HubFB, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%HubFB)) then - allocate(DstRotMiscVarTypeData%HubFB(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%HubFB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_OutParam.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%HubFB = SrcRotMiscVarTypeData%HubFB + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcRotParameterTypeData%BldNd_OutParam(i1), DstRotParameterTypeData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcRotMiscVarTypeData%HubMB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%HubMB, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%HubMB, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%HubMB)) then - allocate(DstRotMiscVarTypeData%HubMB(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%HubMB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BldNd_BlOutNd.', ErrStat, ErrMsg, RoutineName) return end if end if - DstRotMiscVarTypeData%HubMB = SrcRotMiscVarTypeData%HubMB + DstRotParameterTypeData%BldNd_BlOutNd = SrcRotParameterTypeData%BldNd_BlOutNd end if - if (allocated(SrcRotMiscVarTypeData%NacFB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFB, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacFB, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%NacFB)) then - allocate(DstRotMiscVarTypeData%NacFB(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacFB.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotMiscVarTypeData%NacFB = SrcRotMiscVarTypeData%NacFB - end if - if (allocated(SrcRotMiscVarTypeData%NacMB)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacMB, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacMB, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%NacMB)) then - allocate(DstRotMiscVarTypeData%NacMB(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacMB.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotMiscVarTypeData%NacMB = SrcRotMiscVarTypeData%NacMB - end if - if (allocated(SrcRotMiscVarTypeData%NacDragF)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacDragF, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacDragF, kind=B8Ki) - 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 - DstRotMiscVarTypeData%NacDragF = SrcRotMiscVarTypeData%NacDragF - end if - if (allocated(SrcRotMiscVarTypeData%NacDragM)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacDragM, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacDragM, kind=B8Ki) - 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 DstRotMiscVarTypeData%NacDragM.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotMiscVarTypeData%NacDragM = SrcRotMiscVarTypeData%NacDragM - end if - if (allocated(SrcRotMiscVarTypeData%NacFi)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFi, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacFi, kind=B8Ki) - 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 DstRotMiscVarTypeData%NacFi.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotMiscVarTypeData%NacFi = SrcRotMiscVarTypeData%NacFi - end if - if (allocated(SrcRotMiscVarTypeData%NacMi)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%NacMi, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%NacMi, kind=B8Ki) - 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 - if (allocated(SrcRotMiscVarTypeData%BladeRootLoad)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeRootLoad, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeRootLoad, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%BladeRootLoad)) then - allocate(DstRotMiscVarTypeData%BladeRootLoad(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeRootLoad.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcRotMiscVarTypeData%BladeRootLoad(i1), DstRotMiscVarTypeData%BladeRootLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcRotMiscVarTypeData%B_L_2_R_P)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_R_P, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_R_P, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%B_L_2_R_P)) then - allocate(DstRotMiscVarTypeData%B_L_2_R_P(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_R_P.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_L_2_R_P(i1), DstRotMiscVarTypeData%B_L_2_R_P(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoadPoint)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoadPoint)) then - allocate(DstRotMiscVarTypeData%BladeBuoyLoadPoint(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoadPoint.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcRotMiscVarTypeData%BladeBuoyLoadPoint(i1), DstRotMiscVarTypeData%BladeBuoyLoadPoint(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcRotMiscVarTypeData%BladeBuoyLoad)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) - if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoad)) then - allocate(DstRotMiscVarTypeData%BladeBuoyLoad(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoad.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call MeshCopy(SrcRotMiscVarTypeData%BladeBuoyLoad(i1), DstRotMiscVarTypeData%BladeBuoyLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcRotMiscVarTypeData%B_P_2_B_L)) then - LB(1:1) = lbound(SrcRotMiscVarTypeData%B_P_2_B_L, kind=B8Ki) - UB(1:1) = ubound(SrcRotMiscVarTypeData%B_P_2_B_L, kind=B8Ki) - 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(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%BEMT_u, kind=B8Ki) - 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) + deallocate(RotParameterTypeData%Vars) + RotParameterTypeData%Vars => null() end if - if (allocated(RotMiscVarTypeData%R_li)) then - deallocate(RotMiscVarTypeData%R_li) + if (allocated(RotParameterTypeData%TwrDiam)) then + deallocate(RotParameterTypeData%TwrDiam) end if - if (allocated(RotMiscVarTypeData%AllOuts)) then - deallocate(RotMiscVarTypeData%AllOuts) + if (allocated(RotParameterTypeData%TwrCd)) then + deallocate(RotParameterTypeData%TwrCd) end if - if (allocated(RotMiscVarTypeData%W_Twr)) then - deallocate(RotMiscVarTypeData%W_Twr) + if (allocated(RotParameterTypeData%TwrTI)) then + deallocate(RotParameterTypeData%TwrTI) end if - if (allocated(RotMiscVarTypeData%X_Twr)) then - deallocate(RotMiscVarTypeData%X_Twr) + if (allocated(RotParameterTypeData%BlTwist)) then + deallocate(RotParameterTypeData%BlTwist) end if - if (allocated(RotMiscVarTypeData%Y_Twr)) then - deallocate(RotMiscVarTypeData%Y_Twr) + if (allocated(RotParameterTypeData%TwrCb)) then + deallocate(RotParameterTypeData%TwrCb) end if - if (allocated(RotMiscVarTypeData%Cant)) then - deallocate(RotMiscVarTypeData%Cant) + if (allocated(RotParameterTypeData%BlCenBn)) then + deallocate(RotParameterTypeData%BlCenBn) end if - if (allocated(RotMiscVarTypeData%Toe)) then - deallocate(RotMiscVarTypeData%Toe) + if (allocated(RotParameterTypeData%BlCenBt)) then + deallocate(RotParameterTypeData%BlCenBt) end if - if (allocated(RotMiscVarTypeData%TwrClrnc)) then - deallocate(RotMiscVarTypeData%TwrClrnc) + if (allocated(RotParameterTypeData%BlRad)) then + deallocate(RotParameterTypeData%BlRad) end if - if (allocated(RotMiscVarTypeData%X)) then - deallocate(RotMiscVarTypeData%X) + if (allocated(RotParameterTypeData%BlDL)) then + deallocate(RotParameterTypeData%BlDL) end if - if (allocated(RotMiscVarTypeData%Y)) then - deallocate(RotMiscVarTypeData%Y) + if (allocated(RotParameterTypeData%BlTaper)) then + deallocate(RotParameterTypeData%BlTaper) end if - if (allocated(RotMiscVarTypeData%Z)) then - deallocate(RotMiscVarTypeData%Z) + if (allocated(RotParameterTypeData%BlAxCent)) then + deallocate(RotParameterTypeData%BlAxCent) end if - if (allocated(RotMiscVarTypeData%M)) then - deallocate(RotMiscVarTypeData%M) + if (allocated(RotParameterTypeData%TwrRad)) then + deallocate(RotParameterTypeData%TwrRad) end if - if (allocated(RotMiscVarTypeData%Mx)) then - deallocate(RotMiscVarTypeData%Mx) + if (allocated(RotParameterTypeData%TwrDL)) then + deallocate(RotParameterTypeData%TwrDL) end if - if (allocated(RotMiscVarTypeData%My)) then - deallocate(RotMiscVarTypeData%My) + if (allocated(RotParameterTypeData%TwrTaper)) then + deallocate(RotParameterTypeData%TwrTaper) end if - if (allocated(RotMiscVarTypeData%Mz)) then - deallocate(RotMiscVarTypeData%Mz) + if (allocated(RotParameterTypeData%TwrAxCent)) then + deallocate(RotParameterTypeData%TwrAxCent) end if - if (allocated(RotMiscVarTypeData%Vind_i)) then - deallocate(RotMiscVarTypeData%Vind_i) + 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%hub_theta_x_root)) then - deallocate(RotMiscVarTypeData%hub_theta_x_root) + if (allocated(RotParameterTypeData%dx)) then + deallocate(RotParameterTypeData%dx) 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, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_H_P, kind=B8Ki) + 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_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_H_P(i1), ErrStat2, ErrMsg2) + call NWTC_Library_DestroyOutParmType(RotParameterTypeData%OutParam(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%BladeRootLoad)) then - LB(1:1) = lbound(RotMiscVarTypeData%BladeRootLoad, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%BladeRootLoad, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%B_L_2_R_P, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoadPoint, kind=B8Ki) - 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) + deallocate(RotParameterTypeData%OutParam) end if - if (allocated(RotMiscVarTypeData%BladeBuoyLoad)) then - LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoad, kind=B8Ki) + 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, kind=B8Ki) - UB(1:1) = ubound(RotMiscVarTypeData%B_P_2_B_L, kind=B8Ki) - 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(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(InData%BEMT_u, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%B_L_2_H_P, kind=B8Ki)) - LB(1:1) = lbound(InData%B_L_2_H_P, kind=B8Ki) - UB(1:1) = ubound(InData%B_L_2_H_P, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%BladeRootLoad, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeRootLoad, kind=B8Ki) - UB(1:1) = ubound(InData%BladeRootLoad, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%B_L_2_R_P, kind=B8Ki)) - LB(1:1) = lbound(InData%B_L_2_R_P, kind=B8Ki) - UB(1:1) = ubound(InData%B_L_2_R_P, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%BladeBuoyLoadPoint, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeBuoyLoadPoint, kind=B8Ki) - UB(1:1) = ubound(InData%BladeBuoyLoadPoint, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%BladeBuoyLoad, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeBuoyLoad, kind=B8Ki) - UB(1:1) = ubound(InData%BladeBuoyLoad, kind=B8Ki) + 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 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 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, kind=B8Ki), ubound(InData%B_P_2_B_L, kind=B8Ki)) - LB(1:1) = lbound(InData%B_P_2_B_L, kind=B8Ki) - UB(1:1) = ubound(InData%B_P_2_B_L, kind=B8Ki) + 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(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(OutData%BEMT_u, kind=B8Ki) - 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%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 - if (allocated(OutData%BladeRootLoad)) deallocate(OutData%BladeRootLoad) + 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%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 + 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 MeshUnpack(RF, OutData%BladeBuoyLoadPoint(i1)) ! BladeBuoyLoadPoint - end do + else + OutData%Vars => null() 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%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 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%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_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) - type(AD_MiscVarType), intent(inout) :: SrcMiscData - type(AD_MiscVarType), intent(inout) :: DstMiscData +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(B8Ki) :: i1, i2 - integer(B8Ki) :: 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_CopyParam' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcMiscData%rotors)) then - LB(1:1) = lbound(SrcMiscData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%rotors, kind=B8Ki) - if (.not. allocated(DstMiscData%rotors)) then - allocate(DstMiscData%rotors(LB(1):UB(1)), 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 DstMiscData%rotors.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%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_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(SrcMiscData%FVW_u)) then - LB(1:1) = lbound(SrcMiscData%FVW_u, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FVW_u, kind=B8Ki) - if (.not. allocated(DstMiscData%FVW_u)) then - allocate(DstMiscData%FVW_u(LB(1):UB(1)), 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 DstMiscData%FVW_u.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFI.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call FVW_CopyInput(SrcMiscData%FVW_u(i1), DstMiscData%FVW_u(i1), CtrlCode, ErrStat2, ErrMsg2) + call 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 - 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) + 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 - if (allocated(SrcMiscData%WindPos)) then - LB(1:2) = lbound(SrcMiscData%WindPos, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%WindPos, kind=B8Ki) - if (.not. allocated(DstMiscData%WindPos)) then - allocate(DstMiscData%WindPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindPos.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%WindPos = SrcMiscData%WindPos - end if - if (allocated(SrcMiscData%WindVel)) then - LB(1:2) = lbound(SrcMiscData%WindVel, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%WindVel, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%WindAcc, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Inflow, kind=B8Ki) - 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 - end if + 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_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(AD_MiscVarType), intent(inout) :: MiscData +subroutine AD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(AD_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: 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_DestroyParam' ErrStat = ErrID_None ErrMsg = '' - if (allocated(MiscData%rotors)) then - LB(1:1) = lbound(MiscData%rotors, kind=B8Ki) - UB(1:1) = ubound(MiscData%rotors, kind=B8Ki) + 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_DestroyRotMiscVarType(MiscData%rotors(i1), ErrStat2, ErrMsg2) + call AD_DestroyRotParameterType(ParamData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%rotors) + deallocate(ParamData%rotors) end if - if (allocated(MiscData%FVW_u)) then - LB(1:1) = lbound(MiscData%FVW_u, kind=B8Ki) - UB(1:1) = ubound(MiscData%FVW_u, kind=B8Ki) + if (allocated(ParamData%AFI)) then + LB(1:1) = lbound(ParamData%AFI) + UB(1:1) = ubound(ParamData%AFI) do i1 = LB(1), UB(1) - call FVW_DestroyInput(MiscData%FVW_u(i1), ErrStat2, ErrMsg2) + call AFI_DestroyParam(ParamData%AFI(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%FVW_u) + deallocate(ParamData%AFI) 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 FVW_DestroyParam(ParamData%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 - if (allocated(MiscData%Inflow)) then - LB(1:1) = lbound(MiscData%Inflow, kind=B8Ki) - UB(1:1) = ubound(MiscData%Inflow, kind=B8Ki) - 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 + nullify(ParamData%FlowField) end subroutine -subroutine AD_PackMisc(RF, Indata) +subroutine AD_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF - type(AD_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + 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, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + 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)) + call AD_PackRotParameterType(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, kind=B8Ki), ubound(InData%FVW_u, kind=B8Ki)) - LB(1:1) = lbound(InData%FVW_u, kind=B8Ki) - UB(1:1) = ubound(InData%FVW_u, kind=B8Ki) + 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 FVW_PackInput(RF, InData%FVW_u(i1)) + call AFI_PackParam(RF, InData%AFI(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, kind=B8Ki), ubound(InData%Inflow, kind=B8Ki)) - LB(1:1) = lbound(InData%Inflow, kind=B8Ki) - UB(1:1) = ubound(InData%Inflow, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_PackInflowType(RF, InData%Inflow(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, 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) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AD_UnPackMisc(RF, OutData) +subroutine AD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF - type(AD_MiscVarType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: 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%rotors)) deallocate(OutData%rotors) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return @@ -4318,1805 +4232,1870 @@ subroutine AD_UnPackMisc(RF, OutData) return end if do i1 = LB(1), UB(1) - call AD_UnpackRotMiscVarType(RF, OutData%rotors(i1)) ! rotors + call AD_UnpackRotParameterType(RF, OutData%rotors(i1)) ! rotors end do end if - if (allocated(OutData%FVW_u)) deallocate(OutData%FVW_u) + 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%FVW_u(LB(1):UB(1)),stat=stat) + allocate(OutData%AFI(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FVW_u.', RF%ErrStat, RF%ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFI.', RF%ErrStat, RF%ErrMsg, RoutineName) return end if do i1 = LB(1), UB(1) - call FVW_UnpackInput(RF, OutData%FVW_u(i1)) ! FVW_u + call AFI_UnpackParam(RF, OutData%AFI(i1)) ! AFI 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 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 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 + 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 - do i1 = LB(1), UB(1) - call AD_UnpackInflowType(RF, OutData%Inflow(i1)) ! Inflow - end do + 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 end subroutine -subroutine AD_CopyElemInflowType(SrcElemInflowTypeData, DstElemInflowTypeData, CtrlCode, ErrStat, ErrMsg) - type(ElemInflowType), intent(in) :: SrcElemInflowTypeData - type(ElemInflowType), intent(inout) :: DstElemInflowTypeData +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(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 - character(*), parameter :: RoutineName = 'AD_CopyElemInflowType' + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_CopyRotInputType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcElemInflowTypeData%InflowVel)) then - LB(1:2) = lbound(SrcElemInflowTypeData%InflowVel, kind=B8Ki) - UB(1:2) = ubound(SrcElemInflowTypeData%InflowVel, kind=B8Ki) - if (.not. allocated(DstElemInflowTypeData%InflowVel)) then - allocate(DstElemInflowTypeData%InflowVel(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 DstElemInflowTypeData%InflowVel.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) return end if end if - DstElemInflowTypeData%InflowVel = SrcElemInflowTypeData%InflowVel + 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(SrcElemInflowTypeData%InflowAcc)) then - LB(1:2) = lbound(SrcElemInflowTypeData%InflowAcc, kind=B8Ki) - UB(1:2) = ubound(SrcElemInflowTypeData%InflowAcc, kind=B8Ki) - if (.not. allocated(DstElemInflowTypeData%InflowAcc)) then - allocate(DstElemInflowTypeData%InflowAcc(LB(1):UB(1),LB(2):UB(2)), 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 DstElemInflowTypeData%InflowAcc.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeMotion.', ErrStat, ErrMsg, RoutineName) return end if end if - DstElemInflowTypeData%InflowAcc = SrcElemInflowTypeData%InflowAcc + do i1 = LB(1), UB(1) + call MeshCopy(SrcRotInputTypeData%BladeMotion(i1), DstRotInputTypeData%BladeMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcRotInputTypeData%TFinMotion, DstRotInputTypeData%TFinMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotInputTypeData%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_DestroyElemInflowType(ElemInflowTypeData, ErrStat, ErrMsg) - type(ElemInflowType), intent(inout) :: ElemInflowTypeData +subroutine AD_DestroyRotInputType(RotInputTypeData, ErrStat, ErrMsg) + type(RotInputType), intent(inout) :: RotInputTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'AD_DestroyElemInflowType' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_DestroyRotInputType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(ElemInflowTypeData%InflowVel)) then - deallocate(ElemInflowTypeData%InflowVel) + 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(ElemInflowTypeData%InflowAcc)) then - deallocate(ElemInflowTypeData%InflowAcc) + if (allocated(RotInputTypeData%BladeMotion)) then + LB(1:1) = lbound(RotInputTypeData%BladeMotion) + UB(1:1) = ubound(RotInputTypeData%BladeMotion) + do i1 = LB(1), UB(1) + call MeshDestroy( RotInputTypeData%BladeMotion(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(RotInputTypeData%BladeMotion) + end if + call MeshDestroy( RotInputTypeData%TFinMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(RotInputTypeData%UserProp)) then + deallocate(RotInputTypeData%UserProp) end if end subroutine -subroutine AD_PackElemInflowType(RF, Indata) +subroutine AD_PackRotInputType(RF, Indata) type(RegFile), intent(inout) :: RF - type(ElemInflowType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackElemInflowType' + 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%InflowVel) - call RegPackAlloc(RF, InData%InflowAcc) + 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 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_UnPackElemInflowType(RF, OutData) +subroutine AD_UnPackRotInputType(RF, OutData) type(RegFile), intent(inout) :: RF - type(ElemInflowType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackElemInflowType' - integer(B8Ki) :: LB(2), UB(2) + 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%InflowVel); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%InflowAcc); if (RegCheckErr(RF, RoutineName)) 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 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 + 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_CopyRotInflowType(SrcRotInflowTypeData, DstRotInflowTypeData, CtrlCode, ErrStat, ErrMsg) - type(RotInflowType), intent(in) :: SrcRotInflowTypeData - type(RotInflowType), intent(inout) :: DstRotInflowTypeData +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(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyRotInflowType' + character(*), parameter :: RoutineName = 'AD_CopyInput' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcRotInflowTypeData%Blade)) then - LB(1:1) = lbound(SrcRotInflowTypeData%Blade, kind=B8Ki) - UB(1:1) = ubound(SrcRotInflowTypeData%Blade, kind=B8Ki) - if (.not. allocated(DstRotInflowTypeData%Blade)) then - allocate(DstRotInflowTypeData%Blade(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 DstRotInflowTypeData%Blade.', 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_CopyElemInflowType(SrcRotInflowTypeData%Blade(i1), DstRotInflowTypeData%Blade(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 - 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 +subroutine AD_DestroyInput(InputData, ErrStat, ErrMsg) + type(AD_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyRotInflowType' + character(*), parameter :: RoutineName = 'AD_DestroyInput' ErrStat = ErrID_None ErrMsg = '' - if (allocated(RotInflowTypeData%Blade)) then - LB(1:1) = lbound(RotInflowTypeData%Blade, kind=B8Ki) - UB(1:1) = ubound(RotInflowTypeData%Blade, kind=B8Ki) + 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_DestroyElemInflowType(RotInflowTypeData%Blade(i1), ErrStat2, ErrMsg2) + call AD_DestroyRotInputType(InputData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(RotInflowTypeData%Blade) + deallocate(InputData%rotors) end if - call AD_DestroyElemInflowType(RotInflowTypeData%Tower, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD_PackRotInflowType(RF, Indata) +subroutine AD_PackInput(RF, Indata) type(RegFile), intent(inout) :: RF - type(RotInflowType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackRotInflowType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + 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%Blade)) - if (allocated(InData%Blade)) then - call RegPackBounds(RF, 1, lbound(InData%Blade, kind=B8Ki), ubound(InData%Blade, kind=B8Ki)) - LB(1:1) = lbound(InData%Blade, kind=B8Ki) - UB(1:1) = ubound(InData%Blade, kind=B8Ki) + 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_PackElemInflowType(RF, InData%Blade(i1)) + call AD_PackRotInputType(RF, InData%rotors(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) +subroutine AD_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF - type(RotInflowType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackRotInflowType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + 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%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_UnpackRotInputType(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 end subroutine -subroutine AD_CopyInflowType(SrcInflowTypeData, DstInflowTypeData, CtrlCode, ErrStat, ErrMsg) - type(AD_InflowType), intent(in) :: SrcInflowTypeData - type(AD_InflowType), intent(inout) :: DstInflowTypeData +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(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyInflowType' + character(*), parameter :: RoutineName = 'AD_CopyRotOutputType' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcInflowTypeData%InflowWakeVel)) then - LB(1:2) = lbound(SrcInflowTypeData%InflowWakeVel, kind=B8Ki) - UB(1:2) = ubound(SrcInflowTypeData%InflowWakeVel, kind=B8Ki) - if (.not. allocated(DstInflowTypeData%InflowWakeVel)) then - allocate(DstInflowTypeData%InflowWakeVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + call MeshCopy(SrcRotOutputTypeData%NacelleLoad, DstRotOutputTypeData%NacelleLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotOutputTypeData%HubLoad, DstRotOutputTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcRotOutputTypeData%TowerLoad, DstRotOutputTypeData%TowerLoad, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcRotOutputTypeData%BladeLoad)) then + LB(1:1) = lbound(SrcRotOutputTypeData%BladeLoad) + UB(1:1) = ubound(SrcRotOutputTypeData%BladeLoad) + if (.not. allocated(DstRotOutputTypeData%BladeLoad)) then + allocate(DstRotOutputTypeData%BladeLoad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowTypeData%InflowWakeVel.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%BladeLoad.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInflowTypeData%InflowWakeVel = SrcInflowTypeData%InflowWakeVel + 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(SrcInflowTypeData%RotInflow)) then - LB(1:1) = lbound(SrcInflowTypeData%RotInflow, kind=B8Ki) - UB(1:1) = ubound(SrcInflowTypeData%RotInflow, kind=B8Ki) - if (.not. allocated(DstInflowTypeData%RotInflow)) then - allocate(DstInflowTypeData%RotInflow(LB(1):UB(1)), 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 DstInflowTypeData%RotInflow.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%WriteOutput.', 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstRotOutputTypeData%WriteOutput = SrcRotOutputTypeData%WriteOutput end if end subroutine -subroutine AD_DestroyInflowType(InflowTypeData, ErrStat, ErrMsg) - type(AD_InflowType), intent(inout) :: InflowTypeData +subroutine AD_DestroyRotOutputType(RotOutputTypeData, ErrStat, ErrMsg) + type(RotOutputType), intent(inout) :: RotOutputTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyInflowType' + character(*), parameter :: RoutineName = 'AD_DestroyRotOutputType' 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, kind=B8Ki) - UB(1:1) = ubound(InflowTypeData%RotInflow, kind=B8Ki) + 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 AD_DestroyRotInflowType(InflowTypeData%RotInflow(i1), ErrStat2, ErrMsg2) + call MeshDestroy( RotOutputTypeData%BladeLoad(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(InflowTypeData%RotInflow) + 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_PackInflowType(RF, Indata) +subroutine AD_PackRotOutputType(RF, Indata) type(RegFile), intent(inout) :: RF - type(AD_InflowType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackInflowType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: 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 RegPackAlloc(RF, InData%InflowWakeVel) - call RegPack(RF, allocated(InData%RotInflow)) - if (allocated(InData%RotInflow)) then - call RegPackBounds(RF, 1, lbound(InData%RotInflow, kind=B8Ki), ubound(InData%RotInflow, kind=B8Ki)) - LB(1:1) = lbound(InData%RotInflow, kind=B8Ki) - UB(1:1) = ubound(InData%RotInflow, kind=B8Ki) + 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_PackRotInflowType(RF, InData%RotInflow(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_UnPackInflowType(RF, OutData) +subroutine AD_UnPackRotOutputType(RF, OutData) type(RegFile), intent(inout) :: RF - type(AD_InflowType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackInflowType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: 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 - call RegUnpackAlloc(RF, OutData%InflowWakeVel); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%RotInflow)) deallocate(OutData%RotInflow) + 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%RotInflow(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%RotInflow.', 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_UnpackRotInflowType(RF, OutData%RotInflow(i1)) ! RotInflow + 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 - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'AD_CopyJac_u_idxStarts' - 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 - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'AD_DestroyJac_u_idxStarts' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine AD_PackJac_u_idxStarts(RF, Indata) - type(RegFile), intent(inout) :: RF - type(Jac_u_idxStarts), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackJac_u_idxStarts' - 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) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AD_UnPackJac_u_idxStarts(RF, OutData) - type(RegFile), intent(inout) :: RF - type(Jac_u_idxStarts), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackJac_u_idxStarts' - 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 +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_y_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_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 + 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_DestroyJac_y_idxStarts(Jac_y_idxStartsData, ErrStat, ErrMsg) - type(Jac_y_idxStarts), intent(inout) :: Jac_y_idxStartsData +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_y_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_y_idxStarts(RF, Indata) +subroutine AD_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF - type(Jac_y_idxStarts), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackJac_y_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%NacelleLoad) - call RegPack(RF, InData%HubLoad) - call RegPack(RF, InData%TFinLoad) - call RegPack(RF, InData%TowerLoad) - call RegPack(RF, InData%BladeLoad) + 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_y_idxStarts(RF, OutData) +subroutine AD_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF - type(Jac_y_idxStarts), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackJac_y_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%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(B8Ki) :: i1, i2 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrDiam, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrCd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrTI, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlTwist, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrCb, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBn, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlCenBt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlRad, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlDL, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlTaper, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%BlAxCent, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrRad, kind=B8Ki) - if (.not. allocated(DstRotParameterTypeData%TwrRad)) then - allocate(DstRotParameterTypeData%TwrRad(LB(1):UB(1)), stat=ErrStat2) + 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 DstRotParameterTypeData%TwrRad.', ErrStat, ErrMsg, RoutineName) + 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, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrDL, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrTaper, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%TwrAxCent, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcRotParameterTypeData%Jac_u_indx, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%du, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%dx, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%OutParam, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_OutParam, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcRotParameterTypeData%BldNd_BlOutNd, kind=B8Ki) - 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(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyRotParameterType' - ErrStat = ErrID_None - ErrMsg = '' - if (allocated(RotParameterTypeData%TwrDiam)) then - deallocate(RotParameterTypeData%TwrDiam) - end if - if (allocated(RotParameterTypeData%TwrCd)) then - deallocate(RotParameterTypeData%TwrCd) - end if - if (allocated(RotParameterTypeData%TwrTI)) then - deallocate(RotParameterTypeData%TwrTI) + DstRotMiscVarTypeData%SigmaCavitCrit = SrcRotMiscVarTypeData%SigmaCavitCrit end if - if (allocated(RotParameterTypeData%BlTwist)) then - deallocate(RotParameterTypeData%BlTwist) + 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%TwrCb)) then - deallocate(RotParameterTypeData%TwrCb) + 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%BlCenBn)) then - deallocate(RotParameterTypeData%BlCenBn) + 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%BlCenBt)) then - deallocate(RotParameterTypeData%BlCenBt) + 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%BlRad)) then - deallocate(RotParameterTypeData%BlRad) + if (allocated(SrcRotMiscVarTypeData%HubFB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%HubFB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%HubFB) + if (.not. allocated(DstRotMiscVarTypeData%HubFB)) then + allocate(DstRotMiscVarTypeData%HubFB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubFB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%HubFB = SrcRotMiscVarTypeData%HubFB end if - if (allocated(RotParameterTypeData%BlDL)) then - deallocate(RotParameterTypeData%BlDL) + if (allocated(SrcRotMiscVarTypeData%HubMB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%HubMB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%HubMB) + if (.not. allocated(DstRotMiscVarTypeData%HubMB)) then + allocate(DstRotMiscVarTypeData%HubMB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%HubMB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%HubMB = SrcRotMiscVarTypeData%HubMB end if - if (allocated(RotParameterTypeData%BlTaper)) then - deallocate(RotParameterTypeData%BlTaper) + if (allocated(SrcRotMiscVarTypeData%NacFB)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%NacFB) + UB(1:1) = ubound(SrcRotMiscVarTypeData%NacFB) + if (.not. allocated(DstRotMiscVarTypeData%NacFB)) then + allocate(DstRotMiscVarTypeData%NacFB(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%NacFB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstRotMiscVarTypeData%NacFB = SrcRotMiscVarTypeData%NacFB end if - if (allocated(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, kind=B8Ki) - UB(1:1) = ubound(RotParameterTypeData%OutParam, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(RotParameterTypeData%BldNd_OutParam, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyOutParmType(RotParameterTypeData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(RotParameterTypeData%BldNd_OutParam) - end if - if (allocated(RotParameterTypeData%BldNd_BlOutNd)) then - deallocate(RotParameterTypeData%BldNd_BlOutNd) - end if - call AD_DestroyTFinParameterType(RotParameterTypeData%TFin, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -end subroutine - -subroutine AD_PackRotParameterType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(RotParameterType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackRotParameterType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: 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, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) - end do - 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, kind=B8Ki), ubound(InData%BldNd_OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%BldNd_OutParam, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_PackOutParmType(RF, InData%BldNd_OutParam(i1)) - end do - 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(B8Ki) :: i1, i2 - integer(B8Ki) :: 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(B8Ki) :: i1 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rotors, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%AFI, kind=B8Ki) - 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(B8Ki) :: i1 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(ParamData%rotors, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_DestroyRotParameterType(ParamData%rotors(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%rotors) - end if - if (allocated(ParamData%AFI)) then - LB(1:1) = lbound(ParamData%AFI, kind=B8Ki) - UB(1:1) = ubound(ParamData%AFI, kind=B8Ki) - do i1 = LB(1), UB(1) - call AFI_DestroyParam(ParamData%AFI(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%AFI) - end if - call FVW_DestroyParam(ParamData%FVW, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - nullify(ParamData%FlowField) -end subroutine - -subroutine AD_PackParam(RF, Indata) - type(RegFile), intent(inout) :: RF - type(AD_ParameterType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: 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, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_PackRotParameterType(RF, InData%rotors(i1)) - end do + DstRotMiscVarTypeData%NacFi = SrcRotMiscVarTypeData%NacFi 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, kind=B8Ki), ubound(InData%AFI, kind=B8Ki)) - LB(1:1) = lbound(InData%AFI, kind=B8Ki) - UB(1:1) = ubound(InData%AFI, kind=B8Ki) + 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 + if (allocated(SrcRotMiscVarTypeData%BladeRootLoad)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeRootLoad) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeRootLoad) + if (.not. allocated(DstRotMiscVarTypeData%BladeRootLoad)) then + allocate(DstRotMiscVarTypeData%BladeRootLoad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeRootLoad.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call AFI_PackParam(RF, InData%AFI(i1)) + 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 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%B_L_2_R_P)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%B_L_2_R_P) + UB(1:1) = ubound(SrcRotMiscVarTypeData%B_L_2_R_P) + if (.not. allocated(DstRotMiscVarTypeData%B_L_2_R_P)) then + allocate(DstRotMiscVarTypeData%B_L_2_R_P(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%B_L_2_R_P.', ErrStat, ErrMsg, RoutineName) + return + end if end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyMeshMapType(SrcRotMiscVarTypeData%B_L_2_R_P(i1), DstRotMiscVarTypeData%B_L_2_R_P(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - 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(B8Ki) :: i1 - integer(B8Ki) :: 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%BladeBuoyLoadPoint)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoadPoint) + if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoadPoint)) then + allocate(DstRotMiscVarTypeData%BladeBuoyLoadPoint(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoadPoint.', ErrStat, ErrMsg, RoutineName) + return + end if end if do i1 = LB(1), UB(1) - call AD_UnpackRotParameterType(RF, OutData%rotors(i1)) ! rotors + 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 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%BladeBuoyLoad)) then + LB(1:1) = lbound(SrcRotMiscVarTypeData%BladeBuoyLoad) + UB(1:1) = ubound(SrcRotMiscVarTypeData%BladeBuoyLoad) + if (.not. allocated(DstRotMiscVarTypeData%BladeBuoyLoad)) then + allocate(DstRotMiscVarTypeData%BladeBuoyLoad(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%BladeBuoyLoad.', ErrStat, ErrMsg, RoutineName) + return + end if end if do i1 = LB(1), UB(1) - call AFI_UnpackParam(RF, OutData%AFI(i1)) ! AFI + 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 - 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%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 - 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 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 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 + 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_CopyRotInputType(SrcRotInputTypeData, DstRotInputTypeData, CtrlCode, ErrStat, ErrMsg) - type(RotInputType), intent(inout) :: SrcRotInputTypeData - type(RotInputType), intent(inout) :: DstRotInputTypeData - integer(IntKi), intent(in ) :: CtrlCode +subroutine AD_DestroyRotMiscVarType(RotMiscVarTypeData, ErrStat, ErrMsg) + type(RotMiscVarType), intent(inout) :: RotMiscVarTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: 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_CopyRotInputType' + character(*), parameter :: RoutineName = 'AD_DestroyRotMiscVarType' ErrStat = ErrID_None ErrMsg = '' - call MeshCopy(SrcRotInputTypeData%NacelleMotion, DstRotInputTypeData%NacelleMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call NWTC_Library_DestroyModJacType(RotMiscVarTypeData%Jac, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcRotInputTypeData%TowerMotion, DstRotInputTypeData%TowerMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call AD_DestroyRotContinuousStateType(RotMiscVarTypeData%x_init, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcRotInputTypeData%HubMotion, DstRotInputTypeData%HubMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call AD_DestroyRotContinuousStateType(RotMiscVarTypeData%x_perturb, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcRotInputTypeData%BladeRootMotion)) then - LB(1:1) = lbound(SrcRotInputTypeData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(SrcRotInputTypeData%BladeRootMotion, kind=B8Ki) - if (.not. allocated(DstRotInputTypeData%BladeRootMotion)) then - allocate(DstRotInputTypeData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeRootMotion.', ErrStat, ErrMsg, RoutineName) - return - end if - end if + 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 MeshCopy(SrcRotInputTypeData%BladeRootMotion(i1), DstRotInputTypeData%BladeRootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_H_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end do + deallocate(RotMiscVarTypeData%B_L_2_H_P) end if - if (allocated(SrcRotInputTypeData%BladeMotion)) then - LB(1:1) = lbound(SrcRotInputTypeData%BladeMotion, kind=B8Ki) - UB(1:1) = ubound(SrcRotInputTypeData%BladeMotion, kind=B8Ki) - if (.not. allocated(DstRotInputTypeData%BladeMotion)) then - allocate(DstRotInputTypeData%BladeMotion(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%BladeMotion.', ErrStat, ErrMsg, RoutineName) - return - end if - end if + 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%BladeRootLoad)) then + LB(1:1) = lbound(RotMiscVarTypeData%BladeRootLoad) + UB(1:1) = ubound(RotMiscVarTypeData%BladeRootLoad) do i1 = LB(1), UB(1) - call MeshCopy(SrcRotInputTypeData%BladeMotion(i1), DstRotInputTypeData%BladeMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call MeshDestroy( RotMiscVarTypeData%BladeRootLoad(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end do + deallocate(RotMiscVarTypeData%BladeRootLoad) 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, kind=B8Ki) - UB(1:2) = ubound(SrcRotInputTypeData%UserProp, kind=B8Ki) - if (.not. allocated(DstRotInputTypeData%UserProp)) then - allocate(DstRotInputTypeData%UserProp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotInputTypeData%UserProp.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstRotInputTypeData%UserProp = SrcRotInputTypeData%UserProp - end if -end subroutine - -subroutine AD_DestroyRotInputType(RotInputTypeData, ErrStat, ErrMsg) - type(RotInputType), intent(inout) :: RotInputTypeData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_DestroyRotInputType' - ErrStat = ErrID_None - ErrMsg = '' - call MeshDestroy( RotInputTypeData%NacelleMotion, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( RotInputTypeData%TowerMotion, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call MeshDestroy( RotInputTypeData%HubMotion, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(RotInputTypeData%BladeRootMotion)) then - LB(1:1) = lbound(RotInputTypeData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(RotInputTypeData%BladeRootMotion, kind=B8Ki) + 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 MeshDestroy( RotInputTypeData%BladeRootMotion(i1), ErrStat2, ErrMsg2) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_L_2_R_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(RotInputTypeData%BladeRootMotion) + deallocate(RotMiscVarTypeData%B_L_2_R_P) end if - if (allocated(RotInputTypeData%BladeMotion)) then - LB(1:1) = lbound(RotInputTypeData%BladeMotion, kind=B8Ki) - UB(1:1) = ubound(RotInputTypeData%BladeMotion, kind=B8Ki) + 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( RotInputTypeData%BladeMotion(i1), ErrStat2, ErrMsg2) + call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoadPoint(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(RotInputTypeData%BladeMotion) - end if - call MeshDestroy( RotInputTypeData%TFinMotion, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(RotInputTypeData%UserProp)) then - deallocate(RotInputTypeData%UserProp) + deallocate(RotMiscVarTypeData%BladeBuoyLoadPoint) end if -end subroutine - -subroutine AD_PackRotInputType(RF, Indata) - type(RegFile), intent(inout) :: RF - type(RotInputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AD_PackRotInputType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - 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, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(InData%BladeRootMotion, kind=B8Ki) + if (allocated(RotMiscVarTypeData%BladeBuoyLoad)) then + LB(1:1) = lbound(RotMiscVarTypeData%BladeBuoyLoad) + UB(1:1) = ubound(RotMiscVarTypeData%BladeBuoyLoad) do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BladeRootMotion(i1)) + call MeshDestroy( RotMiscVarTypeData%BladeBuoyLoad(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(RotMiscVarTypeData%BladeBuoyLoad) end if - call RegPack(RF, allocated(InData%BladeMotion)) - if (allocated(InData%BladeMotion)) then - call RegPackBounds(RF, 1, lbound(InData%BladeMotion, kind=B8Ki), ubound(InData%BladeMotion, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeMotion, kind=B8Ki) - UB(1:1) = ubound(InData%BladeMotion, kind=B8Ki) + 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 MeshPack(RF, InData%BladeMotion(i1)) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%B_P_2_B_L(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do + deallocate(RotMiscVarTypeData%B_P_2_B_L) end if - call MeshPack(RF, InData%TFinMotion) - call RegPackAlloc(RF, InData%UserProp) - if (RegCheckErr(RF, RoutineName)) return + call MeshDestroy( RotMiscVarTypeData%TwrBuoyLoadPoint, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( RotMiscVarTypeData%TwrBuoyLoad, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_DestroyMeshMapType(RotMiscVarTypeData%T_P_2_T_L, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine AD_UnPackRotInputType(RF, OutData) - type(RegFile), intent(inout) :: RF - type(RotInputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackRotInputType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) - 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 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 - 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 +subroutine AD_PackRotMiscVarType(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) + if (RF%ErrStat >= AbortErrLev) return + 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 MeshUnpack(RF, OutData%BladeMotion(i1)) ! BladeMotion + call NWTC_Library_PackMeshMapType(RF, InData%B_L_2_H_P(i1)) 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(B8Ki) :: i1 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%rotors, kind=B8Ki) - if (.not. allocated(DstInputData%rotors)) then - allocate(DstInputData%rotors(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%rotors.', ErrStat, ErrMsg, RoutineName) - return - end if - end if + 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 AD_CopyRotInputType(SrcInputData%rotors(i1), DstInputData%rotors(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%BladeRootLoad(i1)) 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(B8Ki) :: i1 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(InputData%rotors, kind=B8Ki) + 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 AD_DestroyRotInputType(InputData%rotors(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_PackMeshMapType(RF, InData%B_L_2_R_P(i1)) 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(B8Ki) :: i1 - integer(B8Ki) :: 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, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + 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 AD_PackRotInputType(RF, InData%rotors(i1)) + 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_UnPackInput(RF, OutData) +subroutine AD_UnPackRotMiscVarType(RF, OutData) type(RegFile), intent(inout) :: RF - type(AD_InputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AD_UnPackInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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 - if (allocated(OutData%rotors)) deallocate(OutData%rotors) + 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%rotors(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%rotors.', RF%ErrStat, RF%ErrMsg, RoutineName) + 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 AD_UnpackRotInputType(RF, OutData%rotors(i1)) ! rotors + call NWTC_Library_UnpackMeshMapType(RF, OutData%B_L_2_H_P(i1)) ! B_L_2_H_P 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(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyRotOutputType' - ErrStat = ErrID_None - ErrMsg = '' - call MeshCopy(SrcRotOutputTypeData%NacelleLoad, DstRotOutputTypeData%NacelleLoad, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcRotOutputTypeData%HubLoad, DstRotOutputTypeData%HubLoad, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcRotOutputTypeData%TowerLoad, DstRotOutputTypeData%TowerLoad, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcRotOutputTypeData%BladeLoad)) then - LB(1:1) = lbound(SrcRotOutputTypeData%BladeLoad, kind=B8Ki) - UB(1:1) = ubound(SrcRotOutputTypeData%BladeLoad, kind=B8Ki) - if (.not. allocated(DstRotOutputTypeData%BladeLoad)) then - allocate(DstRotOutputTypeData%BladeLoad(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstRotOutputTypeData%BladeLoad.', ErrStat, ErrMsg, RoutineName) - return - end if + 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 MeshCopy(SrcRotOutputTypeData%BladeLoad(i1), DstRotOutputTypeData%BladeLoad(i1), CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call MeshUnpack(RF, OutData%BladeRootLoad(i1)) ! BladeRootLoad 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, kind=B8Ki) - UB(1:1) = ubound(SrcRotOutputTypeData%WriteOutput, kind=B8Ki) - 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 + 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 - 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(B8Ki) :: i1 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(RotOutputTypeData%BladeLoad, kind=B8Ki) do i1 = LB(1), UB(1) - call MeshDestroy( RotOutputTypeData%BladeLoad(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call NWTC_Library_UnpackMeshMapType(RF, OutData%B_L_2_R_P(i1)) ! B_L_2_R_P 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(B8Ki) :: i1 - integer(B8Ki) :: 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, kind=B8Ki), ubound(InData%BladeLoad, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeLoad, kind=B8Ki) - UB(1:1) = ubound(InData%BladeLoad, kind=B8Ki) + 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 MeshPack(RF, InData%BladeLoad(i1)) + call MeshUnpack(RF, OutData%BladeBuoyLoadPoint(i1)) ! BladeBuoyLoadPoint 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(B8Ki) :: i1 - integer(B8Ki) :: 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) + 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 MeshUnpack(RF, OutData%BladeBuoyLoad(i1)) ! BladeBuoyLoad + end do + end if + if (allocated(OutData%B_P_2_B_L)) deallocate(OutData%B_P_2_B_L) call RegUnpack(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) + allocate(OutData%B_P_2_B_L(LB(1):UB(1)),stat=stat) if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeLoad.', 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 MeshUnpack(RF, OutData%BladeLoad(i1)) ! BladeLoad + 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%TFinLoad) ! TFinLoad - call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + 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_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) - type(AD_OutputType), intent(inout) :: SrcOutputData - type(AD_OutputType), intent(inout) :: DstOutputData +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(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CopyOutput' + character(*), parameter :: RoutineName = 'AD_CopyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcOutputData%rotors)) then - LB(1:1) = lbound(SrcOutputData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%rotors, kind=B8Ki) - if (.not. allocated(DstOutputData%rotors)) then - allocate(DstOutputData%rotors(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 DstOutputData%rotors.', 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 AD_CopyRotOutputType(SrcOutputData%rotors(i1), DstOutputData%rotors(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 + if (allocated(SrcMiscData%FVW_u)) then + LB(1:1) = lbound(SrcMiscData%FVW_u) + UB(1:1) = ubound(SrcMiscData%FVW_u) + if (.not. allocated(DstMiscData%FVW_u)) then + allocate(DstMiscData%FVW_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FVW_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call FVW_CopyInput(SrcMiscData%FVW_u(i1), DstMiscData%FVW_u(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call FVW_CopyOutput(SrcMiscData%FVW_y, DstMiscData%FVW_y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call FVW_CopyMisc(SrcMiscData%FVW, DstMiscData%FVW, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%WindPos)) then + LB(1:2) = lbound(SrcMiscData%WindPos) + UB(1:2) = ubound(SrcMiscData%WindPos) + if (.not. allocated(DstMiscData%WindPos)) then + allocate(DstMiscData%WindPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindPos.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindPos = SrcMiscData%WindPos + end if + if (allocated(SrcMiscData%WindVel)) then + LB(1:2) = lbound(SrcMiscData%WindVel) + UB(1:2) = ubound(SrcMiscData%WindVel) + if (.not. allocated(DstMiscData%WindVel)) then + allocate(DstMiscData%WindVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindVel.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindVel = SrcMiscData%WindVel + end if + if (allocated(SrcMiscData%WindAcc)) then + LB(1:2) = lbound(SrcMiscData%WindAcc) + UB(1:2) = ubound(SrcMiscData%WindAcc) + if (.not. allocated(DstMiscData%WindAcc)) then + allocate(DstMiscData%WindAcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WindAcc.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%WindAcc = SrcMiscData%WindAcc + end if + 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 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(B8Ki) :: i1 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(OutputData%rotors, kind=B8Ki) + 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 + 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(B8Ki) :: i1 - integer(B8Ki) :: 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 - call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + 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)) + 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) + 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(B8Ki) :: i1 - integer(B8Ki) :: 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 +6109,38 @@ 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 + 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 @@ -6235,39 +6245,39 @@ SUBROUTINE AD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) a2 = t_out/t(2) IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) CALL MeshExtrapInterp1(u1%rotors(i01)%NacelleMotion, u2%rotors(i01)%NacelleMotion, tin, u_out%rotors(i01)%NacelleMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) CALL MeshExtrapInterp1(u1%rotors(i01)%TowerMotion, u2%rotors(i01)%TowerMotion, tin, u_out%rotors(i01)%TowerMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) CALL MeshExtrapInterp1(u1%rotors(i01)%HubMotion, u2%rotors(i01)%HubMotion, tin, u_out%rotors(i01)%HubMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) IF (ALLOCATED(u_out%rotors(i01)%BladeRootMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeRootMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeRootMotion,1, kind=B8Ki),UBOUND(u_out%rotors(i01)%BladeRootMotion,1, kind=B8Ki) + do i1 = lbound(u_out%rotors(i01)%BladeRootMotion,1),ubound(u_out%rotors(i01)%BladeRootMotion,1) CALL MeshExtrapInterp1(u1%rotors(i01)%BladeRootMotion(i1), u2%rotors(i01)%BladeRootMotion(i1), tin, u_out%rotors(i01)%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) IF (ALLOCATED(u_out%rotors(i01)%BladeMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeMotion,1, kind=B8Ki),UBOUND(u_out%rotors(i01)%BladeMotion,1, kind=B8Ki) + do i1 = lbound(u_out%rotors(i01)%BladeMotion,1),ubound(u_out%rotors(i01)%BladeMotion,1) CALL MeshExtrapInterp1(u1%rotors(i01)%BladeMotion(i1), u2%rotors(i01)%BladeMotion(i1), tin, u_out%rotors(i01)%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) CALL MeshExtrapInterp1(u1%rotors(i01)%TFinMotion, u2%rotors(i01)%TFinMotion, tin, u_out%rotors(i01)%TFinMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN u_out%rotors(i01)%UserProp = a1*u1%rotors(i01)%UserProp + a2*u2%rotors(i01)%UserProp END IF ! check if allocated @@ -6333,39 +6343,39 @@ SUBROUTINE AD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) CALL MeshExtrapInterp2(u1%rotors(i01)%NacelleMotion, u2%rotors(i01)%NacelleMotion, u3%rotors(i01)%NacelleMotion, tin, u_out%rotors(i01)%NacelleMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) CALL MeshExtrapInterp2(u1%rotors(i01)%TowerMotion, u2%rotors(i01)%TowerMotion, u3%rotors(i01)%TowerMotion, tin, u_out%rotors(i01)%TowerMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) CALL MeshExtrapInterp2(u1%rotors(i01)%HubMotion, u2%rotors(i01)%HubMotion, u3%rotors(i01)%HubMotion, tin, u_out%rotors(i01)%HubMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) IF (ALLOCATED(u_out%rotors(i01)%BladeRootMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeRootMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeRootMotion,1, kind=B8Ki),UBOUND(u_out%rotors(i01)%BladeRootMotion,1, kind=B8Ki) + do i1 = lbound(u_out%rotors(i01)%BladeRootMotion,1),ubound(u_out%rotors(i01)%BladeRootMotion,1) CALL MeshExtrapInterp2(u1%rotors(i01)%BladeRootMotion(i1), u2%rotors(i01)%BladeRootMotion(i1), u3%rotors(i01)%BladeRootMotion(i1), tin, u_out%rotors(i01)%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) IF (ALLOCATED(u_out%rotors(i01)%BladeMotion) .AND. ALLOCATED(u1%rotors(i01)%BladeMotion)) THEN - DO i1 = LBOUND(u_out%rotors(i01)%BladeMotion,1, kind=B8Ki),UBOUND(u_out%rotors(i01)%BladeMotion,1, kind=B8Ki) + do i1 = lbound(u_out%rotors(i01)%BladeMotion,1),ubound(u_out%rotors(i01)%BladeMotion,1) CALL MeshExtrapInterp2(u1%rotors(i01)%BladeMotion(i1), u2%rotors(i01)%BladeMotion(i1), u3%rotors(i01)%BladeMotion(i1), tin, u_out%rotors(i01)%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) CALL MeshExtrapInterp2(u1%rotors(i01)%TFinMotion, u2%rotors(i01)%TFinMotion, u3%rotors(i01)%TFinMotion, tin, u_out%rotors(i01)%TFinMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) IF (ALLOCATED(u_out%rotors(i01)%UserProp) .AND. ALLOCATED(u1%rotors(i01)%UserProp)) THEN u_out%rotors(i01)%UserProp = a1*u1%rotors(i01)%UserProp + a2*u2%rotors(i01)%UserProp + a3*u3%rotors(i01)%UserProp END IF ! check if allocated @@ -6471,31 +6481,31 @@ SUBROUTINE AD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(y_out%rotors) .AND. ALLOCATED(y1%rotors)) THEN - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) CALL MeshExtrapInterp1(y1%rotors(i01)%NacelleLoad, y2%rotors(i01)%NacelleLoad, tin, y_out%rotors(i01)%NacelleLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) CALL MeshExtrapInterp1(y1%rotors(i01)%HubLoad, y2%rotors(i01)%HubLoad, tin, y_out%rotors(i01)%HubLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) CALL MeshExtrapInterp1(y1%rotors(i01)%TowerLoad, y2%rotors(i01)%TowerLoad, tin, y_out%rotors(i01)%TowerLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) IF (ALLOCATED(y_out%rotors(i01)%BladeLoad) .AND. ALLOCATED(y1%rotors(i01)%BladeLoad)) THEN - DO i1 = LBOUND(y_out%rotors(i01)%BladeLoad,1, kind=B8Ki),UBOUND(y_out%rotors(i01)%BladeLoad,1, kind=B8Ki) + do i1 = lbound(y_out%rotors(i01)%BladeLoad,1),ubound(y_out%rotors(i01)%BladeLoad,1) CALL MeshExtrapInterp1(y1%rotors(i01)%BladeLoad(i1), y2%rotors(i01)%BladeLoad(i1), tin, y_out%rotors(i01)%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) CALL MeshExtrapInterp1(y1%rotors(i01)%TFinLoad, y2%rotors(i01)%TFinLoad, tin, y_out%rotors(i01)%TFinLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) IF (ALLOCATED(y_out%rotors(i01)%WriteOutput) .AND. ALLOCATED(y1%rotors(i01)%WriteOutput)) THEN y_out%rotors(i01)%WriteOutput = a1*y1%rotors(i01)%WriteOutput + a2*y2%rotors(i01)%WriteOutput END IF ! check if allocated @@ -6559,31 +6569,31 @@ SUBROUTINE AD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%rotors) .AND. ALLOCATED(y1%rotors)) THEN - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) CALL MeshExtrapInterp2(y1%rotors(i01)%NacelleLoad, y2%rotors(i01)%NacelleLoad, y3%rotors(i01)%NacelleLoad, tin, y_out%rotors(i01)%NacelleLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) CALL MeshExtrapInterp2(y1%rotors(i01)%HubLoad, y2%rotors(i01)%HubLoad, y3%rotors(i01)%HubLoad, tin, y_out%rotors(i01)%HubLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) CALL MeshExtrapInterp2(y1%rotors(i01)%TowerLoad, y2%rotors(i01)%TowerLoad, y3%rotors(i01)%TowerLoad, tin, y_out%rotors(i01)%TowerLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) IF (ALLOCATED(y_out%rotors(i01)%BladeLoad) .AND. ALLOCATED(y1%rotors(i01)%BladeLoad)) THEN - DO i1 = LBOUND(y_out%rotors(i01)%BladeLoad,1, kind=B8Ki),UBOUND(y_out%rotors(i01)%BladeLoad,1, kind=B8Ki) + do i1 = lbound(y_out%rotors(i01)%BladeLoad,1),ubound(y_out%rotors(i01)%BladeLoad,1) CALL MeshExtrapInterp2(y1%rotors(i01)%BladeLoad(i1), y2%rotors(i01)%BladeLoad(i1), y3%rotors(i01)%BladeLoad(i1), tin, y_out%rotors(i01)%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) CALL MeshExtrapInterp2(y1%rotors(i01)%TFinLoad, y2%rotors(i01)%TFinLoad, y3%rotors(i01)%TFinLoad, tin, y_out%rotors(i01)%TFinLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO - DO i01 = LBOUND(y_out%rotors,1, kind=B8Ki),UBOUND(y_out%rotors,1, kind=B8Ki) + do i01 = lbound(y_out%rotors,1),ubound(y_out%rotors,1) IF (ALLOCATED(y_out%rotors(i01)%WriteOutput) .AND. ALLOCATED(y1%rotors(i01)%WriteOutput)) THEN y_out%rotors(i01)%WriteOutput = a1*y1%rotors(i01)%WriteOutput + a2*y2%rotors(i01)%WriteOutput + a3*y3%rotors(i01)%WriteOutput END IF ! check if allocated @@ -6696,21 +6706,21 @@ SUBROUTINE AD_InflowType_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err u_out%InflowWakeVel = a1*u1%InflowWakeVel + a2*u2%InflowWakeVel END IF ! check if allocated IF (ALLOCATED(u_out%RotInflow) .AND. ALLOCATED(u1%RotInflow)) THEN - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) IF (ALLOCATED(u_out%RotInflow(i01)%Blade) .AND. ALLOCATED(u1%RotInflow(i01)%Blade)) THEN - DO i11 = LBOUND(u_out%RotInflow(i01)%Blade,1, kind=B8Ki),UBOUND(u_out%RotInflow(i01)%Blade,1, kind=B8Ki) + do i11 = lbound(u_out%RotInflow(i01)%Blade,1),ubound(u_out%RotInflow(i01)%Blade,1) IF (ALLOCATED(u_out%RotInflow(i01)%Blade(i11)%InflowVel) .AND. ALLOCATED(u1%RotInflow(i01)%Blade(i11)%InflowVel)) THEN u_out%RotInflow(i01)%Blade(i11)%InflowVel = a1*u1%RotInflow(i01)%Blade(i11)%InflowVel + a2*u2%RotInflow(i01)%Blade(i11)%InflowVel END IF ! check if allocated END DO - DO i11 = LBOUND(u_out%RotInflow(i01)%Blade,1, kind=B8Ki),UBOUND(u_out%RotInflow(i01)%Blade,1, kind=B8Ki) + do i11 = lbound(u_out%RotInflow(i01)%Blade,1),ubound(u_out%RotInflow(i01)%Blade,1) IF (ALLOCATED(u_out%RotInflow(i01)%Blade(i11)%InflowAcc) .AND. ALLOCATED(u1%RotInflow(i01)%Blade(i11)%InflowAcc)) THEN u_out%RotInflow(i01)%Blade(i11)%InflowAcc = a1*u1%RotInflow(i01)%Blade(i11)%InflowAcc + a2*u2%RotInflow(i01)%Blade(i11)%InflowAcc END IF ! check if allocated END DO END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) IF (ALLOCATED(u_out%RotInflow(i01)%Tower%InflowVel) .AND. ALLOCATED(u1%RotInflow(i01)%Tower%InflowVel)) THEN u_out%RotInflow(i01)%Tower%InflowVel = a1*u1%RotInflow(i01)%Tower%InflowVel + a2*u2%RotInflow(i01)%Tower%InflowVel END IF ! check if allocated @@ -6718,16 +6728,16 @@ SUBROUTINE AD_InflowType_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err u_out%RotInflow(i01)%Tower%InflowAcc = a1*u1%RotInflow(i01)%Tower%InflowAcc + a2*u2%RotInflow(i01)%Tower%InflowAcc END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) u_out%RotInflow(i01)%InflowOnHub = a1*u1%RotInflow(i01)%InflowOnHub + a2*u2%RotInflow(i01)%InflowOnHub END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) u_out%RotInflow(i01)%InflowOnNacelle = a1*u1%RotInflow(i01)%InflowOnNacelle + a2*u2%RotInflow(i01)%InflowOnNacelle END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) u_out%RotInflow(i01)%InflowOnTailFin = a1*u1%RotInflow(i01)%InflowOnTailFin + a2*u2%RotInflow(i01)%InflowOnTailFin END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) u_out%RotInflow(i01)%AvgDiskVel = a1*u1%RotInflow(i01)%AvgDiskVel + a2*u2%RotInflow(i01)%AvgDiskVel END DO END IF ! check if allocated @@ -6796,21 +6806,21 @@ SUBROUTINE AD_InflowType_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, u_out%InflowWakeVel = a1*u1%InflowWakeVel + a2*u2%InflowWakeVel + a3*u3%InflowWakeVel END IF ! check if allocated IF (ALLOCATED(u_out%RotInflow) .AND. ALLOCATED(u1%RotInflow)) THEN - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) IF (ALLOCATED(u_out%RotInflow(i01)%Blade) .AND. ALLOCATED(u1%RotInflow(i01)%Blade)) THEN - DO i11 = LBOUND(u_out%RotInflow(i01)%Blade,1, kind=B8Ki),UBOUND(u_out%RotInflow(i01)%Blade,1, kind=B8Ki) + do i11 = lbound(u_out%RotInflow(i01)%Blade,1),ubound(u_out%RotInflow(i01)%Blade,1) IF (ALLOCATED(u_out%RotInflow(i01)%Blade(i11)%InflowVel) .AND. ALLOCATED(u1%RotInflow(i01)%Blade(i11)%InflowVel)) THEN u_out%RotInflow(i01)%Blade(i11)%InflowVel = a1*u1%RotInflow(i01)%Blade(i11)%InflowVel + a2*u2%RotInflow(i01)%Blade(i11)%InflowVel + a3*u3%RotInflow(i01)%Blade(i11)%InflowVel END IF ! check if allocated END DO - DO i11 = LBOUND(u_out%RotInflow(i01)%Blade,1, kind=B8Ki),UBOUND(u_out%RotInflow(i01)%Blade,1, kind=B8Ki) + do i11 = lbound(u_out%RotInflow(i01)%Blade,1),ubound(u_out%RotInflow(i01)%Blade,1) IF (ALLOCATED(u_out%RotInflow(i01)%Blade(i11)%InflowAcc) .AND. ALLOCATED(u1%RotInflow(i01)%Blade(i11)%InflowAcc)) THEN u_out%RotInflow(i01)%Blade(i11)%InflowAcc = a1*u1%RotInflow(i01)%Blade(i11)%InflowAcc + a2*u2%RotInflow(i01)%Blade(i11)%InflowAcc + a3*u3%RotInflow(i01)%Blade(i11)%InflowAcc END IF ! check if allocated END DO END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) IF (ALLOCATED(u_out%RotInflow(i01)%Tower%InflowVel) .AND. ALLOCATED(u1%RotInflow(i01)%Tower%InflowVel)) THEN u_out%RotInflow(i01)%Tower%InflowVel = a1*u1%RotInflow(i01)%Tower%InflowVel + a2*u2%RotInflow(i01)%Tower%InflowVel + a3*u3%RotInflow(i01)%Tower%InflowVel END IF ! check if allocated @@ -6818,19 +6828,417 @@ SUBROUTINE AD_InflowType_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, u_out%RotInflow(i01)%Tower%InflowAcc = a1*u1%RotInflow(i01)%Tower%InflowAcc + a2*u2%RotInflow(i01)%Tower%InflowAcc + a3*u3%RotInflow(i01)%Tower%InflowAcc END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) u_out%RotInflow(i01)%InflowOnHub = a1*u1%RotInflow(i01)%InflowOnHub + a2*u2%RotInflow(i01)%InflowOnHub + a3*u3%RotInflow(i01)%InflowOnHub END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) u_out%RotInflow(i01)%InflowOnNacelle = a1*u1%RotInflow(i01)%InflowOnNacelle + a2*u2%RotInflow(i01)%InflowOnNacelle + a3*u3%RotInflow(i01)%InflowOnNacelle END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) u_out%RotInflow(i01)%InflowOnTailFin = a1*u1%RotInflow(i01)%InflowOnTailFin + a2*u2%RotInflow(i01)%InflowOnTailFin + a3*u3%RotInflow(i01)%InflowOnTailFin END DO - DO i01 = LBOUND(u_out%RotInflow,1, kind=B8Ki),UBOUND(u_out%RotInflow,1, kind=B8Ki) + do i01 = lbound(u_out%RotInflow,1),ubound(u_out%RotInflow,1) u_out%RotInflow(i01)%AvgDiskVel = a1*u1%RotInflow(i01)%AvgDiskVel + a2*u2%RotInflow(i01)%AvgDiskVel + a3*u3%RotInflow(i01)%AvgDiskVel 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.f90 b/modules/aerodyn/src/AirfoilInfo.f90 index e11f3b8656..ad76c2c689 100644 --- a/modules/aerodyn/src/AirfoilInfo.f90 +++ b/modules/aerodyn/src/AirfoilInfo.f90 @@ -990,6 +990,8 @@ SUBROUTINE CalculateUACoeffs(CalcDefaults,p,ColCl,ColCd,ColCm,ColUAf,UAMod) ! find bounding indices for limitAlphaRange iHighLimit = min( maxloc( alpha_ , DIM=1, MASK=alpha_ < LimitAlphaRange) + 1, size(alpha_) ) ! we can limit this to some range iLowLimit = max( minloc( alpha_ , DIM=1, MASK=alpha_ > -LimitAlphaRange) - 1, 1 ) ! we can limit this to some range + if (iHighLimit - iLowLimit < 3) iHighLimit = min(iLowLimit+2,size(alpha_)) ! this could still be an issue if we don't have very many points in the airfoil table. If that's the case, this data is not worth anything anyway + if (iHighLimit - iLowLimit < 3) iLowLimit = max(iHighLimit-2,1) ! this could still be an issue if we don't have very many points in the airfoil table. If that's the case, this data is not worth anything anyway ! find alphaUpper (using smoothed Cn values): if (CalcDefaults%alphaUpper) then @@ -1053,12 +1055,12 @@ SUBROUTINE CalculateUACoeffs(CalcDefaults,p,ColCl,ColCd,ColCm,ColUAf,UAMod) !mask = p%alpha >= p%UA_BL%alphaLower+alphaMargin & p%alpha <= p%UA_BL%alphaUpper-alphaMargin; iLow2 = iLowLimit - do while (iLow2 < iHighLimit .and. p%alpha(iLow2) < p%UA_BL%alphaLower + alphaMargin) + do while (iLow2 < iHighLimit-1 .and. p%alpha(iLow2) < p%UA_BL%alphaLower + alphaMargin) iLow2 = iLow2 + 1 end do iHigh2 = iHighLimit - do while (iHigh2 > iLowLimit .and. p%alpha(iHigh2) > p%UA_BL%alphaUpper - alphaMargin) + do while (iHigh2 > iLow2+1 .and. p%alpha(iHigh2) > p%UA_BL%alphaUpper - alphaMargin) iHigh2 = iHigh2 - 1 end do @@ -1181,11 +1183,25 @@ SUBROUTINE Calculate_C_alpha(alpha, Cn, Cl, Default_Cn_alpha, Default_Cl_alpha, REAL(ReKi) :: A( size(alpha), 2) REAL(ReKi) :: B(max(2,size(alpha)),2) + if (SIZE(Cn) < 2 .OR. SIZE(Cl) < 2) then + ErrMsg='Calculate_C_alpha: Not enough data points to compute Cn and Cl slopes.' + ErrStat=ErrID_Fatal + Default_Cn_alpha = EPSILON(Default_Cn_alpha) + Default_Cl_alpha = EPSILON(Default_Cl_alpha) + Default_alpha0 = 0.0_ReKi + return + end if + A(:,1) = alpha A(:,2) = 1.0_ReKi - B(:,1) = Cn - B(:,2) = Cl + if (size(Cn) == 1) then + B(:,1) = Cn(1) + B(:,2) = Cl(1) + else + B(:,1) = Cn + B(:,2) = Cl + end if CALL LAPACK_gels('N', A, B, ErrStat, ErrMsg) diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index f6a2b351fd..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 @@ -522,15 +535,15 @@ subroutine AFI_CopyTable_Type(SrcTable_TypeData, DstTable_TypeData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AFI_CopyTable_Type' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcTable_TypeData%Alpha)) then - LB(1:1) = lbound(SrcTable_TypeData%Alpha, kind=B8Ki) - UB(1:1) = ubound(SrcTable_TypeData%Alpha, kind=B8Ki) + LB(1:1) = lbound(SrcTable_TypeData%Alpha) + UB(1:1) = ubound(SrcTable_TypeData%Alpha) if (.not. allocated(DstTable_TypeData%Alpha)) then allocate(DstTable_TypeData%Alpha(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -541,8 +554,8 @@ subroutine AFI_CopyTable_Type(SrcTable_TypeData, DstTable_TypeData, CtrlCode, Er DstTable_TypeData%Alpha = SrcTable_TypeData%Alpha end if if (allocated(SrcTable_TypeData%Coefs)) then - LB(1:2) = lbound(SrcTable_TypeData%Coefs, kind=B8Ki) - UB(1:2) = ubound(SrcTable_TypeData%Coefs, kind=B8Ki) + LB(1:2) = lbound(SrcTable_TypeData%Coefs) + UB(1:2) = ubound(SrcTable_TypeData%Coefs) if (.not. allocated(DstTable_TypeData%Coefs)) then allocate(DstTable_TypeData%Coefs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -553,8 +566,8 @@ subroutine AFI_CopyTable_Type(SrcTable_TypeData, DstTable_TypeData, CtrlCode, Er DstTable_TypeData%Coefs = SrcTable_TypeData%Coefs end if if (allocated(SrcTable_TypeData%SplineCoefs)) then - LB(1:3) = lbound(SrcTable_TypeData%SplineCoefs, kind=B8Ki) - UB(1:3) = ubound(SrcTable_TypeData%SplineCoefs, kind=B8Ki) + LB(1:3) = lbound(SrcTable_TypeData%SplineCoefs) + UB(1:3) = ubound(SrcTable_TypeData%SplineCoefs) if (.not. allocated(DstTable_TypeData%SplineCoefs)) then allocate(DstTable_TypeData%SplineCoefs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -617,7 +630,7 @@ subroutine AFI_UnPackTable_Type(RF, OutData) type(RegFile), intent(inout) :: RF type(AFI_Table_Type), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackTable_Type' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -743,8 +756,8 @@ subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AFI_CopyParam' @@ -757,8 +770,8 @@ subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ColUAf = SrcParamData%ColUAf DstParamData%AFTabMod = SrcParamData%AFTabMod if (allocated(SrcParamData%secondVals)) then - LB(1:1) = lbound(SrcParamData%secondVals, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%secondVals, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%secondVals) + UB(1:1) = ubound(SrcParamData%secondVals) if (.not. allocated(DstParamData%secondVals)) then allocate(DstParamData%secondVals(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -773,8 +786,8 @@ subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NonDimArea = SrcParamData%NonDimArea DstParamData%NumCoords = SrcParamData%NumCoords if (allocated(SrcParamData%X_Coord)) then - LB(1:1) = lbound(SrcParamData%X_Coord, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%X_Coord, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%X_Coord) + UB(1:1) = ubound(SrcParamData%X_Coord) if (.not. allocated(DstParamData%X_Coord)) then allocate(DstParamData%X_Coord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -785,8 +798,8 @@ subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%X_Coord = SrcParamData%X_Coord end if if (allocated(SrcParamData%Y_Coord)) then - LB(1:1) = lbound(SrcParamData%Y_Coord, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Y_Coord, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Y_Coord) + UB(1:1) = ubound(SrcParamData%Y_Coord) if (.not. allocated(DstParamData%Y_Coord)) then allocate(DstParamData%Y_Coord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -798,8 +811,8 @@ subroutine AFI_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NumTabs = SrcParamData%NumTabs if (allocated(SrcParamData%Table)) then - LB(1:1) = lbound(SrcParamData%Table, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Table, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Table) + UB(1:1) = ubound(SrcParamData%Table) if (.not. allocated(DstParamData%Table)) then allocate(DstParamData%Table(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -821,8 +834,8 @@ subroutine AFI_DestroyParam(ParamData, ErrStat, ErrMsg) type(AFI_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AFI_DestroyParam' @@ -838,8 +851,8 @@ subroutine AFI_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%Y_Coord) end if if (allocated(ParamData%Table)) then - LB(1:1) = lbound(ParamData%Table, kind=B8Ki) - UB(1:1) = ubound(ParamData%Table, kind=B8Ki) + LB(1:1) = lbound(ParamData%Table) + UB(1:1) = ubound(ParamData%Table) do i1 = LB(1), UB(1) call AFI_DestroyTable_Type(ParamData%Table(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -852,8 +865,8 @@ subroutine AFI_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(AFI_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AFI_PackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%ColCd) call RegPack(RF, InData%ColCl) @@ -871,9 +884,9 @@ subroutine AFI_PackParam(RF, Indata) call RegPack(RF, InData%NumTabs) call RegPack(RF, allocated(InData%Table)) if (allocated(InData%Table)) then - call RegPackBounds(RF, 1, lbound(InData%Table, kind=B8Ki), ubound(InData%Table, kind=B8Ki)) - LB(1:1) = lbound(InData%Table, kind=B8Ki) - UB(1:1) = ubound(InData%Table, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Table), ubound(InData%Table)) + LB(1:1) = lbound(InData%Table) + UB(1:1) = ubound(InData%Table) do i1 = LB(1), UB(1) call AFI_PackTable_Type(RF, InData%Table(i1)) end do @@ -887,8 +900,8 @@ subroutine AFI_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(AFI_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AFI_UnPackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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.f90 b/modules/aerodyn/src/BEMT.f90 index f1eb5b1b98..04df6a4098 100644 --- a/modules/aerodyn/src/BEMT.f90 +++ b/modules/aerodyn/src/BEMT.f90 @@ -636,7 +636,7 @@ subroutine BEMT_Init( InitInp, u, p, x, xd, z, OtherState, AFInfo, y, misc, Inte if (errStat >= AbortErrLev) return InitInp_DBEMT%DBEMT_Mod = p%DBEMT_Mod - if ( p%DBEMT_Mod > DBEMT_none .or. p%DBEMT_Mod == DBEMT_Frozen ) then + if ( p%DBEMT_Mod > DBEMT_none ) then InitInp_DBEMT%DBEMT_Mod = p%DBEMT_Mod InitInp_DBEMT%numBlades = p%numBlades InitInp_DBEMT%numNodes = p%numBladeNodes @@ -929,7 +929,7 @@ subroutine BEMT_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, !............................................................................................................................... ! update DBEMT states to step n+1 !............................................................................................................................... - if (p%DBEMT_Mod /= DBEMT_none) then + if (p%DBEMT_Mod > DBEMT_none) then !........................ ! update DBEMT states to t+dt @@ -956,7 +956,7 @@ subroutine BEMT_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, !............................................ ! apply DBEMT correction to axInduction and tanInduction: !............................................ - if (p%DBEMT_Mod /= DBEMT_none) then + if (p%DBEMT_Mod > DBEMT_none) then call calculate_Inductions_from_DBEMT_AllNodes(TimeIndex_t_plus_dt, uTimes(TimeIndex_t_plus_dt), u(TimeIndex_t_plus_dt), p, x, OtherState, m, m%axInduction, m%tanInduction) end if diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 68c43d1838..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 @@ -234,15 +281,15 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BEMT_CopyInitInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitInputData%chord)) then - LB(1:2) = lbound(SrcInitInputData%chord, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%chord, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%chord) + UB(1:2) = ubound(SrcInitInputData%chord) if (.not. allocated(DstInitInputData%chord)) then allocate(DstInitInputData%chord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -269,8 +316,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%numReIterations = SrcInitInputData%numReIterations DstInitInputData%maxIndIterations = SrcInitInputData%maxIndIterations if (allocated(SrcInitInputData%AFindx)) then - LB(1:2) = lbound(SrcInitInputData%AFindx, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%AFindx, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%AFindx) + UB(1:2) = ubound(SrcInitInputData%AFindx) if (.not. allocated(DstInitInputData%AFindx)) then allocate(DstInitInputData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -281,8 +328,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%AFindx = SrcInitInputData%AFindx end if if (allocated(SrcInitInputData%zHub)) then - LB(1:1) = lbound(SrcInitInputData%zHub, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%zHub, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%zHub) + UB(1:1) = ubound(SrcInitInputData%zHub) if (.not. allocated(DstInitInputData%zHub)) then allocate(DstInitInputData%zHub(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -293,8 +340,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%zHub = SrcInitInputData%zHub end if if (allocated(SrcInitInputData%zLocal)) then - LB(1:2) = lbound(SrcInitInputData%zLocal, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%zLocal, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%zLocal) + UB(1:2) = ubound(SrcInitInputData%zLocal) if (.not. allocated(DstInitInputData%zLocal)) then allocate(DstInitInputData%zLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -305,8 +352,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%zLocal = SrcInitInputData%zLocal end if if (allocated(SrcInitInputData%zTip)) then - LB(1:1) = lbound(SrcInitInputData%zTip, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%zTip, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%zTip) + UB(1:1) = ubound(SrcInitInputData%zTip) if (.not. allocated(DstInitInputData%zTip)) then allocate(DstInitInputData%zTip(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -317,8 +364,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%zTip = SrcInitInputData%zTip end if if (allocated(SrcInitInputData%rLocal)) then - LB(1:2) = lbound(SrcInitInputData%rLocal, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%rLocal, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%rLocal) + UB(1:2) = ubound(SrcInitInputData%rLocal) if (.not. allocated(DstInitInputData%rLocal)) then allocate(DstInitInputData%rLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -329,8 +376,8 @@ subroutine BEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%rLocal = SrcInitInputData%rLocal end if if (allocated(SrcInitInputData%rTipFix)) then - LB(1:1) = lbound(SrcInitInputData%rTipFix, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%rTipFix, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%rTipFix) + UB(1:1) = ubound(SrcInitInputData%rTipFix) if (.not. allocated(DstInitInputData%rTipFix)) then allocate(DstInitInputData%rTipFix(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -429,7 +476,7 @@ subroutine BEMT_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(BEMT_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackInitInput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -664,14 +711,14 @@ subroutine BEMT_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BEMT_CopyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcConstrStateData%phi)) then - LB(1:2) = lbound(SrcConstrStateData%phi, kind=B8Ki) - UB(1:2) = ubound(SrcConstrStateData%phi, kind=B8Ki) + LB(1:2) = lbound(SrcConstrStateData%phi) + UB(1:2) = ubound(SrcConstrStateData%phi) if (.not. allocated(DstConstrStateData%phi)) then allocate(DstConstrStateData%phi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -708,7 +755,7 @@ subroutine BEMT_UnPackConstrState(RF, OutData) type(RegFile), intent(inout) :: RF type(BEMT_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackConstrState' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -721,8 +768,8 @@ subroutine BEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BEMT_CopyOtherState' @@ -735,8 +782,8 @@ subroutine BEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOtherStateData%ValidPhi)) then - LB(1:2) = lbound(SrcOtherStateData%ValidPhi, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%ValidPhi, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%ValidPhi) + UB(1:2) = ubound(SrcOtherStateData%ValidPhi) if (.not. allocated(DstOtherStateData%ValidPhi)) then allocate(DstOtherStateData%ValidPhi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -747,8 +794,8 @@ subroutine BEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%ValidPhi = SrcOtherStateData%ValidPhi end if DstOtherStateData%nodesInitialized = SrcOtherStateData%nodesInitialized - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call BEMT_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -761,8 +808,8 @@ subroutine BEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(BEMT_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BEMT_DestroyOtherState' @@ -775,8 +822,8 @@ subroutine BEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) if (allocated(OtherStateData%ValidPhi)) then deallocate(OtherStateData%ValidPhi) end if - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call BEMT_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -787,15 +834,15 @@ subroutine BEMT_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(BEMT_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackOtherState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call UA_PackOtherState(RF, InData%UA) call DBEMT_PackOtherState(RF, InData%DBEMT) call RegPackAlloc(RF, InData%ValidPhi) call RegPack(RF, InData%nodesInitialized) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call BEMT_PackContState(RF, InData%xdot(i1)) end do @@ -807,8 +854,8 @@ subroutine BEMT_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(BEMT_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackOtherState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -816,8 +863,8 @@ subroutine BEMT_UnPackOtherState(RF, OutData) call DBEMT_UnpackOtherState(RF, OutData%DBEMT) ! DBEMT call RegUnpackAlloc(RF, OutData%ValidPhi); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%nodesInitialized); if (RegCheckErr(RF, RoutineName)) return - LB(1:1) = lbound(OutData%xdot, kind=B8Ki) - UB(1:1) = ubound(OutData%xdot, kind=B8Ki) + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call BEMT_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do @@ -830,8 +877,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BEMT_CopyMisc' @@ -850,8 +897,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%u_UA)) then - LB(1:3) = lbound(SrcMiscData%u_UA, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%u_UA, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%u_UA) + UB(1:3) = ubound(SrcMiscData%u_UA) if (.not. allocated(DstMiscData%u_UA)) then allocate(DstMiscData%u_UA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -869,23 +916,23 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end do end if - LB(1:1) = lbound(SrcMiscData%u_DBEMT, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%u_DBEMT, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%u_DBEMT) + UB(1:1) = ubound(SrcMiscData%u_DBEMT) do i1 = LB(1), UB(1) call DBEMT_CopyInput(SrcMiscData%u_DBEMT(i1), DstMiscData%u_DBEMT(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcMiscData%u_SkewWake, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%u_SkewWake, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%u_SkewWake) + UB(1:1) = ubound(SrcMiscData%u_SkewWake) do i1 = LB(1), UB(1) call BEMT_CopySkewWake_InputType(SrcMiscData%u_SkewWake(i1), DstMiscData%u_SkewWake(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do if (allocated(SrcMiscData%TnInd_op)) then - LB(1:2) = lbound(SrcMiscData%TnInd_op, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%TnInd_op, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%TnInd_op) + UB(1:2) = ubound(SrcMiscData%TnInd_op) if (.not. allocated(DstMiscData%TnInd_op)) then allocate(DstMiscData%TnInd_op(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -896,8 +943,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%TnInd_op = SrcMiscData%TnInd_op end if if (allocated(SrcMiscData%AxInd_op)) then - LB(1:2) = lbound(SrcMiscData%AxInd_op, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%AxInd_op, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%AxInd_op) + UB(1:2) = ubound(SrcMiscData%AxInd_op) if (.not. allocated(DstMiscData%AxInd_op)) then allocate(DstMiscData%AxInd_op(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -908,8 +955,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AxInd_op = SrcMiscData%AxInd_op end if if (allocated(SrcMiscData%AxInduction)) then - LB(1:2) = lbound(SrcMiscData%AxInduction, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%AxInduction, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%AxInduction) + UB(1:2) = ubound(SrcMiscData%AxInduction) if (.not. allocated(DstMiscData%AxInduction)) then allocate(DstMiscData%AxInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -920,8 +967,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%AxInduction = SrcMiscData%AxInduction end if if (allocated(SrcMiscData%TanInduction)) then - LB(1:2) = lbound(SrcMiscData%TanInduction, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%TanInduction, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%TanInduction) + UB(1:2) = ubound(SrcMiscData%TanInduction) if (.not. allocated(DstMiscData%TanInduction)) then allocate(DstMiscData%TanInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -933,8 +980,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%UseFrozenWake = SrcMiscData%UseFrozenWake if (allocated(SrcMiscData%Rtip)) then - LB(1:1) = lbound(SrcMiscData%Rtip, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Rtip, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%Rtip) + UB(1:1) = ubound(SrcMiscData%Rtip) if (.not. allocated(DstMiscData%Rtip)) then allocate(DstMiscData%Rtip(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -945,8 +992,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Rtip = SrcMiscData%Rtip end if if (allocated(SrcMiscData%phi)) then - LB(1:2) = lbound(SrcMiscData%phi, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%phi, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%phi) + UB(1:2) = ubound(SrcMiscData%phi) if (.not. allocated(DstMiscData%phi)) then allocate(DstMiscData%phi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -957,8 +1004,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%phi = SrcMiscData%phi end if if (allocated(SrcMiscData%chi)) then - LB(1:2) = lbound(SrcMiscData%chi, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%chi, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%chi) + UB(1:2) = ubound(SrcMiscData%chi) if (.not. allocated(DstMiscData%chi)) then allocate(DstMiscData%chi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -969,8 +1016,8 @@ subroutine BEMT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%chi = SrcMiscData%chi end if if (allocated(SrcMiscData%ValidPhi)) then - LB(1:2) = lbound(SrcMiscData%ValidPhi, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%ValidPhi, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%ValidPhi) + UB(1:2) = ubound(SrcMiscData%ValidPhi) if (.not. allocated(DstMiscData%ValidPhi)) then allocate(DstMiscData%ValidPhi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -987,8 +1034,8 @@ subroutine BEMT_DestroyMisc(MiscData, ErrStat, ErrMsg) type(BEMT_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BEMT_DestroyMisc' @@ -1001,8 +1048,8 @@ subroutine BEMT_DestroyMisc(MiscData, ErrStat, ErrMsg) call UA_DestroyOutput(MiscData%y_UA, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%u_UA)) then - LB(1:3) = lbound(MiscData%u_UA, kind=B8Ki) - UB(1:3) = ubound(MiscData%u_UA, kind=B8Ki) + LB(1:3) = lbound(MiscData%u_UA) + UB(1:3) = ubound(MiscData%u_UA) do i3 = LB(3), UB(3) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) @@ -1013,14 +1060,14 @@ subroutine BEMT_DestroyMisc(MiscData, ErrStat, ErrMsg) end do deallocate(MiscData%u_UA) end if - LB(1:1) = lbound(MiscData%u_DBEMT, kind=B8Ki) - UB(1:1) = ubound(MiscData%u_DBEMT, kind=B8Ki) + LB(1:1) = lbound(MiscData%u_DBEMT) + UB(1:1) = ubound(MiscData%u_DBEMT) do i1 = LB(1), UB(1) call DBEMT_DestroyInput(MiscData%u_DBEMT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(MiscData%u_SkewWake, kind=B8Ki) - UB(1:1) = ubound(MiscData%u_SkewWake, kind=B8Ki) + LB(1:1) = lbound(MiscData%u_SkewWake) + UB(1:1) = ubound(MiscData%u_SkewWake) do i1 = LB(1), UB(1) call BEMT_DestroySkewWake_InputType(MiscData%u_SkewWake(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1055,8 +1102,8 @@ subroutine BEMT_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(BEMT_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'BEMT_PackMisc' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%FirstWarn_Skew) call RegPack(RF, InData%FirstWarn_Phi) @@ -1066,9 +1113,9 @@ subroutine BEMT_PackMisc(RF, Indata) call UA_PackOutput(RF, InData%y_UA) call RegPack(RF, allocated(InData%u_UA)) if (allocated(InData%u_UA)) then - call RegPackBounds(RF, 3, lbound(InData%u_UA, kind=B8Ki), ubound(InData%u_UA, kind=B8Ki)) - LB(1:3) = lbound(InData%u_UA, kind=B8Ki) - UB(1:3) = ubound(InData%u_UA, kind=B8Ki) + call RegPackBounds(RF, 3, lbound(InData%u_UA), ubound(InData%u_UA)) + LB(1:3) = lbound(InData%u_UA) + UB(1:3) = ubound(InData%u_UA) do i3 = LB(3), UB(3) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) @@ -1077,13 +1124,13 @@ subroutine BEMT_PackMisc(RF, Indata) end do end do end if - LB(1:1) = lbound(InData%u_DBEMT, kind=B8Ki) - UB(1:1) = ubound(InData%u_DBEMT, kind=B8Ki) + LB(1:1) = lbound(InData%u_DBEMT) + UB(1:1) = ubound(InData%u_DBEMT) do i1 = LB(1), UB(1) call DBEMT_PackInput(RF, InData%u_DBEMT(i1)) end do - LB(1:1) = lbound(InData%u_SkewWake, kind=B8Ki) - UB(1:1) = ubound(InData%u_SkewWake, kind=B8Ki) + LB(1:1) = lbound(InData%u_SkewWake) + UB(1:1) = ubound(InData%u_SkewWake) do i1 = LB(1), UB(1) call BEMT_PackSkewWake_InputType(RF, InData%u_SkewWake(i1)) end do @@ -1104,8 +1151,8 @@ subroutine BEMT_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(BEMT_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackMisc' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1132,13 +1179,13 @@ subroutine BEMT_UnPackMisc(RF, OutData) end do end do end if - LB(1:1) = lbound(OutData%u_DBEMT, kind=B8Ki) - UB(1:1) = ubound(OutData%u_DBEMT, kind=B8Ki) + LB(1:1) = lbound(OutData%u_DBEMT) + UB(1:1) = ubound(OutData%u_DBEMT) do i1 = LB(1), UB(1) call DBEMT_UnpackInput(RF, OutData%u_DBEMT(i1)) ! u_DBEMT end do - LB(1:1) = lbound(OutData%u_SkewWake, kind=B8Ki) - UB(1:1) = ubound(OutData%u_SkewWake, kind=B8Ki) + LB(1:1) = lbound(OutData%u_SkewWake) + UB(1:1) = ubound(OutData%u_SkewWake) do i1 = LB(1), UB(1) call BEMT_UnpackSkewWake_InputType(RF, OutData%u_SkewWake(i1)) ! u_SkewWake end do @@ -1160,7 +1207,7 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BEMT_CopyParam' @@ -1168,8 +1215,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) ErrMsg = '' DstParamData%DT = SrcParamData%DT if (allocated(SrcParamData%chord)) then - LB(1:2) = lbound(SrcParamData%chord, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%chord, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%chord) + UB(1:2) = ubound(SrcParamData%chord) if (.not. allocated(DstParamData%chord)) then allocate(DstParamData%chord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1195,8 +1242,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%numReIterations = SrcParamData%numReIterations DstParamData%maxIndIterations = SrcParamData%maxIndIterations if (allocated(SrcParamData%AFindx)) then - LB(1:2) = lbound(SrcParamData%AFindx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%AFindx, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%AFindx) + UB(1:2) = ubound(SrcParamData%AFindx) if (.not. allocated(DstParamData%AFindx)) then allocate(DstParamData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1207,8 +1254,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AFindx = SrcParamData%AFindx end if if (allocated(SrcParamData%tipLossConst)) then - LB(1:2) = lbound(SrcParamData%tipLossConst, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%tipLossConst, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%tipLossConst) + UB(1:2) = ubound(SrcParamData%tipLossConst) if (.not. allocated(DstParamData%tipLossConst)) then allocate(DstParamData%tipLossConst(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1219,8 +1266,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%tipLossConst = SrcParamData%tipLossConst end if if (allocated(SrcParamData%hubLossConst)) then - LB(1:2) = lbound(SrcParamData%hubLossConst, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%hubLossConst, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%hubLossConst) + UB(1:2) = ubound(SrcParamData%hubLossConst) if (.not. allocated(DstParamData%hubLossConst)) then allocate(DstParamData%hubLossConst(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1231,8 +1278,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%hubLossConst = SrcParamData%hubLossConst end if if (allocated(SrcParamData%zHub)) then - LB(1:1) = lbound(SrcParamData%zHub, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%zHub, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%zHub) + UB(1:1) = ubound(SrcParamData%zHub) if (.not. allocated(DstParamData%zHub)) then allocate(DstParamData%zHub(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1252,8 +1299,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%DBEMT_Mod = SrcParamData%DBEMT_Mod DstParamData%yawCorrFactor = SrcParamData%yawCorrFactor if (allocated(SrcParamData%FixedInductions)) then - LB(1:2) = lbound(SrcParamData%FixedInductions, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%FixedInductions, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%FixedInductions) + UB(1:2) = ubound(SrcParamData%FixedInductions) if (.not. allocated(DstParamData%FixedInductions)) then allocate(DstParamData%FixedInductions(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1266,8 +1313,8 @@ subroutine BEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%MomentumCorr = SrcParamData%MomentumCorr DstParamData%rTipFixMax = SrcParamData%rTipFixMax if (allocated(SrcParamData%IntegrateWeight)) then - LB(1:2) = lbound(SrcParamData%IntegrateWeight, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%IntegrateWeight, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%IntegrateWeight) + UB(1:2) = ubound(SrcParamData%IntegrateWeight) if (.not. allocated(DstParamData%IntegrateWeight)) then allocate(DstParamData%IntegrateWeight(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1361,7 +1408,7 @@ subroutine BEMT_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(BEMT_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackParam' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1405,14 +1452,14 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BEMT_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%theta)) then - LB(1:2) = lbound(SrcInputData%theta, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%theta, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%theta) + UB(1:2) = ubound(SrcInputData%theta) if (.not. allocated(DstInputData%theta)) then allocate(DstInputData%theta(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1425,8 +1472,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%chi0 = SrcInputData%chi0 DstInputData%psiSkewOffset = SrcInputData%psiSkewOffset if (allocated(SrcInputData%psi_s)) then - LB(1:1) = lbound(SrcInputData%psi_s, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%psi_s, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%psi_s) + UB(1:1) = ubound(SrcInputData%psi_s) if (.not. allocated(DstInputData%psi_s)) then allocate(DstInputData%psi_s(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1439,8 +1486,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%omega = SrcInputData%omega DstInputData%TSR = SrcInputData%TSR if (allocated(SrcInputData%Vx)) then - LB(1:2) = lbound(SrcInputData%Vx, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%Vx, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%Vx) + UB(1:2) = ubound(SrcInputData%Vx) if (.not. allocated(DstInputData%Vx)) then allocate(DstInputData%Vx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1451,8 +1498,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vx = SrcInputData%Vx end if if (allocated(SrcInputData%Vy)) then - LB(1:2) = lbound(SrcInputData%Vy, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%Vy, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%Vy) + UB(1:2) = ubound(SrcInputData%Vy) if (.not. allocated(DstInputData%Vy)) then allocate(DstInputData%Vy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1463,8 +1510,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vy = SrcInputData%Vy end if if (allocated(SrcInputData%Vz)) then - LB(1:2) = lbound(SrcInputData%Vz, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%Vz, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%Vz) + UB(1:2) = ubound(SrcInputData%Vz) if (.not. allocated(DstInputData%Vz)) then allocate(DstInputData%Vz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1475,8 +1522,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vz = SrcInputData%Vz end if if (allocated(SrcInputData%omega_z)) then - LB(1:2) = lbound(SrcInputData%omega_z, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%omega_z, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%omega_z) + UB(1:2) = ubound(SrcInputData%omega_z) if (.not. allocated(DstInputData%omega_z)) then allocate(DstInputData%omega_z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1487,8 +1534,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%omega_z = SrcInputData%omega_z end if if (allocated(SrcInputData%xVelCorr)) then - LB(1:2) = lbound(SrcInputData%xVelCorr, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%xVelCorr, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%xVelCorr) + UB(1:2) = ubound(SrcInputData%xVelCorr) if (.not. allocated(DstInputData%xVelCorr)) then allocate(DstInputData%xVelCorr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1499,8 +1546,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%xVelCorr = SrcInputData%xVelCorr end if if (allocated(SrcInputData%rLocal)) then - LB(1:2) = lbound(SrcInputData%rLocal, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%rLocal, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%rLocal) + UB(1:2) = ubound(SrcInputData%rLocal) if (.not. allocated(DstInputData%rLocal)) then allocate(DstInputData%rLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1514,8 +1561,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%V0 = SrcInputData%V0 DstInputData%x_hat_disk = SrcInputData%x_hat_disk if (allocated(SrcInputData%UserProp)) then - LB(1:2) = lbound(SrcInputData%UserProp, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%UserProp, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%UserProp) + UB(1:2) = ubound(SrcInputData%UserProp) if (.not. allocated(DstInputData%UserProp)) then allocate(DstInputData%UserProp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1526,8 +1573,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%UserProp = SrcInputData%UserProp end if if (allocated(SrcInputData%CantAngle)) then - LB(1:2) = lbound(SrcInputData%CantAngle, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%CantAngle, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%CantAngle) + UB(1:2) = ubound(SrcInputData%CantAngle) if (.not. allocated(DstInputData%CantAngle)) then allocate(DstInputData%CantAngle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1538,8 +1585,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%CantAngle = SrcInputData%CantAngle end if if (allocated(SrcInputData%drdz)) then - LB(1:2) = lbound(SrcInputData%drdz, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%drdz, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%drdz) + UB(1:2) = ubound(SrcInputData%drdz) if (.not. allocated(DstInputData%drdz)) then allocate(DstInputData%drdz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1550,8 +1597,8 @@ subroutine BEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%drdz = SrcInputData%drdz end if if (allocated(SrcInputData%toeAngle)) then - LB(1:2) = lbound(SrcInputData%toeAngle, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%toeAngle, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%toeAngle) + UB(1:2) = ubound(SrcInputData%toeAngle) if (.not. allocated(DstInputData%toeAngle)) then allocate(DstInputData%toeAngle(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1639,7 +1686,7 @@ subroutine BEMT_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(BEMT_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackInput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1670,14 +1717,14 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BEMT_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%Vrel)) then - LB(1:2) = lbound(SrcOutputData%Vrel, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Vrel, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Vrel) + UB(1:2) = ubound(SrcOutputData%Vrel) if (.not. allocated(DstOutputData%Vrel)) then allocate(DstOutputData%Vrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1688,8 +1735,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Vrel = SrcOutputData%Vrel end if if (allocated(SrcOutputData%phi)) then - LB(1:2) = lbound(SrcOutputData%phi, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%phi, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%phi) + UB(1:2) = ubound(SrcOutputData%phi) if (.not. allocated(DstOutputData%phi)) then allocate(DstOutputData%phi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1700,8 +1747,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%phi = SrcOutputData%phi end if if (allocated(SrcOutputData%axInduction)) then - LB(1:2) = lbound(SrcOutputData%axInduction, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%axInduction, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%axInduction) + UB(1:2) = ubound(SrcOutputData%axInduction) if (.not. allocated(DstOutputData%axInduction)) then allocate(DstOutputData%axInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1712,8 +1759,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%axInduction = SrcOutputData%axInduction end if if (allocated(SrcOutputData%tanInduction)) then - LB(1:2) = lbound(SrcOutputData%tanInduction, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%tanInduction, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%tanInduction) + UB(1:2) = ubound(SrcOutputData%tanInduction) if (.not. allocated(DstOutputData%tanInduction)) then allocate(DstOutputData%tanInduction(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1724,8 +1771,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%tanInduction = SrcOutputData%tanInduction end if if (allocated(SrcOutputData%axInduction_qs)) then - LB(1:2) = lbound(SrcOutputData%axInduction_qs, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%axInduction_qs, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%axInduction_qs) + UB(1:2) = ubound(SrcOutputData%axInduction_qs) if (.not. allocated(DstOutputData%axInduction_qs)) then allocate(DstOutputData%axInduction_qs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1736,8 +1783,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%axInduction_qs = SrcOutputData%axInduction_qs end if if (allocated(SrcOutputData%tanInduction_qs)) then - LB(1:2) = lbound(SrcOutputData%tanInduction_qs, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%tanInduction_qs, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%tanInduction_qs) + UB(1:2) = ubound(SrcOutputData%tanInduction_qs) if (.not. allocated(DstOutputData%tanInduction_qs)) then allocate(DstOutputData%tanInduction_qs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1748,8 +1795,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%tanInduction_qs = SrcOutputData%tanInduction_qs end if if (allocated(SrcOutputData%k)) then - LB(1:2) = lbound(SrcOutputData%k, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%k, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%k) + UB(1:2) = ubound(SrcOutputData%k) if (.not. allocated(DstOutputData%k)) then allocate(DstOutputData%k(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1760,8 +1807,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%k = SrcOutputData%k end if if (allocated(SrcOutputData%k_p)) then - LB(1:2) = lbound(SrcOutputData%k_p, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%k_p, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%k_p) + UB(1:2) = ubound(SrcOutputData%k_p) if (.not. allocated(DstOutputData%k_p)) then allocate(DstOutputData%k_p(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1772,8 +1819,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%k_p = SrcOutputData%k_p end if if (allocated(SrcOutputData%F)) then - LB(1:2) = lbound(SrcOutputData%F, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%F, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%F) + UB(1:2) = ubound(SrcOutputData%F) if (.not. allocated(DstOutputData%F)) then allocate(DstOutputData%F(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1784,8 +1831,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%F = SrcOutputData%F end if if (allocated(SrcOutputData%Re)) then - LB(1:2) = lbound(SrcOutputData%Re, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Re, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Re) + UB(1:2) = ubound(SrcOutputData%Re) if (.not. allocated(DstOutputData%Re)) then allocate(DstOutputData%Re(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1796,8 +1843,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Re = SrcOutputData%Re end if if (allocated(SrcOutputData%AOA)) then - LB(1:2) = lbound(SrcOutputData%AOA, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%AOA, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%AOA) + UB(1:2) = ubound(SrcOutputData%AOA) if (.not. allocated(DstOutputData%AOA)) then allocate(DstOutputData%AOA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1808,8 +1855,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%AOA = SrcOutputData%AOA end if if (allocated(SrcOutputData%Cx)) then - LB(1:2) = lbound(SrcOutputData%Cx, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cx, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cx) + UB(1:2) = ubound(SrcOutputData%Cx) if (.not. allocated(DstOutputData%Cx)) then allocate(DstOutputData%Cx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1820,8 +1867,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cx = SrcOutputData%Cx end if if (allocated(SrcOutputData%Cy)) then - LB(1:2) = lbound(SrcOutputData%Cy, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cy, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cy) + UB(1:2) = ubound(SrcOutputData%Cy) if (.not. allocated(DstOutputData%Cy)) then allocate(DstOutputData%Cy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1832,8 +1879,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cy = SrcOutputData%Cy end if if (allocated(SrcOutputData%Cz)) then - LB(1:2) = lbound(SrcOutputData%Cz, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cz, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cz) + UB(1:2) = ubound(SrcOutputData%Cz) if (.not. allocated(DstOutputData%Cz)) then allocate(DstOutputData%Cz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1844,8 +1891,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cz = SrcOutputData%Cz end if if (allocated(SrcOutputData%Cmx)) then - LB(1:2) = lbound(SrcOutputData%Cmx, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cmx, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cmx) + UB(1:2) = ubound(SrcOutputData%Cmx) if (.not. allocated(DstOutputData%Cmx)) then allocate(DstOutputData%Cmx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1856,8 +1903,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cmx = SrcOutputData%Cmx end if if (allocated(SrcOutputData%Cmy)) then - LB(1:2) = lbound(SrcOutputData%Cmy, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cmy, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cmy) + UB(1:2) = ubound(SrcOutputData%Cmy) if (.not. allocated(DstOutputData%Cmy)) then allocate(DstOutputData%Cmy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1868,8 +1915,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cmy = SrcOutputData%Cmy end if if (allocated(SrcOutputData%Cmz)) then - LB(1:2) = lbound(SrcOutputData%Cmz, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cmz, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cmz) + UB(1:2) = ubound(SrcOutputData%Cmz) if (.not. allocated(DstOutputData%Cmz)) then allocate(DstOutputData%Cmz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1880,8 +1927,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cmz = SrcOutputData%Cmz end if if (allocated(SrcOutputData%Cm)) then - LB(1:2) = lbound(SrcOutputData%Cm, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cm, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cm) + UB(1:2) = ubound(SrcOutputData%Cm) if (.not. allocated(DstOutputData%Cm)) then allocate(DstOutputData%Cm(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1892,8 +1939,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cm = SrcOutputData%Cm end if if (allocated(SrcOutputData%Cl)) then - LB(1:2) = lbound(SrcOutputData%Cl, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cl, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cl) + UB(1:2) = ubound(SrcOutputData%Cl) if (.not. allocated(DstOutputData%Cl)) then allocate(DstOutputData%Cl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1904,8 +1951,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cl = SrcOutputData%Cl end if if (allocated(SrcOutputData%Cd)) then - LB(1:2) = lbound(SrcOutputData%Cd, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cd, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cd) + UB(1:2) = ubound(SrcOutputData%Cd) if (.not. allocated(DstOutputData%Cd)) then allocate(DstOutputData%Cd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1916,8 +1963,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%Cd = SrcOutputData%Cd end if if (allocated(SrcOutputData%chi)) then - LB(1:2) = lbound(SrcOutputData%chi, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%chi, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%chi) + UB(1:2) = ubound(SrcOutputData%chi) if (.not. allocated(DstOutputData%chi)) then allocate(DstOutputData%chi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1928,8 +1975,8 @@ subroutine BEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%chi = SrcOutputData%chi end if if (allocated(SrcOutputData%Cpmin)) then - LB(1:2) = lbound(SrcOutputData%Cpmin, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Cpmin, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Cpmin) + UB(1:2) = ubound(SrcOutputData%Cpmin) if (.not. allocated(DstOutputData%Cpmin)) then allocate(DstOutputData%Cpmin(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2050,7 +2097,7 @@ subroutine BEMT_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(BEMT_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BEMT_UnPackOutput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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.f90 b/modules/aerodyn/src/DBEMT.f90 index 4b8d001d08..4f5a2d6bd8 100644 --- a/modules/aerodyn/src/DBEMT.f90 +++ b/modules/aerodyn/src/DBEMT.f90 @@ -64,11 +64,9 @@ subroutine DBEMT_ValidateInitInp(interval, InitInp, errStat, errMsg) errMsg = "" if ( interval <= sqrt(epsilon(1.0_ReKi)) ) call SetErrStat( ErrID_Fatal, " The timestep size for DBEMT (interval) must be larger than sqrt(epsilon).", ErrStat, ErrMsg, RoutineName) - select case(InitInp%DBEMT_Mod) - case (DBEMT_frozen, DBEMT_tauConst, DBEMT_tauVaries, DBEMT_cont_tauConst) - case default - call SetErrStat( ErrID_Fatal, " DBEMT_Mod must be set to -1, 1, 2, or 3.", ErrStat, ErrMsg, RoutineName) - end select + if ( (InitInp%DBEMT_Mod .ne. DBEMT_tauConst) .and. (InitInp%DBEMT_Mod .ne. DBEMT_tauVaries) .and. (InitInp%DBEMT_Mod .ne. DBEMT_cont_tauConst)) then + call SetErrStat( ErrID_Fatal, " DBEMT_Mod must be set to 1, 2, or 3.", ErrStat, ErrMsg, RoutineName) + end if if (InitInp%numBlades < 1) call SetErrStat( ErrID_Fatal, " InitInp%numBlades must set to 1 or more.", ErrStat, ErrMsg, RoutineName) if (InitInp%numNodes < 2) call SetErrStat( ErrID_Fatal, " InitInp%numNodes must set to 2 or more.", ErrStat, ErrMsg, RoutineName) diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index 57e4bea283..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 @@ -126,7 +136,7 @@ subroutine DBEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'DBEMT_CopyInitInput' ErrStat = ErrID_None @@ -136,8 +146,8 @@ subroutine DBEMT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%tau1_const = SrcInitInputData%tau1_const DstInitInputData%DBEMT_Mod = SrcInitInputData%DBEMT_Mod if (allocated(SrcInitInputData%rLocal)) then - LB(1:2) = lbound(SrcInitInputData%rLocal, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%rLocal, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%rLocal) + UB(1:2) = ubound(SrcInitInputData%rLocal) if (.not. allocated(DstInitInputData%rLocal)) then allocate(DstInitInputData%rLocal(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -178,7 +188,7 @@ subroutine DBEMT_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(DBEMT_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackInitInput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -282,16 +292,16 @@ subroutine DBEMT_CopyContState(SrcContStateData, DstContStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DBEMT_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%element)) then - LB(1:2) = lbound(SrcContStateData%element, kind=B8Ki) - UB(1:2) = ubound(SrcContStateData%element, kind=B8Ki) + LB(1:2) = lbound(SrcContStateData%element) + UB(1:2) = ubound(SrcContStateData%element) if (.not. allocated(DstContStateData%element)) then allocate(DstContStateData%element(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -313,16 +323,16 @@ subroutine DBEMT_DestroyContState(ContStateData, ErrStat, ErrMsg) type(DBEMT_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DBEMT_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%element)) then - LB(1:2) = lbound(ContStateData%element, kind=B8Ki) - UB(1:2) = ubound(ContStateData%element, kind=B8Ki) + LB(1:2) = lbound(ContStateData%element) + UB(1:2) = ubound(ContStateData%element) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call DBEMT_DestroyElementContinuousStateType(ContStateData%element(i1,i2), ErrStat2, ErrMsg2) @@ -337,14 +347,14 @@ subroutine DBEMT_PackContState(RF, Indata) type(RegFile), intent(inout) :: RF type(DBEMT_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackContState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%element)) if (allocated(InData%element)) then - call RegPackBounds(RF, 2, lbound(InData%element, kind=B8Ki), ubound(InData%element, kind=B8Ki)) - LB(1:2) = lbound(InData%element, kind=B8Ki) - UB(1:2) = ubound(InData%element, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%element), ubound(InData%element)) + LB(1:2) = lbound(InData%element) + UB(1:2) = ubound(InData%element) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call DBEMT_PackElementContinuousStateType(RF, InData%element(i1,i2)) @@ -358,8 +368,8 @@ subroutine DBEMT_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(DBEMT_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackContState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -462,16 +472,16 @@ subroutine DBEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DBEMT_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%areStatesInitialized)) then - LB(1:2) = lbound(SrcOtherStateData%areStatesInitialized, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%areStatesInitialized, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%areStatesInitialized) + UB(1:2) = ubound(SrcOtherStateData%areStatesInitialized) if (.not. allocated(DstOtherStateData%areStatesInitialized)) then allocate(DstOtherStateData%areStatesInitialized(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -484,8 +494,8 @@ subroutine DBEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, DstOtherStateData%tau1 = SrcOtherStateData%tau1 DstOtherStateData%tau2 = SrcOtherStateData%tau2 if (allocated(SrcOtherStateData%n)) then - LB(1:2) = lbound(SrcOtherStateData%n, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%n, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%n) + UB(1:2) = ubound(SrcOtherStateData%n) if (.not. allocated(DstOtherStateData%n)) then allocate(DstOtherStateData%n(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -495,8 +505,8 @@ subroutine DBEMT_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, end if DstOtherStateData%n = SrcOtherStateData%n end if - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call DBEMT_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -508,8 +518,8 @@ subroutine DBEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(DBEMT_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DBEMT_DestroyOtherState' @@ -521,8 +531,8 @@ subroutine DBEMT_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) if (allocated(OtherStateData%n)) then deallocate(OtherStateData%n) end if - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call DBEMT_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -533,15 +543,15 @@ subroutine DBEMT_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(DBEMT_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackOtherState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%areStatesInitialized) call RegPack(RF, InData%tau1) call RegPack(RF, InData%tau2) call RegPackAlloc(RF, InData%n) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call DBEMT_PackContState(RF, InData%xdot(i1)) end do @@ -552,8 +562,8 @@ subroutine DBEMT_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(DBEMT_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackOtherState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -561,8 +571,8 @@ subroutine DBEMT_UnPackOtherState(RF, OutData) call RegUnpack(RF, OutData%tau1); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%tau2); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return - LB(1:1) = lbound(OutData%xdot, kind=B8Ki) - UB(1:1) = ubound(OutData%xdot, kind=B8Ki) + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call DBEMT_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do @@ -612,7 +622,7 @@ subroutine DBEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'DBEMT_CopyParam' ErrStat = ErrID_None @@ -624,8 +634,8 @@ subroutine DBEMT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%k_0ye = SrcParamData%k_0ye DstParamData%tau1_const = SrcParamData%tau1_const if (allocated(SrcParamData%spanRatio)) then - LB(1:2) = lbound(SrcParamData%spanRatio, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%spanRatio, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%spanRatio) + UB(1:2) = ubound(SrcParamData%spanRatio) if (.not. allocated(DstParamData%spanRatio)) then allocate(DstParamData%spanRatio(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -670,7 +680,7 @@ subroutine DBEMT_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(DBEMT_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackParam' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -731,8 +741,8 @@ subroutine DBEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DBEMT_CopyInput' @@ -742,8 +752,8 @@ subroutine DBEMT_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg DstInputData%Un_disk = SrcInputData%Un_disk DstInputData%R_disk = SrcInputData%R_disk if (allocated(SrcInputData%element)) then - LB(1:2) = lbound(SrcInputData%element, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%element, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%element) + UB(1:2) = ubound(SrcInputData%element) if (.not. allocated(DstInputData%element)) then allocate(DstInputData%element(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -765,16 +775,16 @@ subroutine DBEMT_DestroyInput(InputData, ErrStat, ErrMsg) type(DBEMT_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'DBEMT_DestroyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InputData%element)) then - LB(1:2) = lbound(InputData%element, kind=B8Ki) - UB(1:2) = ubound(InputData%element, kind=B8Ki) + LB(1:2) = lbound(InputData%element) + UB(1:2) = ubound(InputData%element) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call DBEMT_DestroyElementInputType(InputData%element(i1,i2), ErrStat2, ErrMsg2) @@ -789,17 +799,17 @@ subroutine DBEMT_PackInput(RF, Indata) type(RegFile), intent(inout) :: RF type(DBEMT_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'DBEMT_PackInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%AxInd_disk) call RegPack(RF, InData%Un_disk) call RegPack(RF, InData%R_disk) call RegPack(RF, allocated(InData%element)) if (allocated(InData%element)) then - call RegPackBounds(RF, 2, lbound(InData%element, kind=B8Ki), ubound(InData%element, kind=B8Ki)) - LB(1:2) = lbound(InData%element, kind=B8Ki) - UB(1:2) = ubound(InData%element, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%element), ubound(InData%element)) + LB(1:2) = lbound(InData%element) + UB(1:2) = ubound(InData%element) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call DBEMT_PackElementInputType(RF, InData%element(i1,i2)) @@ -813,8 +823,8 @@ subroutine DBEMT_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(DBEMT_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -844,14 +854,14 @@ subroutine DBEMT_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'DBEMT_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%vind)) then - LB(1:3) = lbound(SrcOutputData%vind, kind=B8Ki) - UB(1:3) = ubound(SrcOutputData%vind, kind=B8Ki) + LB(1:3) = lbound(SrcOutputData%vind) + UB(1:3) = ubound(SrcOutputData%vind) if (.not. allocated(DstOutputData%vind)) then allocate(DstOutputData%vind(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -888,7 +898,7 @@ subroutine DBEMT_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(DBEMT_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'DBEMT_UnPackOutput' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1158,13 +1168,13 @@ SUBROUTINE DBEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs u_out%Un_disk = a1*u1%Un_disk + a2*u2%Un_disk u_out%R_disk = a1*u1%R_disk + a2*u2%R_disk IF (ALLOCATED(u_out%element) .AND. ALLOCATED(u1%element)) THEN - DO i02 = LBOUND(u_out%element,2, kind=B8Ki),UBOUND(u_out%element,2, kind=B8Ki) - DO i01 = LBOUND(u_out%element,1, kind=B8Ki),UBOUND(u_out%element,1, kind=B8Ki) + do i02 = lbound(u_out%element,2),ubound(u_out%element,2) + do i01 = lbound(u_out%element,1),ubound(u_out%element,1) u_out%element(i01,i02)%vind_s = a1*u1%element(i01,i02)%vind_s + a2*u2%element(i01,i02)%vind_s END DO END DO - DO i02 = LBOUND(u_out%element,2, kind=B8Ki),UBOUND(u_out%element,2, kind=B8Ki) - DO i01 = LBOUND(u_out%element,1, kind=B8Ki),UBOUND(u_out%element,1, kind=B8Ki) + do i02 = lbound(u_out%element,2),ubound(u_out%element,2) + do i01 = lbound(u_out%element,1),ubound(u_out%element,1) u_out%element(i01,i02)%spanRatio = a1*u1%element(i01,i02)%spanRatio + a2*u2%element(i01,i02)%spanRatio END DO END DO @@ -1232,13 +1242,13 @@ SUBROUTINE DBEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E u_out%Un_disk = a1*u1%Un_disk + a2*u2%Un_disk + a3*u3%Un_disk u_out%R_disk = a1*u1%R_disk + a2*u2%R_disk + a3*u3%R_disk IF (ALLOCATED(u_out%element) .AND. ALLOCATED(u1%element)) THEN - DO i02 = LBOUND(u_out%element,2, kind=B8Ki),UBOUND(u_out%element,2, kind=B8Ki) - DO i01 = LBOUND(u_out%element,1, kind=B8Ki),UBOUND(u_out%element,1, kind=B8Ki) + do i02 = lbound(u_out%element,2),ubound(u_out%element,2) + do i01 = lbound(u_out%element,1),ubound(u_out%element,1) u_out%element(i01,i02)%vind_s = a1*u1%element(i01,i02)%vind_s + a2*u2%element(i01,i02)%vind_s + a3*u3%element(i01,i02)%vind_s END DO END DO - DO i02 = LBOUND(u_out%element,2, kind=B8Ki),UBOUND(u_out%element,2, kind=B8Ki) - DO i01 = LBOUND(u_out%element,1, kind=B8Ki),UBOUND(u_out%element,1, kind=B8Ki) + do i02 = lbound(u_out%element,2),ubound(u_out%element,2) + do i01 = lbound(u_out%element,1),ubound(u_out%element,1) u_out%element(i01,i02)%spanRatio = a1*u1%element(i01,i02)%spanRatio + a2*u2%element(i01,i02)%spanRatio + a3*u3%element(i01,i02)%spanRatio END DO END DO @@ -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 45b4b0e841..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 @@ -360,7 +377,7 @@ subroutine FVW_CopyGridOutType(SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyGridOutType' ErrStat = ErrID_None @@ -380,8 +397,8 @@ subroutine FVW_CopyGridOutType(SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, DstGridOutTypeData%ny = SrcGridOutTypeData%ny DstGridOutTypeData%nz = SrcGridOutTypeData%nz if (allocated(SrcGridOutTypeData%uGrid)) then - LB(1:4) = lbound(SrcGridOutTypeData%uGrid, kind=B8Ki) - UB(1:4) = ubound(SrcGridOutTypeData%uGrid, kind=B8Ki) + LB(1:4) = lbound(SrcGridOutTypeData%uGrid) + UB(1:4) = ubound(SrcGridOutTypeData%uGrid) if (.not. allocated(DstGridOutTypeData%uGrid)) then allocate(DstGridOutTypeData%uGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -392,8 +409,8 @@ subroutine FVW_CopyGridOutType(SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, DstGridOutTypeData%uGrid = SrcGridOutTypeData%uGrid end if if (allocated(SrcGridOutTypeData%omGrid)) then - LB(1:4) = lbound(SrcGridOutTypeData%omGrid, kind=B8Ki) - UB(1:4) = ubound(SrcGridOutTypeData%omGrid, kind=B8Ki) + LB(1:4) = lbound(SrcGridOutTypeData%omGrid) + UB(1:4) = ubound(SrcGridOutTypeData%omGrid) if (.not. allocated(DstGridOutTypeData%omGrid)) then allocate(DstGridOutTypeData%omGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -450,7 +467,7 @@ subroutine FVW_UnPackGridOutType(RF, OutData) type(RegFile), intent(inout) :: RF type(GridOutType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackGridOutType' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -479,14 +496,14 @@ subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyT_Sgmt' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcT_SgmtData%Points)) then - LB(1:2) = lbound(SrcT_SgmtData%Points, kind=B8Ki) - UB(1:2) = ubound(SrcT_SgmtData%Points, kind=B8Ki) + LB(1:2) = lbound(SrcT_SgmtData%Points) + UB(1:2) = ubound(SrcT_SgmtData%Points) if (.not. allocated(DstT_SgmtData%Points)) then allocate(DstT_SgmtData%Points(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -497,8 +514,8 @@ subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMs DstT_SgmtData%Points = SrcT_SgmtData%Points end if if (allocated(SrcT_SgmtData%Connct)) then - LB(1:2) = lbound(SrcT_SgmtData%Connct, kind=B8Ki) - UB(1:2) = ubound(SrcT_SgmtData%Connct, kind=B8Ki) + LB(1:2) = lbound(SrcT_SgmtData%Connct) + UB(1:2) = ubound(SrcT_SgmtData%Connct) if (.not. allocated(DstT_SgmtData%Connct)) then allocate(DstT_SgmtData%Connct(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -509,8 +526,8 @@ subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMs DstT_SgmtData%Connct = SrcT_SgmtData%Connct end if if (allocated(SrcT_SgmtData%Gamma)) then - LB(1:1) = lbound(SrcT_SgmtData%Gamma, kind=B8Ki) - UB(1:1) = ubound(SrcT_SgmtData%Gamma, kind=B8Ki) + LB(1:1) = lbound(SrcT_SgmtData%Gamma) + UB(1:1) = ubound(SrcT_SgmtData%Gamma) if (.not. allocated(DstT_SgmtData%Gamma)) then allocate(DstT_SgmtData%Gamma(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -521,8 +538,8 @@ subroutine FVW_CopyT_Sgmt(SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMs DstT_SgmtData%Gamma = SrcT_SgmtData%Gamma end if if (allocated(SrcT_SgmtData%Epsilon)) then - LB(1:1) = lbound(SrcT_SgmtData%Epsilon, kind=B8Ki) - UB(1:1) = ubound(SrcT_SgmtData%Epsilon, kind=B8Ki) + LB(1:1) = lbound(SrcT_SgmtData%Epsilon) + UB(1:1) = ubound(SrcT_SgmtData%Epsilon) if (.not. allocated(DstT_SgmtData%Epsilon)) then allocate(DstT_SgmtData%Epsilon(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -577,7 +594,7 @@ subroutine FVW_UnPackT_Sgmt(RF, OutData) type(RegFile), intent(inout) :: RF type(T_Sgmt), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackT_Sgmt' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -596,14 +613,14 @@ subroutine FVW_CopyT_Part(SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyT_Part' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcT_PartData%P)) then - LB(1:2) = lbound(SrcT_PartData%P, kind=B8Ki) - UB(1:2) = ubound(SrcT_PartData%P, kind=B8Ki) + LB(1:2) = lbound(SrcT_PartData%P) + UB(1:2) = ubound(SrcT_PartData%P) if (.not. allocated(DstT_PartData%P)) then allocate(DstT_PartData%P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -614,8 +631,8 @@ subroutine FVW_CopyT_Part(SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMs DstT_PartData%P = SrcT_PartData%P end if if (allocated(SrcT_PartData%Alpha)) then - LB(1:2) = lbound(SrcT_PartData%Alpha, kind=B8Ki) - UB(1:2) = ubound(SrcT_PartData%Alpha, kind=B8Ki) + LB(1:2) = lbound(SrcT_PartData%Alpha) + UB(1:2) = ubound(SrcT_PartData%Alpha) if (.not. allocated(DstT_PartData%Alpha)) then allocate(DstT_PartData%Alpha(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -626,8 +643,8 @@ subroutine FVW_CopyT_Part(SrcT_PartData, DstT_PartData, CtrlCode, ErrStat, ErrMs DstT_PartData%Alpha = SrcT_PartData%Alpha end if if (allocated(SrcT_PartData%RegParam)) then - LB(1:1) = lbound(SrcT_PartData%RegParam, kind=B8Ki) - UB(1:1) = ubound(SrcT_PartData%RegParam, kind=B8Ki) + LB(1:1) = lbound(SrcT_PartData%RegParam) + UB(1:1) = ubound(SrcT_PartData%RegParam) if (.not. allocated(DstT_PartData%RegParam)) then allocate(DstT_PartData%RegParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -676,7 +693,7 @@ subroutine FVW_UnPackT_Part(RF, OutData) type(RegFile), intent(inout) :: RF type(T_Part), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackT_Part' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -693,14 +710,14 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyWng_ParameterType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_ParameterTypeData%chord_LL)) then - LB(1:1) = lbound(SrcWng_ParameterTypeData%chord_LL, kind=B8Ki) - UB(1:1) = ubound(SrcWng_ParameterTypeData%chord_LL, kind=B8Ki) + LB(1:1) = lbound(SrcWng_ParameterTypeData%chord_LL) + UB(1:1) = ubound(SrcWng_ParameterTypeData%chord_LL) if (.not. allocated(DstWng_ParameterTypeData%chord_LL)) then allocate(DstWng_ParameterTypeData%chord_LL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -711,8 +728,8 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT DstWng_ParameterTypeData%chord_LL = SrcWng_ParameterTypeData%chord_LL end if if (allocated(SrcWng_ParameterTypeData%chord_CP)) then - LB(1:1) = lbound(SrcWng_ParameterTypeData%chord_CP, kind=B8Ki) - UB(1:1) = ubound(SrcWng_ParameterTypeData%chord_CP, kind=B8Ki) + LB(1:1) = lbound(SrcWng_ParameterTypeData%chord_CP) + UB(1:1) = ubound(SrcWng_ParameterTypeData%chord_CP) if (.not. allocated(DstWng_ParameterTypeData%chord_CP)) then allocate(DstWng_ParameterTypeData%chord_CP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -723,8 +740,8 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT DstWng_ParameterTypeData%chord_CP = SrcWng_ParameterTypeData%chord_CP end if if (allocated(SrcWng_ParameterTypeData%s_LL)) then - LB(1:1) = lbound(SrcWng_ParameterTypeData%s_LL, kind=B8Ki) - UB(1:1) = ubound(SrcWng_ParameterTypeData%s_LL, kind=B8Ki) + LB(1:1) = lbound(SrcWng_ParameterTypeData%s_LL) + UB(1:1) = ubound(SrcWng_ParameterTypeData%s_LL) if (.not. allocated(DstWng_ParameterTypeData%s_LL)) then allocate(DstWng_ParameterTypeData%s_LL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -735,8 +752,8 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT DstWng_ParameterTypeData%s_LL = SrcWng_ParameterTypeData%s_LL end if if (allocated(SrcWng_ParameterTypeData%s_CP)) then - LB(1:1) = lbound(SrcWng_ParameterTypeData%s_CP, kind=B8Ki) - UB(1:1) = ubound(SrcWng_ParameterTypeData%s_CP, kind=B8Ki) + LB(1:1) = lbound(SrcWng_ParameterTypeData%s_CP) + UB(1:1) = ubound(SrcWng_ParameterTypeData%s_CP) if (.not. allocated(DstWng_ParameterTypeData%s_CP)) then allocate(DstWng_ParameterTypeData%s_CP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -748,8 +765,8 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT end if DstWng_ParameterTypeData%iRotor = SrcWng_ParameterTypeData%iRotor if (allocated(SrcWng_ParameterTypeData%AFindx)) then - LB(1:2) = lbound(SrcWng_ParameterTypeData%AFindx, kind=B8Ki) - UB(1:2) = ubound(SrcWng_ParameterTypeData%AFindx, kind=B8Ki) + LB(1:2) = lbound(SrcWng_ParameterTypeData%AFindx) + UB(1:2) = ubound(SrcWng_ParameterTypeData%AFindx) if (.not. allocated(DstWng_ParameterTypeData%AFindx)) then allocate(DstWng_ParameterTypeData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -761,8 +778,8 @@ subroutine FVW_CopyWng_ParameterType(SrcWng_ParameterTypeData, DstWng_ParameterT end if DstWng_ParameterTypeData%nSpan = SrcWng_ParameterTypeData%nSpan if (allocated(SrcWng_ParameterTypeData%PrescribedCirculation)) then - LB(1:1) = lbound(SrcWng_ParameterTypeData%PrescribedCirculation, kind=B8Ki) - UB(1:1) = ubound(SrcWng_ParameterTypeData%PrescribedCirculation, kind=B8Ki) + LB(1:1) = lbound(SrcWng_ParameterTypeData%PrescribedCirculation) + UB(1:1) = ubound(SrcWng_ParameterTypeData%PrescribedCirculation) if (.not. allocated(DstWng_ParameterTypeData%PrescribedCirculation)) then allocate(DstWng_ParameterTypeData%PrescribedCirculation(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -821,7 +838,7 @@ subroutine FVW_UnPackWng_ParameterType(RF, OutData) type(RegFile), intent(inout) :: RF type(Wng_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_ParameterType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -841,8 +858,8 @@ subroutine FVW_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyParam' @@ -851,8 +868,8 @@ subroutine FVW_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nRotors = SrcParamData%nRotors DstParamData%nWings = SrcParamData%nWings if (allocated(SrcParamData%W)) then - LB(1:1) = lbound(SrcParamData%W, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%W, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%W) + UB(1:1) = ubound(SrcParamData%W) if (.not. allocated(DstParamData%W)) then allocate(DstParamData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -867,8 +884,8 @@ subroutine FVW_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%Bld2Wings)) then - LB(1:2) = lbound(SrcParamData%Bld2Wings, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Bld2Wings, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Bld2Wings) + UB(1:2) = ubound(SrcParamData%Bld2Wings) if (.not. allocated(DstParamData%Bld2Wings)) then allocate(DstParamData%Bld2Wings(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -929,16 +946,16 @@ subroutine FVW_DestroyParam(ParamData, ErrStat, ErrMsg) type(FVW_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(ParamData%W)) then - LB(1:1) = lbound(ParamData%W, kind=B8Ki) - UB(1:1) = ubound(ParamData%W, kind=B8Ki) + LB(1:1) = lbound(ParamData%W) + UB(1:1) = ubound(ParamData%W) do i1 = LB(1), UB(1) call FVW_DestroyWng_ParameterType(ParamData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -954,16 +971,16 @@ subroutine FVW_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(FVW_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%nRotors) call RegPack(RF, InData%nWings) call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) - LB(1:1) = lbound(InData%W, kind=B8Ki) - UB(1:1) = ubound(InData%W, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) do i1 = LB(1), UB(1) call FVW_PackWng_ParameterType(RF, InData%W(i1)) end do @@ -1021,8 +1038,8 @@ subroutine FVW_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(FVW_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1095,14 +1112,14 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyWng_ContinuousStateType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_ContinuousStateTypeData%Gamma_NW)) then - LB(1:2) = lbound(SrcWng_ContinuousStateTypeData%Gamma_NW, kind=B8Ki) - UB(1:2) = ubound(SrcWng_ContinuousStateTypeData%Gamma_NW, kind=B8Ki) + LB(1:2) = lbound(SrcWng_ContinuousStateTypeData%Gamma_NW) + UB(1:2) = ubound(SrcWng_ContinuousStateTypeData%Gamma_NW) if (.not. allocated(DstWng_ContinuousStateTypeData%Gamma_NW)) then allocate(DstWng_ContinuousStateTypeData%Gamma_NW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1113,8 +1130,8 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn DstWng_ContinuousStateTypeData%Gamma_NW = SrcWng_ContinuousStateTypeData%Gamma_NW end if if (allocated(SrcWng_ContinuousStateTypeData%Gamma_FW)) then - LB(1:2) = lbound(SrcWng_ContinuousStateTypeData%Gamma_FW, kind=B8Ki) - UB(1:2) = ubound(SrcWng_ContinuousStateTypeData%Gamma_FW, kind=B8Ki) + LB(1:2) = lbound(SrcWng_ContinuousStateTypeData%Gamma_FW) + UB(1:2) = ubound(SrcWng_ContinuousStateTypeData%Gamma_FW) if (.not. allocated(DstWng_ContinuousStateTypeData%Gamma_FW)) then allocate(DstWng_ContinuousStateTypeData%Gamma_FW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1125,8 +1142,8 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn DstWng_ContinuousStateTypeData%Gamma_FW = SrcWng_ContinuousStateTypeData%Gamma_FW end if if (allocated(SrcWng_ContinuousStateTypeData%Eps_NW)) then - LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_NW, kind=B8Ki) - UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%Eps_NW, kind=B8Ki) + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_NW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%Eps_NW) if (.not. allocated(DstWng_ContinuousStateTypeData%Eps_NW)) then allocate(DstWng_ContinuousStateTypeData%Eps_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1137,8 +1154,8 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn DstWng_ContinuousStateTypeData%Eps_NW = SrcWng_ContinuousStateTypeData%Eps_NW end if if (allocated(SrcWng_ContinuousStateTypeData%Eps_FW)) then - LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_FW, kind=B8Ki) - UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%Eps_FW, kind=B8Ki) + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%Eps_FW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%Eps_FW) if (.not. allocated(DstWng_ContinuousStateTypeData%Eps_FW)) then allocate(DstWng_ContinuousStateTypeData%Eps_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1149,8 +1166,8 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn DstWng_ContinuousStateTypeData%Eps_FW = SrcWng_ContinuousStateTypeData%Eps_FW end if if (allocated(SrcWng_ContinuousStateTypeData%r_NW)) then - LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_NW, kind=B8Ki) - UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%r_NW, kind=B8Ki) + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_NW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%r_NW) if (.not. allocated(DstWng_ContinuousStateTypeData%r_NW)) then allocate(DstWng_ContinuousStateTypeData%r_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1161,8 +1178,8 @@ subroutine FVW_CopyWng_ContinuousStateType(SrcWng_ContinuousStateTypeData, DstWn DstWng_ContinuousStateTypeData%r_NW = SrcWng_ContinuousStateTypeData%r_NW end if if (allocated(SrcWng_ContinuousStateTypeData%r_FW)) then - LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_FW, kind=B8Ki) - UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%r_FW, kind=B8Ki) + LB(1:3) = lbound(SrcWng_ContinuousStateTypeData%r_FW) + UB(1:3) = ubound(SrcWng_ContinuousStateTypeData%r_FW) if (.not. allocated(DstWng_ContinuousStateTypeData%r_FW)) then allocate(DstWng_ContinuousStateTypeData%r_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1219,7 +1236,7 @@ subroutine FVW_UnPackWng_ContinuousStateType(RF, OutData) type(RegFile), intent(inout) :: RF type(Wng_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_ContinuousStateType' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1237,16 +1254,16 @@ subroutine FVW_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%W)) then - LB(1:1) = lbound(SrcContStateData%W, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%W, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%W) + UB(1:1) = ubound(SrcContStateData%W) if (.not. allocated(DstContStateData%W)) then allocate(DstContStateData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1261,8 +1278,8 @@ subroutine FVW_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSt end do end if if (allocated(SrcContStateData%UA)) then - LB(1:1) = lbound(SrcContStateData%UA, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%UA, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%UA) + UB(1:1) = ubound(SrcContStateData%UA) if (.not. allocated(DstContStateData%UA)) then allocate(DstContStateData%UA(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1282,16 +1299,16 @@ subroutine FVW_DestroyContState(ContStateData, ErrStat, ErrMsg) type(FVW_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%W)) then - LB(1:1) = lbound(ContStateData%W, kind=B8Ki) - UB(1:1) = ubound(ContStateData%W, kind=B8Ki) + LB(1:1) = lbound(ContStateData%W) + UB(1:1) = ubound(ContStateData%W) do i1 = LB(1), UB(1) call FVW_DestroyWng_ContinuousStateType(ContStateData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1299,8 +1316,8 @@ subroutine FVW_DestroyContState(ContStateData, ErrStat, ErrMsg) deallocate(ContStateData%W) end if if (allocated(ContStateData%UA)) then - LB(1:1) = lbound(ContStateData%UA, kind=B8Ki) - UB(1:1) = ubound(ContStateData%UA, kind=B8Ki) + LB(1:1) = lbound(ContStateData%UA) + UB(1:1) = ubound(ContStateData%UA) do i1 = LB(1), UB(1) call UA_DestroyContState(ContStateData%UA(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1313,23 +1330,23 @@ subroutine FVW_PackContState(RF, Indata) type(RegFile), intent(inout) :: RF type(FVW_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) - LB(1:1) = lbound(InData%W, kind=B8Ki) - UB(1:1) = ubound(InData%W, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) do i1 = LB(1), UB(1) call FVW_PackWng_ContinuousStateType(RF, InData%W(i1)) end do end if call RegPack(RF, allocated(InData%UA)) if (allocated(InData%UA)) then - call RegPackBounds(RF, 1, lbound(InData%UA, kind=B8Ki), ubound(InData%UA, kind=B8Ki)) - LB(1:1) = lbound(InData%UA, kind=B8Ki) - UB(1:1) = ubound(InData%UA, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%UA), ubound(InData%UA)) + LB(1:1) = lbound(InData%UA) + UB(1:1) = ubound(InData%UA) do i1 = LB(1), UB(1) call UA_PackContState(RF, InData%UA(i1)) end do @@ -1341,8 +1358,8 @@ subroutine FVW_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(FVW_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1380,14 +1397,14 @@ subroutine FVW_CopyWng_OutputType(SrcWng_OutputTypeData, DstWng_OutputTypeData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyWng_OutputType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_OutputTypeData%Vind)) then - LB(1:2) = lbound(SrcWng_OutputTypeData%Vind, kind=B8Ki) - UB(1:2) = ubound(SrcWng_OutputTypeData%Vind, kind=B8Ki) + LB(1:2) = lbound(SrcWng_OutputTypeData%Vind) + UB(1:2) = ubound(SrcWng_OutputTypeData%Vind) if (.not. allocated(DstWng_OutputTypeData%Vind)) then allocate(DstWng_OutputTypeData%Vind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1424,7 +1441,7 @@ subroutine FVW_UnPackWng_OutputType(RF, OutData) type(RegFile), intent(inout) :: RF type(Wng_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_OutputType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1437,16 +1454,16 @@ subroutine FVW_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%W)) then - LB(1:1) = lbound(SrcOutputData%W, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%W, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%W) + UB(1:1) = ubound(SrcOutputData%W) if (.not. allocated(DstOutputData%W)) then allocate(DstOutputData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1466,16 +1483,16 @@ subroutine FVW_DestroyOutput(OutputData, ErrStat, ErrMsg) type(FVW_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%W)) then - LB(1:1) = lbound(OutputData%W, kind=B8Ki) - UB(1:1) = ubound(OutputData%W, kind=B8Ki) + LB(1:1) = lbound(OutputData%W) + UB(1:1) = ubound(OutputData%W) do i1 = LB(1), UB(1) call FVW_DestroyWng_OutputType(OutputData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1488,14 +1505,14 @@ subroutine FVW_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(FVW_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) - LB(1:1) = lbound(InData%W, kind=B8Ki) - UB(1:1) = ubound(InData%W, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) do i1 = LB(1), UB(1) call FVW_PackWng_OutputType(RF, InData%W(i1)) end do @@ -1507,8 +1524,8 @@ subroutine FVW_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(FVW_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1533,16 +1550,16 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyWng_MiscVarType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_MiscVarTypeData%LE)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%LE, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%LE, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%LE) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%LE) if (.not. allocated(DstWng_MiscVarTypeData%LE)) then allocate(DstWng_MiscVarTypeData%LE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1553,8 +1570,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%LE = SrcWng_MiscVarTypeData%LE end if if (allocated(SrcWng_MiscVarTypeData%TE)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%TE, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%TE, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%TE) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%TE) if (.not. allocated(DstWng_MiscVarTypeData%TE)) then allocate(DstWng_MiscVarTypeData%TE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1565,8 +1582,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%TE = SrcWng_MiscVarTypeData%TE end if if (allocated(SrcWng_MiscVarTypeData%r_LL)) then - LB(1:3) = lbound(SrcWng_MiscVarTypeData%r_LL, kind=B8Ki) - UB(1:3) = ubound(SrcWng_MiscVarTypeData%r_LL, kind=B8Ki) + LB(1:3) = lbound(SrcWng_MiscVarTypeData%r_LL) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%r_LL) if (.not. allocated(DstWng_MiscVarTypeData%r_LL)) then allocate(DstWng_MiscVarTypeData%r_LL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1577,8 +1594,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%r_LL = SrcWng_MiscVarTypeData%r_LL end if if (allocated(SrcWng_MiscVarTypeData%CP)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%CP, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%CP, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%CP) if (.not. allocated(DstWng_MiscVarTypeData%CP)) then allocate(DstWng_MiscVarTypeData%CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1589,8 +1606,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%CP = SrcWng_MiscVarTypeData%CP end if if (allocated(SrcWng_MiscVarTypeData%Tang)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Tang, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Tang, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Tang) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Tang) if (.not. allocated(DstWng_MiscVarTypeData%Tang)) then allocate(DstWng_MiscVarTypeData%Tang(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1601,8 +1618,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Tang = SrcWng_MiscVarTypeData%Tang end if if (allocated(SrcWng_MiscVarTypeData%Norm)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Norm, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Norm, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Norm) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Norm) if (.not. allocated(DstWng_MiscVarTypeData%Norm)) then allocate(DstWng_MiscVarTypeData%Norm(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1613,8 +1630,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Norm = SrcWng_MiscVarTypeData%Norm end if if (allocated(SrcWng_MiscVarTypeData%Orth)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Orth, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Orth, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Orth) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Orth) if (.not. allocated(DstWng_MiscVarTypeData%Orth)) then allocate(DstWng_MiscVarTypeData%Orth(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1625,8 +1642,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Orth = SrcWng_MiscVarTypeData%Orth end if if (allocated(SrcWng_MiscVarTypeData%dl)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%dl, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%dl, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%dl) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%dl) if (.not. allocated(DstWng_MiscVarTypeData%dl)) then allocate(DstWng_MiscVarTypeData%dl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1637,8 +1654,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%dl = SrcWng_MiscVarTypeData%dl end if if (allocated(SrcWng_MiscVarTypeData%Area)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%Area, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%Area, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%Area) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%Area) if (.not. allocated(DstWng_MiscVarTypeData%Area)) then allocate(DstWng_MiscVarTypeData%Area(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1649,8 +1666,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Area = SrcWng_MiscVarTypeData%Area end if if (allocated(SrcWng_MiscVarTypeData%diag_LL)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%diag_LL, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%diag_LL, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%diag_LL) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%diag_LL) if (.not. allocated(DstWng_MiscVarTypeData%diag_LL)) then allocate(DstWng_MiscVarTypeData%diag_LL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1661,8 +1678,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%diag_LL = SrcWng_MiscVarTypeData%diag_LL end if if (allocated(SrcWng_MiscVarTypeData%Vind_CP)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vind_CP, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vind_CP, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vind_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vind_CP) if (.not. allocated(DstWng_MiscVarTypeData%Vind_CP)) then allocate(DstWng_MiscVarTypeData%Vind_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1673,8 +1690,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vind_CP = SrcWng_MiscVarTypeData%Vind_CP end if if (allocated(SrcWng_MiscVarTypeData%Vtot_CP)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vtot_CP, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vtot_CP, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vtot_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vtot_CP) if (.not. allocated(DstWng_MiscVarTypeData%Vtot_CP)) then allocate(DstWng_MiscVarTypeData%Vtot_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1685,8 +1702,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vtot_CP = SrcWng_MiscVarTypeData%Vtot_CP end if if (allocated(SrcWng_MiscVarTypeData%Vstr_CP)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vstr_CP, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vstr_CP, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vstr_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vstr_CP) if (.not. allocated(DstWng_MiscVarTypeData%Vstr_CP)) then allocate(DstWng_MiscVarTypeData%Vstr_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1697,8 +1714,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vstr_CP = SrcWng_MiscVarTypeData%Vstr_CP end if if (allocated(SrcWng_MiscVarTypeData%Vwnd_CP)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vwnd_CP, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vwnd_CP, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vwnd_CP) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vwnd_CP) if (.not. allocated(DstWng_MiscVarTypeData%Vwnd_CP)) then allocate(DstWng_MiscVarTypeData%Vwnd_CP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1709,8 +1726,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vwnd_CP = SrcWng_MiscVarTypeData%Vwnd_CP end if if (allocated(SrcWng_MiscVarTypeData%Vwnd_NW)) then - LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_NW, kind=B8Ki) - UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vwnd_NW, kind=B8Ki) + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_NW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vwnd_NW) if (.not. allocated(DstWng_MiscVarTypeData%Vwnd_NW)) then allocate(DstWng_MiscVarTypeData%Vwnd_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1721,8 +1738,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vwnd_NW = SrcWng_MiscVarTypeData%Vwnd_NW end if if (allocated(SrcWng_MiscVarTypeData%Vwnd_FW)) then - LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_FW, kind=B8Ki) - UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vwnd_FW, kind=B8Ki) + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vwnd_FW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vwnd_FW) if (.not. allocated(DstWng_MiscVarTypeData%Vwnd_FW)) then allocate(DstWng_MiscVarTypeData%Vwnd_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1733,8 +1750,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vwnd_FW = SrcWng_MiscVarTypeData%Vwnd_FW end if if (allocated(SrcWng_MiscVarTypeData%Vind_NW)) then - LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_NW, kind=B8Ki) - UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vind_NW, kind=B8Ki) + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_NW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vind_NW) if (.not. allocated(DstWng_MiscVarTypeData%Vind_NW)) then allocate(DstWng_MiscVarTypeData%Vind_NW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1745,8 +1762,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vind_NW = SrcWng_MiscVarTypeData%Vind_NW end if if (allocated(SrcWng_MiscVarTypeData%Vind_FW)) then - LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_FW, kind=B8Ki) - UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vind_FW, kind=B8Ki) + LB(1:3) = lbound(SrcWng_MiscVarTypeData%Vind_FW) + UB(1:3) = ubound(SrcWng_MiscVarTypeData%Vind_FW) if (.not. allocated(DstWng_MiscVarTypeData%Vind_FW)) then allocate(DstWng_MiscVarTypeData%Vind_FW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1757,8 +1774,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vind_FW = SrcWng_MiscVarTypeData%Vind_FW end if if (allocated(SrcWng_MiscVarTypeData%PitchAndTwist)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%PitchAndTwist, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%PitchAndTwist, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%PitchAndTwist) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%PitchAndTwist) if (.not. allocated(DstWng_MiscVarTypeData%PitchAndTwist)) then allocate(DstWng_MiscVarTypeData%PitchAndTwist(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1771,8 +1788,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%iTip = SrcWng_MiscVarTypeData%iTip DstWng_MiscVarTypeData%iRoot = SrcWng_MiscVarTypeData%iRoot if (allocated(SrcWng_MiscVarTypeData%alpha_LL)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%alpha_LL, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%alpha_LL, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%alpha_LL) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%alpha_LL) if (.not. allocated(DstWng_MiscVarTypeData%alpha_LL)) then allocate(DstWng_MiscVarTypeData%alpha_LL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1783,8 +1800,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%alpha_LL = SrcWng_MiscVarTypeData%alpha_LL end if if (allocated(SrcWng_MiscVarTypeData%Vreln_LL)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%Vreln_LL, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%Vreln_LL, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%Vreln_LL) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%Vreln_LL) if (.not. allocated(DstWng_MiscVarTypeData%Vreln_LL)) then allocate(DstWng_MiscVarTypeData%Vreln_LL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1795,8 +1812,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vreln_LL = SrcWng_MiscVarTypeData%Vreln_LL end if if (allocated(SrcWng_MiscVarTypeData%u_UA)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%u_UA, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%u_UA, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%u_UA) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%u_UA) if (.not. allocated(DstWng_MiscVarTypeData%u_UA)) then allocate(DstWng_MiscVarTypeData%u_UA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1822,8 +1839,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcWng_MiscVarTypeData%Vind_LL)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vind_LL, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vind_LL, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%Vind_LL) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%Vind_LL) if (.not. allocated(DstWng_MiscVarTypeData%Vind_LL)) then allocate(DstWng_MiscVarTypeData%Vind_LL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1834,8 +1851,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%Vind_LL = SrcWng_MiscVarTypeData%Vind_LL end if if (allocated(SrcWng_MiscVarTypeData%BN_AxInd)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_AxInd, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_AxInd, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_AxInd) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_AxInd) if (.not. allocated(DstWng_MiscVarTypeData%BN_AxInd)) then allocate(DstWng_MiscVarTypeData%BN_AxInd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1846,8 +1863,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_AxInd = SrcWng_MiscVarTypeData%BN_AxInd end if if (allocated(SrcWng_MiscVarTypeData%BN_TanInd)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_TanInd, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_TanInd, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_TanInd) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_TanInd) if (.not. allocated(DstWng_MiscVarTypeData%BN_TanInd)) then allocate(DstWng_MiscVarTypeData%BN_TanInd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1858,8 +1875,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_TanInd = SrcWng_MiscVarTypeData%BN_TanInd end if if (allocated(SrcWng_MiscVarTypeData%BN_Vrel)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Vrel, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Vrel, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Vrel) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Vrel) if (.not. allocated(DstWng_MiscVarTypeData%BN_Vrel)) then allocate(DstWng_MiscVarTypeData%BN_Vrel(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1870,8 +1887,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Vrel = SrcWng_MiscVarTypeData%BN_Vrel end if if (allocated(SrcWng_MiscVarTypeData%BN_alpha)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_alpha, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_alpha, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_alpha) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_alpha) if (.not. allocated(DstWng_MiscVarTypeData%BN_alpha)) then allocate(DstWng_MiscVarTypeData%BN_alpha(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1882,8 +1899,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_alpha = SrcWng_MiscVarTypeData%BN_alpha end if if (allocated(SrcWng_MiscVarTypeData%BN_phi)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_phi, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_phi, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_phi) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_phi) if (.not. allocated(DstWng_MiscVarTypeData%BN_phi)) then allocate(DstWng_MiscVarTypeData%BN_phi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1894,8 +1911,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_phi = SrcWng_MiscVarTypeData%BN_phi end if if (allocated(SrcWng_MiscVarTypeData%BN_Re)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Re, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Re, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Re) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Re) if (.not. allocated(DstWng_MiscVarTypeData%BN_Re)) then allocate(DstWng_MiscVarTypeData%BN_Re(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1906,8 +1923,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Re = SrcWng_MiscVarTypeData%BN_Re end if if (allocated(SrcWng_MiscVarTypeData%BN_URelWind_s)) then - LB(1:2) = lbound(SrcWng_MiscVarTypeData%BN_URelWind_s, kind=B8Ki) - UB(1:2) = ubound(SrcWng_MiscVarTypeData%BN_URelWind_s, kind=B8Ki) + LB(1:2) = lbound(SrcWng_MiscVarTypeData%BN_URelWind_s) + UB(1:2) = ubound(SrcWng_MiscVarTypeData%BN_URelWind_s) if (.not. allocated(DstWng_MiscVarTypeData%BN_URelWind_s)) then allocate(DstWng_MiscVarTypeData%BN_URelWind_s(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1918,8 +1935,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_URelWind_s = SrcWng_MiscVarTypeData%BN_URelWind_s end if if (allocated(SrcWng_MiscVarTypeData%BN_Cl_Static)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl_Static, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cl_Static, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl_Static) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cl_Static) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cl_Static)) then allocate(DstWng_MiscVarTypeData%BN_Cl_Static(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1930,8 +1947,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cl_Static = SrcWng_MiscVarTypeData%BN_Cl_Static end if if (allocated(SrcWng_MiscVarTypeData%BN_Cd_Static)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd_Static, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cd_Static, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd_Static) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cd_Static) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cd_Static)) then allocate(DstWng_MiscVarTypeData%BN_Cd_Static(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1942,8 +1959,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cd_Static = SrcWng_MiscVarTypeData%BN_Cd_Static end if if (allocated(SrcWng_MiscVarTypeData%BN_Cm_Static)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm_Static, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cm_Static, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm_Static) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cm_Static) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cm_Static)) then allocate(DstWng_MiscVarTypeData%BN_Cm_Static(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1954,8 +1971,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cm_Static = SrcWng_MiscVarTypeData%BN_Cm_Static end if if (allocated(SrcWng_MiscVarTypeData%BN_Cpmin)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cpmin, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cpmin, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cpmin) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cpmin) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cpmin)) then allocate(DstWng_MiscVarTypeData%BN_Cpmin(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1966,8 +1983,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cpmin = SrcWng_MiscVarTypeData%BN_Cpmin end if if (allocated(SrcWng_MiscVarTypeData%BN_Cl)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cl, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cl) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cl) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cl)) then allocate(DstWng_MiscVarTypeData%BN_Cl(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1978,8 +1995,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cl = SrcWng_MiscVarTypeData%BN_Cl end if if (allocated(SrcWng_MiscVarTypeData%BN_Cd)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cd, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cd) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cd) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cd)) then allocate(DstWng_MiscVarTypeData%BN_Cd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1990,8 +2007,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cd = SrcWng_MiscVarTypeData%BN_Cd end if if (allocated(SrcWng_MiscVarTypeData%BN_Cm)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cm, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cm) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cm) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cm)) then allocate(DstWng_MiscVarTypeData%BN_Cm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2002,8 +2019,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cm = SrcWng_MiscVarTypeData%BN_Cm end if if (allocated(SrcWng_MiscVarTypeData%BN_Cx)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cx, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cx, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cx) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cx) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cx)) then allocate(DstWng_MiscVarTypeData%BN_Cx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2014,8 +2031,8 @@ subroutine FVW_CopyWng_MiscVarType(SrcWng_MiscVarTypeData, DstWng_MiscVarTypeDat DstWng_MiscVarTypeData%BN_Cx = SrcWng_MiscVarTypeData%BN_Cx end if if (allocated(SrcWng_MiscVarTypeData%BN_Cy)) then - LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cy, kind=B8Ki) - UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cy, kind=B8Ki) + LB(1:1) = lbound(SrcWng_MiscVarTypeData%BN_Cy) + UB(1:1) = ubound(SrcWng_MiscVarTypeData%BN_Cy) if (.not. allocated(DstWng_MiscVarTypeData%BN_Cy)) then allocate(DstWng_MiscVarTypeData%BN_Cy(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2031,8 +2048,8 @@ subroutine FVW_DestroyWng_MiscVarType(Wng_MiscVarTypeData, ErrStat, ErrMsg) type(Wng_MiscVarType), intent(inout) :: Wng_MiscVarTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyWng_MiscVarType' @@ -2102,8 +2119,8 @@ subroutine FVW_DestroyWng_MiscVarType(Wng_MiscVarTypeData, ErrStat, ErrMsg) deallocate(Wng_MiscVarTypeData%Vreln_LL) end if if (allocated(Wng_MiscVarTypeData%u_UA)) then - LB(1:2) = lbound(Wng_MiscVarTypeData%u_UA, kind=B8Ki) - UB(1:2) = ubound(Wng_MiscVarTypeData%u_UA, kind=B8Ki) + LB(1:2) = lbound(Wng_MiscVarTypeData%u_UA) + UB(1:2) = ubound(Wng_MiscVarTypeData%u_UA) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call UA_DestroyInput(Wng_MiscVarTypeData%u_UA(i1,i2), ErrStat2, ErrMsg2) @@ -2175,8 +2192,8 @@ subroutine FVW_PackWng_MiscVarType(RF, Indata) type(RegFile), intent(inout) :: RF type(Wng_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackWng_MiscVarType' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%LE) call RegPackAlloc(RF, InData%TE) @@ -2203,9 +2220,9 @@ subroutine FVW_PackWng_MiscVarType(RF, Indata) call RegPackAlloc(RF, InData%Vreln_LL) call RegPack(RF, allocated(InData%u_UA)) if (allocated(InData%u_UA)) then - call RegPackBounds(RF, 2, lbound(InData%u_UA, kind=B8Ki), ubound(InData%u_UA, kind=B8Ki)) - LB(1:2) = lbound(InData%u_UA, kind=B8Ki) - UB(1:2) = ubound(InData%u_UA, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%u_UA), ubound(InData%u_UA)) + LB(1:2) = lbound(InData%u_UA) + UB(1:2) = ubound(InData%u_UA) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call UA_PackInput(RF, InData%u_UA(i1,i2)) @@ -2239,8 +2256,8 @@ subroutine FVW_UnPackWng_MiscVarType(RF, OutData) type(RegFile), intent(inout) :: RF type(Wng_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_MiscVarType' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2310,16 +2327,16 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%W)) then - LB(1:1) = lbound(SrcMiscData%W, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%W, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%W) + UB(1:1) = ubound(SrcMiscData%W) if (.not. allocated(DstMiscData%W)) then allocate(DstMiscData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2340,8 +2357,8 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%VTKstep = SrcMiscData%VTKstep DstMiscData%VTKlastTime = SrcMiscData%VTKlastTime if (allocated(SrcMiscData%r_wind)) then - LB(1:2) = lbound(SrcMiscData%r_wind, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%r_wind, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%r_wind) + UB(1:2) = ubound(SrcMiscData%r_wind) if (.not. allocated(DstMiscData%r_wind)) then allocate(DstMiscData%r_wind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2372,8 +2389,8 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%CPs)) then - LB(1:2) = lbound(SrcMiscData%CPs, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%CPs, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%CPs) + UB(1:2) = ubound(SrcMiscData%CPs) if (.not. allocated(DstMiscData%CPs)) then allocate(DstMiscData%CPs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2384,8 +2401,8 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%CPs = SrcMiscData%CPs end if if (allocated(SrcMiscData%Uind)) then - LB(1:2) = lbound(SrcMiscData%Uind, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%Uind, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%Uind) + UB(1:2) = ubound(SrcMiscData%Uind) if (.not. allocated(DstMiscData%Uind)) then allocate(DstMiscData%Uind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2396,8 +2413,8 @@ subroutine FVW_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Uind = SrcMiscData%Uind end if if (allocated(SrcMiscData%GridOutputs)) then - LB(1:1) = lbound(SrcMiscData%GridOutputs, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%GridOutputs, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%GridOutputs) + UB(1:1) = ubound(SrcMiscData%GridOutputs) if (.not. allocated(DstMiscData%GridOutputs)) then allocate(DstMiscData%GridOutputs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2418,16 +2435,16 @@ subroutine FVW_DestroyMisc(MiscData, ErrStat, ErrMsg) type(FVW_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(MiscData%W)) then - LB(1:1) = lbound(MiscData%W, kind=B8Ki) - UB(1:1) = ubound(MiscData%W, kind=B8Ki) + LB(1:1) = lbound(MiscData%W) + UB(1:1) = ubound(MiscData%W) do i1 = LB(1), UB(1) call FVW_DestroyWng_MiscVarType(MiscData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2454,8 +2471,8 @@ subroutine FVW_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%Uind) end if if (allocated(MiscData%GridOutputs)) then - LB(1:1) = lbound(MiscData%GridOutputs, kind=B8Ki) - UB(1:1) = ubound(MiscData%GridOutputs, kind=B8Ki) + LB(1:1) = lbound(MiscData%GridOutputs) + UB(1:1) = ubound(MiscData%GridOutputs) do i1 = LB(1), UB(1) call FVW_DestroyGridOutType(MiscData%GridOutputs(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2468,14 +2485,14 @@ subroutine FVW_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(FVW_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) - LB(1:1) = lbound(InData%W, kind=B8Ki) - UB(1:1) = ubound(InData%W, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) do i1 = LB(1), UB(1) call FVW_PackWng_MiscVarType(RF, InData%W(i1)) end do @@ -2501,9 +2518,9 @@ subroutine FVW_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%Uind) call RegPack(RF, allocated(InData%GridOutputs)) if (allocated(InData%GridOutputs)) then - call RegPackBounds(RF, 1, lbound(InData%GridOutputs, kind=B8Ki), ubound(InData%GridOutputs, kind=B8Ki)) - LB(1:1) = lbound(InData%GridOutputs, kind=B8Ki) - UB(1:1) = ubound(InData%GridOutputs, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%GridOutputs), ubound(InData%GridOutputs)) + LB(1:1) = lbound(InData%GridOutputs) + UB(1:1) = ubound(InData%GridOutputs) do i1 = LB(1), UB(1) call FVW_PackGridOutType(RF, InData%GridOutputs(i1)) end do @@ -2516,8 +2533,8 @@ subroutine FVW_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(FVW_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2616,14 +2633,14 @@ subroutine FVW_CopyWng_InputType(SrcWng_InputTypeData, DstWng_InputTypeData, Ctr integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyWng_InputType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_InputTypeData%Vwnd_LL)) then - LB(1:2) = lbound(SrcWng_InputTypeData%Vwnd_LL, kind=B8Ki) - UB(1:2) = ubound(SrcWng_InputTypeData%Vwnd_LL, kind=B8Ki) + LB(1:2) = lbound(SrcWng_InputTypeData%Vwnd_LL) + UB(1:2) = ubound(SrcWng_InputTypeData%Vwnd_LL) if (.not. allocated(DstWng_InputTypeData%Vwnd_LL)) then allocate(DstWng_InputTypeData%Vwnd_LL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2634,8 +2651,8 @@ subroutine FVW_CopyWng_InputType(SrcWng_InputTypeData, DstWng_InputTypeData, Ctr DstWng_InputTypeData%Vwnd_LL = SrcWng_InputTypeData%Vwnd_LL end if if (allocated(SrcWng_InputTypeData%omega_z)) then - LB(1:1) = lbound(SrcWng_InputTypeData%omega_z, kind=B8Ki) - UB(1:1) = ubound(SrcWng_InputTypeData%omega_z, kind=B8Ki) + LB(1:1) = lbound(SrcWng_InputTypeData%omega_z) + UB(1:1) = ubound(SrcWng_InputTypeData%omega_z) if (.not. allocated(DstWng_InputTypeData%omega_z)) then allocate(DstWng_InputTypeData%omega_z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2676,7 +2693,7 @@ subroutine FVW_UnPackWng_InputType(RF, OutData) type(RegFile), intent(inout) :: RF type(Wng_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_InputType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2690,16 +2707,16 @@ subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%rotors)) then - LB(1:1) = lbound(SrcInputData%rotors, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%rotors, kind=B8Ki) + 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 @@ -2714,8 +2731,8 @@ subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%W)) then - LB(1:1) = lbound(SrcInputData%W, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%W, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%W) + UB(1:1) = ubound(SrcInputData%W) if (.not. allocated(DstInputData%W)) then allocate(DstInputData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2730,8 +2747,8 @@ subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%WingsMesh)) then - LB(1:1) = lbound(SrcInputData%WingsMesh, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%WingsMesh, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%WingsMesh) + UB(1:1) = ubound(SrcInputData%WingsMesh) if (.not. allocated(DstInputData%WingsMesh)) then allocate(DstInputData%WingsMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2746,8 +2763,8 @@ subroutine FVW_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%V_wind)) then - LB(1:2) = lbound(SrcInputData%V_wind, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%V_wind, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%V_wind) + UB(1:2) = ubound(SrcInputData%V_wind) if (.not. allocated(DstInputData%V_wind)) then allocate(DstInputData%V_wind(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2763,16 +2780,16 @@ subroutine FVW_DestroyInput(InputData, ErrStat, ErrMsg) type(FVW_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InputData%rotors)) then - LB(1:1) = lbound(InputData%rotors, kind=B8Ki) - UB(1:1) = ubound(InputData%rotors, kind=B8Ki) + LB(1:1) = lbound(InputData%rotors) + UB(1:1) = ubound(InputData%rotors) do i1 = LB(1), UB(1) call FVW_DestroyRot_InputType(InputData%rotors(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2780,8 +2797,8 @@ subroutine FVW_DestroyInput(InputData, ErrStat, ErrMsg) deallocate(InputData%rotors) end if if (allocated(InputData%W)) then - LB(1:1) = lbound(InputData%W, kind=B8Ki) - UB(1:1) = ubound(InputData%W, kind=B8Ki) + LB(1:1) = lbound(InputData%W) + UB(1:1) = ubound(InputData%W) do i1 = LB(1), UB(1) call FVW_DestroyWng_InputType(InputData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2789,8 +2806,8 @@ subroutine FVW_DestroyInput(InputData, ErrStat, ErrMsg) deallocate(InputData%W) end if if (allocated(InputData%WingsMesh)) then - LB(1:1) = lbound(InputData%WingsMesh, kind=B8Ki) - UB(1:1) = ubound(InputData%WingsMesh, kind=B8Ki) + LB(1:1) = lbound(InputData%WingsMesh) + UB(1:1) = ubound(InputData%WingsMesh) do i1 = LB(1), UB(1) call MeshDestroy( InputData%WingsMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2806,32 +2823,32 @@ subroutine FVW_PackInput(RF, Indata) type(RegFile), intent(inout) :: RF type(FVW_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + 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 - call RegPackBounds(RF, 1, lbound(InData%rotors, kind=B8Ki), ubound(InData%rotors, kind=B8Ki)) - LB(1:1) = lbound(InData%rotors, kind=B8Ki) - UB(1:1) = ubound(InData%rotors, kind=B8Ki) + 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 FVW_PackRot_InputType(RF, InData%rotors(i1)) end do end if call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) - LB(1:1) = lbound(InData%W, kind=B8Ki) - UB(1:1) = ubound(InData%W, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) do i1 = LB(1), UB(1) call FVW_PackWng_InputType(RF, InData%W(i1)) end do end if call RegPack(RF, allocated(InData%WingsMesh)) if (allocated(InData%WingsMesh)) then - call RegPackBounds(RF, 1, lbound(InData%WingsMesh, kind=B8Ki), ubound(InData%WingsMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%WingsMesh, kind=B8Ki) - UB(1:1) = ubound(InData%WingsMesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%WingsMesh), ubound(InData%WingsMesh)) + LB(1:1) = lbound(InData%WingsMesh) + UB(1:1) = ubound(InData%WingsMesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%WingsMesh(i1)) end do @@ -2844,8 +2861,8 @@ subroutine FVW_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(FVW_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2897,8 +2914,8 @@ subroutine FVW_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyDiscState' @@ -2906,8 +2923,8 @@ subroutine FVW_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSt ErrMsg = '' DstDiscStateData%Dummy = SrcDiscStateData%Dummy if (allocated(SrcDiscStateData%UA)) then - LB(1:1) = lbound(SrcDiscStateData%UA, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%UA, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%UA) + UB(1:1) = ubound(SrcDiscStateData%UA) if (.not. allocated(DstDiscStateData%UA)) then allocate(DstDiscStateData%UA(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2927,16 +2944,16 @@ subroutine FVW_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) type(FVW_DiscreteStateType), intent(inout) :: DiscStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(DiscStateData%UA)) then - LB(1:1) = lbound(DiscStateData%UA, kind=B8Ki) - UB(1:1) = ubound(DiscStateData%UA, kind=B8Ki) + LB(1:1) = lbound(DiscStateData%UA) + UB(1:1) = ubound(DiscStateData%UA) do i1 = LB(1), UB(1) call UA_DestroyDiscState(DiscStateData%UA(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2949,15 +2966,15 @@ subroutine FVW_PackDiscState(RF, Indata) type(RegFile), intent(inout) :: RF type(FVW_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%Dummy) call RegPack(RF, allocated(InData%UA)) if (allocated(InData%UA)) then - call RegPackBounds(RF, 1, lbound(InData%UA, kind=B8Ki), ubound(InData%UA, kind=B8Ki)) - LB(1:1) = lbound(InData%UA, kind=B8Ki) - UB(1:1) = ubound(InData%UA, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%UA), ubound(InData%UA)) + LB(1:1) = lbound(InData%UA) + UB(1:1) = ubound(InData%UA) do i1 = LB(1), UB(1) call UA_PackDiscState(RF, InData%UA(i1)) end do @@ -2969,8 +2986,8 @@ subroutine FVW_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(FVW_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2996,14 +3013,14 @@ subroutine FVW_CopyWng_ConstraintStateType(SrcWng_ConstraintStateTypeData, DstWn integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyWng_ConstraintStateType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_ConstraintStateTypeData%Gamma_LL)) then - LB(1:1) = lbound(SrcWng_ConstraintStateTypeData%Gamma_LL, kind=B8Ki) - UB(1:1) = ubound(SrcWng_ConstraintStateTypeData%Gamma_LL, kind=B8Ki) + LB(1:1) = lbound(SrcWng_ConstraintStateTypeData%Gamma_LL) + UB(1:1) = ubound(SrcWng_ConstraintStateTypeData%Gamma_LL) if (.not. allocated(DstWng_ConstraintStateTypeData%Gamma_LL)) then allocate(DstWng_ConstraintStateTypeData%Gamma_LL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3040,7 +3057,7 @@ subroutine FVW_UnPackWng_ConstraintStateType(RF, OutData) type(RegFile), intent(inout) :: RF type(Wng_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_ConstraintStateType' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3053,16 +3070,16 @@ subroutine FVW_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcConstrStateData%W)) then - LB(1:1) = lbound(SrcConstrStateData%W, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%W, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%W) + UB(1:1) = ubound(SrcConstrStateData%W) if (.not. allocated(DstConstrStateData%W)) then allocate(DstConstrStateData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3083,16 +3100,16 @@ subroutine FVW_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) type(FVW_ConstraintStateType), intent(inout) :: ConstrStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ConstrStateData%W)) then - LB(1:1) = lbound(ConstrStateData%W, kind=B8Ki) - UB(1:1) = ubound(ConstrStateData%W, kind=B8Ki) + LB(1:1) = lbound(ConstrStateData%W) + UB(1:1) = ubound(ConstrStateData%W) do i1 = LB(1), UB(1) call FVW_DestroyWng_ConstraintStateType(ConstrStateData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3105,14 +3122,14 @@ subroutine FVW_PackConstrState(RF, Indata) type(RegFile), intent(inout) :: RF type(FVW_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackConstrState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) - LB(1:1) = lbound(InData%W, kind=B8Ki) - UB(1:1) = ubound(InData%W, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) do i1 = LB(1), UB(1) call FVW_PackWng_ConstraintStateType(RF, InData%W(i1)) end do @@ -3125,8 +3142,8 @@ subroutine FVW_UnPackConstrState(RF, OutData) type(RegFile), intent(inout) :: RF type(FVW_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackConstrState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3152,8 +3169,8 @@ subroutine FVW_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyOtherState' @@ -3161,8 +3178,8 @@ subroutine FVW_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er ErrMsg = '' DstOtherStateData%Dummy = SrcOtherStateData%Dummy if (allocated(SrcOtherStateData%UA)) then - LB(1:1) = lbound(SrcOtherStateData%UA, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%UA, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%UA) + UB(1:1) = ubound(SrcOtherStateData%UA) if (.not. allocated(DstOtherStateData%UA)) then allocate(DstOtherStateData%UA(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3182,16 +3199,16 @@ subroutine FVW_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(FVW_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%UA)) then - LB(1:1) = lbound(OtherStateData%UA, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%UA, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%UA) + UB(1:1) = ubound(OtherStateData%UA) do i1 = LB(1), UB(1) call UA_DestroyOtherState(OtherStateData%UA(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3204,15 +3221,15 @@ subroutine FVW_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(FVW_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%Dummy) call RegPack(RF, allocated(InData%UA)) if (allocated(InData%UA)) then - call RegPackBounds(RF, 1, lbound(InData%UA, kind=B8Ki), ubound(InData%UA, kind=B8Ki)) - LB(1:1) = lbound(InData%UA, kind=B8Ki) - UB(1:1) = ubound(InData%UA, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%UA), ubound(InData%UA)) + LB(1:1) = lbound(InData%UA) + UB(1:1) = ubound(InData%UA) do i1 = LB(1), UB(1) call UA_PackOtherState(RF, InData%UA(i1)) end do @@ -3224,8 +3241,8 @@ subroutine FVW_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(FVW_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3251,14 +3268,14 @@ subroutine FVW_CopyWng_InitInputType(SrcWng_InitInputTypeData, DstWng_InitInputT integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FVW_CopyWng_InitInputType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcWng_InitInputTypeData%AFindx)) then - LB(1:2) = lbound(SrcWng_InitInputTypeData%AFindx, kind=B8Ki) - UB(1:2) = ubound(SrcWng_InitInputTypeData%AFindx, kind=B8Ki) + LB(1:2) = lbound(SrcWng_InitInputTypeData%AFindx) + UB(1:2) = ubound(SrcWng_InitInputTypeData%AFindx) if (.not. allocated(DstWng_InitInputTypeData%AFindx)) then allocate(DstWng_InitInputTypeData%AFindx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3269,8 +3286,8 @@ subroutine FVW_CopyWng_InitInputType(SrcWng_InitInputTypeData, DstWng_InitInputT DstWng_InitInputTypeData%AFindx = SrcWng_InitInputTypeData%AFindx end if if (allocated(SrcWng_InitInputTypeData%chord)) then - LB(1:1) = lbound(SrcWng_InitInputTypeData%chord, kind=B8Ki) - UB(1:1) = ubound(SrcWng_InitInputTypeData%chord, kind=B8Ki) + LB(1:1) = lbound(SrcWng_InitInputTypeData%chord) + UB(1:1) = ubound(SrcWng_InitInputTypeData%chord) if (.not. allocated(DstWng_InitInputTypeData%chord)) then allocate(DstWng_InitInputTypeData%chord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3281,8 +3298,8 @@ subroutine FVW_CopyWng_InitInputType(SrcWng_InitInputTypeData, DstWng_InitInputT DstWng_InitInputTypeData%chord = SrcWng_InitInputTypeData%chord end if if (allocated(SrcWng_InitInputTypeData%RElm)) then - LB(1:1) = lbound(SrcWng_InitInputTypeData%RElm, kind=B8Ki) - UB(1:1) = ubound(SrcWng_InitInputTypeData%RElm, kind=B8Ki) + LB(1:1) = lbound(SrcWng_InitInputTypeData%RElm) + UB(1:1) = ubound(SrcWng_InitInputTypeData%RElm) if (.not. allocated(DstWng_InitInputTypeData%RElm)) then allocate(DstWng_InitInputTypeData%RElm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3333,7 +3350,7 @@ subroutine FVW_UnPackWng_InitInputType(RF, OutData) type(RegFile), intent(inout) :: RF type(Wng_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackWng_InitInputType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3351,8 +3368,8 @@ subroutine FVW_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CopyInitInput' @@ -3361,8 +3378,8 @@ subroutine FVW_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%FVWFileName = SrcInitInputData%FVWFileName DstInitInputData%RootName = SrcInitInputData%RootName if (allocated(SrcInitInputData%W)) then - LB(1:1) = lbound(SrcInitInputData%W, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%W, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%W) + UB(1:1) = ubound(SrcInitInputData%W) if (.not. allocated(DstInitInputData%W)) then allocate(DstInitInputData%W(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3377,8 +3394,8 @@ subroutine FVW_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt end do end if if (allocated(SrcInitInputData%WingsMesh)) then - LB(1:1) = lbound(SrcInitInputData%WingsMesh, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%WingsMesh, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%WingsMesh) + UB(1:1) = ubound(SrcInitInputData%WingsMesh) if (.not. allocated(DstInitInputData%WingsMesh)) then allocate(DstInitInputData%WingsMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3407,16 +3424,16 @@ subroutine FVW_DestroyInitInput(InitInputData, ErrStat, ErrMsg) type(FVW_InitInputType), intent(inout) :: InitInputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InitInputData%W)) then - LB(1:1) = lbound(InitInputData%W, kind=B8Ki) - UB(1:1) = ubound(InitInputData%W, kind=B8Ki) + LB(1:1) = lbound(InitInputData%W) + UB(1:1) = ubound(InitInputData%W) do i1 = LB(1), UB(1) call FVW_DestroyWng_InitInputType(InitInputData%W(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3424,8 +3441,8 @@ subroutine FVW_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%W) end if if (allocated(InitInputData%WingsMesh)) then - LB(1:1) = lbound(InitInputData%WingsMesh, kind=B8Ki) - UB(1:1) = ubound(InitInputData%WingsMesh, kind=B8Ki) + LB(1:1) = lbound(InitInputData%WingsMesh) + UB(1:1) = ubound(InitInputData%WingsMesh) do i1 = LB(1), UB(1) call MeshDestroy( InitInputData%WingsMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3440,25 +3457,25 @@ subroutine FVW_PackInitInput(RF, Indata) type(RegFile), intent(inout) :: RF type(FVW_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'FVW_PackInitInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%FVWFileName) call RegPack(RF, InData%RootName) call RegPack(RF, allocated(InData%W)) if (allocated(InData%W)) then - call RegPackBounds(RF, 1, lbound(InData%W, kind=B8Ki), ubound(InData%W, kind=B8Ki)) - LB(1:1) = lbound(InData%W, kind=B8Ki) - UB(1:1) = ubound(InData%W, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%W), ubound(InData%W)) + LB(1:1) = lbound(InData%W) + UB(1:1) = ubound(InData%W) do i1 = LB(1), UB(1) call FVW_PackWng_InitInputType(RF, InData%W(i1)) end do end if call RegPack(RF, allocated(InData%WingsMesh)) if (allocated(InData%WingsMesh)) then - call RegPackBounds(RF, 1, lbound(InData%WingsMesh, kind=B8Ki), ubound(InData%WingsMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%WingsMesh, kind=B8Ki) - UB(1:1) = ubound(InData%WingsMesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%WingsMesh), ubound(InData%WingsMesh)) + LB(1:1) = lbound(InData%WingsMesh) + UB(1:1) = ubound(InData%WingsMesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%WingsMesh(i1)) end do @@ -3477,8 +3494,8 @@ subroutine FVW_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(FVW_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FVW_UnPackInitInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3788,27 +3805,27 @@ SUBROUTINE FVW_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) u_out%rotors(i01)%HubOrientation = a1*u1%rotors(i01)%HubOrientation + a2*u2%rotors(i01)%HubOrientation END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) u_out%rotors(i01)%HubPosition = a1*u1%rotors(i01)%HubPosition + a2*u2%rotors(i01)%HubPosition END DO END IF ! check if allocated IF (ALLOCATED(u_out%W) .AND. ALLOCATED(u1%W)) THEN - DO i01 = LBOUND(u_out%W,1, kind=B8Ki),UBOUND(u_out%W,1, kind=B8Ki) + do i01 = lbound(u_out%W,1),ubound(u_out%W,1) IF (ALLOCATED(u_out%W(i01)%Vwnd_LL) .AND. ALLOCATED(u1%W(i01)%Vwnd_LL)) THEN u_out%W(i01)%Vwnd_LL = a1*u1%W(i01)%Vwnd_LL + a2*u2%W(i01)%Vwnd_LL END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%W,1, kind=B8Ki),UBOUND(u_out%W,1, kind=B8Ki) + do i01 = lbound(u_out%W,1),ubound(u_out%W,1) IF (ALLOCATED(u_out%W(i01)%omega_z) .AND. ALLOCATED(u1%W(i01)%omega_z)) THEN u_out%W(i01)%omega_z = a1*u1%W(i01)%omega_z + a2*u2%W(i01)%omega_z END IF ! check if allocated END DO END IF ! check if allocated IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN - DO i1 = LBOUND(u_out%WingsMesh,1, kind=B8Ki),UBOUND(u_out%WingsMesh,1, kind=B8Ki) + do i1 = lbound(u_out%WingsMesh,1),ubound(u_out%WingsMesh,1) CALL MeshExtrapInterp1(u1%WingsMesh(i1), u2%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -3876,27 +3893,27 @@ SUBROUTINE FVW_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(u_out%rotors) .AND. ALLOCATED(u1%rotors)) THEN - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) u_out%rotors(i01)%HubOrientation = a1*u1%rotors(i01)%HubOrientation + a2*u2%rotors(i01)%HubOrientation + a3*u3%rotors(i01)%HubOrientation END DO - DO i01 = LBOUND(u_out%rotors,1, kind=B8Ki),UBOUND(u_out%rotors,1, kind=B8Ki) + do i01 = lbound(u_out%rotors,1),ubound(u_out%rotors,1) u_out%rotors(i01)%HubPosition = a1*u1%rotors(i01)%HubPosition + a2*u2%rotors(i01)%HubPosition + a3*u3%rotors(i01)%HubPosition END DO END IF ! check if allocated IF (ALLOCATED(u_out%W) .AND. ALLOCATED(u1%W)) THEN - DO i01 = LBOUND(u_out%W,1, kind=B8Ki),UBOUND(u_out%W,1, kind=B8Ki) + do i01 = lbound(u_out%W,1),ubound(u_out%W,1) IF (ALLOCATED(u_out%W(i01)%Vwnd_LL) .AND. ALLOCATED(u1%W(i01)%Vwnd_LL)) THEN u_out%W(i01)%Vwnd_LL = a1*u1%W(i01)%Vwnd_LL + a2*u2%W(i01)%Vwnd_LL + a3*u3%W(i01)%Vwnd_LL END IF ! check if allocated END DO - DO i01 = LBOUND(u_out%W,1, kind=B8Ki),UBOUND(u_out%W,1, kind=B8Ki) + do i01 = lbound(u_out%W,1),ubound(u_out%W,1) IF (ALLOCATED(u_out%W(i01)%omega_z) .AND. ALLOCATED(u1%W(i01)%omega_z)) THEN u_out%W(i01)%omega_z = a1*u1%W(i01)%omega_z + a2*u2%W(i01)%omega_z + a3*u3%W(i01)%omega_z END IF ! check if allocated END DO END IF ! check if allocated IF (ALLOCATED(u_out%WingsMesh) .AND. ALLOCATED(u1%WingsMesh)) THEN - DO i1 = LBOUND(u_out%WingsMesh,1, kind=B8Ki),UBOUND(u_out%WingsMesh,1, kind=B8Ki) + do i1 = lbound(u_out%WingsMesh,1),ubound(u_out%WingsMesh,1) CALL MeshExtrapInterp2(u1%WingsMesh(i1), u2%WingsMesh(i1), u3%WingsMesh(i1), tin, u_out%WingsMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -4006,7 +4023,7 @@ SUBROUTINE FVW_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(y_out%W) .AND. ALLOCATED(y1%W)) THEN - DO i01 = LBOUND(y_out%W,1, kind=B8Ki),UBOUND(y_out%W,1, kind=B8Ki) + do i01 = lbound(y_out%W,1),ubound(y_out%W,1) IF (ALLOCATED(y_out%W(i01)%Vind) .AND. ALLOCATED(y1%W(i01)%Vind)) THEN y_out%W(i01)%Vind = a1*y1%W(i01)%Vind + a2*y2%W(i01)%Vind END IF ! check if allocated @@ -4072,12 +4089,370 @@ SUBROUTINE FVW_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%W) .AND. ALLOCATED(y1%W)) THEN - DO i01 = LBOUND(y_out%W,1, kind=B8Ki),UBOUND(y_out%W,1, kind=B8Ki) + do i01 = lbound(y_out%W,1),ubound(y_out%W,1) IF (ALLOCATED(y_out%W(i01)%Vind) .AND. ALLOCATED(y1%W(i01)%Vind)) THEN y_out%W(i01)%Vind = a1*y1%W(i01)%Vind + a2*y2%W(i01)%Vind + a3*y3%W(i01)%Vind END IF ! check if allocated END DO END IF ! check if allocated END SUBROUTINE + +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 1d46fdb26d..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 @@ -257,7 +272,7 @@ subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'UA_CopyInitInput' ErrStat = ErrID_None @@ -265,8 +280,8 @@ subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%dt = SrcInitInputData%dt DstInitInputData%OutRootName = SrcInitInputData%OutRootName if (allocated(SrcInitInputData%c)) then - LB(1:2) = lbound(SrcInitInputData%c, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%c, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%c) + UB(1:2) = ubound(SrcInitInputData%c) if (.not. allocated(DstInitInputData%c)) then allocate(DstInitInputData%c(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -285,8 +300,8 @@ subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%ShedEffect = SrcInitInputData%ShedEffect DstInitInputData%WrSum = SrcInitInputData%WrSum if (allocated(SrcInitInputData%UAOff_innerNode)) then - LB(1:1) = lbound(SrcInitInputData%UAOff_innerNode, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%UAOff_innerNode, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%UAOff_innerNode) + UB(1:1) = ubound(SrcInitInputData%UAOff_innerNode) if (.not. allocated(DstInitInputData%UAOff_innerNode)) then allocate(DstInitInputData%UAOff_innerNode(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -297,8 +312,8 @@ subroutine UA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%UAOff_innerNode = SrcInitInputData%UAOff_innerNode end if if (allocated(SrcInitInputData%UAOff_outerNode)) then - LB(1:1) = lbound(SrcInitInputData%UAOff_outerNode, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%UAOff_outerNode, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%UAOff_outerNode) + UB(1:1) = ubound(SrcInitInputData%UAOff_outerNode) if (.not. allocated(DstInitInputData%UAOff_outerNode)) then allocate(DstInitInputData%UAOff_outerNode(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -357,7 +372,7 @@ subroutine UA_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(UA_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackInitInput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -384,7 +399,7 @@ subroutine UA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'UA_CopyInitOutput' @@ -394,8 +409,8 @@ subroutine UA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -406,8 +421,8 @@ subroutine UA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -453,7 +468,7 @@ subroutine UA_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(UA_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -694,16 +709,16 @@ subroutine UA_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'UA_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%element)) then - LB(1:2) = lbound(SrcContStateData%element, kind=B8Ki) - UB(1:2) = ubound(SrcContStateData%element, kind=B8Ki) + LB(1:2) = lbound(SrcContStateData%element) + UB(1:2) = ubound(SrcContStateData%element) if (.not. allocated(DstContStateData%element)) then allocate(DstContStateData%element(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -725,16 +740,16 @@ subroutine UA_DestroyContState(ContStateData, ErrStat, ErrMsg) type(UA_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'UA_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%element)) then - LB(1:2) = lbound(ContStateData%element, kind=B8Ki) - UB(1:2) = ubound(ContStateData%element, kind=B8Ki) + LB(1:2) = lbound(ContStateData%element) + UB(1:2) = ubound(ContStateData%element) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call UA_DestroyElementContinuousStateType(ContStateData%element(i1,i2), ErrStat2, ErrMsg2) @@ -749,14 +764,14 @@ subroutine UA_PackContState(RF, Indata) type(RegFile), intent(inout) :: RF type(UA_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackContState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%element)) if (allocated(InData%element)) then - call RegPackBounds(RF, 2, lbound(InData%element, kind=B8Ki), ubound(InData%element, kind=B8Ki)) - LB(1:2) = lbound(InData%element, kind=B8Ki) - UB(1:2) = ubound(InData%element, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%element), ubound(InData%element)) + LB(1:2) = lbound(InData%element) + UB(1:2) = ubound(InData%element) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call UA_PackElementContinuousStateType(RF, InData%element(i1,i2)) @@ -770,8 +785,8 @@ subroutine UA_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(UA_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackContState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -798,14 +813,14 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'UA_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%alpha_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%alpha_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%alpha_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%alpha_minus1) + UB(1:2) = ubound(SrcDiscStateData%alpha_minus1) if (.not. allocated(DstDiscStateData%alpha_minus1)) then allocate(DstDiscStateData%alpha_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -816,8 +831,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%alpha_minus1 = SrcDiscStateData%alpha_minus1 end if if (allocated(SrcDiscStateData%alpha_filt_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%alpha_filt_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%alpha_filt_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%alpha_filt_minus1) + UB(1:2) = ubound(SrcDiscStateData%alpha_filt_minus1) if (.not. allocated(DstDiscStateData%alpha_filt_minus1)) then allocate(DstDiscStateData%alpha_filt_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -828,8 +843,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%alpha_filt_minus1 = SrcDiscStateData%alpha_filt_minus1 end if if (allocated(SrcDiscStateData%alpha_dot)) then - LB(1:2) = lbound(SrcDiscStateData%alpha_dot, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%alpha_dot, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%alpha_dot) + UB(1:2) = ubound(SrcDiscStateData%alpha_dot) if (.not. allocated(DstDiscStateData%alpha_dot)) then allocate(DstDiscStateData%alpha_dot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -840,8 +855,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%alpha_dot = SrcDiscStateData%alpha_dot end if if (allocated(SrcDiscStateData%alpha_dot_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%alpha_dot_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%alpha_dot_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%alpha_dot_minus1) + UB(1:2) = ubound(SrcDiscStateData%alpha_dot_minus1) if (.not. allocated(DstDiscStateData%alpha_dot_minus1)) then allocate(DstDiscStateData%alpha_dot_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -852,8 +867,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%alpha_dot_minus1 = SrcDiscStateData%alpha_dot_minus1 end if if (allocated(SrcDiscStateData%q_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%q_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%q_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%q_minus1) + UB(1:2) = ubound(SrcDiscStateData%q_minus1) if (.not. allocated(DstDiscStateData%q_minus1)) then allocate(DstDiscStateData%q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -864,8 +879,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%q_minus1 = SrcDiscStateData%q_minus1 end if if (allocated(SrcDiscStateData%Kalpha_f_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Kalpha_f_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Kalpha_f_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Kalpha_f_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kalpha_f_minus1) if (.not. allocated(DstDiscStateData%Kalpha_f_minus1)) then allocate(DstDiscStateData%Kalpha_f_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -876,8 +891,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Kalpha_f_minus1 = SrcDiscStateData%Kalpha_f_minus1 end if if (allocated(SrcDiscStateData%Kq_f_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Kq_f_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Kq_f_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Kq_f_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kq_f_minus1) if (.not. allocated(DstDiscStateData%Kq_f_minus1)) then allocate(DstDiscStateData%Kq_f_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -888,8 +903,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Kq_f_minus1 = SrcDiscStateData%Kq_f_minus1 end if if (allocated(SrcDiscStateData%q_f_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%q_f_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%q_f_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%q_f_minus1) + UB(1:2) = ubound(SrcDiscStateData%q_f_minus1) if (.not. allocated(DstDiscStateData%q_f_minus1)) then allocate(DstDiscStateData%q_f_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -900,8 +915,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%q_f_minus1 = SrcDiscStateData%q_f_minus1 end if if (allocated(SrcDiscStateData%X1_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%X1_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%X1_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%X1_minus1) + UB(1:2) = ubound(SrcDiscStateData%X1_minus1) if (.not. allocated(DstDiscStateData%X1_minus1)) then allocate(DstDiscStateData%X1_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -912,8 +927,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%X1_minus1 = SrcDiscStateData%X1_minus1 end if if (allocated(SrcDiscStateData%X2_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%X2_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%X2_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%X2_minus1) + UB(1:2) = ubound(SrcDiscStateData%X2_minus1) if (.not. allocated(DstDiscStateData%X2_minus1)) then allocate(DstDiscStateData%X2_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -924,8 +939,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%X2_minus1 = SrcDiscStateData%X2_minus1 end if if (allocated(SrcDiscStateData%X3_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%X3_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%X3_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%X3_minus1) + UB(1:2) = ubound(SrcDiscStateData%X3_minus1) if (.not. allocated(DstDiscStateData%X3_minus1)) then allocate(DstDiscStateData%X3_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -936,8 +951,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%X3_minus1 = SrcDiscStateData%X3_minus1 end if if (allocated(SrcDiscStateData%X4_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%X4_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%X4_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%X4_minus1) + UB(1:2) = ubound(SrcDiscStateData%X4_minus1) if (.not. allocated(DstDiscStateData%X4_minus1)) then allocate(DstDiscStateData%X4_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -948,8 +963,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%X4_minus1 = SrcDiscStateData%X4_minus1 end if if (allocated(SrcDiscStateData%Kprime_alpha_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Kprime_alpha_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Kprime_alpha_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Kprime_alpha_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kprime_alpha_minus1) if (.not. allocated(DstDiscStateData%Kprime_alpha_minus1)) then allocate(DstDiscStateData%Kprime_alpha_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -960,8 +975,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Kprime_alpha_minus1 = SrcDiscStateData%Kprime_alpha_minus1 end if if (allocated(SrcDiscStateData%Kprime_q_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Kprime_q_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Kprime_q_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Kprime_q_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kprime_q_minus1) if (.not. allocated(DstDiscStateData%Kprime_q_minus1)) then allocate(DstDiscStateData%Kprime_q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -972,8 +987,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Kprime_q_minus1 = SrcDiscStateData%Kprime_q_minus1 end if if (allocated(SrcDiscStateData%Kprimeprime_q_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Kprimeprime_q_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Kprimeprime_q_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Kprimeprime_q_minus1) + UB(1:2) = ubound(SrcDiscStateData%Kprimeprime_q_minus1) if (.not. allocated(DstDiscStateData%Kprimeprime_q_minus1)) then allocate(DstDiscStateData%Kprimeprime_q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -984,8 +999,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Kprimeprime_q_minus1 = SrcDiscStateData%Kprimeprime_q_minus1 end if if (allocated(SrcDiscStateData%K3prime_q_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%K3prime_q_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%K3prime_q_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%K3prime_q_minus1) + UB(1:2) = ubound(SrcDiscStateData%K3prime_q_minus1) if (.not. allocated(DstDiscStateData%K3prime_q_minus1)) then allocate(DstDiscStateData%K3prime_q_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -996,8 +1011,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%K3prime_q_minus1 = SrcDiscStateData%K3prime_q_minus1 end if if (allocated(SrcDiscStateData%Dp_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Dp_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Dp_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Dp_minus1) + UB(1:2) = ubound(SrcDiscStateData%Dp_minus1) if (.not. allocated(DstDiscStateData%Dp_minus1)) then allocate(DstDiscStateData%Dp_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1008,8 +1023,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Dp_minus1 = SrcDiscStateData%Dp_minus1 end if if (allocated(SrcDiscStateData%Cn_pot_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Cn_pot_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Cn_pot_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Cn_pot_minus1) + UB(1:2) = ubound(SrcDiscStateData%Cn_pot_minus1) if (.not. allocated(DstDiscStateData%Cn_pot_minus1)) then allocate(DstDiscStateData%Cn_pot_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1020,8 +1035,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Cn_pot_minus1 = SrcDiscStateData%Cn_pot_minus1 end if if (allocated(SrcDiscStateData%fprimeprime_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%fprimeprime_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%fprimeprime_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%fprimeprime_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprimeprime_minus1) if (.not. allocated(DstDiscStateData%fprimeprime_minus1)) then allocate(DstDiscStateData%fprimeprime_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1032,8 +1047,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%fprimeprime_minus1 = SrcDiscStateData%fprimeprime_minus1 end if if (allocated(SrcDiscStateData%fprimeprime_c_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%fprimeprime_c_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%fprimeprime_c_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%fprimeprime_c_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprimeprime_c_minus1) if (.not. allocated(DstDiscStateData%fprimeprime_c_minus1)) then allocate(DstDiscStateData%fprimeprime_c_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1044,8 +1059,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%fprimeprime_c_minus1 = SrcDiscStateData%fprimeprime_c_minus1 end if if (allocated(SrcDiscStateData%fprimeprime_m_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%fprimeprime_m_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%fprimeprime_m_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%fprimeprime_m_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprimeprime_m_minus1) if (.not. allocated(DstDiscStateData%fprimeprime_m_minus1)) then allocate(DstDiscStateData%fprimeprime_m_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1056,8 +1071,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%fprimeprime_m_minus1 = SrcDiscStateData%fprimeprime_m_minus1 end if if (allocated(SrcDiscStateData%Df_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Df_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Df_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Df_minus1) + UB(1:2) = ubound(SrcDiscStateData%Df_minus1) if (.not. allocated(DstDiscStateData%Df_minus1)) then allocate(DstDiscStateData%Df_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1068,8 +1083,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Df_minus1 = SrcDiscStateData%Df_minus1 end if if (allocated(SrcDiscStateData%Df_c_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Df_c_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Df_c_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Df_c_minus1) + UB(1:2) = ubound(SrcDiscStateData%Df_c_minus1) if (.not. allocated(DstDiscStateData%Df_c_minus1)) then allocate(DstDiscStateData%Df_c_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1080,8 +1095,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Df_c_minus1 = SrcDiscStateData%Df_c_minus1 end if if (allocated(SrcDiscStateData%Df_m_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Df_m_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Df_m_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Df_m_minus1) + UB(1:2) = ubound(SrcDiscStateData%Df_m_minus1) if (.not. allocated(DstDiscStateData%Df_m_minus1)) then allocate(DstDiscStateData%Df_m_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1092,8 +1107,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Df_m_minus1 = SrcDiscStateData%Df_m_minus1 end if if (allocated(SrcDiscStateData%Dalphaf_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Dalphaf_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Dalphaf_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Dalphaf_minus1) + UB(1:2) = ubound(SrcDiscStateData%Dalphaf_minus1) if (.not. allocated(DstDiscStateData%Dalphaf_minus1)) then allocate(DstDiscStateData%Dalphaf_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1104,8 +1119,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Dalphaf_minus1 = SrcDiscStateData%Dalphaf_minus1 end if if (allocated(SrcDiscStateData%alphaf_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%alphaf_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%alphaf_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%alphaf_minus1) + UB(1:2) = ubound(SrcDiscStateData%alphaf_minus1) if (.not. allocated(DstDiscStateData%alphaf_minus1)) then allocate(DstDiscStateData%alphaf_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1116,8 +1131,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%alphaf_minus1 = SrcDiscStateData%alphaf_minus1 end if if (allocated(SrcDiscStateData%fprime_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%fprime_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%fprime_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%fprime_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprime_minus1) if (.not. allocated(DstDiscStateData%fprime_minus1)) then allocate(DstDiscStateData%fprime_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1128,8 +1143,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%fprime_minus1 = SrcDiscStateData%fprime_minus1 end if if (allocated(SrcDiscStateData%fprime_c_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%fprime_c_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%fprime_c_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%fprime_c_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprime_c_minus1) if (.not. allocated(DstDiscStateData%fprime_c_minus1)) then allocate(DstDiscStateData%fprime_c_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1140,8 +1155,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%fprime_c_minus1 = SrcDiscStateData%fprime_c_minus1 end if if (allocated(SrcDiscStateData%fprime_m_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%fprime_m_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%fprime_m_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%fprime_m_minus1) + UB(1:2) = ubound(SrcDiscStateData%fprime_m_minus1) if (.not. allocated(DstDiscStateData%fprime_m_minus1)) then allocate(DstDiscStateData%fprime_m_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1152,8 +1167,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%fprime_m_minus1 = SrcDiscStateData%fprime_m_minus1 end if if (allocated(SrcDiscStateData%tau_V)) then - LB(1:2) = lbound(SrcDiscStateData%tau_V, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%tau_V, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%tau_V) + UB(1:2) = ubound(SrcDiscStateData%tau_V) if (.not. allocated(DstDiscStateData%tau_V)) then allocate(DstDiscStateData%tau_V(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1164,8 +1179,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%tau_V = SrcDiscStateData%tau_V end if if (allocated(SrcDiscStateData%tau_V_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%tau_V_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%tau_V_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%tau_V_minus1) + UB(1:2) = ubound(SrcDiscStateData%tau_V_minus1) if (.not. allocated(DstDiscStateData%tau_V_minus1)) then allocate(DstDiscStateData%tau_V_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1176,8 +1191,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%tau_V_minus1 = SrcDiscStateData%tau_V_minus1 end if if (allocated(SrcDiscStateData%Cn_v_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Cn_v_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Cn_v_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Cn_v_minus1) + UB(1:2) = ubound(SrcDiscStateData%Cn_v_minus1) if (.not. allocated(DstDiscStateData%Cn_v_minus1)) then allocate(DstDiscStateData%Cn_v_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1188,8 +1203,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Cn_v_minus1 = SrcDiscStateData%Cn_v_minus1 end if if (allocated(SrcDiscStateData%C_V_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%C_V_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%C_V_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%C_V_minus1) + UB(1:2) = ubound(SrcDiscStateData%C_V_minus1) if (.not. allocated(DstDiscStateData%C_V_minus1)) then allocate(DstDiscStateData%C_V_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1200,8 +1215,8 @@ subroutine UA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%C_V_minus1 = SrcDiscStateData%C_V_minus1 end if if (allocated(SrcDiscStateData%Cn_prime_minus1)) then - LB(1:2) = lbound(SrcDiscStateData%Cn_prime_minus1, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Cn_prime_minus1, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Cn_prime_minus1) + UB(1:2) = ubound(SrcDiscStateData%Cn_prime_minus1) if (.not. allocated(DstDiscStateData%Cn_prime_minus1)) then allocate(DstDiscStateData%Cn_prime_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1370,7 +1385,7 @@ subroutine UA_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(UA_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackDiscState' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1454,16 +1469,16 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'UA_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%FirstPass)) then - LB(1:2) = lbound(SrcOtherStateData%FirstPass, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%FirstPass, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%FirstPass) + UB(1:2) = ubound(SrcOtherStateData%FirstPass) if (.not. allocated(DstOtherStateData%FirstPass)) then allocate(DstOtherStateData%FirstPass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1474,8 +1489,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%FirstPass = SrcOtherStateData%FirstPass end if if (allocated(SrcOtherStateData%sigma1)) then - LB(1:2) = lbound(SrcOtherStateData%sigma1, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%sigma1, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%sigma1) + UB(1:2) = ubound(SrcOtherStateData%sigma1) if (.not. allocated(DstOtherStateData%sigma1)) then allocate(DstOtherStateData%sigma1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1486,8 +1501,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%sigma1 = SrcOtherStateData%sigma1 end if if (allocated(SrcOtherStateData%sigma1c)) then - LB(1:2) = lbound(SrcOtherStateData%sigma1c, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%sigma1c, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%sigma1c) + UB(1:2) = ubound(SrcOtherStateData%sigma1c) if (.not. allocated(DstOtherStateData%sigma1c)) then allocate(DstOtherStateData%sigma1c(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1498,8 +1513,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%sigma1c = SrcOtherStateData%sigma1c end if if (allocated(SrcOtherStateData%sigma1m)) then - LB(1:2) = lbound(SrcOtherStateData%sigma1m, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%sigma1m, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%sigma1m) + UB(1:2) = ubound(SrcOtherStateData%sigma1m) if (.not. allocated(DstOtherStateData%sigma1m)) then allocate(DstOtherStateData%sigma1m(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1510,8 +1525,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%sigma1m = SrcOtherStateData%sigma1m end if if (allocated(SrcOtherStateData%sigma3)) then - LB(1:2) = lbound(SrcOtherStateData%sigma3, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%sigma3, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%sigma3) + UB(1:2) = ubound(SrcOtherStateData%sigma3) if (.not. allocated(DstOtherStateData%sigma3)) then allocate(DstOtherStateData%sigma3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1522,8 +1537,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%sigma3 = SrcOtherStateData%sigma3 end if if (allocated(SrcOtherStateData%n)) then - LB(1:2) = lbound(SrcOtherStateData%n, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%n, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%n) + UB(1:2) = ubound(SrcOtherStateData%n) if (.not. allocated(DstOtherStateData%n)) then allocate(DstOtherStateData%n(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1533,23 +1548,23 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err end if DstOtherStateData%n = SrcOtherStateData%n end if - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call UA_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcOtherStateData%xHistory, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xHistory, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xHistory) + UB(1:1) = ubound(SrcOtherStateData%xHistory) do i1 = LB(1), UB(1) call UA_CopyContState(SrcOtherStateData%xHistory(i1), DstOtherStateData%xHistory(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do if (allocated(SrcOtherStateData%t_vortexBegin)) then - LB(1:2) = lbound(SrcOtherStateData%t_vortexBegin, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%t_vortexBegin, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%t_vortexBegin) + UB(1:2) = ubound(SrcOtherStateData%t_vortexBegin) if (.not. allocated(DstOtherStateData%t_vortexBegin)) then allocate(DstOtherStateData%t_vortexBegin(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1560,8 +1575,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%t_vortexBegin = SrcOtherStateData%t_vortexBegin end if if (allocated(SrcOtherStateData%SignOfOmega)) then - LB(1:2) = lbound(SrcOtherStateData%SignOfOmega, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%SignOfOmega, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%SignOfOmega) + UB(1:2) = ubound(SrcOtherStateData%SignOfOmega) if (.not. allocated(DstOtherStateData%SignOfOmega)) then allocate(DstOtherStateData%SignOfOmega(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1572,8 +1587,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%SignOfOmega = SrcOtherStateData%SignOfOmega end if if (allocated(SrcOtherStateData%PositivePressure)) then - LB(1:2) = lbound(SrcOtherStateData%PositivePressure, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%PositivePressure, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%PositivePressure) + UB(1:2) = ubound(SrcOtherStateData%PositivePressure) if (.not. allocated(DstOtherStateData%PositivePressure)) then allocate(DstOtherStateData%PositivePressure(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1584,8 +1599,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%PositivePressure = SrcOtherStateData%PositivePressure end if if (allocated(SrcOtherStateData%vortexOn)) then - LB(1:2) = lbound(SrcOtherStateData%vortexOn, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%vortexOn, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%vortexOn) + UB(1:2) = ubound(SrcOtherStateData%vortexOn) if (.not. allocated(DstOtherStateData%vortexOn)) then allocate(DstOtherStateData%vortexOn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1596,8 +1611,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%vortexOn = SrcOtherStateData%vortexOn end if if (allocated(SrcOtherStateData%BelowThreshold)) then - LB(1:2) = lbound(SrcOtherStateData%BelowThreshold, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%BelowThreshold, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%BelowThreshold) + UB(1:2) = ubound(SrcOtherStateData%BelowThreshold) if (.not. allocated(DstOtherStateData%BelowThreshold)) then allocate(DstOtherStateData%BelowThreshold(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1608,8 +1623,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%BelowThreshold = SrcOtherStateData%BelowThreshold end if if (allocated(SrcOtherStateData%activeL)) then - LB(1:2) = lbound(SrcOtherStateData%activeL, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%activeL, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%activeL) + UB(1:2) = ubound(SrcOtherStateData%activeL) if (.not. allocated(DstOtherStateData%activeL)) then allocate(DstOtherStateData%activeL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1620,8 +1635,8 @@ subroutine UA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%activeL = SrcOtherStateData%activeL end if if (allocated(SrcOtherStateData%activeD)) then - LB(1:2) = lbound(SrcOtherStateData%activeD, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%activeD, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%activeD) + UB(1:2) = ubound(SrcOtherStateData%activeD) if (.not. allocated(DstOtherStateData%activeD)) then allocate(DstOtherStateData%activeD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1637,8 +1652,8 @@ subroutine UA_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(UA_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'UA_DestroyOtherState' @@ -1662,14 +1677,14 @@ subroutine UA_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) if (allocated(OtherStateData%n)) then deallocate(OtherStateData%n) end if - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call UA_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(OtherStateData%xHistory, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xHistory, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xHistory) + UB(1:1) = ubound(OtherStateData%xHistory) do i1 = LB(1), UB(1) call UA_DestroyContState(OtherStateData%xHistory(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1701,8 +1716,8 @@ subroutine UA_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(UA_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'UA_PackOtherState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%FirstPass) call RegPackAlloc(RF, InData%sigma1) @@ -1710,13 +1725,13 @@ subroutine UA_PackOtherState(RF, Indata) call RegPackAlloc(RF, InData%sigma1m) call RegPackAlloc(RF, InData%sigma3) call RegPackAlloc(RF, InData%n) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call UA_PackContState(RF, InData%xdot(i1)) end do - LB(1:1) = lbound(InData%xHistory, kind=B8Ki) - UB(1:1) = ubound(InData%xHistory, kind=B8Ki) + LB(1:1) = lbound(InData%xHistory) + UB(1:1) = ubound(InData%xHistory) do i1 = LB(1), UB(1) call UA_PackContState(RF, InData%xHistory(i1)) end do @@ -1734,8 +1749,8 @@ subroutine UA_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(UA_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackOtherState' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1745,13 +1760,13 @@ subroutine UA_UnPackOtherState(RF, OutData) call RegUnpackAlloc(RF, OutData%sigma1m); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%sigma3); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return - LB(1:1) = lbound(OutData%xdot, kind=B8Ki) - UB(1:1) = ubound(OutData%xdot, kind=B8Ki) + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call UA_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do - LB(1:1) = lbound(OutData%xHistory, kind=B8Ki) - UB(1:1) = ubound(OutData%xHistory, kind=B8Ki) + LB(1:1) = lbound(OutData%xHistory) + UB(1:1) = ubound(OutData%xHistory) do i1 = LB(1), UB(1) call UA_UnpackContState(RF, OutData%xHistory(i1)) ! xHistory end do @@ -1770,7 +1785,7 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'UA_CopyMisc' ErrStat = ErrID_None @@ -1779,8 +1794,8 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FirstWarn_UA = SrcMiscData%FirstWarn_UA DstMiscData%FirstWarn_UA_off = SrcMiscData%FirstWarn_UA_off if (allocated(SrcMiscData%TESF)) then - LB(1:2) = lbound(SrcMiscData%TESF, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%TESF, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%TESF) + UB(1:2) = ubound(SrcMiscData%TESF) if (.not. allocated(DstMiscData%TESF)) then allocate(DstMiscData%TESF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1791,8 +1806,8 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%TESF = SrcMiscData%TESF end if if (allocated(SrcMiscData%LESF)) then - LB(1:2) = lbound(SrcMiscData%LESF, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%LESF, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%LESF) + UB(1:2) = ubound(SrcMiscData%LESF) if (.not. allocated(DstMiscData%LESF)) then allocate(DstMiscData%LESF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1803,8 +1818,8 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LESF = SrcMiscData%LESF end if if (allocated(SrcMiscData%VRTX)) then - LB(1:2) = lbound(SrcMiscData%VRTX, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%VRTX, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%VRTX) + UB(1:2) = ubound(SrcMiscData%VRTX) if (.not. allocated(DstMiscData%VRTX)) then allocate(DstMiscData%VRTX(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1815,8 +1830,8 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%VRTX = SrcMiscData%VRTX end if if (allocated(SrcMiscData%T_Sh)) then - LB(1:2) = lbound(SrcMiscData%T_Sh, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%T_Sh, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%T_Sh) + UB(1:2) = ubound(SrcMiscData%T_Sh) if (.not. allocated(DstMiscData%T_Sh)) then allocate(DstMiscData%T_Sh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1827,8 +1842,8 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%T_Sh = SrcMiscData%T_Sh end if if (allocated(SrcMiscData%BEDSEP)) then - LB(1:2) = lbound(SrcMiscData%BEDSEP, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%BEDSEP, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%BEDSEP) + UB(1:2) = ubound(SrcMiscData%BEDSEP) if (.not. allocated(DstMiscData%BEDSEP)) then allocate(DstMiscData%BEDSEP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1839,8 +1854,8 @@ subroutine UA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%BEDSEP = SrcMiscData%BEDSEP end if if (allocated(SrcMiscData%weight)) then - LB(1:2) = lbound(SrcMiscData%weight, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%weight, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%weight) + UB(1:2) = ubound(SrcMiscData%weight) if (.not. allocated(DstMiscData%weight)) then allocate(DstMiscData%weight(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1900,7 +1915,7 @@ subroutine UA_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(UA_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackMisc' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1921,15 +1936,15 @@ subroutine UA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'UA_CopyParam' ErrStat = ErrID_None ErrMsg = '' DstParamData%dt = SrcParamData%dt if (allocated(SrcParamData%c)) then - LB(1:2) = lbound(SrcParamData%c, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%c, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%c) + UB(1:2) = ubound(SrcParamData%c) if (.not. allocated(DstParamData%c)) then allocate(DstParamData%c(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1954,8 +1969,8 @@ subroutine UA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ShedEffect = SrcParamData%ShedEffect DstParamData%lin_nx = SrcParamData%lin_nx if (allocated(SrcParamData%UA_off_forGood)) then - LB(1:2) = lbound(SrcParamData%UA_off_forGood, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%UA_off_forGood, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%UA_off_forGood) + UB(1:2) = ubound(SrcParamData%UA_off_forGood) if (.not. allocated(DstParamData%UA_off_forGood)) then allocate(DstParamData%UA_off_forGood(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1966,8 +1981,8 @@ subroutine UA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%UA_off_forGood = SrcParamData%UA_off_forGood end if if (allocated(SrcParamData%lin_xIndx)) then - LB(1:2) = lbound(SrcParamData%lin_xIndx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%lin_xIndx, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%lin_xIndx) + UB(1:2) = ubound(SrcParamData%lin_xIndx) if (.not. allocated(DstParamData%lin_xIndx)) then allocate(DstParamData%lin_xIndx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2033,7 +2048,7 @@ subroutine UA_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(UA_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackParam' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2119,7 +2134,7 @@ subroutine UA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'UA_CopyOutput' ErrStat = ErrID_None @@ -2130,8 +2145,8 @@ subroutine UA_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%Cl = SrcOutputData%Cl DstOutputData%Cd = SrcOutputData%Cd if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -2173,7 +2188,7 @@ subroutine UA_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(UA_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'UA_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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 8f78bf78cf..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 @@ -260,14 +274,14 @@ subroutine AWAE_CopyHighWindGrid(SrcHighWindGridData, DstHighWindGridData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AWAE_CopyHighWindGrid' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcHighWindGridData%data)) then - LB(1:5) = lbound(SrcHighWindGridData%data, kind=B8Ki) - UB(1:5) = ubound(SrcHighWindGridData%data, kind=B8Ki) + LB(1:5) = lbound(SrcHighWindGridData%data) + UB(1:5) = ubound(SrcHighWindGridData%data) if (.not. associated(DstHighWindGridData%data)) then allocate(DstHighWindGridData%data(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -306,7 +320,7 @@ subroutine AWAE_UnPackHighWindGrid(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_HighWindGrid), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackHighWindGrid' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -321,7 +335,7 @@ subroutine AWAE_CopyHighWindGridPtr(SrcHighWindGridPtrData, DstHighWindGridPtrDa integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AWAE_CopyHighWindGridPtr' ErrStat = ErrID_None @@ -353,7 +367,7 @@ subroutine AWAE_UnPackHighWindGridPtr(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_HighWindGridPtr), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackHighWindGridPtr' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -368,7 +382,7 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AWAE_CopyInputFileType' ErrStat = ErrID_None @@ -382,8 +396,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%WrDisWind = SrcInputFileTypeData%WrDisWind DstInputFileTypeData%NOutDisWindXY = SrcInputFileTypeData%NOutDisWindXY if (allocated(SrcInputFileTypeData%OutDisWindZ)) then - LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindZ, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindZ, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindZ) + UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindZ) if (.not. allocated(DstInputFileTypeData%OutDisWindZ)) then allocate(DstInputFileTypeData%OutDisWindZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -395,8 +409,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct end if DstInputFileTypeData%NOutDisWindYZ = SrcInputFileTypeData%NOutDisWindYZ if (allocated(SrcInputFileTypeData%OutDisWindX)) then - LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindX, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindX, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindX) + UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindX) if (.not. allocated(DstInputFileTypeData%OutDisWindX)) then allocate(DstInputFileTypeData%OutDisWindX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -408,8 +422,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct end if DstInputFileTypeData%NOutDisWindXZ = SrcInputFileTypeData%NOutDisWindXZ if (allocated(SrcInputFileTypeData%OutDisWindY)) then - LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindY, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindY, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileTypeData%OutDisWindY) + UB(1:1) = ubound(SrcInputFileTypeData%OutDisWindY) if (.not. allocated(DstInputFileTypeData%OutDisWindY)) then allocate(DstInputFileTypeData%OutDisWindY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -427,8 +441,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%InflowFile = SrcInputFileTypeData%InflowFile DstInputFileTypeData%dt_high = SrcInputFileTypeData%dt_high if (allocated(SrcInputFileTypeData%X0_high)) then - LB(1:1) = lbound(SrcInputFileTypeData%X0_high, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileTypeData%X0_high, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileTypeData%X0_high) + UB(1:1) = ubound(SrcInputFileTypeData%X0_high) if (.not. allocated(DstInputFileTypeData%X0_high)) then allocate(DstInputFileTypeData%X0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -439,8 +453,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%X0_high = SrcInputFileTypeData%X0_high end if if (allocated(SrcInputFileTypeData%Y0_high)) then - LB(1:1) = lbound(SrcInputFileTypeData%Y0_high, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileTypeData%Y0_high, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileTypeData%Y0_high) + UB(1:1) = ubound(SrcInputFileTypeData%Y0_high) if (.not. allocated(DstInputFileTypeData%Y0_high)) then allocate(DstInputFileTypeData%Y0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -451,8 +465,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%Y0_high = SrcInputFileTypeData%Y0_high end if if (allocated(SrcInputFileTypeData%Z0_high)) then - LB(1:1) = lbound(SrcInputFileTypeData%Z0_high, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileTypeData%Z0_high, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileTypeData%Z0_high) + UB(1:1) = ubound(SrcInputFileTypeData%Z0_high) if (.not. allocated(DstInputFileTypeData%Z0_high)) then allocate(DstInputFileTypeData%Z0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -463,8 +477,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%Z0_high = SrcInputFileTypeData%Z0_high end if if (allocated(SrcInputFileTypeData%dX_high)) then - LB(1:1) = lbound(SrcInputFileTypeData%dX_high, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileTypeData%dX_high, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileTypeData%dX_high) + UB(1:1) = ubound(SrcInputFileTypeData%dX_high) if (.not. allocated(DstInputFileTypeData%dX_high)) then allocate(DstInputFileTypeData%dX_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -475,8 +489,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%dX_high = SrcInputFileTypeData%dX_high end if if (allocated(SrcInputFileTypeData%dY_high)) then - LB(1:1) = lbound(SrcInputFileTypeData%dY_high, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileTypeData%dY_high, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileTypeData%dY_high) + UB(1:1) = ubound(SrcInputFileTypeData%dY_high) if (.not. allocated(DstInputFileTypeData%dY_high)) then allocate(DstInputFileTypeData%dY_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -487,8 +501,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%dY_high = SrcInputFileTypeData%dY_high end if if (allocated(SrcInputFileTypeData%dZ_high)) then - LB(1:1) = lbound(SrcInputFileTypeData%dZ_high, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileTypeData%dZ_high, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileTypeData%dZ_high) + UB(1:1) = ubound(SrcInputFileTypeData%dZ_high) if (.not. allocated(DstInputFileTypeData%dZ_high)) then allocate(DstInputFileTypeData%dZ_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -511,8 +525,8 @@ subroutine AWAE_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, Ct DstInputFileTypeData%Y0_low = SrcInputFileTypeData%Y0_low DstInputFileTypeData%Z0_low = SrcInputFileTypeData%Z0_low if (allocated(SrcInputFileTypeData%WT_Position)) then - LB(1:2) = lbound(SrcInputFileTypeData%WT_Position, kind=B8Ki) - UB(1:2) = ubound(SrcInputFileTypeData%WT_Position, kind=B8Ki) + LB(1:2) = lbound(SrcInputFileTypeData%WT_Position) + UB(1:2) = ubound(SrcInputFileTypeData%WT_Position) if (.not. allocated(DstInputFileTypeData%WT_Position)) then allocate(DstInputFileTypeData%WT_Position(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -616,7 +630,7 @@ subroutine AWAE_UnPackInputFileType(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_InputFileType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackInputFileType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -668,7 +682,7 @@ subroutine AWAE_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(0), UB(0) + integer(B4Ki) :: LB(0), UB(0) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyInitInput' @@ -723,7 +737,7 @@ subroutine AWAE_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackInitInput' - integer(B8Ki) :: LB(0), UB(0) + integer(B4Ki) :: LB(0), UB(0) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -760,8 +774,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyInitOutput' @@ -771,8 +785,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%X0_high)) then - LB(1:1) = lbound(SrcInitOutputData%X0_high, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%X0_high, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%X0_high) + UB(1:1) = ubound(SrcInitOutputData%X0_high) if (.not. allocated(DstInitOutputData%X0_high)) then allocate(DstInitOutputData%X0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -783,8 +797,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%X0_high = SrcInitOutputData%X0_high end if if (allocated(SrcInitOutputData%Y0_high)) then - LB(1:1) = lbound(SrcInitOutputData%Y0_high, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%Y0_high, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%Y0_high) + UB(1:1) = ubound(SrcInitOutputData%Y0_high) if (.not. allocated(DstInitOutputData%Y0_high)) then allocate(DstInitOutputData%Y0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -795,8 +809,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%Y0_high = SrcInitOutputData%Y0_high end if if (allocated(SrcInitOutputData%Z0_high)) then - LB(1:1) = lbound(SrcInitOutputData%Z0_high, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%Z0_high, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%Z0_high) + UB(1:1) = ubound(SrcInitOutputData%Z0_high) if (.not. allocated(DstInitOutputData%Z0_high)) then allocate(DstInitOutputData%Z0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -807,8 +821,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%Z0_high = SrcInitOutputData%Z0_high end if if (allocated(SrcInitOutputData%dX_high)) then - LB(1:1) = lbound(SrcInitOutputData%dX_high, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%dX_high, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%dX_high) + UB(1:1) = ubound(SrcInitOutputData%dX_high) if (.not. allocated(DstInitOutputData%dX_high)) then allocate(DstInitOutputData%dX_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -819,8 +833,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%dX_high = SrcInitOutputData%dX_high end if if (allocated(SrcInitOutputData%dY_high)) then - LB(1:1) = lbound(SrcInitOutputData%dY_high, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%dY_high, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%dY_high) + UB(1:1) = ubound(SrcInitOutputData%dY_high) if (.not. allocated(DstInitOutputData%dY_high)) then allocate(DstInitOutputData%dY_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -831,8 +845,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%dY_high = SrcInitOutputData%dY_high end if if (allocated(SrcInitOutputData%dZ_high)) then - LB(1:1) = lbound(SrcInitOutputData%dZ_high, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%dZ_high, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%dZ_high) + UB(1:1) = ubound(SrcInitOutputData%dZ_high) if (.not. allocated(DstInitOutputData%dZ_high)) then allocate(DstInitOutputData%dZ_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -855,8 +869,8 @@ subroutine AWAE_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%Y0_low = SrcInitOutputData%Y0_low DstInitOutputData%Z0_low = SrcInitOutputData%Z0_low if (allocated(SrcInitOutputData%Vdist_High)) then - LB(1:1) = lbound(SrcInitOutputData%Vdist_High, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%Vdist_High, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%Vdist_High) + UB(1:1) = ubound(SrcInitOutputData%Vdist_High) if (.not. allocated(DstInitOutputData%Vdist_High)) then allocate(DstInitOutputData%Vdist_High(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -876,8 +890,8 @@ subroutine AWAE_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) type(AWAE_InitOutputType), intent(inout) :: InitOutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyInitOutput' @@ -904,8 +918,8 @@ subroutine AWAE_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) deallocate(InitOutputData%dZ_high) end if if (allocated(InitOutputData%Vdist_High)) then - LB(1:1) = lbound(InitOutputData%Vdist_High, kind=B8Ki) - UB(1:1) = ubound(InitOutputData%Vdist_High, kind=B8Ki) + LB(1:1) = lbound(InitOutputData%Vdist_High) + UB(1:1) = ubound(InitOutputData%Vdist_High) do i1 = LB(1), UB(1) call AWAE_DestroyHighWindGridPtr(InitOutputData%Vdist_High(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -918,8 +932,8 @@ subroutine AWAE_PackInitOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(AWAE_InitOutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackInitOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call NWTC_Library_PackProgDesc(RF, InData%Ver) call RegPackAlloc(RF, InData%X0_high) @@ -942,9 +956,9 @@ subroutine AWAE_PackInitOutput(RF, Indata) call RegPack(RF, InData%Z0_low) call RegPack(RF, allocated(InData%Vdist_High)) if (allocated(InData%Vdist_High)) then - call RegPackBounds(RF, 1, lbound(InData%Vdist_High, kind=B8Ki), ubound(InData%Vdist_High, kind=B8Ki)) - LB(1:1) = lbound(InData%Vdist_High, kind=B8Ki) - UB(1:1) = ubound(InData%Vdist_High, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) + LB(1:1) = lbound(InData%Vdist_High) + UB(1:1) = ubound(InData%Vdist_High) do i1 = LB(1), UB(1) call AWAE_PackHighWindGridPtr(RF, InData%Vdist_High(i1)) end do @@ -956,8 +970,8 @@ subroutine AWAE_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackInitOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1001,16 +1015,16 @@ subroutine AWAE_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%IfW)) then - LB(1:1) = lbound(SrcContStateData%IfW, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%IfW, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%IfW) + UB(1:1) = ubound(SrcContStateData%IfW) if (.not. allocated(DstContStateData%IfW)) then allocate(DstContStateData%IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1030,16 +1044,16 @@ subroutine AWAE_DestroyContState(ContStateData, ErrStat, ErrMsg) type(AWAE_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%IfW)) then - LB(1:1) = lbound(ContStateData%IfW, kind=B8Ki) - UB(1:1) = ubound(ContStateData%IfW, kind=B8Ki) + LB(1:1) = lbound(ContStateData%IfW) + UB(1:1) = ubound(ContStateData%IfW) do i1 = LB(1), UB(1) call InflowWind_DestroyContState(ContStateData%IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1052,14 +1066,14 @@ subroutine AWAE_PackContState(RF, Indata) type(RegFile), intent(inout) :: RF type(AWAE_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(RF, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%IfW, kind=B8Ki) - UB(1:1) = ubound(InData%IfW, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) do i1 = LB(1), UB(1) call InflowWind_PackContState(RF, InData%IfW(i1)) end do @@ -1071,8 +1085,8 @@ subroutine AWAE_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1097,16 +1111,16 @@ subroutine AWAE_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%IfW)) then - LB(1:1) = lbound(SrcDiscStateData%IfW, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%IfW, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%IfW) + UB(1:1) = ubound(SrcDiscStateData%IfW) if (.not. allocated(DstDiscStateData%IfW)) then allocate(DstDiscStateData%IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1128,16 +1142,16 @@ subroutine AWAE_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) type(AWAE_DiscreteStateType), intent(inout) :: DiscStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(DiscStateData%IfW)) then - LB(1:1) = lbound(DiscStateData%IfW, kind=B8Ki) - UB(1:1) = ubound(DiscStateData%IfW, kind=B8Ki) + LB(1:1) = lbound(DiscStateData%IfW) + UB(1:1) = ubound(DiscStateData%IfW) do i1 = LB(1), UB(1) call InflowWind_DestroyDiscState(DiscStateData%IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1150,14 +1164,14 @@ subroutine AWAE_PackDiscState(RF, Indata) type(RegFile), intent(inout) :: RF type(AWAE_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(RF, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%IfW, kind=B8Ki) - UB(1:1) = ubound(InData%IfW, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) do i1 = LB(1), UB(1) call InflowWind_PackDiscState(RF, InData%IfW(i1)) end do @@ -1171,8 +1185,8 @@ subroutine AWAE_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1199,16 +1213,16 @@ subroutine AWAE_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcConstrStateData%IfW)) then - LB(1:1) = lbound(SrcConstrStateData%IfW, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%IfW, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%IfW) + UB(1:1) = ubound(SrcConstrStateData%IfW) if (.not. allocated(DstConstrStateData%IfW)) then allocate(DstConstrStateData%IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1228,16 +1242,16 @@ subroutine AWAE_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) type(AWAE_ConstraintStateType), intent(inout) :: ConstrStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ConstrStateData%IfW)) then - LB(1:1) = lbound(ConstrStateData%IfW, kind=B8Ki) - UB(1:1) = ubound(ConstrStateData%IfW, kind=B8Ki) + LB(1:1) = lbound(ConstrStateData%IfW) + UB(1:1) = ubound(ConstrStateData%IfW) do i1 = LB(1), UB(1) call InflowWind_DestroyConstrState(ConstrStateData%IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1250,14 +1264,14 @@ subroutine AWAE_PackConstrState(RF, Indata) type(RegFile), intent(inout) :: RF type(AWAE_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackConstrState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(RF, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%IfW, kind=B8Ki) - UB(1:1) = ubound(InData%IfW, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) do i1 = LB(1), UB(1) call InflowWind_PackConstrState(RF, InData%IfW(i1)) end do @@ -1269,8 +1283,8 @@ subroutine AWAE_UnPackConstrState(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackConstrState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1295,16 +1309,16 @@ subroutine AWAE_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%IfW)) then - LB(1:1) = lbound(SrcOtherStateData%IfW, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%IfW, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%IfW) + UB(1:1) = ubound(SrcOtherStateData%IfW) if (.not. allocated(DstOtherStateData%IfW)) then allocate(DstOtherStateData%IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1324,16 +1338,16 @@ subroutine AWAE_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(AWAE_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%IfW)) then - LB(1:1) = lbound(OtherStateData%IfW, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%IfW, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%IfW) + UB(1:1) = ubound(OtherStateData%IfW) do i1 = LB(1), UB(1) call InflowWind_DestroyOtherState(OtherStateData%IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1346,14 +1360,14 @@ subroutine AWAE_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(AWAE_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(RF, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%IfW, kind=B8Ki) - UB(1:1) = ubound(InData%IfW, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) do i1 = LB(1), UB(1) call InflowWind_PackOtherState(RF, InData%IfW(i1)) end do @@ -1365,8 +1379,8 @@ subroutine AWAE_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1391,16 +1405,16 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%Vamb_low)) then - LB(1:4) = lbound(SrcMiscData%Vamb_low, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%Vamb_low, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%Vamb_low) + UB(1:4) = ubound(SrcMiscData%Vamb_low) if (.not. allocated(DstMiscData%Vamb_low)) then allocate(DstMiscData%Vamb_low(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1411,8 +1425,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Vamb_low = SrcMiscData%Vamb_low end if if (allocated(SrcMiscData%Vamb_lowpol)) then - LB(1:2) = lbound(SrcMiscData%Vamb_lowpol, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%Vamb_lowpol, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%Vamb_lowpol) + UB(1:2) = ubound(SrcMiscData%Vamb_lowpol) if (.not. allocated(DstMiscData%Vamb_lowpol)) then allocate(DstMiscData%Vamb_lowpol(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1423,8 +1437,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Vamb_lowpol = SrcMiscData%Vamb_lowpol end if if (allocated(SrcMiscData%Vdist_low)) then - LB(1:4) = lbound(SrcMiscData%Vdist_low, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%Vdist_low, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%Vdist_low) + UB(1:4) = ubound(SrcMiscData%Vdist_low) if (.not. allocated(DstMiscData%Vdist_low)) then allocate(DstMiscData%Vdist_low(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1435,8 +1449,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Vdist_low = SrcMiscData%Vdist_low end if if (allocated(SrcMiscData%Vdist_low_full)) then - LB(1:4) = lbound(SrcMiscData%Vdist_low_full, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%Vdist_low_full, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%Vdist_low_full) + UB(1:4) = ubound(SrcMiscData%Vdist_low_full) if (.not. allocated(DstMiscData%Vdist_low_full)) then allocate(DstMiscData%Vdist_low_full(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1447,8 +1461,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Vdist_low_full = SrcMiscData%Vdist_low_full end if if (allocated(SrcMiscData%Vamb_High)) then - LB(1:1) = lbound(SrcMiscData%Vamb_High, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Vamb_High, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%Vamb_High) + UB(1:1) = ubound(SrcMiscData%Vamb_High) if (.not. allocated(DstMiscData%Vamb_High)) then allocate(DstMiscData%Vamb_High(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1463,8 +1477,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%parallelFlag)) then - LB(1:2) = lbound(SrcMiscData%parallelFlag, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%parallelFlag, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%parallelFlag) + UB(1:2) = ubound(SrcMiscData%parallelFlag) if (.not. allocated(DstMiscData%parallelFlag)) then allocate(DstMiscData%parallelFlag(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1475,8 +1489,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%parallelFlag = SrcMiscData%parallelFlag end if if (allocated(SrcMiscData%r_s)) then - LB(1:2) = lbound(SrcMiscData%r_s, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%r_s, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%r_s) + UB(1:2) = ubound(SrcMiscData%r_s) if (.not. allocated(DstMiscData%r_s)) then allocate(DstMiscData%r_s(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1487,8 +1501,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%r_s = SrcMiscData%r_s end if if (allocated(SrcMiscData%r_e)) then - LB(1:2) = lbound(SrcMiscData%r_e, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%r_e, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%r_e) + UB(1:2) = ubound(SrcMiscData%r_e) if (.not. allocated(DstMiscData%r_e)) then allocate(DstMiscData%r_e(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1499,8 +1513,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%r_e = SrcMiscData%r_e end if if (allocated(SrcMiscData%rhat_s)) then - LB(1:3) = lbound(SrcMiscData%rhat_s, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%rhat_s, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%rhat_s) + UB(1:3) = ubound(SrcMiscData%rhat_s) if (.not. allocated(DstMiscData%rhat_s)) then allocate(DstMiscData%rhat_s(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1511,8 +1525,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rhat_s = SrcMiscData%rhat_s end if if (allocated(SrcMiscData%rhat_e)) then - LB(1:3) = lbound(SrcMiscData%rhat_e, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%rhat_e, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%rhat_e) + UB(1:3) = ubound(SrcMiscData%rhat_e) if (.not. allocated(DstMiscData%rhat_e)) then allocate(DstMiscData%rhat_e(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1523,8 +1537,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rhat_e = SrcMiscData%rhat_e end if if (allocated(SrcMiscData%pvec_cs)) then - LB(1:3) = lbound(SrcMiscData%pvec_cs, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%pvec_cs, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%pvec_cs) + UB(1:3) = ubound(SrcMiscData%pvec_cs) if (.not. allocated(DstMiscData%pvec_cs)) then allocate(DstMiscData%pvec_cs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1535,8 +1549,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%pvec_cs = SrcMiscData%pvec_cs end if if (allocated(SrcMiscData%pvec_ce)) then - LB(1:3) = lbound(SrcMiscData%pvec_ce, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%pvec_ce, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%pvec_ce) + UB(1:3) = ubound(SrcMiscData%pvec_ce) if (.not. allocated(DstMiscData%pvec_ce)) then allocate(DstMiscData%pvec_ce(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1547,8 +1561,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%pvec_ce = SrcMiscData%pvec_ce end if if (allocated(SrcMiscData%outVizXYPlane)) then - LB(1:4) = lbound(SrcMiscData%outVizXYPlane, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%outVizXYPlane, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%outVizXYPlane) + UB(1:4) = ubound(SrcMiscData%outVizXYPlane) if (.not. allocated(DstMiscData%outVizXYPlane)) then allocate(DstMiscData%outVizXYPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1559,8 +1573,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%outVizXYPlane = SrcMiscData%outVizXYPlane end if if (allocated(SrcMiscData%outVizYZPlane)) then - LB(1:4) = lbound(SrcMiscData%outVizYZPlane, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%outVizYZPlane, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%outVizYZPlane) + UB(1:4) = ubound(SrcMiscData%outVizYZPlane) if (.not. allocated(DstMiscData%outVizYZPlane)) then allocate(DstMiscData%outVizYZPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1571,8 +1585,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%outVizYZPlane = SrcMiscData%outVizYZPlane end if if (allocated(SrcMiscData%outVizXZPlane)) then - LB(1:4) = lbound(SrcMiscData%outVizXZPlane, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%outVizXZPlane, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%outVizXZPlane) + UB(1:4) = ubound(SrcMiscData%outVizXZPlane) if (.not. allocated(DstMiscData%outVizXZPlane)) then allocate(DstMiscData%outVizXZPlane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1583,8 +1597,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%outVizXZPlane = SrcMiscData%outVizXZPlane end if if (allocated(SrcMiscData%IfW)) then - LB(1:1) = lbound(SrcMiscData%IfW, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%IfW, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%IfW) + UB(1:1) = ubound(SrcMiscData%IfW) if (.not. allocated(DstMiscData%IfW)) then allocate(DstMiscData%IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1611,8 +1625,8 @@ subroutine AWAE_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%V_amb_low_disk)) then - LB(1:2) = lbound(SrcMiscData%V_amb_low_disk, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%V_amb_low_disk, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%V_amb_low_disk) + UB(1:2) = ubound(SrcMiscData%V_amb_low_disk) if (.not. allocated(DstMiscData%V_amb_low_disk)) then allocate(DstMiscData%V_amb_low_disk(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1628,8 +1642,8 @@ subroutine AWAE_DestroyMisc(MiscData, ErrStat, ErrMsg) type(AWAE_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyMisc' @@ -1648,8 +1662,8 @@ subroutine AWAE_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%Vdist_low_full) end if if (allocated(MiscData%Vamb_High)) then - LB(1:1) = lbound(MiscData%Vamb_High, kind=B8Ki) - UB(1:1) = ubound(MiscData%Vamb_High, kind=B8Ki) + LB(1:1) = lbound(MiscData%Vamb_High) + UB(1:1) = ubound(MiscData%Vamb_High) do i1 = LB(1), UB(1) call AWAE_DestroyHighWindGrid(MiscData%Vamb_High(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1687,8 +1701,8 @@ subroutine AWAE_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%outVizXZPlane) end if if (allocated(MiscData%IfW)) then - LB(1:1) = lbound(MiscData%IfW, kind=B8Ki) - UB(1:1) = ubound(MiscData%IfW, kind=B8Ki) + LB(1:1) = lbound(MiscData%IfW) + UB(1:1) = ubound(MiscData%IfW) do i1 = LB(1), UB(1) call InflowWind_DestroyMisc(MiscData%IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1712,8 +1726,8 @@ subroutine AWAE_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(AWAE_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackMisc' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%Vamb_low) call RegPackAlloc(RF, InData%Vamb_lowpol) @@ -1721,9 +1735,9 @@ subroutine AWAE_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%Vdist_low_full) call RegPack(RF, allocated(InData%Vamb_High)) if (allocated(InData%Vamb_High)) then - call RegPackBounds(RF, 1, lbound(InData%Vamb_High, kind=B8Ki), ubound(InData%Vamb_High, kind=B8Ki)) - LB(1:1) = lbound(InData%Vamb_High, kind=B8Ki) - UB(1:1) = ubound(InData%Vamb_High, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Vamb_High), ubound(InData%Vamb_High)) + LB(1:1) = lbound(InData%Vamb_High) + UB(1:1) = ubound(InData%Vamb_High) do i1 = LB(1), UB(1) call AWAE_PackHighWindGrid(RF, InData%Vamb_High(i1)) end do @@ -1740,9 +1754,9 @@ subroutine AWAE_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%outVizXZPlane) call RegPack(RF, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(RF, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%IfW, kind=B8Ki) - UB(1:1) = ubound(InData%IfW, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) do i1 = LB(1), UB(1) call InflowWind_PackMisc(RF, InData%IfW(i1)) end do @@ -1759,8 +1773,8 @@ subroutine AWAE_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackMisc' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1817,8 +1831,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyParam' @@ -1829,8 +1843,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumRadii = SrcParamData%NumRadii DstParamData%NumPlanes = SrcParamData%NumPlanes if (allocated(SrcParamData%y)) then - LB(1:1) = lbound(SrcParamData%y, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%y, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%y) + UB(1:1) = ubound(SrcParamData%y) if (.not. allocated(DstParamData%y)) then allocate(DstParamData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1841,8 +1855,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%y = SrcParamData%y end if if (allocated(SrcParamData%z)) then - LB(1:1) = lbound(SrcParamData%z, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%z, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%z) + UB(1:1) = ubound(SrcParamData%z) if (.not. allocated(DstParamData%z)) then allocate(DstParamData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1867,8 +1881,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Y0_low = SrcParamData%Y0_low DstParamData%Z0_low = SrcParamData%Z0_low if (allocated(SrcParamData%X0_high)) then - LB(1:1) = lbound(SrcParamData%X0_high, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%X0_high, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%X0_high) + UB(1:1) = ubound(SrcParamData%X0_high) if (.not. allocated(DstParamData%X0_high)) then allocate(DstParamData%X0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1879,8 +1893,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%X0_high = SrcParamData%X0_high end if if (allocated(SrcParamData%Y0_high)) then - LB(1:1) = lbound(SrcParamData%Y0_high, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Y0_high, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Y0_high) + UB(1:1) = ubound(SrcParamData%Y0_high) if (.not. allocated(DstParamData%Y0_high)) then allocate(DstParamData%Y0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1891,8 +1905,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Y0_high = SrcParamData%Y0_high end if if (allocated(SrcParamData%Z0_high)) then - LB(1:1) = lbound(SrcParamData%Z0_high, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Z0_high, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Z0_high) + UB(1:1) = ubound(SrcParamData%Z0_high) if (.not. allocated(DstParamData%Z0_high)) then allocate(DstParamData%Z0_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1903,8 +1917,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Z0_high = SrcParamData%Z0_high end if if (allocated(SrcParamData%dX_high)) then - LB(1:1) = lbound(SrcParamData%dX_high, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dX_high, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%dX_high) + UB(1:1) = ubound(SrcParamData%dX_high) if (.not. allocated(DstParamData%dX_high)) then allocate(DstParamData%dX_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1915,8 +1929,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%dX_high = SrcParamData%dX_high end if if (allocated(SrcParamData%dY_high)) then - LB(1:1) = lbound(SrcParamData%dY_high, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dY_high, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%dY_high) + UB(1:1) = ubound(SrcParamData%dY_high) if (.not. allocated(DstParamData%dY_high)) then allocate(DstParamData%dY_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1927,8 +1941,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%dY_high = SrcParamData%dY_high end if if (allocated(SrcParamData%dZ_high)) then - LB(1:1) = lbound(SrcParamData%dZ_high, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dZ_high, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%dZ_high) + UB(1:1) = ubound(SrcParamData%dZ_high) if (.not. allocated(DstParamData%dZ_high)) then allocate(DstParamData%dZ_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1942,8 +1956,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nY_high = SrcParamData%nY_high DstParamData%nZ_high = SrcParamData%nZ_high if (allocated(SrcParamData%Grid_low)) then - LB(1:2) = lbound(SrcParamData%Grid_low, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Grid_low, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Grid_low) + UB(1:2) = ubound(SrcParamData%Grid_low) if (.not. allocated(DstParamData%Grid_low)) then allocate(DstParamData%Grid_low(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1954,8 +1968,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Grid_low = SrcParamData%Grid_low end if if (allocated(SrcParamData%Grid_high)) then - LB(1:3) = lbound(SrcParamData%Grid_high, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%Grid_high, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%Grid_high) + UB(1:3) = ubound(SrcParamData%Grid_high) if (.not. allocated(DstParamData%Grid_high)) then allocate(DstParamData%Grid_high(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1966,8 +1980,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Grid_high = SrcParamData%Grid_high end if if (allocated(SrcParamData%WT_Position)) then - LB(1:2) = lbound(SrcParamData%WT_Position, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%WT_Position, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%WT_Position) + UB(1:2) = ubound(SrcParamData%WT_Position) if (.not. allocated(DstParamData%WT_Position)) then allocate(DstParamData%WT_Position(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1986,8 +2000,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%C_ScaleDiam = SrcParamData%C_ScaleDiam DstParamData%Mod_Projection = SrcParamData%Mod_Projection if (allocated(SrcParamData%IfW)) then - LB(1:1) = lbound(SrcParamData%IfW, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IfW, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%IfW) + UB(1:1) = ubound(SrcParamData%IfW) if (.not. allocated(DstParamData%IfW)) then allocate(DstParamData%IfW(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2005,8 +2019,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WrDisWind = SrcParamData%WrDisWind DstParamData%NOutDisWindXY = SrcParamData%NOutDisWindXY if (allocated(SrcParamData%OutDisWindZ)) then - LB(1:1) = lbound(SrcParamData%OutDisWindZ, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutDisWindZ, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutDisWindZ) + UB(1:1) = ubound(SrcParamData%OutDisWindZ) if (.not. allocated(DstParamData%OutDisWindZ)) then allocate(DstParamData%OutDisWindZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2018,8 +2032,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NOutDisWindYZ = SrcParamData%NOutDisWindYZ if (allocated(SrcParamData%OutDisWindX)) then - LB(1:1) = lbound(SrcParamData%OutDisWindX, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutDisWindX, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutDisWindX) + UB(1:1) = ubound(SrcParamData%OutDisWindX) if (.not. allocated(DstParamData%OutDisWindX)) then allocate(DstParamData%OutDisWindX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2031,8 +2045,8 @@ subroutine AWAE_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NOutDisWindXZ = SrcParamData%NOutDisWindXZ if (allocated(SrcParamData%OutDisWindY)) then - LB(1:1) = lbound(SrcParamData%OutDisWindY, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutDisWindY, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutDisWindY) + UB(1:1) = ubound(SrcParamData%OutDisWindY) if (.not. allocated(DstParamData%OutDisWindY)) then allocate(DstParamData%OutDisWindY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2053,8 +2067,8 @@ subroutine AWAE_DestroyParam(ParamData, ErrStat, ErrMsg) type(AWAE_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyParam' @@ -2094,8 +2108,8 @@ subroutine AWAE_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%WT_Position) end if if (allocated(ParamData%IfW)) then - LB(1:1) = lbound(ParamData%IfW, kind=B8Ki) - UB(1:1) = ubound(ParamData%IfW, kind=B8Ki) + LB(1:1) = lbound(ParamData%IfW) + UB(1:1) = ubound(ParamData%IfW) do i1 = LB(1), UB(1) call InflowWind_DestroyParam(ParamData%IfW(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2118,8 +2132,8 @@ subroutine AWAE_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(AWAE_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%WindFilePath) @@ -2164,9 +2178,9 @@ subroutine AWAE_PackParam(RF, Indata) call RegPack(RF, InData%Mod_Projection) call RegPack(RF, allocated(InData%IfW)) if (allocated(InData%IfW)) then - call RegPackBounds(RF, 1, lbound(InData%IfW, kind=B8Ki), ubound(InData%IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%IfW, kind=B8Ki) - UB(1:1) = ubound(InData%IfW, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%IfW), ubound(InData%IfW)) + LB(1:1) = lbound(InData%IfW) + UB(1:1) = ubound(InData%IfW) do i1 = LB(1), UB(1) call InflowWind_PackParam(RF, InData%IfW(i1)) end do @@ -2197,8 +2211,8 @@ subroutine AWAE_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -2295,16 +2309,16 @@ subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%Vdist_High)) then - LB(1:1) = lbound(SrcOutputData%Vdist_High, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%Vdist_High, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%Vdist_High) + UB(1:1) = ubound(SrcOutputData%Vdist_High) if (.not. allocated(DstOutputData%Vdist_High)) then allocate(DstOutputData%Vdist_High(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2319,8 +2333,8 @@ subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM end do end if if (allocated(SrcOutputData%V_plane)) then - LB(1:3) = lbound(SrcOutputData%V_plane, kind=B8Ki) - UB(1:3) = ubound(SrcOutputData%V_plane, kind=B8Ki) + LB(1:3) = lbound(SrcOutputData%V_plane) + UB(1:3) = ubound(SrcOutputData%V_plane) if (.not. allocated(DstOutputData%V_plane)) then allocate(DstOutputData%V_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2331,8 +2345,8 @@ subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%V_plane = SrcOutputData%V_plane end if if (allocated(SrcOutputData%TI_amb)) then - LB(1:1) = lbound(SrcOutputData%TI_amb, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%TI_amb, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%TI_amb) + UB(1:1) = ubound(SrcOutputData%TI_amb) if (.not. allocated(DstOutputData%TI_amb)) then allocate(DstOutputData%TI_amb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2343,8 +2357,8 @@ subroutine AWAE_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM DstOutputData%TI_amb = SrcOutputData%TI_amb end if if (allocated(SrcOutputData%Vx_wind_disk)) then - LB(1:1) = lbound(SrcOutputData%Vx_wind_disk, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%Vx_wind_disk, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%Vx_wind_disk) + UB(1:1) = ubound(SrcOutputData%Vx_wind_disk) if (.not. allocated(DstOutputData%Vx_wind_disk)) then allocate(DstOutputData%Vx_wind_disk(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2360,16 +2374,16 @@ subroutine AWAE_DestroyOutput(OutputData, ErrStat, ErrMsg) type(AWAE_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AWAE_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%Vdist_High)) then - LB(1:1) = lbound(OutputData%Vdist_High, kind=B8Ki) - UB(1:1) = ubound(OutputData%Vdist_High, kind=B8Ki) + LB(1:1) = lbound(OutputData%Vdist_High) + UB(1:1) = ubound(OutputData%Vdist_High) do i1 = LB(1), UB(1) call AWAE_DestroyHighWindGrid(OutputData%Vdist_High(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2391,14 +2405,14 @@ subroutine AWAE_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(AWAE_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AWAE_PackOutput' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%Vdist_High)) if (allocated(InData%Vdist_High)) then - call RegPackBounds(RF, 1, lbound(InData%Vdist_High, kind=B8Ki), ubound(InData%Vdist_High, kind=B8Ki)) - LB(1:1) = lbound(InData%Vdist_High, kind=B8Ki) - UB(1:1) = ubound(InData%Vdist_High, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Vdist_High), ubound(InData%Vdist_High)) + LB(1:1) = lbound(InData%Vdist_High) + UB(1:1) = ubound(InData%Vdist_High) do i1 = LB(1), UB(1) call AWAE_PackHighWindGrid(RF, InData%Vdist_High(i1)) end do @@ -2413,8 +2427,8 @@ subroutine AWAE_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackOutput' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2442,14 +2456,14 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'AWAE_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%xhat_plane)) then - LB(1:3) = lbound(SrcInputData%xhat_plane, kind=B8Ki) - UB(1:3) = ubound(SrcInputData%xhat_plane, kind=B8Ki) + LB(1:3) = lbound(SrcInputData%xhat_plane) + UB(1:3) = ubound(SrcInputData%xhat_plane) if (.not. allocated(DstInputData%xhat_plane)) then allocate(DstInputData%xhat_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2460,8 +2474,8 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%xhat_plane = SrcInputData%xhat_plane end if if (allocated(SrcInputData%p_plane)) then - LB(1:3) = lbound(SrcInputData%p_plane, kind=B8Ki) - UB(1:3) = ubound(SrcInputData%p_plane, kind=B8Ki) + LB(1:3) = lbound(SrcInputData%p_plane) + UB(1:3) = ubound(SrcInputData%p_plane) if (.not. allocated(DstInputData%p_plane)) then allocate(DstInputData%p_plane(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2472,8 +2486,8 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%p_plane = SrcInputData%p_plane end if if (allocated(SrcInputData%Vx_wake)) then - LB(1:4) = lbound(SrcInputData%Vx_wake, kind=B8Ki) - UB(1:4) = ubound(SrcInputData%Vx_wake, kind=B8Ki) + LB(1:4) = lbound(SrcInputData%Vx_wake) + UB(1:4) = ubound(SrcInputData%Vx_wake) if (.not. allocated(DstInputData%Vx_wake)) then allocate(DstInputData%Vx_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2484,8 +2498,8 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vx_wake = SrcInputData%Vx_wake end if if (allocated(SrcInputData%Vy_wake)) then - LB(1:4) = lbound(SrcInputData%Vy_wake, kind=B8Ki) - UB(1:4) = ubound(SrcInputData%Vy_wake, kind=B8Ki) + LB(1:4) = lbound(SrcInputData%Vy_wake) + UB(1:4) = ubound(SrcInputData%Vy_wake) if (.not. allocated(DstInputData%Vy_wake)) then allocate(DstInputData%Vy_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2496,8 +2510,8 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vy_wake = SrcInputData%Vy_wake end if if (allocated(SrcInputData%Vz_wake)) then - LB(1:4) = lbound(SrcInputData%Vz_wake, kind=B8Ki) - UB(1:4) = ubound(SrcInputData%Vz_wake, kind=B8Ki) + LB(1:4) = lbound(SrcInputData%Vz_wake) + UB(1:4) = ubound(SrcInputData%Vz_wake) if (.not. allocated(DstInputData%Vz_wake)) then allocate(DstInputData%Vz_wake(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2508,8 +2522,8 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Vz_wake = SrcInputData%Vz_wake end if if (allocated(SrcInputData%D_wake)) then - LB(1:2) = lbound(SrcInputData%D_wake, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%D_wake, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%D_wake) + UB(1:2) = ubound(SrcInputData%D_wake) if (.not. allocated(DstInputData%D_wake)) then allocate(DstInputData%D_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2520,8 +2534,8 @@ subroutine AWAE_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%D_wake = SrcInputData%D_wake end if if (allocated(SrcInputData%WAT_k)) then - LB(1:4) = lbound(SrcInputData%WAT_k, kind=B8Ki) - UB(1:4) = ubound(SrcInputData%WAT_k, kind=B8Ki) + LB(1:4) = lbound(SrcInputData%WAT_k) + UB(1:4) = ubound(SrcInputData%WAT_k) if (.not. allocated(DstInputData%WAT_k)) then allocate(DstInputData%WAT_k(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2582,7 +2596,7 @@ subroutine AWAE_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(AWAE_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AWAE_UnPackInput' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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 33ff645fb6..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 @@ -1653,7 +1654,7 @@ subroutine Init_MiscVars( p, u, y, m, ErrStat, ErrMsg ) ! Array for storing the position information for the quadrature points. CALL AllocAry(m%qp%uuu, p%dof_node ,p%nqp,p%elem_total, 'm%qp%uuu displacement at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry(m%qp%uup, p%dof_node/2,p%nqp,p%elem_total, 'm%qp%uup displacement prime at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry(m%qp%uup, p%dof_node ,p%nqp,p%elem_total, 'm%qp%uup displacement prime at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(m%qp%vvv, p%dof_node ,p%nqp,p%elem_total, 'm%qp%vvv velocity at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(m%qp%vvp, p%dof_node ,p%nqp,p%elem_total, 'm%qp%vvp velocity prime at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(m%qp%aaa, p%dof_node ,p%nqp,p%elem_total, 'm%qp%aaa acceleration at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -1682,7 +1683,7 @@ subroutine Init_MiscVars( p, u, y, m, ErrStat, ErrMsg ) ! Inertial force terms CALL AllocAry(m%qp%Gi, 6,6, p%nqp,p%elem_total, 'm%qp%Gi gyroscopic at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(m%qp%Ki, 6,6, p%nqp,p%elem_total, 'm%qp%Ki stiffness at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry(m%qp%Mi, 6,6, p%nqp,p%elem_total, 'm%qp%Mi mass at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry(m%qp%Mi, p%nqp, 6,6, p%elem_total, 'm%qp%Mi mass at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Elastic force terms: \f$ \underline{\underline{\mathcal{O}}} \f$, etc. from equation (19-21) of NREL CP-2C00-60759. CALL AllocAry(m%qp%Oe, 6,6, p%nqp,p%elem_total, 'm%qp%Oe term at quadrature point',ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -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,48 +2364,44 @@ 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 !< 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 - CHARACTER(*), PARAMETER :: RoutineName = 'BD_DisplacementQP' - - DO idx_qp=1,p%nqp - ! Node point before start of this element - elem_start = p%node_elem_idx( nelem,1 ) - - - !> ### Calculate the the displacement fields in an element - !! Using equations (27) and (28) \n - !! \f$ \underline{u}\left( \xi \right) = - !! \sum_{i=1}^{p+1} h^i\left( \xi \right) \underline{\hat{u}}^i - !! \f$ \n - !! and \n - !! \f$ \underline{u}^\prime \left( \xi \right) = - !! \sum_{k=1}^{p+1} h^{k\prime} \left( \xi \right) \underline{\hat{u}}^i - !! \f$ - !! - !! | Variable | Value | - !! | :---------: | :------------------------------------------------------------------------- | - !! | \f$ \xi \f$ | Element natural coordinate \f$ \in [-1,1] \f$ | - !! | \f$ k \f$ | Node number of a \f$ p^\text{th} \f$ order Langrangian-interpolant | - !! | \f$ h^i \left( \xi \right ) \f$ | Component of the shape function matrix, \f$ \underline{\underline{N}} \f$ | - !! | \f$ h^{k\prime} \left( \xi \right ) \f$ | \f$ \frac{\mathrm{d}}{\mathrm{d}x_1} h^i \left( \xi \right) \f$ | - !! | \f$ \underline{\hat{u}}^i \f$ | \f$ k^\text{th} \f$ nodal value | + !> ### Calculate the the displacement fields in an element + !! Using equations (27) and (28) \n + !! \f$ \underline{u}\left( \xi \right) = + !! \sum_{i=1}^{p+1} h^i\left( \xi \right) \underline{\hat{u}}^i + !! \f$ \n + !! and \n + !! \f$ \underline{u}^\prime \left( \xi \right) = + !! \sum_{k=1}^{p+1} h^{k\prime} \left( \xi \right) \underline{\hat{u}}^i + !! \f$ + !! + !! | Variable | Value | + !! | :---------: | :------------------------------------------------------------------------- | + !! | \f$ \xi \f$ | Element natural coordinate \f$ \in [-1,1] \f$ | + !! | \f$ k \f$ | Node number of a \f$ p^\text{th} \f$ order Langrangian-interpolant | + !! | \f$ h^i \left( \xi \right ) \f$ | Component of the shape function matrix, \f$ \underline{\underline{N}} \f$ | + !! | \f$ h^{k\prime} \left( \xi \right ) \f$ | \f$ \frac{\mathrm{d}}{\mathrm{d}x_1} h^i \left( \xi \right) \f$ | + !! | \f$ \underline{\hat{u}}^i \f$ | \f$ k^\text{th} \f$ nodal value | + + ! Node point before start of this element + elem_start = p%node_elem_idx(nelem,1) - ! Initialize values for summation - m%qp%uuu(:,idx_qp,nelem) = 0.0_BDKi ! displacement field \f$ \underline{u} \left( \xi \right) \f$ - m%qp%uup(:,idx_qp,nelem) = 0.0_BDKi ! displacement field \f$ \underline{u}^\prime \left( \xi \right) \f$ + ! Use matrix multiplication to interpolate position and position derivative to quadrature points + 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) - DO idx_node=1,p%nodes_per_elem - m%qp%uuu(1:3,idx_qp,nelem) = m%qp%uuu(1:3,idx_qp,nelem) + p%Shp(idx_node,idx_qp) *x%q(1:3,elem_start - 1 + idx_node) - m%qp%uup(1:3,idx_qp,nelem) = m%qp%uup(1:3,idx_qp,nelem) + p%ShpDer(idx_node,idx_qp)/p%Jacobian(idx_qp,nelem)*x%q(1:3,elem_start - 1 + idx_node) - ENDDO + ! Apply Jacobian to get position derivative with respect to X-axis + do idx_qp = 1, p%nqp + m%qp%uup(1:3,idx_qp,nelem) = m%qp%uup(1:3,idx_qp,nelem) / p%Jacobian(idx_qp,nelem) + end do - !> Calculate \f$ \underline{E}_1 = x_0^\prime + u^\prime \f$ (equation 23). Note E_1 is along the z direction. - m%qp%E1(1:3,idx_qp,nelem) = p%E10(1:3,idx_qp,nelem) + m%qp%uup(1:3,idx_qp,nelem) + !> Calculate \f$ \underline{E}_1 = x_0^\prime + u^\prime \f$ (equation 23). Note E_1 is along the z direction. + m%qp%E1(1:3,:,nelem) = p%E10(1:3,:,nelem) + m%qp%uup(1:3,:,nelem) - ENDDO END SUBROUTINE BD_DisplacementQP @@ -2423,6 +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 !< 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 @@ -2431,8 +2428,6 @@ SUBROUTINE BD_RotationalInterpQP( nelem, p, x, m ) REAL(BDKi) :: cc(3) REAL(BDKi) :: temp33(3,3) REAL(BDKi) :: DCM_root(3,3) !< DCM for first node - CHARACTER(*), PARAMETER :: RoutineName = 'BD_RotationalInterpQP' - !> ## Calculate the interpolated rotational displacements !! To calculate this, the algorithm given in http://www.nrel.gov/docs/fy14osti/60759.pdf @@ -2487,6 +2482,15 @@ SUBROUTINE BD_RotationalInterpQP( nelem, p, x, m ) ENDDO + ! 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) + 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 + m%qp%uup(4:6,idx_qp,nelem) = m%qp%uup(4:6,idx_qp,nelem) / p%Jacobian(idx_qp,nelem) + end do ! QP rotational interpolation DO idx_qp=1,p%nqp @@ -2512,16 +2516,9 @@ SUBROUTINE BD_RotationalInterpQP( nelem, p, x, m ) !! | \f$ h^{k\prime} \left( \xi \right ) \f$ | \f$ \frac{\mathrm{d}}{\mathrm{d}x_1} h^i \left( \xi \right) \f$ | !! | \f$ \underline{\hat{r}}^i \f$ | \f$ k^\text{th} \f$ nodal value | - - ! Initialize values for summations - rrr = 0.0_BDKi ! intermediate rotation field for calculation - rrp = 0.0_BDKi - - ! Note: `m%Nrrr` is \f$ \underline{\hat{r}}^i \f$ - DO idx_node=1,p%nodes_per_elem - rrr(1:3) = rrr(1:3) + p%Shp(idx_node,idx_qp) *m%Nrrr(1:3,idx_node,nelem) - rrp(1:3) = rrp(1:3) + p%ShpDer(idx_node,idx_qp)/p%Jacobian(idx_qp,nelem)*m%Nrrr(1:3,idx_node,nelem) - ENDDO + ! Get rotation and rotation derivative at quadrature point (root rotation is not included) + rrr = m%qp%uuu(4:6,idx_qp,nelem) + rrp = m%qp%uup(4:6,idx_qp,nelem) !> **Step 3:** Restore the rigid body rotation at node \f$ \xi \f$ with \n !! \f$ \underline{c}(\xi) = \underline{\hat{c}}^1 \oplus \underline{r}(\xi) \f$ \n @@ -2569,30 +2566,53 @@ SUBROUTINE BD_StifAtDeformedQP( nelem, p, m ) TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables INTEGER(IntKi) :: idx_qp !< index counter for quadrature point - INTEGER(IntKi) :: temp_id2 !< Index to last node of previous element - INTEGER(IntKi) :: i,j !< generic counters - REAL(BDKi) :: tempR6(6,6) - REAL(BDKi) :: tempBeta6(6,6) + INTEGER(IntKi) :: idx_Stif0 !< Index to last node of previous element + + ! Initial stiffness matrix index + idx_Stif0 = (nelem-1)*p%nqp + ! Loop through quadrature points + do idx_qp = 1, p%nqp - ! see Bauchau 2011 Flexible Multibody Dynamics p 692-693, section 17.7.2 + ! Initial stiffness matrix index + idx_Stif0 = idx_Stif0 + 1 - ! extract the mass and stiffness matrices for the current element - temp_id2 = (nelem-1)*p%nqp + ! Calculate stiffness and damping matrices for this quadrature point + call Calc_Stif_betaC(m%qp%RR0(:,:,idx_qp,nelem), & + p%Stif0_QP(:,:,idx_Stif0), & + m%qp%Stif(:,:,idx_qp,nelem), & + m%qp%betaC(:,:,idx_qp,nelem)) + end do - DO idx_qp=1,p%nqp +contains + subroutine Calc_Stif_betaC(RR0, Stif0, Stif, betaC) + REAL(BDKi), intent(in) :: RR0(:,:), Stif0(:,:) + REAL(BDKi), intent(inout) :: Stif(:,:), betaC(:,:) + REAL(BDKi) :: tempR6(6,6) + REAL(BDKi) :: tempR6_T(6,6) + REAL(BDKi) :: tempBeta6(6,6) + REAL(BDKi) :: tempBeta_diag(6) + INTEGER(IntKi) :: i, j + + ! see Bauchau 2011 Flexible Multibody Dynamics p 692-693, section 17.7.2 !> RR0 is the rotation tensor at quadrature point \f$ \left(\underline{\underline{R}}\underline{\underline{R}}_0\right) \f$ (3x3) - - ! Setup the temporary matrix for modifying the stiffness matrix. RR0 is changing with time. + + ! Setup the temporary matrix for modifying the stiffness matrix. RR0 is changing with time. tempR6 = 0.0_BDKi - tempBeta6 = 0.0_BDKi - tempR6(1:3,1:3) = m%qp%RR0(:,:,idx_qp,nelem) ! upper left -- translation - tempR6(4:6,4:6) = m%qp%RR0(:,:,idx_qp,nelem) ! lower right -- rotation - !NOTE: Bauchau has the lower right corner multiplied by H - - ! Move damping ratio from material frame to the calculation reference frame - ! This is the following: - ! tempBEta6=matmul(tempR6,matmul(diag(p%beta),transpose(tempR6))) + tempR6(1:3,1:3) = RR0 ! upper left -- translation + tempR6(4:6,4:6) = RR0 ! lower right -- rotation + !NOTE: Bauchau has the lower right corner multiplied by H + + ! Compute the transpose of tempR6 + tempR6_T = TRANSPOSE(tempR6) + + ! Move damping ratio from material frame to the calculation reference frame + ! This is the following: + ! tempBeta6 = matmul(tempR6, matmul(diag(p%beta), transpose(tempR6))) + + ! Move damping ratio from material frame to the calculation reference frame + ! This is the following: + ! tempBEta6=matmul(tempR6,matmul(diag(p%beta),transpose(tempR6))) do j=1,6 do i=1,6 ! diagonal of p%beta * TRANSPOSE(tempR6) @@ -2601,23 +2621,21 @@ SUBROUTINE BD_StifAtDeformedQP( nelem, p, m ) enddo tempBeta6 = matmul(tempR6,tempBeta6) - - !> Modify the Mass matrix so it is in the calculation reference frame - !! \f$ \begin{bmatrix} - !! \left(\underline{\underline{R}} \underline{\underline{R}}_0\right) & 0 \\ - !! 0 & \left(\underline{\underline{R}} \underline{\underline{R}}_0\right) - !! \end{bmatrix} - !! \underline{\underline{C}} - !! \begin{bmatrix} - !! \left(\underline{\underline{R}} \underline{\underline{R}}_0\right)^T & 0 \\ - !! 0 & \left(\underline{\underline{R}} \underline{\underline{R}}_0\right)^T - !! \end{bmatrix} \f$ - m%qp%Stif(:,:,idx_qp,nelem) = MATMUL(tempR6,MATMUL(p%Stif0_QP(1:6,1:6,temp_id2+idx_qp),TRANSPOSE(tempR6))) - - ! Now apply the damping - m%qp%betaC(:,:,idx_qp,nelem) = matmul(tempBeta6,m%qp%Stif(:,:,idx_qp,nelem)) - ENDDO - + !> Modify the Mass matrix so it is in the calculation reference frame + !! \f$ \begin{bmatrix} + !! \left(\underline{\underline{R}} \underline{\underline{R}}_0\right) & 0 \\ + !! 0 & \left(\underline{\underline{R}} \underline{\underline{R}}_0\right) + !! \end{bmatrix} + !! \underline{\underline{C}} + !! \begin{bmatrix} + !! \left(\underline{\underline{R}} \underline{\underline{R}}_0\right)^T & 0 \\ + !! 0 & \left(\underline{\underline{R}} \underline{\underline{R}}_0\right)^T + !! \end{bmatrix} \f$ + Stif = matmul(tempR6, matmul(Stif0, tempR6_T)) + + ! Now apply the damping + betaC = matmul(tempBeta6, Stif) + end subroutine END SUBROUTINE BD_StifAtDeformedQP @@ -2635,23 +2653,35 @@ SUBROUTINE BD_QPData_mEta_rho( p, m ) TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables INTEGER(IntKi) :: nelem !< index to current element number + INTEGER(IntKi) :: qp_start !< index to start qp indexing for element INTEGER(IntKi) :: idx_qp !< index to the current quadrature point - DO nelem=1,p%elem_total - DO idx_qp=1,p%nqp + do nelem = 1, p%elem_total + qp_start = (nelem-1)*p%nqp + do idx_qp = 1, p%nqp + call Calc_RR0mEta_rho(m%qp%RR0(:,:,idx_qp,nelem), & + p%Mass0_QP(:,:,qp_start+idx_qp), & + m%qp%RR0mEta(:,idx_qp,nelem), & + m%qp%rho(:,:,idx_qp,nelem)) + end do + end do + +contains + subroutine Calc_RR0mEta_rho(RR0, Mass0, RR0mEta, rho) + real(BDKi), intent(in) :: RR0(:,:), Mass0(:,:) + real(BDKi), intent(out) :: RR0mEta(:), rho(:,:) + !> Calculate the new center of mass times mass at the deflected location !! as \f$ \left(\underline{\underline{R}}\underline{\underline{R}}_0\right) m \underline{\eta} \f$ - m%qp%RR0mEta(:,idx_qp,nelem) = MATMUL(m%qp%RR0(:,:,idx_qp,nelem),p%qp%mEta(:,idx_qp,nelem)) + m%qp%RR0mEta(:,idx_qp,nelem) = MATMUL(RR0, p%qp%mEta(:,idx_qp,nelem)) !> Calculate \f$ \rho = \left(\underline{\underline{R}}\underline{\underline{R}}_0\right) !! \underline{\underline{M}}_{2,2} !! \left(\underline{\underline{R}}\underline{\underline{R}}_0\right)^T \f$ where !! \f$ \underline{\underline{M}}_{2,2} \f$ is the inertial terms of the undeflected mass matrix at this quadrature point - m%qp%rho(:,:,idx_qp,nelem) = p%Mass0_QP(4:6,4:6,(nelem-1)*p%nqp+idx_qp) - m%qp%rho(:,:,idx_qp,nelem) = MATMUL(m%qp%RR0(:,:,idx_qp,nelem),MATMUL(m%qp%rho(:,:,idx_qp,nelem),TRANSPOSE(m%qp%RR0(:,:,idx_qp,nelem)))) - ENDDO - ENDDO + rho = MATMUL(RR0, MATMUL(Mass0(4:6,4:6), TRANSPOSE(RR0))) + end subroutine END SUBROUTINE BD_QPData_mEta_rho @@ -2668,99 +2698,125 @@ SUBROUTINE BD_ElasticForce(nelem,p,m,fact) TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables. LOGICAL, INTENT(IN ) :: fact !< Boolean to calculate the Jacobian - REAL(BDKi) :: cet !< for storing the \f$ I_{yy} + I_{zz} \f$ inertia term - REAL(BDKi) :: k1s - REAL(BDKi) :: Wrk33(3,3) - REAL(BDKi) :: tildeE(3,3) - REAL(BDKi) :: C21(3,3) - REAL(BDKi) :: epsi(3,3) - REAL(BDKi) :: mu(3,3) - - INTEGER(IntKi) :: idx_qp !< Index to quadrature point currently being calculated + REAL(BDKi) :: cet_t !< for storing the \f$ I_{yy} + I_{zz} \f$ inertia term + REAL(BDKi) :: k1s_t + INTEGER(IntKi) :: idx_qp !< Index to quadrature point currently being calculated if (.not. fact) then - do idx_qp=1,p%nqp - call Calc_Fc_Fd() + call Calc_Fc_Fd(m%qp%RR0(:,:,idx_qp,nelem), & + m%qp%uuu(:,idx_qp,nelem), & + p%E10(:,idx_qp,nelem), & + m%qp%E1(:,idx_qp,nelem), & + m%qp%kappa(1:3,idx_qp,nelem), & + p%Stif0_QP(:,:,(nelem-1)*p%nqp+idx_qp), & + m%qp%Stif(:,:,idx_qp,nelem), & + m%qp%Fc(:,idx_qp,nelem), & + m%qp%Fd(:,idx_qp,nelem), & + cet_t, k1s_t) end do - else - do idx_qp=1,p%nqp - - call Calc_Fc_Fd() - - - !> ###Calculate the \f$ \underline{\underline{\mathcal{O}}} \f$ from equation (19) - !! - !! \f$ \underline{\underline{\mathcal{O}}} = - !! \begin{bmatrix} - !! \underline{\underline{0}} & \underline{\underline{C}}_{11} \tilde{E}_1 - \tilde{F} \\ - !! \underline{\underline{0}} & \underline{\underline{C}}_{21} \tilde{E}_1 - \tilde{M} - !! \end{bmatrix} - !! = \begin{bmatrix} - !! \underline{\underline{0}} & \psi_E - \tilde{F} \\ - !! \underline{\underline{0}} & \mu - \tilde{M} - !! \end{bmatrix} - !! \f$ - Wrk33(:,:) = OuterProduct(m%qp%RR0(1:3,3,idx_qp,nelem), m%qp%RR0(1:3,3,idx_qp,nelem)) ! z-direction in IEC coords - C21(:,:) = m%qp%Stif(4:6,1:3,idx_qp,nelem) + cet*k1s*Wrk33(:,:) - - tildeE = SkewSymMat(m%qp%E1(:,idx_qp,nelem)) - epsi(:,:) = MATMUL(m%qp%Stif(1:3,1:3,idx_qp,nelem),tildeE) ! Stif is RR0 * p%Stif0_QP * RR0^T - mu(:,:) = MATMUL(C21,tildeE) - - m%qp%Oe(:,:,idx_qp,nelem) = 0.0_BDKi - m%qp%Oe(1:3,4:6,idx_qp,nelem) = epsi(1:3,1:3) - SkewSymMat(m%qp%Fc(1:3,idx_qp,nelem)) - m%qp%Oe(4:6,4:6,idx_qp,nelem) = mu(1:3,1:3) - SkewSymMat(m%qp%Fc(4:6,idx_qp,nelem)) - - - !> ###Calculated \f$ \underline{\underline{\mathcal{P}}} \f$ from equation (20) - !! - !! \f$ \underline{\underline{\mathcal{P}}} = - !! \begin{bmatrix} - !! \underline{\underline{0}} & \underline{\underline{0}} \\ - !! \left(\underline{\underline{\bar{C}}}_{11} \tilde{E}_1 \right)^T + \tilde{F} - !! \left(\underline{\underline{\bar{C}}}_{11} \tilde{E}_1 \right)^T - !! \end{bmatrix} - !! = \begin{bmatrix} - !! \underline{\underline{0}} & \underline{\underline{0}} \\ - !! \psi_E^T + \tilde{F} & \mu^T - !! \end{bmatrix} \f$ - m%qp%Pe(:,:,idx_qp,nelem) = 0.0_BDKi - m%qp%Pe(4:6,1:3,idx_qp,nelem) = TRANSPOSE(epsi) + SkewSymMat(m%qp%Fc(1:3,idx_qp,nelem)) - m%qp%Pe(4:6,4:6,idx_qp,nelem) = TRANSPOSE(mu) - - !> ###Calculated \f$ \underline{\underline{\mathcal{Q}}} \f$ from equation (21) - !! - !! \f{eqnarray*}{ - !! \underline{\underline{\mathcal{Q}}} - !! & =& \underline{\underline{\Upsilon}} \underline{\underline{\mathcal{O}}} - !! = \begin{bmatrix} 0 & 0 \\ - !! \tilde{E}_1^T & 0 \end{bmatrix} - !! \underline{\underline{\mathcal{O}}} \\ - !! \begin{bmatrix} 0 & 0 \\ - !! 0 & \underline{\underline{\mathcal{Q}}}_{22} \end{bmatrix} - !! & =& \tilde{E}_1^T \underline{\underline{\mathcal{O}}}_{12} - !! = - \tilde{E}_1 \underline{\underline{\mathcal{O}}}_{12} - !! \f}\n - !! Note: \f$ \tilde{E}_1^T = - \tilde{E}_1 \f$ - m%qp%Qe(:,:,idx_qp,nelem) = 0.0_BDKi - m%qp%Qe(4:6,4:6,idx_qp,nelem) = -MATMUL(tildeE,m%qp%Oe(1:3,4:6,idx_qp,nelem)) + call Calc_Fc_Fd(m%qp%RR0(:,:,idx_qp,nelem), & + m%qp%uuu(:,idx_qp,nelem), & + p%E10(:,idx_qp,nelem), & + m%qp%E1(:,idx_qp,nelem), & + m%qp%kappa(1:3,idx_qp,nelem), & + p%Stif0_QP(:,:,(nelem-1)*p%nqp+idx_qp), & + m%qp%Stif(:,:,idx_qp,nelem), & + m%qp%Fc(:,idx_qp,nelem), & + m%qp%Fd(:,idx_qp,nelem), & + cet_t, k1s_t) + + call Calc_Oe_Pe_Qe(m%qp%RR0(:,:,idx_qp,nelem), & + m%qp%Stif(:,:,idx_qp,nelem), & + m%qp%E1(:,idx_qp,nelem), & + m%qp%Fc(:,idx_qp,nelem), & + cet_t, k1s_t, & + m%qp%Oe(:,:,idx_qp,nelem), & + m%qp%Pe(:,:,idx_qp,nelem), & + m%qp%Qe(:,:,idx_qp,nelem)) end do - - ENDIF + end if contains - subroutine Calc_Fc_Fd() - REAL(BDKi) :: e1s - REAL(BDKi) :: eee(6) !< intermediate array for calculation Strain and curvature terms of Fc - REAL(BDKi) :: fff(6) !< intermediate array for calculation of the elastic force, Fc - REAL(BDKi) :: R(3,3) !< rotation matrix at quatrature point - REAL(BDKi) :: Rx0p(3) !< \f$ \underline{R} \underline{x}^\prime_0 \f$ - !REAL(BDKi) :: Wrk(3) - + subroutine Calc_Oe_Pe_Qe(RR0, Stif, E1, Fc, cet, k1s, Oe, Pe, Qe) + REAL(BDKi), intent(in) :: RR0(:,:), Stif(:,:), E1(:), Fc(:), cet, k1s + REAL(BDKi), intent(inout) :: Oe(:,:), Pe(:,:), Qe(:,:) + REAL(BDKi) :: Wrk33(3,3) + REAL(BDKi) :: tildeE(3,3) + REAL(BDKi) :: C21(3,3) + REAL(BDKi) :: epsi(3,3) + REAL(BDKi) :: mu(3,3) + + !> ###Calculate the \f$ \underline{\underline{\mathcal{O}}} \f$ from equation (19) + !! + !! \f$ \underline{\underline{\mathcal{O}}} = + !! \begin{bmatrix} + !! \underline{\underline{0}} & \underline{\underline{C}}_{11} \tilde{E}_1 - \tilde{F} \\ + !! \underline{\underline{0}} & \underline{\underline{C}}_{21} \tilde{E}_1 - \tilde{M} + !! \end{bmatrix} + !! = \begin{bmatrix} + !! \underline{\underline{0}} & \psi_E - \tilde{F} \\ + !! \underline{\underline{0}} & \mu - \tilde{M} + !! \end{bmatrix} + !! \f$ + Wrk33 = OuterProduct(RR0(1:3,3), RR0(1:3,3)) ! z-direction in IEC coords + C21 = Stif(4:6,1:3) + cet*k1s*Wrk33(:,:) + + tildeE = SkewSymMat(E1) + epsi = MATMUL(Stif(1:3,1:3),tildeE) ! Stif is RR0 * p%Stif0_QP * RR0^T + mu = MATMUL(C21,tildeE) + + Oe = 0.0_BDKi + Oe(1:3,4:6) = epsi(1:3,1:3) - SkewSymMat(Fc(1:3)) + Oe(4:6,4:6) = mu(1:3,1:3) - SkewSymMat(Fc(4:6)) + + + !> ###Calculated \f$ \underline{\underline{\mathcal{P}}} \f$ from equation (20) + !! + !! \f$ \underline{\underline{\mathcal{P}}} = + !! \begin{bmatrix} + !! \underline{\underline{0}} & \underline{\underline{0}} \\ + !! \left(\underline{\underline{\bar{C}}}_{11} \tilde{E}_1 \right)^T + \tilde{F} + !! \left(\underline{\underline{\bar{C}}}_{11} \tilde{E}_1 \right)^T + !! \end{bmatrix} + !! = \begin{bmatrix} + !! \underline{\underline{0}} & \underline{\underline{0}} \\ + !! \psi_E^T + \tilde{F} & \mu^T + !! \end{bmatrix} \f$ + Pe = 0.0_BDKi + Pe(4:6,1:3) = TRANSPOSE(epsi) + SkewSymMat(Fc(1:3)) + Pe(4:6,4:6) = TRANSPOSE(mu) + + !> ###Calculated \f$ \underline{\underline{\mathcal{Q}}} \f$ from equation (21) + !! + !! \f{eqnarray*}{ + !! \underline{\underline{\mathcal{Q}}} + !! & =& \underline{\underline{\Upsilon}} \underline{\underline{\mathcal{O}}} + !! = \begin{bmatrix} 0 & 0 \\ + !! \tilde{E}_1^T & 0 \end{bmatrix} + !! \underline{\underline{\mathcal{O}}} \\ + !! \begin{bmatrix} 0 & 0 \\ + !! 0 & \underline{\underline{\mathcal{Q}}}_{22} \end{bmatrix} + !! & =& \tilde{E}_1^T \underline{\underline{\mathcal{O}}}_{12} + !! = - \tilde{E}_1 \underline{\underline{\mathcal{O}}}_{12} + !! \f}\n + !! Note: \f$ \tilde{E}_1^T = - \tilde{E}_1 \f$ + Qe(:,:) = 0.0_BDKi + Qe(4:6,4:6) = -MATMUL(tildeE,Oe(1:3,4:6)) + end subroutine + + subroutine Calc_Fc_Fd(RR0, uuu, E10, E1, kappa, Stif0, Stif, Fc, Fd, cet, k1s) + REAL(BDKi), intent(in) :: RR0(:,:), uuu(:), E10(:), E1(:), kappa(:), Stif0(:,:), Stif(:,:) + REAL(BDKi), intent(out) :: Fc(:), Fd(:), cet, k1s + REAL(BDKi) :: e1s + REAL(BDKi) :: eee(6) !< intermediate array for calculation Strain and curvature terms of Fc + REAL(BDKi) :: fff(6) !< intermediate array for calculation of the elastic force, Fc + REAL(BDKi) :: R(3,3) !< rotation matrix at quatrature point + REAL(BDKi) :: Rx0p(3) !< \f$ \underline{R} \underline{x}^\prime_0 \f$ + REAL(BDKi) :: Wrk(3) !> ### Calculate the 1D strain, \f$ \underline{\epsilon} \f$, equation (5) !! \f$ \underline{\epsilon} = \underline{x}^\prime_0 + \underline{u}^\prime - @@ -2773,9 +2829,9 @@ subroutine Calc_Fc_Fd() !! Note: \f$ \underline{\underline{R}}\underline{\underline{R}}_0 \f$ is used to go from the material basis into the inertial basis !! and the transpose for the other direction. ! eee(1:3) = m%qp%E1(1:3,idx_qp,nelem) - m%qp%RR0(1:3,3,idx_qp,nelem) ! Using RR0 z direction in IEC coords - call BD_CrvMatrixR(m%qp%uuu(4:6,idx_qp,nelem), R) ! Get rotation at QP as a matrix - Rx0p = matmul(R,p%E10(:,idx_qp,nelem)) ! Calculate rotated initial tangent - eee(1:3) = m%qp%E1(1:3,idx_qp,nelem) - Rx0p ! Use rotated initial tangent in place of RR0*i1 to eliminate likely mismatch between R0*i1 and x0' + call BD_CrvMatrixR(uuu(4:6), R) ! Get rotation at QP as a matrix + Rx0p = matmul(R,E10) ! Calculate rotated initial tangent + eee(1:3) = E1(1:3) - Rx0p ! Use rotated initial tangent in place of RR0*i1 to eliminate likely mismatch between R0*i1 and x0' !> ### Set the 1D sectional curvature, \f$ \underline{\kappa} \f$, equation (5) !! \f$ \underline{\kappa} = \underline{k} + \underline{\underline{R}}\underline{k}_i \f$ @@ -2795,7 +2851,7 @@ subroutine Calc_Fc_Fd() !! \f$ !! In other words, \f$ \tilde{k} = \left(\underline{\underline{R}}^\prime\underline{\underline{R}}^T \right) \f$. !! Note: \f$ \underline{\kappa} \f$ was already calculated in the BD_DisplacementQP routine - eee(4:6) = m%qp%kappa(1:3,idx_qp,nelem) + eee(4:6) = kappa(1:3) !FIXME: note that the k_i terms may not be documented correctly here. @@ -2827,7 +2883,7 @@ subroutine Calc_Fc_Fd() !! \underline{k} !! \end{array} \right\} \f$ !! - fff(1:6) = MATMUL(m%qp%Stif(:,:,idx_qp,nelem),eee) + fff(1:6) = MATMUL(Stif,eee) !> ###Calculate the extension twist coupling. @@ -2840,11 +2896,11 @@ subroutine Calc_Fc_Fd() ! Strain into the material basis (eq (39) of Dymore manual) !Wrk(:) = MATMUL(TRANSPOSE(m%qp%RR0(:,:,idx_qp,nelem)),eee(1:3)) !e1s = Wrk(3) !epsilon_{1} in material basis (for major axis of blade, which is z in the IEC formulation) - e1s = dot_product( m%qp%RR0(:,3,idx_qp,nelem), eee(1:3) ) + e1s = dot_product( RR0(:,3), eee(1:3) ) !Wrk(:) = MATMUL(TRANSPOSE(m%qp%RR0(:,:,idx_qp,nelem)),eee(4:6)) !k1s = Wrk(3) !kappa_{1} in material basis (for major axis of blade, which is z in the IEC formulation) - k1s = dot_product( m%qp%RR0(:,3,idx_qp,nelem), eee(4:6) ) + k1s = dot_product( RR0(:,3), eee(4:6) ) !> Add extension twist coupling terms to the \f$ \underline{F}^c_{a} \f$\n @@ -2862,9 +2918,9 @@ subroutine Calc_Fc_Fd() !! Note that with coverting to the FAST / IEC coordinate system, we now are using the Ixx and Iyy terms which are located at !! \f$ C_{et} = C_{4,4} + C_{5,5} \f$ ! Refer Section 1.4 in "Dymore User's Manual - Formulation and finite element implementation of beam elements". - cet= p%Stif0_QP(4,4,(nelem-1)*p%nqp+idx_qp) + p%Stif0_QP(5,5,(nelem-1)*p%nqp+idx_qp) ! Dymore theory (22) - m%qp%Fc(1:3,idx_qp,nelem) = fff(1:3) + 0.5_BDKi*cet*k1s*k1s*m%qp%RR0(1:3,3,idx_qp,nelem) ! Dymore theory (25a). Note z-axis is the length of blade. - m%qp%Fc(4:6,idx_qp,nelem) = fff(4:6) + cet*e1s*k1s*m%qp%RR0(1:3,3,idx_qp,nelem) ! Dymore theory (25b). Note z-axis is the length of blade. + cet = Stif0(4,4) + Stif0(5,5) ! Dymore theory (22) + Fc(1:3) = fff(1:3) + 0.5_BDKi*cet*k1s*k1s*RR0(1:3,3) ! Dymore theory (25a). Note z-axis is the length of blade. + Fc(4:6) = fff(4:6) + cet*e1s*k1s*RR0(1:3,3) ! Dymore theory (25b). Note z-axis is the length of blade. !> ###Calculate \f$ \underline{\mathcal{F}}^d \f$, equation (16) !! \f$ \underline{F}^d = @@ -2875,9 +2931,9 @@ subroutine Calc_Fc_Fd() !! = \begin{bmatrix} \underline{0} \\ !! \left(\underline{\mathcal{F}}^c \times \underline{E}_1 \right)^T !! \end{bmatrix} \f$ - m%qp%Fd(1:3,idx_qp,nelem) = 0.0_BDKi + Fd(1:3) = 0.0_BDKi ! ADP uu0 ref: If E1 is referenced against a different curve than Stif0_QP, there will be strange coupling terms here. - m%qp%Fd(4:6,idx_qp,nelem) = cross_product(m%qp%Fc(1:3,idx_qp,nelem), m%qp%E1(:,idx_qp,nelem)) + Fd(4:6) = cross_product(Fc(1:3), E1(:)) end subroutine Calc_Fc_Fd END SUBROUTINE BD_ElasticForce @@ -2898,32 +2954,29 @@ 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 !< 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) :: idx_node !< index to the GLL node INTEGER(IntKi) :: elem_start !< Starting quadrature point of current element - DO nelem=1,p%elem_total - - elem_start = p%node_elem_idx(nelem,1) - - DO idx_qp=1,p%nqp - - !> Calculate the values for the + ! Calculate the velocity term, velocity prime (derivative of velocity with respect to X-axis), and acceleration terms - ! Initialize to zero for summation - m%qp%vvv(:,idx_qp,nelem) = 0.0_BDKi - m%qp%vvp(:,idx_qp,nelem) = 0.0_BDKi + ! Loop through elements + do nelem = 1, p%elem_total - ! Calculate the velocity term, velocity prime (derivative of velocity with respect to X-axis), and acceleration terms - DO idx_node=1,p%nodes_per_elem - m%qp%vvv(:,idx_qp,nelem) = m%qp%vvv(:,idx_qp,nelem) + p%Shp(idx_node,idx_qp) * x%dqdt(:,elem_start-1+idx_node) - m%qp%vvp(:,idx_qp,nelem) = m%qp%vvp(:,idx_qp,nelem) + p%ShpDer(idx_node,idx_qp)/p%Jacobian(idx_qp,nelem) * x%dqdt(:,elem_start-1+idx_node) - ENDDO + ! Get start index of quadrature points for given element + elem_start = p%node_elem_idx(nelem,1) - ENDDO + ! Use matrix multiplication to interpolate velocity and velocity derivative to quadrature points + 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) - ENDDO + ! Apply Jacobian to get velocity derivative with respect to X-axis + do idx_qp = 1, p%nqp + m%qp%vvp(:,idx_qp,nelem) = m%qp%vvp(:,idx_qp,nelem) / p%Jacobian(idx_qp,nelem) + end do + end do END SUBROUTINE BD_QPDataVelocity @@ -2943,30 +2996,23 @@ 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 !< 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 INTEGER(IntKi) :: elem_start - - - ! Initialize to zero for summation - m%qp%aaa = 0.0_BDKi - - ! Calculate the acceleration term at t+dt (OtherState%acc is at t+dt) - - DO nelem=1,p%elem_total + ! Loop through elements + do nelem = 1, p%elem_total elem_start = p%node_elem_idx(nelem,1) - DO idx_qp=1,p%nqp - DO idx_node=1,p%nodes_per_elem - m%qp%aaa(:,idx_qp,nelem) = m%qp%aaa(:,idx_qp,nelem) + p%Shp(idx_node,idx_qp) * OtherState%acc(:,elem_start-1+idx_node) - END DO - END DO + ! Interpolate the acceleration term at t+dt (OtherState%acc is at t+dt) 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, OtherState%acc(:,elem_start:elem_start+p%nodes_per_elem-1), p%Shp, 0.0_BDKi, m%qp%aaa(:,:,nelem), ErrStat, ErrMsg) - END DO - + end do END SUBROUTINE BD_QPDataAcceleration @@ -3054,23 +3100,20 @@ SUBROUTINE BD_DissipativeForce( nelem, p, m,fact ) TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables LOGICAL, INTENT(IN ) :: fact - REAL(BDKi) :: SS_ome(3,3) - REAL(BDKi) :: ffd(6) - REAL(BDKi) :: D11(3,3) - REAL(BDKi) :: D12(3,3) - REAL(BDKi) :: D21(3,3) - REAL(BDKi) :: D22(3,3) - REAL(BDKi) :: b11(3,3) - REAL(BDKi) :: b12(3,3) - REAL(BDKi) :: alpha(3,3) - INTEGER(IntKi) :: idx_qp !< index of current quadrature point - - + REAL(BDKi) :: ffd_t(6) + IF (.NOT. fact) then ! skip all but Fc and Fd terms - DO idx_qp=1,p%nqp - call Calc_FC_FD_ffd() ! this modifies m%qp%Fc and m%qp%Fd + DO idx_qp=1,p%nqp + ! this modifies m%qp%Fc and m%qp%Fd + CALL Calc_FC_FD_ffd(m%qp%E1(:,idx_qp,nelem), & + m%qp%vvv(:,idx_qp,nelem), & + m%qp%vvp(:,idx_qp,nelem), & + m%qp%betaC(:,:,idx_qp,nelem), & + m%qp%Fc(:,idx_qp,nelem), & + m%qp%Fd(:,idx_qp,nelem), & + ffd_t) END DO ! bjj: we don't use these values when fact is FALSE, so let's save time and ignore them here, too. @@ -3083,72 +3126,101 @@ SUBROUTINE BD_DissipativeForce( nelem, p, m,fact ) ! m%qp%Yd(:,:,:,nelem) = 0.0_BDKi ELSE -!FIXME: sometime we can condense this with vector arithmetic and removing some variables that aren't needed. DO idx_qp=1,p%nqp - CALL Calc_FC_FD_ffd() ! this sets local variable ffd and modifies m%qp%Fc and m%qp%Fd - - D11 = m%qp%betaC(1:3,1:3,idx_qp,nelem) - D12 = m%qp%betaC(1:3,4:6,idx_qp,nelem) - D21 = m%qp%betaC(4:6,1:3,idx_qp,nelem) - D22 = m%qp%betaC(4:6,4:6,idx_qp,nelem) - - b11(1:3,1:3) = -MATMUL(SkewSymMat(m%qp%E1(:,idx_qp,nelem)),D11) - b12(1:3,1:3) = -MATMUL(SkewSymMat(m%qp%E1(:,idx_qp,nelem)),D12) - - SS_ome = SkewSymMat( m%qp%vvv(4:6,idx_qp,nelem) ) - - ! Compute stiffness matrix Sd - m%qp%Sd(1:3,1:3,idx_qp,nelem) = -MATMUL(D11,SS_ome) - m%qp%Sd(1:3,4:6,idx_qp,nelem) = -MATMUL(D12,SS_ome) - m%qp%Sd(4:6,1:3,idx_qp,nelem) = -MATMUL(D21,SS_ome) - m%qp%Sd(4:6,4:6,idx_qp,nelem) = -MATMUL(D22,SS_ome) - - ! Compute stiffness matrix Pd - m%qp%Pd(:,:,idx_qp,nelem) = 0.0_BDKi - m%qp%Pd(4:6,1:3,idx_qp,nelem) = SkewSymMat(ffd(1:3)) - MATMUL(b11,SS_ome) - m%qp%Pd(4:6,4:6,idx_qp,nelem) = -MATMUL(b12,SS_ome) - - ! Compute stiffness matrix Od - m%qp%Od(:,1:3,idx_qp,nelem) = 0.0_BDKi - alpha = SkewSymMat(m%qp%vvp(1:3,idx_qp,nelem)) - MATMUL(SS_ome,SkewSymMat(m%qp%E1(:,idx_qp,nelem))) - m%qp%Od(1:3,4:6,idx_qp,nelem) = MATMUL(D11,alpha) - SkewSymMat(ffd(1:3)) - m%qp%Od(4:6,4:6,idx_qp,nelem) = MATMUL(D21,alpha) - SkewSymMat(ffd(4:6)) - - ! Compute stiffness matrix Qd - m%qp%Qd(:,:,idx_qp,nelem) = 0.0_BDKi - m%qp%Qd(4:6,4:6,idx_qp,nelem) = -MATMUL(SkewSymMat(m%qp%E1(:,idx_qp,nelem)),m%qp%Od(1:3,4:6,idx_qp,nelem)) - ! Compute gyroscopic matrix Gd - m%qp%Gd(:,1:3,idx_qp,nelem) = 0.0_BDKi - m%qp%Gd(1:3,4:6,idx_qp,nelem) = TRANSPOSE(b11) - m%qp%Gd(4:6,4:6,idx_qp,nelem) = TRANSPOSE(b12) - - ! Compute gyroscopic matrix Xd - m%qp%Xd(:,:,idx_qp,nelem) = 0.0_BDKi - m%qp%Xd(4:6,4:6,idx_qp,nelem) = -MATMUL(SkewSymMat(m%qp%E1(:,idx_qp,nelem)),m%qp%Gd(1:3,4:6,idx_qp,nelem)) - - ! Compute gyroscopic matrix Yd - m%qp%Yd(1:3,:,idx_qp,nelem) = 0.0_BDKi - m%qp%Yd(4:6,1:3,idx_qp,nelem) = b11 - m%qp%Yd(4:6,4:6,idx_qp,nelem) = b12 + ! this sets local variable ffd and modifies m%qp%Fc and m%qp%Fd + CALL Calc_FC_FD_ffd(m%qp%E1(:,idx_qp,nelem), & + m%qp%vvv(:,idx_qp,nelem), & + m%qp%vvp(:,idx_qp,nelem), & + m%qp%betaC(:,:,idx_qp,nelem), & + m%qp%Fc(:,idx_qp,nelem), & + m%qp%Fd(:,idx_qp,nelem), & + ffd_t) + + call Calc_Sd_Pd_Od_Qd_Gd_Xd_Yd(m%qp%E1(:,idx_qp,nelem), & + m%qp%vvp(:,idx_qp,nelem), & + m%qp%betaC(:,:,idx_qp,nelem), & + ffd_t, & + m%qp%Sd(:,:,idx_qp,nelem), & + m%qp%Od(:,:,idx_qp,nelem), & + m%qp%Qd(:,:,idx_qp,nelem), & + m%qp%Gd(:,:,idx_qp,nelem), & + m%qp%Xd(:,:,idx_qp,nelem), & + m%qp%Yd(:,:,idx_qp,nelem), & + m%qp%Pd(:,:,idx_qp,nelem)) END DO ENDIF CONTAINS - SUBROUTINE Calc_FC_FD_ffd() - REAL(BDKi) :: eed(6) - + subroutine Calc_Sd_Pd_Od_Qd_Gd_Xd_Yd(E1, vvp, betaC, ffd, Sd, Od, Qd, Gd, Xd, Yd, Pd) + REAL(BDKi), intent(in) :: E1(:), vvp(:), betaC(:,:), ffd(:) + REAL(BDKi), intent(out) :: Sd(:,:), Od(:,:), Qd(:,:), Gd(:,:), Xd(:,:), Yd(:,:), Pd(:,:) + REAL(BDKi) :: D11(3,3), D12(3,3), D21(3,3), D22(3,3) + REAL(BDKi) :: b11(3,3), b12(3,3) + REAL(BDKi) :: alpha(3,3) + REAL(BDKi) :: SS_ome(3,3) + + D11 = betaC(1:3,1:3) + D12 = betaC(1:3,4:6) + D21 = betaC(4:6,1:3) + D22 = betaC(4:6,4:6) + + b11(1:3,1:3) = -MATMUL(SkewSymMat(E1),D11) + b12(1:3,1:3) = -MATMUL(SkewSymMat(E1),D12) + + SS_ome = SkewSymMat( m%qp%vvv(4:6,idx_qp,nelem) ) + + ! Compute stiffness matrix Sd + Sd(1:3,1:3) = -MATMUL(D11,SS_ome) + Sd(1:3,4:6) = -MATMUL(D12,SS_ome) + Sd(4:6,1:3) = -MATMUL(D21,SS_ome) + Sd(4:6,4:6) = -MATMUL(D22,SS_ome) + + ! Compute stiffness matrix Pd + Pd = 0.0_BDKi + Pd(4:6,1:3) = SkewSymMat(ffd(1:3)) - MATMUL(b11,SS_ome) + Pd(4:6,4:6) = -MATMUL(b12,SS_ome) + + ! Compute stiffness matrix Od + alpha = SkewSymMat(vvp(1:3)) - MATMUL(SS_ome,SkewSymMat(E1)) + Od(:,1:3) = 0.0_BDKi + Od(1:3,4:6) = MATMUL(D11,alpha) - SkewSymMat(ffd(1:3)) + Od(4:6,4:6) = MATMUL(D21,alpha) - SkewSymMat(ffd(4:6)) + + ! Compute stiffness matrix Qd + Qd = 0.0_BDKi + Qd(4:6,4:6) = -MATMUL(SkewSymMat(E1),Od(1:3,4:6)) + + ! Compute gyroscopic matrix Gd + Gd(:,1:3) = 0.0_BDKi + Gd(1:3,4:6) = TRANSPOSE(b11) + Gd(4:6,4:6) = TRANSPOSE(b12) + + ! Compute gyroscopic matrix Xd + Xd = 0.0_BDKi + Xd(4:6,4:6) = -MATMUL(SkewSymMat(E1),Gd(1:3,4:6)) + + ! Compute gyroscopic matrix Yd + Yd(1:3,:) = 0.0_BDKi + Yd(4:6,1:3) = b11 + Yd(4:6,4:6) = b12 + end subroutine + + SUBROUTINE Calc_FC_FD_ffd(E1, vvv, vvp, betaC, Fc, Fd, ffd) + REAL(BDKi), intent(in) :: E1(:), vvv(:), vvp(:), betaC(:,:) + REAL(BDKi), intent(out) :: Fc(:), Fd(:), ffd(:) + REAL(BDKi) :: eed(6) + ! Compute strain rates - eed = m%qp%vvp(1:6,idx_qp,nelem) - eed(1:3) = eed(1:3) + cross_product(m%qp%E1(:,idx_qp,nelem),m%qp%vvv(4:6,idx_qp,nelem)) + eed = vvp + eed(1:3) = eed(1:3) + cross_product(E1,vvv(4:6)) ! Compute dissipative force - ffd(1:6) = MATMUL(m%qp%betaC(:,:,idx_qp,nelem),eed) + ffd(1:6) = MATMUL(betaC(:,:),eed) - m%qp%Fc(1:6,idx_qp,nelem) = m%qp%Fc(1:6,idx_qp,nelem) + ffd - m%qp%Fd(4:6,idx_qp,nelem) = m%qp%Fd(4:6,idx_qp,nelem) + cross_product(ffd(1:3),m%qp%E1(:,idx_qp,nelem)) - + Fc(1:6) = Fc(1:6) + ffd + Fd(4:6) = Fd(4:6) + cross_product(ffd(1:3),E1) END SUBROUTINE Calc_FC_FD_ffd END SUBROUTINE BD_DissipativeForce @@ -3265,21 +3337,21 @@ SUBROUTINE BD_InertialMassMatrix( nelem, p, m ) INTEGER(IntKi) :: i INTEGER(IntKi) :: idx_qp !< index of current quadrature point - do idx_qp=1,p%nqp + m%qp%Mi(:,:,:,nelem) = 0.0_BDKi - m%qp%Mi(:,:,idx_qp,nelem) = 0.0_BDKi + do idx_qp=1,p%nqp ! Set diagonal values for mass DO i=1,3 - m%qp%Mi(i,i,idx_qp,nelem) = p%qp%mmm(idx_qp,nelem) + m%qp%Mi(idx_qp,i,i,nelem) = p%qp%mmm(idx_qp,nelem) ENDDO ! set mass-inertia coupling terms - m%qp%Mi(1:3,4:6,idx_qp,nelem) = -SkewSymMat(m%qp%RR0mEta(:,idx_qp,nelem)) - m%qp%Mi(4:6,1:3,idx_qp,nelem) = SkewSymMat(m%qp%RR0mEta(:,idx_qp,nelem)) + m%qp%Mi(idx_qp,1:3,4:6,nelem) = -SkewSymMat(m%qp%RR0mEta(:,idx_qp,nelem)) + m%qp%Mi(idx_qp,4:6,1:3,nelem) = SkewSymMat(m%qp%RR0mEta(:,idx_qp,nelem)) ! Set inertia terms - m%qp%Mi(4:6,4:6,idx_qp,nelem) = m%qp%rho(:,:,idx_qp,nelem) + m%qp%Mi(idx_qp,4:6,4:6,nelem) = m%qp%rho(:,:,idx_qp,nelem) end do @@ -3776,19 +3848,10 @@ SUBROUTINE Integrate_ElementForce(nelem, p, m) INTEGER(IntKi) :: idx_dof1 CHARACTER(*), PARAMETER :: RoutineName = 'Integrate_ElementForce' - DO i=1,p%nodes_per_elem - DO idx_dof1=1,p%dof_node - - m%elf(idx_dof1,i) = 0.0_BDKi - - DO idx_qp = 1,p%nqp ! dot_product( m%qp%Fc (idx_dof1,:,nelem), p%QPtw_ShpDer( :,i)) - m%elf(idx_dof1,i) = m%elf(idx_dof1,i) - m%qp%Fc (idx_dof1,idx_qp,nelem)*p%QPtw_ShpDer(idx_qp,i) - END DO - - DO idx_qp = 1,p%nqp ! dot_product(m%qp%Ftemp(idx_dof1,:,nelem), p%QPtw_Shp_Jac(:,i,nelem) ) - m%elf(idx_dof1,i) = m%elf(idx_dof1,i) - m%qp%Ftemp(idx_dof1,idx_qp,nelem)*p%QPtw_Shp_Jac(idx_qp,i,nelem) - END DO - + DO i = 1, p%nodes_per_elem + DO idx_dof1 = 1, p%dof_node + m%elf(idx_dof1,i) = -(dot_product(m%qp%Fc(idx_dof1,:,nelem), p%QPtw_ShpDer(:,i)) + & + dot_product(m%qp%Ftemp(idx_dof1,:,nelem), p%QPtw_Shp_Jac(:,i,nelem))) ENDDO ENDDO @@ -3801,31 +3864,28 @@ SUBROUTINE Integrate_ElementMass(nelem, p, m) TYPE(BD_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi) :: idx_qp - INTEGER(IntKi) :: i - INTEGER(IntKi) :: j - INTEGER(IntKi) :: idx_dof1, idx_dof2 CHARACTER(*), PARAMETER :: RoutineName = 'Integrate_ElementMass' - - DO j=1,p%nodes_per_elem - DO idx_dof2=1,p%dof_node - - DO i=1,p%nodes_per_elem - DO idx_dof1=1,p%dof_node - - m%elm(idx_dof1,i,idx_dof2,j) = 0.0_BDKi - - DO idx_qp = 1,p%nqp - m%elm(idx_dof1,i,idx_dof2,j) = m%elm(idx_dof1,i,idx_dof2,j) + m%qp%Mi(idx_dof1,idx_dof2,idx_qp,nelem)*p%QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem) - END DO - - END DO - END DO - + INTEGER(IntKi) :: ErrStat + CHARACTER(ErrMsgLen) :: ErrMsg + INTEGER(IntKi) :: j + INTEGER(IntKi) :: idx_dof2 + ! INTEGER(IntKi) :: idx_qp + ! INTEGER(IntKi) :: i + ! INTEGER(IntKi) :: idx_dof1 + + DO j = 1, p%nodes_per_elem + DO idx_dof2 = 1, p%dof_node + ! DO i = 1, p%nodes_per_elem + ! DO idx_dof1 = 1, p%dof_node + ! do idx_qp = 1, p%nqp + ! m%elm(idx_dof1,i,idx_dof2,j) = m%elm(idx_dof1,i,idx_dof2,j) + (m%qp%Mi(idx_qp,idx_dof1,idx_dof2,nelem),p%QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem)) + ! end do + ! END DO + ! END DO + call LAPACK_gemm('T', 'N', 1.0_R8Ki, m%qp%Mi(:,:,idx_dof2,nelem), p%QPtw_Shp_Shp_Jac(:,:,j,nelem), 0.0_R8Ki, m%elm(:,:,idx_dof2,j), ErrStat, ErrMsg) END DO END DO - END SUBROUTINE Integrate_ElementMass @@ -5587,10 +5647,7 @@ SUBROUTINE BD_CalcForceAcc( u, p, OtherState, m, ErrStat, ErrMsg ) ! Add point forces at GLL points to RHS of equation. - DO j=1,p%node_total - m%RHS(1:3,j) = m%RHS(1:3,j) + m%PointLoadLcl(1:3,j) - m%RHS(4:6,j) = m%RHS(4:6,j) + m%PointLoadLcl(4:6,j) - ENDDO + m%RHS = m%RHS + m%PointLoadLcl ! Now set the root reaction force. @@ -5798,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 @@ -5821,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 + ! 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 - 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) - 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 @@ -6103,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 + ! 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 - - END IF - IF ( PRESENT( dXdx ) ) THEN + ! 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 - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + ! Loop through state variables + do i = 1, size(Vars%x) - 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 number of linearization perturbations in variable + do j = 1, Vars%x(i)%Num - IF ( PRESENT( dXddx ) ) THEN - if (allocated(dXddx)) deallocate(dXddx) - END IF + ! Calculate column index + col = Vars%x(i)%iLoc(1) + j - 1 - IF ( PRESENT( dZdx ) ) THEN - if (allocated(dZdx)) deallocate(dZdx) - 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_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) - 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 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) -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 ) -!.................................................................................................................................. - - 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 @@ -6495,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 @@ -6548,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 !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ @@ -6853,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 @@ -6866,8 +6638,8 @@ subroutine BD_UpdateGlobalRef(u, p, x, OtherState, ErrStat, ErrMsg) character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message real(R8Ki) :: GlbWM_old(3), GlbWM_new(3), GlbWM_diff(3) 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 @@ -6906,8 +6678,8 @@ subroutine BD_UpdateGlobalRef(u, p, x, OtherState, ErrStat, ErrMsg) matmul(GlbRot_new, p%uuN0(1:3, j, i))) ! Update the node orientation rotation of the node - call BD_CrvCompose(x%q(4:6, temp_id), GlbWM_diff, x%q(4:6, temp_id), FLAG_R1R2) - + NodeRot_old = x%q(4:6, temp_id) + call BD_CrvCompose(x%q(4:6, temp_id), GlbWM_diff, NodeRot_old, FLAG_R1R2) end do end do diff --git a/modules/beamdyn/src/BeamDyn_IO.f90 b/modules/beamdyn/src/BeamDyn_IO.f90 index 2a5ecea0de..a16faf23c5 100644 --- a/modules/beamdyn/src/BeamDyn_IO.f90 +++ b/modules/beamdyn/src/BeamDyn_IO.f90 @@ -756,10 +756,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) @@ -2052,609 +2048,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) - - 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 - call BD_CrvMatrixR( x%q( 4:6, node ), 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, dx * perturb_sign, dof-3 ) ! NOTE: call not using DCM_logmap - - rotation = transpose(orientation) - call BD_CrvExtractCrv( rotation, x%q( 4:6, node ), ErrStat2, ErrMsg2 ) ! return the w-m parameters of the new orientation - 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_Subs.f90 b/modules/beamdyn/src/BeamDyn_Subs.f90 index 519a40e589..c1b9796a07 100644 --- a/modules/beamdyn/src/BeamDyn_Subs.f90 +++ b/modules/beamdyn/src/BeamDyn_Subs.f90 @@ -242,32 +242,31 @@ SUBROUTINE BD_CrvCompose( rr, pp, qq, flag) REAL(BDKi), INTENT( OUT):: rr(3) !< Composed rotation REAL(BDKi), INTENT(IN ):: pp(3) !< Input rotation 1 REAL(BDKi), INTENT(IN ):: qq(3) !< Input rotation 2 - INTEGER ,INTENT(IN ):: flag !< Option flag + INTEGER, INTENT(IN ):: flag !< Option flag - REAL(BDKi) :: pp0 - REAL(BDKi) :: p(3) - REAL(BDKi) :: qq0 - REAL(BDKi) :: q(3) + REAL(BDKi) :: pp0, p(3) + REAL(BDKi) :: qq0, q(3) REAL(BDKi) :: tr1 - REAL(BDKi) :: Delta1 - REAL(BDKi) :: Delta2 + REAL(BDKi) :: Delta1, Delta2 REAL(BDKi) :: dd1 REAL(BDKi) :: dd2 - ! Set the local values pp and qq allowing for the transpose - - IF(flag==FLAG_R1TR2 .OR. flag==FLAG_R1TR2T) THEN ! "transpose" (negative) of first rotation parameter - p = -pp - ELSE - p = pp - ENDIF - - IF(flag==FLAG_R1R2T .OR. flag==FLAG_R1TR2T) THEN ! "transpose" (negative) of second rotation parameter - q = -qq - ELSE - q = qq - ENDIF + ! Set the local values pp (R1) and qq (R2) and apply transpose based on flag value + select case (flag) + case (FLAG_R1R2) + p = pp ! R1 + q = qq ! R2 + case (FLAG_R1R2T) + p = pp ! R1 + q = -qq ! R2^T + case (FLAG_R1TR2) + p = -pp ! R1^T + q = qq ! R2 + case (FLAG_R1TR2T) + p = -pp ! R1^T + q = -qq ! R2^T + end select !> ## Composing the resulting Wiener-Milenkovic parameter !! @@ -289,7 +288,6 @@ SUBROUTINE BD_CrvCompose( rr, pp, qq, flag) !! !! - ! Calculate pp0 and qq0. See Bauchau for the mathematics here (equations 8 to 9 and interviening text) pp0 = 2.0_BDKi - dot_product(p,p) / 8.0_BDKi ! p_0 @@ -297,19 +295,16 @@ SUBROUTINE BD_CrvCompose( rr, pp, qq, flag) Delta1 = (4.0_BDKi - pp0) * (4.0_BDKi - qq0) ! Delta_1 in Bauchau Delta2 = pp0 * qq0 - dot_product(p,q) ! Delta_2 in Bauchau - dd1 = Delta1 + Delta2 ! Denomimator term for \Delta_2 >= 0 - dd2 = Delta1 - Delta2 ! Denomimator term for \Delta_2 < 0 - ! Rescaling to remove singularities at +/- 2 \pi - ! Note: changed this to test on \Delta_2 (instead of dd1 > dd2) for better consistency with documentation. - IF ( Delta2 >= 0.0_BDKi ) THEN - tr1 = 4.0_BDKi / dd1 + ! Rescaling to remove singularities at +/- 2 \pi + ! Note: changed this to test on \Delta_2 (instead of dd1 > dd2) for better consistency with documentation. + IF (Delta2 >= 0.0_BDKi) THEN + tr1 = 4.0_BDKi / (Delta1 + Delta2) ELSE - tr1 = -4.0_BDKi / dd2 + tr1 = -4.0_BDKi / (Delta1 - Delta2) ENDIF - rr = tr1 * (qq0*p + pp0*q + cross_product(p,q)) - + rr = tr1 * (qq0*p + pp0*q + Cross_Product(p,q)) END SUBROUTINE BD_CrvCompose diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 6980255649..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 @@ -415,15 +428,15 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -434,8 +447,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -448,9 +461,10 @@ 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, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) + 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 @@ -461,8 +475,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -473,8 +487,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) + 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 @@ -485,8 +499,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + 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 @@ -497,8 +511,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -509,8 +523,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + 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 @@ -521,8 +535,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + 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 @@ -533,8 +547,8 @@ subroutine BD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -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) @@ -612,13 +635,33 @@ subroutine BD_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(BD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + 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 @@ -635,7 +678,7 @@ subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BD_CopyBladeInputData' ErrStat = ErrID_None @@ -643,8 +686,8 @@ subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%station_total = SrcBladeInputDataData%station_total DstBladeInputDataData%format_index = SrcBladeInputDataData%format_index if (allocated(SrcBladeInputDataData%station_eta)) then - LB(1:1) = lbound(SrcBladeInputDataData%station_eta, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%station_eta, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%station_eta) + UB(1:1) = ubound(SrcBladeInputDataData%station_eta) if (.not. allocated(DstBladeInputDataData%station_eta)) then allocate(DstBladeInputDataData%station_eta(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -655,8 +698,8 @@ subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%station_eta = SrcBladeInputDataData%station_eta end if if (allocated(SrcBladeInputDataData%stiff0)) then - LB(1:3) = lbound(SrcBladeInputDataData%stiff0, kind=B8Ki) - UB(1:3) = ubound(SrcBladeInputDataData%stiff0, kind=B8Ki) + LB(1:3) = lbound(SrcBladeInputDataData%stiff0) + UB(1:3) = ubound(SrcBladeInputDataData%stiff0) if (.not. allocated(DstBladeInputDataData%stiff0)) then allocate(DstBladeInputDataData%stiff0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -667,8 +710,8 @@ subroutine BD_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%stiff0 = SrcBladeInputDataData%stiff0 end if if (allocated(SrcBladeInputDataData%mass0)) then - LB(1:3) = lbound(SrcBladeInputDataData%mass0, kind=B8Ki) - UB(1:3) = ubound(SrcBladeInputDataData%mass0, kind=B8Ki) + LB(1:3) = lbound(SrcBladeInputDataData%mass0) + UB(1:3) = ubound(SrcBladeInputDataData%mass0) if (.not. allocated(DstBladeInputDataData%mass0)) then allocate(DstBladeInputDataData%mass0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -719,7 +762,7 @@ subroutine BD_UnPackBladeInputData(RF, OutData) type(RegFile), intent(inout) :: RF type(BladeInputData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackBladeInputData' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -738,7 +781,7 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BD_CopyInputFile' @@ -747,8 +790,8 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%member_total = SrcInputFileData%member_total DstInputFileData%kp_total = SrcInputFileData%kp_total if (allocated(SrcInputFileData%kp_member)) then - LB(1:1) = lbound(SrcInputFileData%kp_member, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%kp_member, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%kp_member) + UB(1:1) = ubound(SrcInputFileData%kp_member) if (.not. allocated(DstInputFileData%kp_member)) then allocate(DstInputFileData%kp_member(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -776,8 +819,8 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%tngt_stf_pert = SrcInputFileData%tngt_stf_pert DstInputFileData%tngt_stf_difftol = SrcInputFileData%tngt_stf_difftol if (allocated(SrcInputFileData%kp_coordinate)) then - LB(1:2) = lbound(SrcInputFileData%kp_coordinate, kind=B8Ki) - UB(1:2) = ubound(SrcInputFileData%kp_coordinate, kind=B8Ki) + LB(1:2) = lbound(SrcInputFileData%kp_coordinate) + UB(1:2) = ubound(SrcInputFileData%kp_coordinate) if (.not. allocated(DstInputFileData%kp_coordinate)) then allocate(DstInputFileData%kp_coordinate(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -792,15 +835,14 @@ 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 DstInputFileData%OutNd = SrcInputFileData%OutNd DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -814,8 +856,8 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%OutFmt = SrcInputFileData%OutFmt DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts if (allocated(SrcInputFileData%BldNd_OutList)) then - LB(1:1) = lbound(SrcInputFileData%BldNd_OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%BldNd_OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%BldNd_OutList) + UB(1:1) = ubound(SrcInputFileData%BldNd_OutList) if (.not. allocated(DstInputFileData%BldNd_OutList)) then allocate(DstInputFileData%BldNd_OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -826,8 +868,8 @@ subroutine BD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList end if if (allocated(SrcInputFileData%BldNd_BlOutNd)) then - LB(1:1) = lbound(SrcInputFileData%BldNd_BlOutNd, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%BldNd_BlOutNd, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%BldNd_BlOutNd) + UB(1:1) = ubound(SrcInputFileData%BldNd_BlOutNd) if (.not. allocated(DstInputFileData%BldNd_BlOutNd)) then allocate(DstInputFileData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -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) @@ -917,7 +958,7 @@ subroutine BD_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(BD_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackInputFile' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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 @@ -966,14 +1006,14 @@ subroutine BD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BD_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%q)) then - LB(1:2) = lbound(SrcContStateData%q, kind=B8Ki) - UB(1:2) = ubound(SrcContStateData%q, kind=B8Ki) + LB(1:2) = lbound(SrcContStateData%q) + UB(1:2) = ubound(SrcContStateData%q) if (.not. allocated(DstContStateData%q)) then allocate(DstContStateData%q(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -984,8 +1024,8 @@ subroutine BD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta DstContStateData%q = SrcContStateData%q end if if (allocated(SrcContStateData%dqdt)) then - LB(1:2) = lbound(SrcContStateData%dqdt, kind=B8Ki) - UB(1:2) = ubound(SrcContStateData%dqdt, kind=B8Ki) + LB(1:2) = lbound(SrcContStateData%dqdt) + UB(1:2) = ubound(SrcContStateData%dqdt) if (.not. allocated(DstContStateData%dqdt)) then allocate(DstContStateData%dqdt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1026,7 +1066,7 @@ subroutine BD_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(BD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackContState' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1119,14 +1159,14 @@ subroutine BD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BD_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%acc)) then - LB(1:2) = lbound(SrcOtherStateData%acc, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%acc, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%acc) + UB(1:2) = ubound(SrcOtherStateData%acc) if (.not. allocated(DstOtherStateData%acc)) then allocate(DstOtherStateData%acc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1137,8 +1177,8 @@ subroutine BD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err DstOtherStateData%acc = SrcOtherStateData%acc end if if (allocated(SrcOtherStateData%xcc)) then - LB(1:2) = lbound(SrcOtherStateData%xcc, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%xcc, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%xcc) + UB(1:2) = ubound(SrcOtherStateData%xcc) if (.not. allocated(DstOtherStateData%xcc)) then allocate(DstOtherStateData%xcc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1189,7 +1229,7 @@ subroutine BD_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(BD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackOtherState' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1208,14 +1248,14 @@ subroutine BD_CopyqpParam(SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BD_CopyqpParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcqpParamData%mmm)) then - LB(1:2) = lbound(SrcqpParamData%mmm, kind=B8Ki) - UB(1:2) = ubound(SrcqpParamData%mmm, kind=B8Ki) + LB(1:2) = lbound(SrcqpParamData%mmm) + UB(1:2) = ubound(SrcqpParamData%mmm) if (.not. allocated(DstqpParamData%mmm)) then allocate(DstqpParamData%mmm(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1226,8 +1266,8 @@ subroutine BD_CopyqpParam(SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, Err DstqpParamData%mmm = SrcqpParamData%mmm end if if (allocated(SrcqpParamData%mEta)) then - LB(1:3) = lbound(SrcqpParamData%mEta, kind=B8Ki) - UB(1:3) = ubound(SrcqpParamData%mEta, kind=B8Ki) + LB(1:3) = lbound(SrcqpParamData%mEta) + UB(1:3) = ubound(SrcqpParamData%mEta) if (.not. allocated(DstqpParamData%mEta)) then allocate(DstqpParamData%mEta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1268,7 +1308,7 @@ subroutine BD_UnPackqpParam(RF, OutData) type(RegFile), intent(inout) :: RF type(qpParam), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackqpParam' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1282,19 +1322,31 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 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 if (allocated(SrcParamData%uuN0)) then - LB(1:3) = lbound(SrcParamData%uuN0, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%uuN0, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%uuN0) + UB(1:3) = ubound(SrcParamData%uuN0) if (.not. allocated(DstParamData%uuN0)) then allocate(DstParamData%uuN0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1305,8 +1357,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%uuN0 = SrcParamData%uuN0 end if if (allocated(SrcParamData%Stif0_QP)) then - LB(1:3) = lbound(SrcParamData%Stif0_QP, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%Stif0_QP, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%Stif0_QP) + UB(1:3) = ubound(SrcParamData%Stif0_QP) if (.not. allocated(DstParamData%Stif0_QP)) then allocate(DstParamData%Stif0_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1317,8 +1369,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Stif0_QP = SrcParamData%Stif0_QP end if if (allocated(SrcParamData%Mass0_QP)) then - LB(1:3) = lbound(SrcParamData%Mass0_QP, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%Mass0_QP, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%Mass0_QP) + UB(1:3) = ubound(SrcParamData%Mass0_QP) if (.not. allocated(DstParamData%Mass0_QP)) then allocate(DstParamData%Mass0_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1330,8 +1382,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%gravity = SrcParamData%gravity if (allocated(SrcParamData%segment_eta)) then - LB(1:1) = lbound(SrcParamData%segment_eta, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%segment_eta, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%segment_eta) + UB(1:1) = ubound(SrcParamData%segment_eta) if (.not. allocated(DstParamData%segment_eta)) then allocate(DstParamData%segment_eta(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1342,8 +1394,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%segment_eta = SrcParamData%segment_eta end if if (allocated(SrcParamData%member_eta)) then - LB(1:1) = lbound(SrcParamData%member_eta, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%member_eta, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%member_eta) + UB(1:1) = ubound(SrcParamData%member_eta) if (.not. allocated(DstParamData%member_eta)) then allocate(DstParamData%member_eta(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1360,8 +1412,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%beta = SrcParamData%beta DstParamData%tol = SrcParamData%tol if (allocated(SrcParamData%QPtN)) then - LB(1:1) = lbound(SrcParamData%QPtN, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%QPtN, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%QPtN) + UB(1:1) = ubound(SrcParamData%QPtN) if (.not. allocated(DstParamData%QPtN)) then allocate(DstParamData%QPtN(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1372,8 +1424,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtN = SrcParamData%QPtN end if if (allocated(SrcParamData%QPtWeight)) then - LB(1:1) = lbound(SrcParamData%QPtWeight, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%QPtWeight, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%QPtWeight) + UB(1:1) = ubound(SrcParamData%QPtWeight) if (.not. allocated(DstParamData%QPtWeight)) then allocate(DstParamData%QPtWeight(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1384,8 +1436,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtWeight = SrcParamData%QPtWeight end if if (allocated(SrcParamData%Shp)) then - LB(1:2) = lbound(SrcParamData%Shp, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Shp, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Shp) + UB(1:2) = ubound(SrcParamData%Shp) if (.not. allocated(DstParamData%Shp)) then allocate(DstParamData%Shp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1396,8 +1448,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Shp = SrcParamData%Shp end if if (allocated(SrcParamData%ShpDer)) then - LB(1:2) = lbound(SrcParamData%ShpDer, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%ShpDer, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%ShpDer) + UB(1:2) = ubound(SrcParamData%ShpDer) if (.not. allocated(DstParamData%ShpDer)) then allocate(DstParamData%ShpDer(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1408,8 +1460,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ShpDer = SrcParamData%ShpDer end if if (allocated(SrcParamData%Jacobian)) then - LB(1:2) = lbound(SrcParamData%Jacobian, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jacobian, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Jacobian) + UB(1:2) = ubound(SrcParamData%Jacobian) if (.not. allocated(DstParamData%Jacobian)) then allocate(DstParamData%Jacobian(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1420,8 +1472,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jacobian = SrcParamData%Jacobian end if if (allocated(SrcParamData%uu0)) then - LB(1:3) = lbound(SrcParamData%uu0, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%uu0, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%uu0) + UB(1:3) = ubound(SrcParamData%uu0) if (.not. allocated(DstParamData%uu0)) then allocate(DstParamData%uu0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1432,8 +1484,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%uu0 = SrcParamData%uu0 end if if (allocated(SrcParamData%rrN0)) then - LB(1:3) = lbound(SrcParamData%rrN0, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%rrN0, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%rrN0) + UB(1:3) = ubound(SrcParamData%rrN0) if (.not. allocated(DstParamData%rrN0)) then allocate(DstParamData%rrN0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1444,8 +1496,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rrN0 = SrcParamData%rrN0 end if if (allocated(SrcParamData%E10)) then - LB(1:3) = lbound(SrcParamData%E10, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%E10, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%E10) + UB(1:3) = ubound(SrcParamData%E10) if (.not. allocated(DstParamData%E10)) then allocate(DstParamData%E10(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1457,8 +1509,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%nodes_per_elem = SrcParamData%nodes_per_elem if (allocated(SrcParamData%node_elem_idx)) then - LB(1:2) = lbound(SrcParamData%node_elem_idx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%node_elem_idx, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%node_elem_idx) + UB(1:2) = ubound(SrcParamData%node_elem_idx) if (.not. allocated(DstParamData%node_elem_idx)) then allocate(DstParamData%node_elem_idx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1485,8 +1537,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%OutInputs = SrcParamData%OutInputs DstParamData%NumOuts = SrcParamData%NumOuts if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + 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 @@ -1503,8 +1555,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NNodeOuts = SrcParamData%NNodeOuts DstParamData%OutNd = SrcParamData%OutNd if (allocated(SrcParamData%NdIndx)) then - LB(1:1) = lbound(SrcParamData%NdIndx, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NdIndx, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%NdIndx) + UB(1:1) = ubound(SrcParamData%NdIndx) if (.not. allocated(DstParamData%NdIndx)) then allocate(DstParamData%NdIndx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1515,8 +1567,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NdIndx = SrcParamData%NdIndx end if if (allocated(SrcParamData%NdIndxInverse)) then - LB(1:1) = lbound(SrcParamData%NdIndxInverse, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NdIndxInverse, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%NdIndxInverse) + UB(1:1) = ubound(SrcParamData%NdIndxInverse) if (.not. allocated(DstParamData%NdIndxInverse)) then allocate(DstParamData%NdIndxInverse(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1527,8 +1579,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NdIndxInverse = SrcParamData%NdIndxInverse end if if (allocated(SrcParamData%OutNd2NdElem)) then - LB(1:2) = lbound(SrcParamData%OutNd2NdElem, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%OutNd2NdElem, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%OutNd2NdElem) + UB(1:2) = ubound(SrcParamData%OutNd2NdElem) if (.not. allocated(DstParamData%OutNd2NdElem)) then allocate(DstParamData%OutNd2NdElem(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1556,8 +1608,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts if (allocated(SrcParamData%BldNd_OutParam)) then - LB(1:1) = lbound(SrcParamData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BldNd_OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%BldNd_OutParam) + UB(1:1) = ubound(SrcParamData%BldNd_OutParam) if (.not. allocated(DstParamData%BldNd_OutParam)) then allocate(DstParamData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1572,8 +1624,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%BldNd_BlOutNd)) then - LB(1:1) = lbound(SrcParamData%BldNd_BlOutNd, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BldNd_BlOutNd, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%BldNd_BlOutNd) + UB(1:1) = ubound(SrcParamData%BldNd_BlOutNd) if (.not. allocated(DstParamData%BldNd_BlOutNd)) then allocate(DstParamData%BldNd_BlOutNd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1584,8 +1636,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldNd_BlOutNd = SrcParamData%BldNd_BlOutNd end if if (allocated(SrcParamData%QPtw_Shp_Shp_Jac)) then - LB(1:4) = lbound(SrcParamData%QPtw_Shp_Shp_Jac, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%QPtw_Shp_Shp_Jac, kind=B8Ki) + LB(1:4) = lbound(SrcParamData%QPtw_Shp_Shp_Jac) + UB(1:4) = ubound(SrcParamData%QPtw_Shp_Shp_Jac) if (.not. allocated(DstParamData%QPtw_Shp_Shp_Jac)) then allocate(DstParamData%QPtw_Shp_Shp_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1596,8 +1648,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtw_Shp_Shp_Jac = SrcParamData%QPtw_Shp_Shp_Jac end if if (allocated(SrcParamData%QPtw_Shp_ShpDer)) then - LB(1:3) = lbound(SrcParamData%QPtw_Shp_ShpDer, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%QPtw_Shp_ShpDer, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%QPtw_Shp_ShpDer) + UB(1:3) = ubound(SrcParamData%QPtw_Shp_ShpDer) if (.not. allocated(DstParamData%QPtw_Shp_ShpDer)) then allocate(DstParamData%QPtw_Shp_ShpDer(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1608,8 +1660,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtw_Shp_ShpDer = SrcParamData%QPtw_Shp_ShpDer end if if (allocated(SrcParamData%QPtw_ShpDer_ShpDer_Jac)) then - LB(1:4) = lbound(SrcParamData%QPtw_ShpDer_ShpDer_Jac, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%QPtw_ShpDer_ShpDer_Jac, kind=B8Ki) + LB(1:4) = lbound(SrcParamData%QPtw_ShpDer_ShpDer_Jac) + UB(1:4) = ubound(SrcParamData%QPtw_ShpDer_ShpDer_Jac) if (.not. allocated(DstParamData%QPtw_ShpDer_ShpDer_Jac)) then allocate(DstParamData%QPtw_ShpDer_ShpDer_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1620,8 +1672,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtw_ShpDer_ShpDer_Jac = SrcParamData%QPtw_ShpDer_ShpDer_Jac end if if (allocated(SrcParamData%QPtw_Shp_Jac)) then - LB(1:3) = lbound(SrcParamData%QPtw_Shp_Jac, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%QPtw_Shp_Jac, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%QPtw_Shp_Jac) + UB(1:3) = ubound(SrcParamData%QPtw_Shp_Jac) if (.not. allocated(DstParamData%QPtw_Shp_Jac)) then allocate(DstParamData%QPtw_Shp_Jac(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1632,8 +1684,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtw_Shp_Jac = SrcParamData%QPtw_Shp_Jac end if if (allocated(SrcParamData%QPtw_ShpDer)) then - LB(1:2) = lbound(SrcParamData%QPtw_ShpDer, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%QPtw_ShpDer, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%QPtw_ShpDer) + UB(1:2) = ubound(SrcParamData%QPtw_ShpDer) if (.not. allocated(DstParamData%QPtw_ShpDer)) then allocate(DstParamData%QPtw_ShpDer(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1644,8 +1696,8 @@ subroutine BD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%QPtw_ShpDer = SrcParamData%QPtw_ShpDer end if if (allocated(SrcParamData%FEweight)) then - LB(1:2) = lbound(SrcParamData%FEweight, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%FEweight, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%FEweight) + UB(1:2) = ubound(SrcParamData%FEweight) if (.not. allocated(DstParamData%FEweight)) then allocate(DstParamData%FEweight(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -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, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) - 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 @@ -1691,13 +1715,19 @@ subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) type(BD_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 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 @@ -1741,8 +1771,8 @@ subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%node_elem_idx) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + 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) @@ -1761,8 +1791,8 @@ subroutine BD_DestroyParam(ParamData, ErrStat, ErrMsg) call BD_DestroyqpParam(ParamData%qp, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%BldNd_OutParam)) then - LB(1:1) = lbound(ParamData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%BldNd_OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%BldNd_OutParam) + UB(1:1) = ubound(ParamData%BldNd_OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1790,21 +1820,23 @@ 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) type(RegFile), intent(inout) :: RF type(BD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'BD_PackParam' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + 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) @@ -1848,9 +1880,9 @@ subroutine BD_PackParam(RF, Indata) call RegPack(RF, InData%NumOuts) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + 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 @@ -1877,9 +1909,9 @@ subroutine BD_PackParam(RF, Indata) 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, kind=B8Ki), ubound(InData%BldNd_OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%BldNd_OutParam, kind=B8Ki) + 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 @@ -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 @@ -1906,11 +1932,31 @@ subroutine BD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(BD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackParam' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + 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 @@ -2088,7 +2128,7 @@ subroutine BD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BD_CopyOutput' @@ -2103,8 +2143,8 @@ subroutine BD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%RootMxr = SrcOutputData%RootMxr DstOutputData%RootMyr = SrcOutputData%RootMyr if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -2151,7 +2191,7 @@ subroutine BD_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(BD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2168,14 +2208,14 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'BD_CopyEqMotionQP' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcEqMotionQPData%uuu)) then - LB(1:3) = lbound(SrcEqMotionQPData%uuu, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%uuu, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%uuu) + UB(1:3) = ubound(SrcEqMotionQPData%uuu) if (.not. allocated(DstEqMotionQPData%uuu)) then allocate(DstEqMotionQPData%uuu(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2186,8 +2226,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%uuu = SrcEqMotionQPData%uuu end if if (allocated(SrcEqMotionQPData%uup)) then - LB(1:3) = lbound(SrcEqMotionQPData%uup, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%uup, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%uup) + UB(1:3) = ubound(SrcEqMotionQPData%uup) if (.not. allocated(DstEqMotionQPData%uup)) then allocate(DstEqMotionQPData%uup(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2198,8 +2238,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%uup = SrcEqMotionQPData%uup end if if (allocated(SrcEqMotionQPData%vvv)) then - LB(1:3) = lbound(SrcEqMotionQPData%vvv, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%vvv, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%vvv) + UB(1:3) = ubound(SrcEqMotionQPData%vvv) if (.not. allocated(DstEqMotionQPData%vvv)) then allocate(DstEqMotionQPData%vvv(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2210,8 +2250,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%vvv = SrcEqMotionQPData%vvv end if if (allocated(SrcEqMotionQPData%vvp)) then - LB(1:3) = lbound(SrcEqMotionQPData%vvp, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%vvp, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%vvp) + UB(1:3) = ubound(SrcEqMotionQPData%vvp) if (.not. allocated(DstEqMotionQPData%vvp)) then allocate(DstEqMotionQPData%vvp(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2222,8 +2262,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%vvp = SrcEqMotionQPData%vvp end if if (allocated(SrcEqMotionQPData%aaa)) then - LB(1:3) = lbound(SrcEqMotionQPData%aaa, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%aaa, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%aaa) + UB(1:3) = ubound(SrcEqMotionQPData%aaa) if (.not. allocated(DstEqMotionQPData%aaa)) then allocate(DstEqMotionQPData%aaa(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2234,8 +2274,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%aaa = SrcEqMotionQPData%aaa end if if (allocated(SrcEqMotionQPData%RR0)) then - LB(1:4) = lbound(SrcEqMotionQPData%RR0, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%RR0, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%RR0) + UB(1:4) = ubound(SrcEqMotionQPData%RR0) if (.not. allocated(DstEqMotionQPData%RR0)) then allocate(DstEqMotionQPData%RR0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2246,8 +2286,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%RR0 = SrcEqMotionQPData%RR0 end if if (allocated(SrcEqMotionQPData%kappa)) then - LB(1:3) = lbound(SrcEqMotionQPData%kappa, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%kappa, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%kappa) + UB(1:3) = ubound(SrcEqMotionQPData%kappa) if (.not. allocated(DstEqMotionQPData%kappa)) then allocate(DstEqMotionQPData%kappa(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2258,8 +2298,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%kappa = SrcEqMotionQPData%kappa end if if (allocated(SrcEqMotionQPData%E1)) then - LB(1:3) = lbound(SrcEqMotionQPData%E1, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%E1, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%E1) + UB(1:3) = ubound(SrcEqMotionQPData%E1) if (.not. allocated(DstEqMotionQPData%E1)) then allocate(DstEqMotionQPData%E1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2270,8 +2310,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%E1 = SrcEqMotionQPData%E1 end if if (allocated(SrcEqMotionQPData%Stif)) then - LB(1:4) = lbound(SrcEqMotionQPData%Stif, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Stif, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Stif) + UB(1:4) = ubound(SrcEqMotionQPData%Stif) if (.not. allocated(DstEqMotionQPData%Stif)) then allocate(DstEqMotionQPData%Stif(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2282,8 +2322,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Stif = SrcEqMotionQPData%Stif end if if (allocated(SrcEqMotionQPData%Fb)) then - LB(1:3) = lbound(SrcEqMotionQPData%Fb, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%Fb, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%Fb) + UB(1:3) = ubound(SrcEqMotionQPData%Fb) if (.not. allocated(DstEqMotionQPData%Fb)) then allocate(DstEqMotionQPData%Fb(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2294,8 +2334,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Fb = SrcEqMotionQPData%Fb end if if (allocated(SrcEqMotionQPData%Fc)) then - LB(1:3) = lbound(SrcEqMotionQPData%Fc, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%Fc, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%Fc) + UB(1:3) = ubound(SrcEqMotionQPData%Fc) if (.not. allocated(DstEqMotionQPData%Fc)) then allocate(DstEqMotionQPData%Fc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2306,8 +2346,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Fc = SrcEqMotionQPData%Fc end if if (allocated(SrcEqMotionQPData%Fd)) then - LB(1:3) = lbound(SrcEqMotionQPData%Fd, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%Fd, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%Fd) + UB(1:3) = ubound(SrcEqMotionQPData%Fd) if (.not. allocated(DstEqMotionQPData%Fd)) then allocate(DstEqMotionQPData%Fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2318,8 +2358,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Fd = SrcEqMotionQPData%Fd end if if (allocated(SrcEqMotionQPData%Fg)) then - LB(1:3) = lbound(SrcEqMotionQPData%Fg, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%Fg, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%Fg) + UB(1:3) = ubound(SrcEqMotionQPData%Fg) if (.not. allocated(DstEqMotionQPData%Fg)) then allocate(DstEqMotionQPData%Fg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2330,8 +2370,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Fg = SrcEqMotionQPData%Fg end if if (allocated(SrcEqMotionQPData%Fi)) then - LB(1:3) = lbound(SrcEqMotionQPData%Fi, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%Fi, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%Fi) + UB(1:3) = ubound(SrcEqMotionQPData%Fi) if (.not. allocated(DstEqMotionQPData%Fi)) then allocate(DstEqMotionQPData%Fi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2342,8 +2382,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Fi = SrcEqMotionQPData%Fi end if if (allocated(SrcEqMotionQPData%Ftemp)) then - LB(1:3) = lbound(SrcEqMotionQPData%Ftemp, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%Ftemp, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%Ftemp) + UB(1:3) = ubound(SrcEqMotionQPData%Ftemp) if (.not. allocated(DstEqMotionQPData%Ftemp)) then allocate(DstEqMotionQPData%Ftemp(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2354,8 +2394,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Ftemp = SrcEqMotionQPData%Ftemp end if if (allocated(SrcEqMotionQPData%RR0mEta)) then - LB(1:3) = lbound(SrcEqMotionQPData%RR0mEta, kind=B8Ki) - UB(1:3) = ubound(SrcEqMotionQPData%RR0mEta, kind=B8Ki) + LB(1:3) = lbound(SrcEqMotionQPData%RR0mEta) + UB(1:3) = ubound(SrcEqMotionQPData%RR0mEta) if (.not. allocated(DstEqMotionQPData%RR0mEta)) then allocate(DstEqMotionQPData%RR0mEta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2366,8 +2406,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%RR0mEta = SrcEqMotionQPData%RR0mEta end if if (allocated(SrcEqMotionQPData%rho)) then - LB(1:4) = lbound(SrcEqMotionQPData%rho, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%rho, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%rho) + UB(1:4) = ubound(SrcEqMotionQPData%rho) if (.not. allocated(DstEqMotionQPData%rho)) then allocate(DstEqMotionQPData%rho(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2378,8 +2418,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%rho = SrcEqMotionQPData%rho end if if (allocated(SrcEqMotionQPData%betaC)) then - LB(1:4) = lbound(SrcEqMotionQPData%betaC, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%betaC, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%betaC) + UB(1:4) = ubound(SrcEqMotionQPData%betaC) if (.not. allocated(DstEqMotionQPData%betaC)) then allocate(DstEqMotionQPData%betaC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2390,8 +2430,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%betaC = SrcEqMotionQPData%betaC end if if (allocated(SrcEqMotionQPData%Gi)) then - LB(1:4) = lbound(SrcEqMotionQPData%Gi, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Gi, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Gi) + UB(1:4) = ubound(SrcEqMotionQPData%Gi) if (.not. allocated(DstEqMotionQPData%Gi)) then allocate(DstEqMotionQPData%Gi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2402,8 +2442,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Gi = SrcEqMotionQPData%Gi end if if (allocated(SrcEqMotionQPData%Ki)) then - LB(1:4) = lbound(SrcEqMotionQPData%Ki, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Ki, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Ki) + UB(1:4) = ubound(SrcEqMotionQPData%Ki) if (.not. allocated(DstEqMotionQPData%Ki)) then allocate(DstEqMotionQPData%Ki(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2414,8 +2454,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Ki = SrcEqMotionQPData%Ki end if if (allocated(SrcEqMotionQPData%Mi)) then - LB(1:4) = lbound(SrcEqMotionQPData%Mi, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Mi, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Mi) + UB(1:4) = ubound(SrcEqMotionQPData%Mi) if (.not. allocated(DstEqMotionQPData%Mi)) then allocate(DstEqMotionQPData%Mi(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2426,8 +2466,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Mi = SrcEqMotionQPData%Mi end if if (allocated(SrcEqMotionQPData%Oe)) then - LB(1:4) = lbound(SrcEqMotionQPData%Oe, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Oe, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Oe) + UB(1:4) = ubound(SrcEqMotionQPData%Oe) if (.not. allocated(DstEqMotionQPData%Oe)) then allocate(DstEqMotionQPData%Oe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2438,8 +2478,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Oe = SrcEqMotionQPData%Oe end if if (allocated(SrcEqMotionQPData%Pe)) then - LB(1:4) = lbound(SrcEqMotionQPData%Pe, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Pe, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Pe) + UB(1:4) = ubound(SrcEqMotionQPData%Pe) if (.not. allocated(DstEqMotionQPData%Pe)) then allocate(DstEqMotionQPData%Pe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2450,8 +2490,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Pe = SrcEqMotionQPData%Pe end if if (allocated(SrcEqMotionQPData%Qe)) then - LB(1:4) = lbound(SrcEqMotionQPData%Qe, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Qe, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Qe) + UB(1:4) = ubound(SrcEqMotionQPData%Qe) if (.not. allocated(DstEqMotionQPData%Qe)) then allocate(DstEqMotionQPData%Qe(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2462,8 +2502,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Qe = SrcEqMotionQPData%Qe end if if (allocated(SrcEqMotionQPData%Gd)) then - LB(1:4) = lbound(SrcEqMotionQPData%Gd, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Gd, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Gd) + UB(1:4) = ubound(SrcEqMotionQPData%Gd) if (.not. allocated(DstEqMotionQPData%Gd)) then allocate(DstEqMotionQPData%Gd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2474,8 +2514,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Gd = SrcEqMotionQPData%Gd end if if (allocated(SrcEqMotionQPData%Od)) then - LB(1:4) = lbound(SrcEqMotionQPData%Od, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Od, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Od) + UB(1:4) = ubound(SrcEqMotionQPData%Od) if (.not. allocated(DstEqMotionQPData%Od)) then allocate(DstEqMotionQPData%Od(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2486,8 +2526,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Od = SrcEqMotionQPData%Od end if if (allocated(SrcEqMotionQPData%Pd)) then - LB(1:4) = lbound(SrcEqMotionQPData%Pd, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Pd, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Pd) + UB(1:4) = ubound(SrcEqMotionQPData%Pd) if (.not. allocated(DstEqMotionQPData%Pd)) then allocate(DstEqMotionQPData%Pd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2498,8 +2538,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Pd = SrcEqMotionQPData%Pd end if if (allocated(SrcEqMotionQPData%Qd)) then - LB(1:4) = lbound(SrcEqMotionQPData%Qd, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Qd, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Qd) + UB(1:4) = ubound(SrcEqMotionQPData%Qd) if (.not. allocated(DstEqMotionQPData%Qd)) then allocate(DstEqMotionQPData%Qd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2510,8 +2550,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Qd = SrcEqMotionQPData%Qd end if if (allocated(SrcEqMotionQPData%Sd)) then - LB(1:4) = lbound(SrcEqMotionQPData%Sd, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Sd, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Sd) + UB(1:4) = ubound(SrcEqMotionQPData%Sd) if (.not. allocated(DstEqMotionQPData%Sd)) then allocate(DstEqMotionQPData%Sd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2522,8 +2562,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Sd = SrcEqMotionQPData%Sd end if if (allocated(SrcEqMotionQPData%Xd)) then - LB(1:4) = lbound(SrcEqMotionQPData%Xd, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Xd, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Xd) + UB(1:4) = ubound(SrcEqMotionQPData%Xd) if (.not. allocated(DstEqMotionQPData%Xd)) then allocate(DstEqMotionQPData%Xd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2534,8 +2574,8 @@ subroutine BD_CopyEqMotionQP(SrcEqMotionQPData, DstEqMotionQPData, CtrlCode, Err DstEqMotionQPData%Xd = SrcEqMotionQPData%Xd end if if (allocated(SrcEqMotionQPData%Yd)) then - LB(1:4) = lbound(SrcEqMotionQPData%Yd, kind=B8Ki) - UB(1:4) = ubound(SrcEqMotionQPData%Yd, kind=B8Ki) + LB(1:4) = lbound(SrcEqMotionQPData%Yd) + UB(1:4) = ubound(SrcEqMotionQPData%Yd) if (.not. allocated(DstEqMotionQPData%Yd)) then allocate(DstEqMotionQPData%Yd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2692,7 +2732,7 @@ subroutine BD_UnPackEqMotionQP(RF, OutData) type(RegFile), intent(inout) :: RF type(EqMotionQP), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackEqMotionQP' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2735,7 +2775,7 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'BD_CopyMisc' @@ -2758,8 +2798,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%lin_A)) then - LB(1:2) = lbound(SrcMiscData%lin_A, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%lin_A, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%lin_A) + UB(1:2) = ubound(SrcMiscData%lin_A) if (.not. allocated(DstMiscData%lin_A)) then allocate(DstMiscData%lin_A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2770,8 +2810,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%lin_A = SrcMiscData%lin_A end if if (allocated(SrcMiscData%lin_C)) then - LB(1:2) = lbound(SrcMiscData%lin_C, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%lin_C, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%lin_C) + UB(1:2) = ubound(SrcMiscData%lin_C) if (.not. allocated(DstMiscData%lin_C)) then allocate(DstMiscData%lin_C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2782,8 +2822,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%lin_C = SrcMiscData%lin_C end if if (allocated(SrcMiscData%Nrrr)) then - LB(1:3) = lbound(SrcMiscData%Nrrr, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%Nrrr, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%Nrrr) + UB(1:3) = ubound(SrcMiscData%Nrrr) if (.not. allocated(DstMiscData%Nrrr)) then allocate(DstMiscData%Nrrr(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2794,8 +2834,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Nrrr = SrcMiscData%Nrrr end if if (allocated(SrcMiscData%elf)) then - LB(1:2) = lbound(SrcMiscData%elf, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%elf, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%elf) + UB(1:2) = ubound(SrcMiscData%elf) if (.not. allocated(DstMiscData%elf)) then allocate(DstMiscData%elf(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2806,8 +2846,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%elf = SrcMiscData%elf end if if (allocated(SrcMiscData%EFint)) then - LB(1:3) = lbound(SrcMiscData%EFint, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%EFint, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%EFint) + UB(1:3) = ubound(SrcMiscData%EFint) if (.not. allocated(DstMiscData%EFint)) then allocate(DstMiscData%EFint(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2818,8 +2858,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%EFint = SrcMiscData%EFint end if if (allocated(SrcMiscData%elk)) then - LB(1:4) = lbound(SrcMiscData%elk, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%elk, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%elk) + UB(1:4) = ubound(SrcMiscData%elk) if (.not. allocated(DstMiscData%elk)) then allocate(DstMiscData%elk(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2830,8 +2870,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%elk = SrcMiscData%elk end if if (allocated(SrcMiscData%elg)) then - LB(1:4) = lbound(SrcMiscData%elg, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%elg, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%elg) + UB(1:4) = ubound(SrcMiscData%elg) if (.not. allocated(DstMiscData%elg)) then allocate(DstMiscData%elg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2842,8 +2882,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%elg = SrcMiscData%elg end if if (allocated(SrcMiscData%elm)) then - LB(1:4) = lbound(SrcMiscData%elm, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%elm, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%elm) + UB(1:4) = ubound(SrcMiscData%elm) if (.not. allocated(DstMiscData%elm)) then allocate(DstMiscData%elm(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2854,8 +2894,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%elm = SrcMiscData%elm end if if (allocated(SrcMiscData%DistrLoad_QP)) then - LB(1:3) = lbound(SrcMiscData%DistrLoad_QP, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%DistrLoad_QP, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%DistrLoad_QP) + UB(1:3) = ubound(SrcMiscData%DistrLoad_QP) if (.not. allocated(DstMiscData%DistrLoad_QP)) then allocate(DstMiscData%DistrLoad_QP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2866,8 +2906,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DistrLoad_QP = SrcMiscData%DistrLoad_QP end if if (allocated(SrcMiscData%PointLoadLcl)) then - LB(1:2) = lbound(SrcMiscData%PointLoadLcl, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%PointLoadLcl, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%PointLoadLcl) + UB(1:2) = ubound(SrcMiscData%PointLoadLcl) if (.not. allocated(DstMiscData%PointLoadLcl)) then allocate(DstMiscData%PointLoadLcl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2878,8 +2918,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%PointLoadLcl = SrcMiscData%PointLoadLcl end if if (allocated(SrcMiscData%StifK)) then - LB(1:4) = lbound(SrcMiscData%StifK, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%StifK, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%StifK) + UB(1:4) = ubound(SrcMiscData%StifK) if (.not. allocated(DstMiscData%StifK)) then allocate(DstMiscData%StifK(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2890,8 +2930,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%StifK = SrcMiscData%StifK end if if (allocated(SrcMiscData%MassM)) then - LB(1:4) = lbound(SrcMiscData%MassM, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%MassM, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%MassM) + UB(1:4) = ubound(SrcMiscData%MassM) if (.not. allocated(DstMiscData%MassM)) then allocate(DstMiscData%MassM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2902,8 +2942,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%MassM = SrcMiscData%MassM end if if (allocated(SrcMiscData%DampG)) then - LB(1:4) = lbound(SrcMiscData%DampG, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%DampG, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%DampG) + UB(1:4) = ubound(SrcMiscData%DampG) if (.not. allocated(DstMiscData%DampG)) then allocate(DstMiscData%DampG(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2914,8 +2954,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DampG = SrcMiscData%DampG end if if (allocated(SrcMiscData%StifK_fd)) then - LB(1:4) = lbound(SrcMiscData%StifK_fd, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%StifK_fd, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%StifK_fd) + UB(1:4) = ubound(SrcMiscData%StifK_fd) if (.not. allocated(DstMiscData%StifK_fd)) then allocate(DstMiscData%StifK_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2926,8 +2966,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%StifK_fd = SrcMiscData%StifK_fd end if if (allocated(SrcMiscData%MassM_fd)) then - LB(1:4) = lbound(SrcMiscData%MassM_fd, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%MassM_fd, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%MassM_fd) + UB(1:4) = ubound(SrcMiscData%MassM_fd) if (.not. allocated(DstMiscData%MassM_fd)) then allocate(DstMiscData%MassM_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2938,8 +2978,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%MassM_fd = SrcMiscData%MassM_fd end if if (allocated(SrcMiscData%DampG_fd)) then - LB(1:4) = lbound(SrcMiscData%DampG_fd, kind=B8Ki) - UB(1:4) = ubound(SrcMiscData%DampG_fd, kind=B8Ki) + LB(1:4) = lbound(SrcMiscData%DampG_fd) + UB(1:4) = ubound(SrcMiscData%DampG_fd) if (.not. allocated(DstMiscData%DampG_fd)) then allocate(DstMiscData%DampG_fd(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2950,8 +2990,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DampG_fd = SrcMiscData%DampG_fd end if if (allocated(SrcMiscData%RHS)) then - LB(1:2) = lbound(SrcMiscData%RHS, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%RHS, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%RHS) + UB(1:2) = ubound(SrcMiscData%RHS) if (.not. allocated(DstMiscData%RHS)) then allocate(DstMiscData%RHS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2962,8 +3002,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%RHS = SrcMiscData%RHS end if if (allocated(SrcMiscData%RHS_p)) then - LB(1:2) = lbound(SrcMiscData%RHS_p, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%RHS_p, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%RHS_p) + UB(1:2) = ubound(SrcMiscData%RHS_p) if (.not. allocated(DstMiscData%RHS_p)) then allocate(DstMiscData%RHS_p(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2974,8 +3014,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%RHS_p = SrcMiscData%RHS_p end if if (allocated(SrcMiscData%RHS_m)) then - LB(1:2) = lbound(SrcMiscData%RHS_m, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%RHS_m, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%RHS_m) + UB(1:2) = ubound(SrcMiscData%RHS_m) if (.not. allocated(DstMiscData%RHS_m)) then allocate(DstMiscData%RHS_m(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2986,8 +3026,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%RHS_m = SrcMiscData%RHS_m end if if (allocated(SrcMiscData%BldInternalForceFE)) then - LB(1:2) = lbound(SrcMiscData%BldInternalForceFE, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%BldInternalForceFE, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%BldInternalForceFE) + UB(1:2) = ubound(SrcMiscData%BldInternalForceFE) if (.not. allocated(DstMiscData%BldInternalForceFE)) then allocate(DstMiscData%BldInternalForceFE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2998,8 +3038,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%BldInternalForceFE = SrcMiscData%BldInternalForceFE end if if (allocated(SrcMiscData%BldInternalForceQP)) then - LB(1:2) = lbound(SrcMiscData%BldInternalForceQP, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%BldInternalForceQP, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%BldInternalForceQP) + UB(1:2) = ubound(SrcMiscData%BldInternalForceQP) if (.not. allocated(DstMiscData%BldInternalForceQP)) then allocate(DstMiscData%BldInternalForceQP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3010,8 +3050,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%BldInternalForceQP = SrcMiscData%BldInternalForceQP end if if (allocated(SrcMiscData%FirstNodeReactionLclForceMoment)) then - LB(1:1) = lbound(SrcMiscData%FirstNodeReactionLclForceMoment, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FirstNodeReactionLclForceMoment, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%FirstNodeReactionLclForceMoment) + UB(1:1) = ubound(SrcMiscData%FirstNodeReactionLclForceMoment) if (.not. allocated(DstMiscData%FirstNodeReactionLclForceMoment)) then allocate(DstMiscData%FirstNodeReactionLclForceMoment(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3022,8 +3062,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FirstNodeReactionLclForceMoment = SrcMiscData%FirstNodeReactionLclForceMoment end if if (allocated(SrcMiscData%Solution)) then - LB(1:2) = lbound(SrcMiscData%Solution, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%Solution, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%Solution) + UB(1:2) = ubound(SrcMiscData%Solution) if (.not. allocated(DstMiscData%Solution)) then allocate(DstMiscData%Solution(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3034,8 +3074,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Solution = SrcMiscData%Solution end if if (allocated(SrcMiscData%LP_StifK)) then - LB(1:2) = lbound(SrcMiscData%LP_StifK, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%LP_StifK, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%LP_StifK) + UB(1:2) = ubound(SrcMiscData%LP_StifK) if (.not. allocated(DstMiscData%LP_StifK)) then allocate(DstMiscData%LP_StifK(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3046,8 +3086,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LP_StifK = SrcMiscData%LP_StifK end if if (allocated(SrcMiscData%LP_MassM)) then - LB(1:2) = lbound(SrcMiscData%LP_MassM, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%LP_MassM, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%LP_MassM) + UB(1:2) = ubound(SrcMiscData%LP_MassM) if (.not. allocated(DstMiscData%LP_MassM)) then allocate(DstMiscData%LP_MassM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3058,8 +3098,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LP_MassM = SrcMiscData%LP_MassM end if if (allocated(SrcMiscData%LP_MassM_LU)) then - LB(1:2) = lbound(SrcMiscData%LP_MassM_LU, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%LP_MassM_LU, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%LP_MassM_LU) + UB(1:2) = ubound(SrcMiscData%LP_MassM_LU) if (.not. allocated(DstMiscData%LP_MassM_LU)) then allocate(DstMiscData%LP_MassM_LU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3070,8 +3110,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LP_MassM_LU = SrcMiscData%LP_MassM_LU end if if (allocated(SrcMiscData%LP_RHS)) then - LB(1:1) = lbound(SrcMiscData%LP_RHS, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LP_RHS, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%LP_RHS) + UB(1:1) = ubound(SrcMiscData%LP_RHS) if (.not. allocated(DstMiscData%LP_RHS)) then allocate(DstMiscData%LP_RHS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3082,8 +3122,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LP_RHS = SrcMiscData%LP_RHS end if if (allocated(SrcMiscData%LP_StifK_LU)) then - LB(1:2) = lbound(SrcMiscData%LP_StifK_LU, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%LP_StifK_LU, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%LP_StifK_LU) + UB(1:2) = ubound(SrcMiscData%LP_StifK_LU) if (.not. allocated(DstMiscData%LP_StifK_LU)) then allocate(DstMiscData%LP_StifK_LU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3094,8 +3134,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LP_StifK_LU = SrcMiscData%LP_StifK_LU end if if (allocated(SrcMiscData%LP_RHS_LU)) then - LB(1:1) = lbound(SrcMiscData%LP_RHS_LU, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LP_RHS_LU, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%LP_RHS_LU) + UB(1:1) = ubound(SrcMiscData%LP_RHS_LU) if (.not. allocated(DstMiscData%LP_RHS_LU)) then allocate(DstMiscData%LP_RHS_LU(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3106,8 +3146,8 @@ subroutine BD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LP_RHS_LU = SrcMiscData%LP_RHS_LU end if if (allocated(SrcMiscData%LP_indx)) then - LB(1:1) = lbound(SrcMiscData%LP_indx, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LP_indx, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%LP_indx) + UB(1:1) = ubound(SrcMiscData%LP_indx) if (.not. allocated(DstMiscData%LP_indx)) then allocate(DstMiscData%LP_indx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -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 @@ -3290,7 +3360,7 @@ subroutine BD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(BD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'BD_UnPackMisc' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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/beamdyn/tests/test_tools.F90 b/modules/beamdyn/tests/test_tools.F90 index f8c520fdc0..7030862c2d 100644 --- a/modules/beamdyn/tests/test_tools.F90 +++ b/modules/beamdyn/tests/test_tools.F90 @@ -286,7 +286,7 @@ type(BD_MiscVarType) function simpleMiscVarType(nqp, dof_node, elem_total, nodes call AllocAry(m%DistrLoad_QP, 6, nqp, elem_total, 'DistrLoad_QP', ErrStat, ErrMsg) call AllocAry(m%qp%uuu, dof_node, nqp, elem_total, 'm%qp%uuu displacement at quadrature point', ErrStat, ErrMsg) - call AllocAry(m%qp%uup, dof_node / 2, nqp, elem_total, 'm%qp%uup displacement prime at quadrature point', ErrStat, ErrMsg) + call AllocAry(m%qp%uup, dof_node, nqp, elem_total, 'm%qp%uup displacement prime at quadrature point', ErrStat, ErrMsg) ! E1, kappa -- used in force calculations call AllocAry(m%qp%E1, dof_node / 2, nqp, elem_total, 'm%qp%E1 at quadrature point', ErrStat, ErrMsg) diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 297db86846..717cd716bd 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. @@ -1976,7 +1993,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). @@ -10334,9 +10353,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 @@ -10351,214 +10371,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 @@ -10573,177 +10543,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 @@ -10778,45 +10686,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 !---------------------------------------------------------------------------------------------------------------------------------- @@ -10848,1035 +10736,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 0ffcb4130a..d532db4489 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" - @@ -531,39 +532,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 - - - "Fz acting on yaw bearing including inertial contributions" N -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" - @@ -793,8 +765,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)" @@ -861,3 +831,23 @@ 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 - - - "Fz acting on yaw bearing including inertial contributions" N +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 64046a0f0f..37f50cd60a 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 ======= @@ -539,45 +541,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) :: FrcONcRt = 0.0_ReKi !< Fz acting on yaw bearing including inertial contributions [N] - 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] @@ -801,8 +764,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) [-] @@ -870,7 +831,80 @@ 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) :: FrcONcRt = 0.0_ReKi !< Fz acting on yaw bearing including inertial contributions [N] + 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 @@ -943,15 +977,15 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -962,8 +996,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -978,8 +1012,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err if (ErrStat >= AbortErrLev) return DstInitOutputData%NumBl = SrcInitOutputData%NumBl if (allocated(SrcInitOutputData%BlPitch)) then - LB(1:1) = lbound(SrcInitOutputData%BlPitch, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%BlPitch, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%BlPitch) + UB(1:1) = ubound(SrcInitOutputData%BlPitch) if (.not. allocated(DstInitOutputData%BlPitch)) then allocate(DstInitOutputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -994,8 +1028,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%TowerBaseHeight = SrcInitOutputData%TowerBaseHeight DstInitOutputData%HubHt = SrcInitOutputData%HubHt if (allocated(SrcInitOutputData%BldRNodes)) then - LB(1:1) = lbound(SrcInitOutputData%BldRNodes, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%BldRNodes, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%BldRNodes) + UB(1:1) = ubound(SrcInitOutputData%BldRNodes) if (.not. allocated(DstInitOutputData%BldRNodes)) then allocate(DstInitOutputData%BldRNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1006,8 +1040,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%BldRNodes = SrcInitOutputData%BldRNodes end if if (allocated(SrcInitOutputData%TwrHNodes)) then - LB(1:1) = lbound(SrcInitOutputData%TwrHNodes, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%TwrHNodes, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%TwrHNodes) + UB(1:1) = ubound(SrcInitOutputData%TwrHNodes) if (.not. allocated(DstInitOutputData%TwrHNodes)) then allocate(DstInitOutputData%TwrHNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1026,8 +1060,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotSpeed = SrcInitOutputData%RotSpeed DstInitOutputData%isFixed_GenDOF = SrcInitOutputData%isFixed_GenDOF if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) + 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 @@ -1038,8 +1072,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1050,8 +1084,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) + 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 @@ -1062,8 +1096,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + 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 @@ -1074,8 +1108,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1086,8 +1120,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1098,8 +1132,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + 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 @@ -1110,8 +1144,8 @@ subroutine ED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + 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 @@ -1122,6 +1156,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) @@ -1174,6 +1211,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) @@ -1209,6 +1248,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 @@ -1216,7 +1256,7 @@ subroutine ED_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackInitOutput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1248,6 +1288,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) @@ -1256,15 +1297,15 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ED_CopyBladeInputData' ErrStat = ErrID_None ErrMsg = '' DstBladeInputDataData%NBlInpSt = SrcBladeInputDataData%NBlInpSt if (allocated(SrcBladeInputDataData%BlFract)) then - LB(1:1) = lbound(SrcBladeInputDataData%BlFract, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%BlFract, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%BlFract) + UB(1:1) = ubound(SrcBladeInputDataData%BlFract) if (.not. allocated(DstBladeInputDataData%BlFract)) then allocate(DstBladeInputDataData%BlFract(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1275,8 +1316,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%BlFract = SrcBladeInputDataData%BlFract end if if (allocated(SrcBladeInputDataData%PitchAx)) then - LB(1:1) = lbound(SrcBladeInputDataData%PitchAx, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%PitchAx, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%PitchAx) + UB(1:1) = ubound(SrcBladeInputDataData%PitchAx) if (.not. allocated(DstBladeInputDataData%PitchAx)) then allocate(DstBladeInputDataData%PitchAx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1287,8 +1328,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%PitchAx = SrcBladeInputDataData%PitchAx end if if (allocated(SrcBladeInputDataData%StrcTwst)) then - LB(1:1) = lbound(SrcBladeInputDataData%StrcTwst, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%StrcTwst, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%StrcTwst) + UB(1:1) = ubound(SrcBladeInputDataData%StrcTwst) if (.not. allocated(DstBladeInputDataData%StrcTwst)) then allocate(DstBladeInputDataData%StrcTwst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1299,8 +1340,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%StrcTwst = SrcBladeInputDataData%StrcTwst end if if (allocated(SrcBladeInputDataData%BMassDen)) then - LB(1:1) = lbound(SrcBladeInputDataData%BMassDen, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%BMassDen, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%BMassDen) + UB(1:1) = ubound(SrcBladeInputDataData%BMassDen) if (.not. allocated(DstBladeInputDataData%BMassDen)) then allocate(DstBladeInputDataData%BMassDen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1311,8 +1352,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%BMassDen = SrcBladeInputDataData%BMassDen end if if (allocated(SrcBladeInputDataData%FlpStff)) then - LB(1:1) = lbound(SrcBladeInputDataData%FlpStff, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%FlpStff, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%FlpStff) + UB(1:1) = ubound(SrcBladeInputDataData%FlpStff) if (.not. allocated(DstBladeInputDataData%FlpStff)) then allocate(DstBladeInputDataData%FlpStff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1323,8 +1364,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%FlpStff = SrcBladeInputDataData%FlpStff end if if (allocated(SrcBladeInputDataData%EdgStff)) then - LB(1:1) = lbound(SrcBladeInputDataData%EdgStff, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%EdgStff, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%EdgStff) + UB(1:1) = ubound(SrcBladeInputDataData%EdgStff) if (.not. allocated(DstBladeInputDataData%EdgStff)) then allocate(DstBladeInputDataData%EdgStff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1338,8 +1379,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%BldEdDmp = SrcBladeInputDataData%BldEdDmp DstBladeInputDataData%FlStTunr = SrcBladeInputDataData%FlStTunr if (allocated(SrcBladeInputDataData%BldFl1Sh)) then - LB(1:1) = lbound(SrcBladeInputDataData%BldFl1Sh, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%BldFl1Sh, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%BldFl1Sh) + UB(1:1) = ubound(SrcBladeInputDataData%BldFl1Sh) if (.not. allocated(DstBladeInputDataData%BldFl1Sh)) then allocate(DstBladeInputDataData%BldFl1Sh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1350,8 +1391,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%BldFl1Sh = SrcBladeInputDataData%BldFl1Sh end if if (allocated(SrcBladeInputDataData%BldFl2Sh)) then - LB(1:1) = lbound(SrcBladeInputDataData%BldFl2Sh, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%BldFl2Sh, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%BldFl2Sh) + UB(1:1) = ubound(SrcBladeInputDataData%BldFl2Sh) if (.not. allocated(DstBladeInputDataData%BldFl2Sh)) then allocate(DstBladeInputDataData%BldFl2Sh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1362,8 +1403,8 @@ subroutine ED_CopyBladeInputData(SrcBladeInputDataData, DstBladeInputDataData, C DstBladeInputDataData%BldFl2Sh = SrcBladeInputDataData%BldFl2Sh end if if (allocated(SrcBladeInputDataData%BldEdgSh)) then - LB(1:1) = lbound(SrcBladeInputDataData%BldEdgSh, kind=B8Ki) - UB(1:1) = ubound(SrcBladeInputDataData%BldEdgSh, kind=B8Ki) + LB(1:1) = lbound(SrcBladeInputDataData%BldEdgSh) + UB(1:1) = ubound(SrcBladeInputDataData%BldEdgSh) if (.not. allocated(DstBladeInputDataData%BldEdgSh)) then allocate(DstBladeInputDataData%BldEdgSh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1436,7 +1477,7 @@ subroutine ED_UnPackBladeInputData(RF, OutData) type(RegFile), intent(inout) :: RF type(BladeInputData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackBladeInputData' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1461,15 +1502,15 @@ subroutine ED_CopyBladeMeshInputData(SrcBladeMeshInputDataData, DstBladeMeshInpu integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ED_CopyBladeMeshInputData' ErrStat = ErrID_None ErrMsg = '' DstBladeMeshInputDataData%BldNodes = SrcBladeMeshInputDataData%BldNodes if (allocated(SrcBladeMeshInputDataData%RNodes)) then - LB(1:1) = lbound(SrcBladeMeshInputDataData%RNodes, kind=B8Ki) - UB(1:1) = ubound(SrcBladeMeshInputDataData%RNodes, kind=B8Ki) + LB(1:1) = lbound(SrcBladeMeshInputDataData%RNodes) + UB(1:1) = ubound(SrcBladeMeshInputDataData%RNodes) if (.not. allocated(DstBladeMeshInputDataData%RNodes)) then allocate(DstBladeMeshInputDataData%RNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1480,8 +1521,8 @@ subroutine ED_CopyBladeMeshInputData(SrcBladeMeshInputDataData, DstBladeMeshInpu DstBladeMeshInputDataData%RNodes = SrcBladeMeshInputDataData%RNodes end if if (allocated(SrcBladeMeshInputDataData%AeroTwst)) then - LB(1:1) = lbound(SrcBladeMeshInputDataData%AeroTwst, kind=B8Ki) - UB(1:1) = ubound(SrcBladeMeshInputDataData%AeroTwst, kind=B8Ki) + LB(1:1) = lbound(SrcBladeMeshInputDataData%AeroTwst) + UB(1:1) = ubound(SrcBladeMeshInputDataData%AeroTwst) if (.not. allocated(DstBladeMeshInputDataData%AeroTwst)) then allocate(DstBladeMeshInputDataData%AeroTwst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1492,8 +1533,8 @@ subroutine ED_CopyBladeMeshInputData(SrcBladeMeshInputDataData, DstBladeMeshInpu DstBladeMeshInputDataData%AeroTwst = SrcBladeMeshInputDataData%AeroTwst end if if (allocated(SrcBladeMeshInputDataData%Chord)) then - LB(1:1) = lbound(SrcBladeMeshInputDataData%Chord, kind=B8Ki) - UB(1:1) = ubound(SrcBladeMeshInputDataData%Chord, kind=B8Ki) + LB(1:1) = lbound(SrcBladeMeshInputDataData%Chord) + UB(1:1) = ubound(SrcBladeMeshInputDataData%Chord) if (.not. allocated(DstBladeMeshInputDataData%Chord)) then allocate(DstBladeMeshInputDataData%Chord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1539,7 +1580,7 @@ subroutine ED_UnPackBladeMeshInputData(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_BladeMeshInputData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackBladeMeshInputData' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1555,8 +1596,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_CopyInputFile' @@ -1583,8 +1624,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%OoPDefl = SrcInputFileData%OoPDefl DstInputFileData%IPDefl = SrcInputFileData%IPDefl if (allocated(SrcInputFileData%BlPitch)) then - LB(1:1) = lbound(SrcInputFileData%BlPitch, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%BlPitch, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%BlPitch) + UB(1:1) = ubound(SrcInputFileData%BlPitch) if (.not. allocated(DstInputFileData%BlPitch)) then allocate(DstInputFileData%BlPitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1610,8 +1651,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TipRad = SrcInputFileData%TipRad DstInputFileData%HubRad = SrcInputFileData%HubRad if (allocated(SrcInputFileData%PreCone)) then - LB(1:1) = lbound(SrcInputFileData%PreCone, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%PreCone, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%PreCone) + UB(1:1) = ubound(SrcInputFileData%PreCone) if (.not. allocated(DstInputFileData%PreCone)) then allocate(DstInputFileData%PreCone(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1642,8 +1683,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%PtfmCMzt = SrcInputFileData%PtfmCMzt DstInputFileData%PtfmRefzt = SrcInputFileData%PtfmRefzt if (allocated(SrcInputFileData%TipMass)) then - LB(1:1) = lbound(SrcInputFileData%TipMass, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%TipMass, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%TipMass) + UB(1:1) = ubound(SrcInputFileData%TipMass) if (.not. allocated(DstInputFileData%TipMass)) then allocate(DstInputFileData%TipMass(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1668,8 +1709,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%PtfmXZIner = SrcInputFileData%PtfmXZIner DstInputFileData%BldNodes = SrcInputFileData%BldNodes if (allocated(SrcInputFileData%InpBlMesh)) then - LB(1:1) = lbound(SrcInputFileData%InpBlMesh, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%InpBlMesh, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%InpBlMesh) + UB(1:1) = ubound(SrcInputFileData%InpBlMesh) if (.not. allocated(DstInputFileData%InpBlMesh)) then allocate(DstInputFileData%InpBlMesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1684,8 +1725,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta end do end if if (allocated(SrcInputFileData%InpBl)) then - LB(1:1) = lbound(SrcInputFileData%InpBl, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%InpBl, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%InpBl) + UB(1:1) = ubound(SrcInputFileData%InpBl) if (.not. allocated(DstInputFileData%InpBl)) then allocate(DstInputFileData%InpBl(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1729,8 +1770,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%BldGagNd = SrcInputFileData%BldGagNd DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1746,8 +1787,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%FAStTunr = SrcInputFileData%FAStTunr DstInputFileData%SSStTunr = SrcInputFileData%SSStTunr if (allocated(SrcInputFileData%HtFract)) then - LB(1:1) = lbound(SrcInputFileData%HtFract, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%HtFract, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%HtFract) + UB(1:1) = ubound(SrcInputFileData%HtFract) if (.not. allocated(DstInputFileData%HtFract)) then allocate(DstInputFileData%HtFract(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1758,8 +1799,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%HtFract = SrcInputFileData%HtFract end if if (allocated(SrcInputFileData%TMassDen)) then - LB(1:1) = lbound(SrcInputFileData%TMassDen, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%TMassDen, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%TMassDen) + UB(1:1) = ubound(SrcInputFileData%TMassDen) if (.not. allocated(DstInputFileData%TMassDen)) then allocate(DstInputFileData%TMassDen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1770,8 +1811,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TMassDen = SrcInputFileData%TMassDen end if if (allocated(SrcInputFileData%TwFAStif)) then - LB(1:1) = lbound(SrcInputFileData%TwFAStif, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%TwFAStif, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%TwFAStif) + UB(1:1) = ubound(SrcInputFileData%TwFAStif) if (.not. allocated(DstInputFileData%TwFAStif)) then allocate(DstInputFileData%TwFAStif(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1782,8 +1823,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TwFAStif = SrcInputFileData%TwFAStif end if if (allocated(SrcInputFileData%TwSSStif)) then - LB(1:1) = lbound(SrcInputFileData%TwSSStif, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%TwSSStif, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%TwSSStif) + UB(1:1) = ubound(SrcInputFileData%TwSSStif) if (.not. allocated(DstInputFileData%TwSSStif)) then allocate(DstInputFileData%TwSSStif(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1794,8 +1835,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TwSSStif = SrcInputFileData%TwSSStif end if if (allocated(SrcInputFileData%TwFAM1Sh)) then - LB(1:1) = lbound(SrcInputFileData%TwFAM1Sh, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%TwFAM1Sh, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%TwFAM1Sh) + UB(1:1) = ubound(SrcInputFileData%TwFAM1Sh) if (.not. allocated(DstInputFileData%TwFAM1Sh)) then allocate(DstInputFileData%TwFAM1Sh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1806,8 +1847,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TwFAM1Sh = SrcInputFileData%TwFAM1Sh end if if (allocated(SrcInputFileData%TwFAM2Sh)) then - LB(1:1) = lbound(SrcInputFileData%TwFAM2Sh, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%TwFAM2Sh, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%TwFAM2Sh) + UB(1:1) = ubound(SrcInputFileData%TwFAM2Sh) if (.not. allocated(DstInputFileData%TwFAM2Sh)) then allocate(DstInputFileData%TwFAM2Sh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1818,8 +1859,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TwFAM2Sh = SrcInputFileData%TwFAM2Sh end if if (allocated(SrcInputFileData%TwSSM1Sh)) then - LB(1:1) = lbound(SrcInputFileData%TwSSM1Sh, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%TwSSM1Sh, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%TwSSM1Sh) + UB(1:1) = ubound(SrcInputFileData%TwSSM1Sh) if (.not. allocated(DstInputFileData%TwSSM1Sh)) then allocate(DstInputFileData%TwSSM1Sh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1830,8 +1871,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%TwSSM1Sh = SrcInputFileData%TwSSM1Sh end if if (allocated(SrcInputFileData%TwSSM2Sh)) then - LB(1:1) = lbound(SrcInputFileData%TwSSM2Sh, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%TwSSM2Sh, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%TwSSM2Sh) + UB(1:1) = ubound(SrcInputFileData%TwSSM2Sh) if (.not. allocated(DstInputFileData%TwSSM2Sh)) then allocate(DstInputFileData%TwSSM2Sh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1886,8 +1927,8 @@ subroutine ED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%method = SrcInputFileData%method DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts if (allocated(SrcInputFileData%BldNd_OutList)) then - LB(1:1) = lbound(SrcInputFileData%BldNd_OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%BldNd_OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%BldNd_OutList) + UB(1:1) = ubound(SrcInputFileData%BldNd_OutList) if (.not. allocated(DstInputFileData%BldNd_OutList)) then allocate(DstInputFileData%BldNd_OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1905,8 +1946,8 @@ subroutine ED_DestroyInputFile(InputFileData, ErrStat, ErrMsg) type(ED_InputFile), intent(inout) :: InputFileData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_DestroyInputFile' @@ -1922,8 +1963,8 @@ subroutine ED_DestroyInputFile(InputFileData, ErrStat, ErrMsg) deallocate(InputFileData%TipMass) end if if (allocated(InputFileData%InpBlMesh)) then - LB(1:1) = lbound(InputFileData%InpBlMesh, kind=B8Ki) - UB(1:1) = ubound(InputFileData%InpBlMesh, kind=B8Ki) + LB(1:1) = lbound(InputFileData%InpBlMesh) + UB(1:1) = ubound(InputFileData%InpBlMesh) do i1 = LB(1), UB(1) call ED_DestroyBladeMeshInputData(InputFileData%InpBlMesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1931,8 +1972,8 @@ subroutine ED_DestroyInputFile(InputFileData, ErrStat, ErrMsg) deallocate(InputFileData%InpBlMesh) end if if (allocated(InputFileData%InpBl)) then - LB(1:1) = lbound(InputFileData%InpBl, kind=B8Ki) - UB(1:1) = ubound(InputFileData%InpBl, kind=B8Ki) + LB(1:1) = lbound(InputFileData%InpBl) + UB(1:1) = ubound(InputFileData%InpBl) do i1 = LB(1), UB(1) call ED_DestroyBladeInputData(InputFileData%InpBl(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1975,8 +2016,8 @@ subroutine ED_PackInputFile(RF, Indata) type(RegFile), intent(inout) :: RF type(ED_InputFile), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackInputFile' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DT) call RegPack(RF, InData%FlapDOF1) @@ -2052,18 +2093,18 @@ subroutine ED_PackInputFile(RF, Indata) call RegPack(RF, InData%BldNodes) call RegPack(RF, allocated(InData%InpBlMesh)) if (allocated(InData%InpBlMesh)) then - call RegPackBounds(RF, 1, lbound(InData%InpBlMesh, kind=B8Ki), ubound(InData%InpBlMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%InpBlMesh, kind=B8Ki) - UB(1:1) = ubound(InData%InpBlMesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%InpBlMesh), ubound(InData%InpBlMesh)) + LB(1:1) = lbound(InData%InpBlMesh) + UB(1:1) = ubound(InData%InpBlMesh) do i1 = LB(1), UB(1) call ED_PackBladeMeshInputData(RF, InData%InpBlMesh(i1)) end do end if call RegPack(RF, allocated(InData%InpBl)) if (allocated(InData%InpBl)) then - call RegPackBounds(RF, 1, lbound(InData%InpBl, kind=B8Ki), ubound(InData%InpBl, kind=B8Ki)) - LB(1:1) = lbound(InData%InpBl, kind=B8Ki) - UB(1:1) = ubound(InData%InpBl, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%InpBl), ubound(InData%InpBl)) + LB(1:1) = lbound(InData%InpBl) + UB(1:1) = ubound(InData%InpBl) do i1 = LB(1), UB(1) call ED_PackBladeInputData(RF, InData%InpBl(i1)) end do @@ -2165,8 +2206,8 @@ subroutine ED_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackInputFile' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2366,7 +2407,7 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ED_CopyCoordSys' ErrStat = ErrID_None @@ -2399,8 +2440,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%g2 = SrcCoordSysData%g2 DstCoordSysData%g3 = SrcCoordSysData%g3 if (allocated(SrcCoordSysData%i1)) then - LB(1:2) = lbound(SrcCoordSysData%i1, kind=B8Ki) - UB(1:2) = ubound(SrcCoordSysData%i1, kind=B8Ki) + LB(1:2) = lbound(SrcCoordSysData%i1) + UB(1:2) = ubound(SrcCoordSysData%i1) if (.not. allocated(DstCoordSysData%i1)) then allocate(DstCoordSysData%i1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2411,8 +2452,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%i1 = SrcCoordSysData%i1 end if if (allocated(SrcCoordSysData%i2)) then - LB(1:2) = lbound(SrcCoordSysData%i2, kind=B8Ki) - UB(1:2) = ubound(SrcCoordSysData%i2, kind=B8Ki) + LB(1:2) = lbound(SrcCoordSysData%i2) + UB(1:2) = ubound(SrcCoordSysData%i2) if (.not. allocated(DstCoordSysData%i2)) then allocate(DstCoordSysData%i2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2423,8 +2464,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%i2 = SrcCoordSysData%i2 end if if (allocated(SrcCoordSysData%i3)) then - LB(1:2) = lbound(SrcCoordSysData%i3, kind=B8Ki) - UB(1:2) = ubound(SrcCoordSysData%i3, kind=B8Ki) + LB(1:2) = lbound(SrcCoordSysData%i3) + UB(1:2) = ubound(SrcCoordSysData%i3) if (.not. allocated(DstCoordSysData%i3)) then allocate(DstCoordSysData%i3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2435,8 +2476,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%i3 = SrcCoordSysData%i3 end if if (allocated(SrcCoordSysData%j1)) then - LB(1:2) = lbound(SrcCoordSysData%j1, kind=B8Ki) - UB(1:2) = ubound(SrcCoordSysData%j1, kind=B8Ki) + LB(1:2) = lbound(SrcCoordSysData%j1) + UB(1:2) = ubound(SrcCoordSysData%j1) if (.not. allocated(DstCoordSysData%j1)) then allocate(DstCoordSysData%j1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2447,8 +2488,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%j1 = SrcCoordSysData%j1 end if if (allocated(SrcCoordSysData%j2)) then - LB(1:2) = lbound(SrcCoordSysData%j2, kind=B8Ki) - UB(1:2) = ubound(SrcCoordSysData%j2, kind=B8Ki) + LB(1:2) = lbound(SrcCoordSysData%j2) + UB(1:2) = ubound(SrcCoordSysData%j2) if (.not. allocated(DstCoordSysData%j2)) then allocate(DstCoordSysData%j2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2459,8 +2500,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%j2 = SrcCoordSysData%j2 end if if (allocated(SrcCoordSysData%j3)) then - LB(1:2) = lbound(SrcCoordSysData%j3, kind=B8Ki) - UB(1:2) = ubound(SrcCoordSysData%j3, kind=B8Ki) + LB(1:2) = lbound(SrcCoordSysData%j3) + UB(1:2) = ubound(SrcCoordSysData%j3) if (.not. allocated(DstCoordSysData%j3)) then allocate(DstCoordSysData%j3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2471,8 +2512,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%j3 = SrcCoordSysData%j3 end if if (allocated(SrcCoordSysData%m1)) then - LB(1:3) = lbound(SrcCoordSysData%m1, kind=B8Ki) - UB(1:3) = ubound(SrcCoordSysData%m1, kind=B8Ki) + LB(1:3) = lbound(SrcCoordSysData%m1) + UB(1:3) = ubound(SrcCoordSysData%m1) if (.not. allocated(DstCoordSysData%m1)) then allocate(DstCoordSysData%m1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2483,8 +2524,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%m1 = SrcCoordSysData%m1 end if if (allocated(SrcCoordSysData%m2)) then - LB(1:3) = lbound(SrcCoordSysData%m2, kind=B8Ki) - UB(1:3) = ubound(SrcCoordSysData%m2, kind=B8Ki) + LB(1:3) = lbound(SrcCoordSysData%m2) + UB(1:3) = ubound(SrcCoordSysData%m2) if (.not. allocated(DstCoordSysData%m2)) then allocate(DstCoordSysData%m2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2495,8 +2536,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%m2 = SrcCoordSysData%m2 end if if (allocated(SrcCoordSysData%m3)) then - LB(1:3) = lbound(SrcCoordSysData%m3, kind=B8Ki) - UB(1:3) = ubound(SrcCoordSysData%m3, kind=B8Ki) + LB(1:3) = lbound(SrcCoordSysData%m3) + UB(1:3) = ubound(SrcCoordSysData%m3) if (.not. allocated(DstCoordSysData%m3)) then allocate(DstCoordSysData%m3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2507,8 +2548,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%m3 = SrcCoordSysData%m3 end if if (allocated(SrcCoordSysData%n1)) then - LB(1:3) = lbound(SrcCoordSysData%n1, kind=B8Ki) - UB(1:3) = ubound(SrcCoordSysData%n1, kind=B8Ki) + LB(1:3) = lbound(SrcCoordSysData%n1) + UB(1:3) = ubound(SrcCoordSysData%n1) if (.not. allocated(DstCoordSysData%n1)) then allocate(DstCoordSysData%n1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2519,8 +2560,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%n1 = SrcCoordSysData%n1 end if if (allocated(SrcCoordSysData%n2)) then - LB(1:3) = lbound(SrcCoordSysData%n2, kind=B8Ki) - UB(1:3) = ubound(SrcCoordSysData%n2, kind=B8Ki) + LB(1:3) = lbound(SrcCoordSysData%n2) + UB(1:3) = ubound(SrcCoordSysData%n2) if (.not. allocated(DstCoordSysData%n2)) then allocate(DstCoordSysData%n2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2531,8 +2572,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%n2 = SrcCoordSysData%n2 end if if (allocated(SrcCoordSysData%n3)) then - LB(1:3) = lbound(SrcCoordSysData%n3, kind=B8Ki) - UB(1:3) = ubound(SrcCoordSysData%n3, kind=B8Ki) + LB(1:3) = lbound(SrcCoordSysData%n3) + UB(1:3) = ubound(SrcCoordSysData%n3) if (.not. allocated(DstCoordSysData%n3)) then allocate(DstCoordSysData%n3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2547,8 +2588,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%rf3 = SrcCoordSysData%rf3 DstCoordSysData%rfa = SrcCoordSysData%rfa if (allocated(SrcCoordSysData%t1)) then - LB(1:2) = lbound(SrcCoordSysData%t1, kind=B8Ki) - UB(1:2) = ubound(SrcCoordSysData%t1, kind=B8Ki) + LB(1:2) = lbound(SrcCoordSysData%t1) + UB(1:2) = ubound(SrcCoordSysData%t1) if (.not. allocated(DstCoordSysData%t1)) then allocate(DstCoordSysData%t1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2559,8 +2600,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%t1 = SrcCoordSysData%t1 end if if (allocated(SrcCoordSysData%t2)) then - LB(1:2) = lbound(SrcCoordSysData%t2, kind=B8Ki) - UB(1:2) = ubound(SrcCoordSysData%t2, kind=B8Ki) + LB(1:2) = lbound(SrcCoordSysData%t2) + UB(1:2) = ubound(SrcCoordSysData%t2) if (.not. allocated(DstCoordSysData%t2)) then allocate(DstCoordSysData%t2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2571,8 +2612,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%t2 = SrcCoordSysData%t2 end if if (allocated(SrcCoordSysData%t3)) then - LB(1:2) = lbound(SrcCoordSysData%t3, kind=B8Ki) - UB(1:2) = ubound(SrcCoordSysData%t3, kind=B8Ki) + LB(1:2) = lbound(SrcCoordSysData%t3) + UB(1:2) = ubound(SrcCoordSysData%t3) if (.not. allocated(DstCoordSysData%t3)) then allocate(DstCoordSysData%t3(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2583,8 +2624,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%t3 = SrcCoordSysData%t3 end if if (allocated(SrcCoordSysData%te1)) then - LB(1:3) = lbound(SrcCoordSysData%te1, kind=B8Ki) - UB(1:3) = ubound(SrcCoordSysData%te1, kind=B8Ki) + LB(1:3) = lbound(SrcCoordSysData%te1) + UB(1:3) = ubound(SrcCoordSysData%te1) if (.not. allocated(DstCoordSysData%te1)) then allocate(DstCoordSysData%te1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2595,8 +2636,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%te1 = SrcCoordSysData%te1 end if if (allocated(SrcCoordSysData%te2)) then - LB(1:3) = lbound(SrcCoordSysData%te2, kind=B8Ki) - UB(1:3) = ubound(SrcCoordSysData%te2, kind=B8Ki) + LB(1:3) = lbound(SrcCoordSysData%te2) + UB(1:3) = ubound(SrcCoordSysData%te2) if (.not. allocated(DstCoordSysData%te2)) then allocate(DstCoordSysData%te2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2607,8 +2648,8 @@ subroutine ED_CopyCoordSys(SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, DstCoordSysData%te2 = SrcCoordSysData%te2 end if if (allocated(SrcCoordSysData%te3)) then - LB(1:3) = lbound(SrcCoordSysData%te3, kind=B8Ki) - UB(1:3) = ubound(SrcCoordSysData%te3, kind=B8Ki) + LB(1:3) = lbound(SrcCoordSysData%te3) + UB(1:3) = ubound(SrcCoordSysData%te3) if (.not. allocated(DstCoordSysData%te3)) then allocate(DstCoordSysData%te3(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2758,7 +2799,7 @@ subroutine ED_UnPackCoordSys(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_CoordSys), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackCoordSys' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2826,7 +2867,7 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ED_CopyActiveDOFs' ErrStat = ErrID_None @@ -2838,8 +2879,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%NPTE = SrcActiveDOFsData%NPTE DstActiveDOFsData%NPTTE = SrcActiveDOFsData%NPTTE if (allocated(SrcActiveDOFsData%NPSBE)) then - LB(1:1) = lbound(SrcActiveDOFsData%NPSBE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%NPSBE, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%NPSBE) + UB(1:1) = ubound(SrcActiveDOFsData%NPSBE) if (.not. allocated(DstActiveDOFsData%NPSBE)) then allocate(DstActiveDOFsData%NPSBE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2850,8 +2891,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%NPSBE = SrcActiveDOFsData%NPSBE end if if (allocated(SrcActiveDOFsData%NPSE)) then - LB(1:1) = lbound(SrcActiveDOFsData%NPSE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%NPSE, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%NPSE) + UB(1:1) = ubound(SrcActiveDOFsData%NPSE) if (.not. allocated(DstActiveDOFsData%NPSE)) then allocate(DstActiveDOFsData%NPSE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2864,8 +2905,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%NPUE = SrcActiveDOFsData%NPUE DstActiveDOFsData%NPYE = SrcActiveDOFsData%NPYE if (allocated(SrcActiveDOFsData%PCE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PCE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%PCE, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%PCE) + UB(1:1) = ubound(SrcActiveDOFsData%PCE) if (.not. allocated(DstActiveDOFsData%PCE)) then allocate(DstActiveDOFsData%PCE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2876,8 +2917,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PCE = SrcActiveDOFsData%PCE end if if (allocated(SrcActiveDOFsData%PDE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PDE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%PDE, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%PDE) + UB(1:1) = ubound(SrcActiveDOFsData%PDE) if (.not. allocated(DstActiveDOFsData%PDE)) then allocate(DstActiveDOFsData%PDE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2888,8 +2929,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PDE = SrcActiveDOFsData%PDE end if if (allocated(SrcActiveDOFsData%PIE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PIE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%PIE, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%PIE) + UB(1:1) = ubound(SrcActiveDOFsData%PIE) if (.not. allocated(DstActiveDOFsData%PIE)) then allocate(DstActiveDOFsData%PIE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2900,8 +2941,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PIE = SrcActiveDOFsData%PIE end if if (allocated(SrcActiveDOFsData%PTE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PTE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%PTE, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%PTE) + UB(1:1) = ubound(SrcActiveDOFsData%PTE) if (.not. allocated(DstActiveDOFsData%PTE)) then allocate(DstActiveDOFsData%PTE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2912,8 +2953,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PTE = SrcActiveDOFsData%PTE end if if (allocated(SrcActiveDOFsData%PTTE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PTTE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%PTTE, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%PTTE) + UB(1:1) = ubound(SrcActiveDOFsData%PTTE) if (.not. allocated(DstActiveDOFsData%PTTE)) then allocate(DstActiveDOFsData%PTTE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2924,8 +2965,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PTTE = SrcActiveDOFsData%PTTE end if if (allocated(SrcActiveDOFsData%PS)) then - LB(1:1) = lbound(SrcActiveDOFsData%PS, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%PS, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%PS) + UB(1:1) = ubound(SrcActiveDOFsData%PS) if (.not. allocated(DstActiveDOFsData%PS)) then allocate(DstActiveDOFsData%PS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2936,8 +2977,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PS = SrcActiveDOFsData%PS end if if (allocated(SrcActiveDOFsData%PSBE)) then - LB(1:2) = lbound(SrcActiveDOFsData%PSBE, kind=B8Ki) - UB(1:2) = ubound(SrcActiveDOFsData%PSBE, kind=B8Ki) + LB(1:2) = lbound(SrcActiveDOFsData%PSBE) + UB(1:2) = ubound(SrcActiveDOFsData%PSBE) if (.not. allocated(DstActiveDOFsData%PSBE)) then allocate(DstActiveDOFsData%PSBE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2948,8 +2989,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PSBE = SrcActiveDOFsData%PSBE end if if (allocated(SrcActiveDOFsData%PSE)) then - LB(1:2) = lbound(SrcActiveDOFsData%PSE, kind=B8Ki) - UB(1:2) = ubound(SrcActiveDOFsData%PSE, kind=B8Ki) + LB(1:2) = lbound(SrcActiveDOFsData%PSE) + UB(1:2) = ubound(SrcActiveDOFsData%PSE) if (.not. allocated(DstActiveDOFsData%PSE)) then allocate(DstActiveDOFsData%PSE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2960,8 +3001,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PSE = SrcActiveDOFsData%PSE end if if (allocated(SrcActiveDOFsData%PUE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PUE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%PUE, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%PUE) + UB(1:1) = ubound(SrcActiveDOFsData%PUE) if (.not. allocated(DstActiveDOFsData%PUE)) then allocate(DstActiveDOFsData%PUE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2972,8 +3013,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PUE = SrcActiveDOFsData%PUE end if if (allocated(SrcActiveDOFsData%PYE)) then - LB(1:1) = lbound(SrcActiveDOFsData%PYE, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%PYE, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%PYE) + UB(1:1) = ubound(SrcActiveDOFsData%PYE) if (.not. allocated(DstActiveDOFsData%PYE)) then allocate(DstActiveDOFsData%PYE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2984,8 +3025,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%PYE = SrcActiveDOFsData%PYE end if if (allocated(SrcActiveDOFsData%SrtPS)) then - LB(1:1) = lbound(SrcActiveDOFsData%SrtPS, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%SrtPS, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%SrtPS) + UB(1:1) = ubound(SrcActiveDOFsData%SrtPS) if (.not. allocated(DstActiveDOFsData%SrtPS)) then allocate(DstActiveDOFsData%SrtPS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2996,8 +3037,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%SrtPS = SrcActiveDOFsData%SrtPS end if if (allocated(SrcActiveDOFsData%SrtPSNAUG)) then - LB(1:1) = lbound(SrcActiveDOFsData%SrtPSNAUG, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%SrtPSNAUG, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%SrtPSNAUG) + UB(1:1) = ubound(SrcActiveDOFsData%SrtPSNAUG) if (.not. allocated(DstActiveDOFsData%SrtPSNAUG)) then allocate(DstActiveDOFsData%SrtPSNAUG(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3008,8 +3049,8 @@ subroutine ED_CopyActiveDOFs(SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, Err DstActiveDOFsData%SrtPSNAUG = SrcActiveDOFsData%SrtPSNAUG end if if (allocated(SrcActiveDOFsData%Diag)) then - LB(1:1) = lbound(SrcActiveDOFsData%Diag, kind=B8Ki) - UB(1:1) = ubound(SrcActiveDOFsData%Diag, kind=B8Ki) + LB(1:1) = lbound(SrcActiveDOFsData%Diag) + UB(1:1) = ubound(SrcActiveDOFsData%Diag) if (.not. allocated(DstActiveDOFsData%Diag)) then allocate(DstActiveDOFsData%Diag(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3110,7 +3151,7 @@ subroutine ED_UnPackActiveDOFs(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_ActiveDOFs), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackActiveDOFs' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3145,15 +3186,15 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ED_CopyRtHndSide' ErrStat = ErrID_None ErrMsg = '' DstRtHndSideData%rO = SrcRtHndSideData%rO if (allocated(SrcRtHndSideData%rQS)) then - LB(1:3) = lbound(SrcRtHndSideData%rQS, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%rQS, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%rQS) + UB(1:3) = ubound(SrcRtHndSideData%rQS) if (.not. allocated(DstRtHndSideData%rQS)) then allocate(DstRtHndSideData%rQS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3164,8 +3205,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%rQS = SrcRtHndSideData%rQS end if if (allocated(SrcRtHndSideData%rS)) then - LB(1:3) = lbound(SrcRtHndSideData%rS, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%rS, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%rS) + UB(1:3) = ubound(SrcRtHndSideData%rS) if (.not. allocated(DstRtHndSideData%rS)) then allocate(DstRtHndSideData%rS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3176,8 +3217,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%rS = SrcRtHndSideData%rS end if if (allocated(SrcRtHndSideData%rS0S)) then - LB(1:3) = lbound(SrcRtHndSideData%rS0S, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%rS0S, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%rS0S) + UB(1:3) = ubound(SrcRtHndSideData%rS0S) if (.not. allocated(DstRtHndSideData%rS0S)) then allocate(DstRtHndSideData%rS0S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3188,8 +3229,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%rS0S = SrcRtHndSideData%rS0S end if if (allocated(SrcRtHndSideData%rT)) then - LB(1:2) = lbound(SrcRtHndSideData%rT, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%rT, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%rT) + UB(1:2) = ubound(SrcRtHndSideData%rT) if (.not. allocated(DstRtHndSideData%rT)) then allocate(DstRtHndSideData%rT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3201,8 +3242,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%rT0O = SrcRtHndSideData%rT0O if (allocated(SrcRtHndSideData%rT0T)) then - LB(1:2) = lbound(SrcRtHndSideData%rT0T, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%rT0T, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%rT0T) + UB(1:2) = ubound(SrcRtHndSideData%rT0T) if (.not. allocated(DstRtHndSideData%rT0T)) then allocate(DstRtHndSideData%rT0T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3215,8 +3256,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%rZ = SrcRtHndSideData%rZ DstRtHndSideData%rZO = SrcRtHndSideData%rZO if (allocated(SrcRtHndSideData%rZT)) then - LB(1:2) = lbound(SrcRtHndSideData%rZT, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%rZT, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%rZT) + UB(1:2) = ubound(SrcRtHndSideData%rZT) if (.not. allocated(DstRtHndSideData%rZT)) then allocate(DstRtHndSideData%rZT(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3237,8 +3278,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%rOW = SrcRtHndSideData%rOW DstRtHndSideData%rPC = SrcRtHndSideData%rPC if (allocated(SrcRtHndSideData%rPS0)) then - LB(1:2) = lbound(SrcRtHndSideData%rPS0, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%rPS0, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%rPS0) + UB(1:2) = ubound(SrcRtHndSideData%rPS0) if (.not. allocated(DstRtHndSideData%rPS0)) then allocate(DstRtHndSideData%rPS0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3256,8 +3297,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%rWJ = SrcRtHndSideData%rWJ DstRtHndSideData%rZT0 = SrcRtHndSideData%rZT0 if (allocated(SrcRtHndSideData%AngPosEF)) then - LB(1:2) = lbound(SrcRtHndSideData%AngPosEF, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%AngPosEF, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%AngPosEF) + UB(1:2) = ubound(SrcRtHndSideData%AngPosEF) if (.not. allocated(DstRtHndSideData%AngPosEF)) then allocate(DstRtHndSideData%AngPosEF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3268,8 +3309,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngPosEF = SrcRtHndSideData%AngPosEF end if if (allocated(SrcRtHndSideData%AngPosXF)) then - LB(1:2) = lbound(SrcRtHndSideData%AngPosXF, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%AngPosXF, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%AngPosXF) + UB(1:2) = ubound(SrcRtHndSideData%AngPosXF) if (.not. allocated(DstRtHndSideData%AngPosXF)) then allocate(DstRtHndSideData%AngPosXF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3280,8 +3321,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngPosXF = SrcRtHndSideData%AngPosXF end if if (allocated(SrcRtHndSideData%AngPosHM)) then - LB(1:3) = lbound(SrcRtHndSideData%AngPosHM, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%AngPosHM, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%AngPosHM) + UB(1:3) = ubound(SrcRtHndSideData%AngPosHM) if (.not. allocated(DstRtHndSideData%AngPosHM)) then allocate(DstRtHndSideData%AngPosHM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3294,8 +3335,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngPosXB = SrcRtHndSideData%AngPosXB DstRtHndSideData%AngPosEX = SrcRtHndSideData%AngPosEX if (allocated(SrcRtHndSideData%PAngVelEA)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEA, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEA, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEA) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEA) if (.not. allocated(DstRtHndSideData%PAngVelEA)) then allocate(DstRtHndSideData%PAngVelEA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3306,8 +3347,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEA = SrcRtHndSideData%PAngVelEA end if if (allocated(SrcRtHndSideData%PAngVelEF)) then - LB(1:4) = lbound(SrcRtHndSideData%PAngVelEF, kind=B8Ki) - UB(1:4) = ubound(SrcRtHndSideData%PAngVelEF, kind=B8Ki) + LB(1:4) = lbound(SrcRtHndSideData%PAngVelEF) + UB(1:4) = ubound(SrcRtHndSideData%PAngVelEF) if (.not. allocated(DstRtHndSideData%PAngVelEF)) then allocate(DstRtHndSideData%PAngVelEF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3318,8 +3359,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEF = SrcRtHndSideData%PAngVelEF end if if (allocated(SrcRtHndSideData%PAngVelEG)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEG, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEG, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEG) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEG) if (.not. allocated(DstRtHndSideData%PAngVelEG)) then allocate(DstRtHndSideData%PAngVelEG(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3330,8 +3371,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEG = SrcRtHndSideData%PAngVelEG end if if (allocated(SrcRtHndSideData%PAngVelEH)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEH, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEH, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEH) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEH) if (.not. allocated(DstRtHndSideData%PAngVelEH)) then allocate(DstRtHndSideData%PAngVelEH(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3342,8 +3383,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEH = SrcRtHndSideData%PAngVelEH end if if (allocated(SrcRtHndSideData%PAngVelEL)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEL, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEL, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEL) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEL) if (.not. allocated(DstRtHndSideData%PAngVelEL)) then allocate(DstRtHndSideData%PAngVelEL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3354,8 +3395,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEL = SrcRtHndSideData%PAngVelEL end if if (allocated(SrcRtHndSideData%PAngVelEM)) then - LB(1:5) = lbound(SrcRtHndSideData%PAngVelEM, kind=B8Ki) - UB(1:5) = ubound(SrcRtHndSideData%PAngVelEM, kind=B8Ki) + LB(1:5) = lbound(SrcRtHndSideData%PAngVelEM) + UB(1:5) = ubound(SrcRtHndSideData%PAngVelEM) if (.not. allocated(DstRtHndSideData%PAngVelEM)) then allocate(DstRtHndSideData%PAngVelEM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3366,8 +3407,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEM = SrcRtHndSideData%PAngVelEM end if if (allocated(SrcRtHndSideData%AngVelEM)) then - LB(1:3) = lbound(SrcRtHndSideData%AngVelEM, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%AngVelEM, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%AngVelEM) + UB(1:3) = ubound(SrcRtHndSideData%AngVelEM) if (.not. allocated(DstRtHndSideData%AngVelEM)) then allocate(DstRtHndSideData%AngVelEM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3378,8 +3419,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngVelEM = SrcRtHndSideData%AngVelEM end if if (allocated(SrcRtHndSideData%PAngVelEN)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEN, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEN, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEN) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEN) if (.not. allocated(DstRtHndSideData%PAngVelEN)) then allocate(DstRtHndSideData%PAngVelEN(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3391,8 +3432,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%AngVelEA = SrcRtHndSideData%AngVelEA if (allocated(SrcRtHndSideData%PAngVelEB)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEB, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEB, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEB) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEB) if (.not. allocated(DstRtHndSideData%PAngVelEB)) then allocate(DstRtHndSideData%PAngVelEB(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3403,8 +3444,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelEB = SrcRtHndSideData%PAngVelEB end if if (allocated(SrcRtHndSideData%PAngVelER)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelER, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelER, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelER) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelER) if (.not. allocated(DstRtHndSideData%PAngVelER)) then allocate(DstRtHndSideData%PAngVelER(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3415,8 +3456,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PAngVelER = SrcRtHndSideData%PAngVelER end if if (allocated(SrcRtHndSideData%PAngVelEX)) then - LB(1:3) = lbound(SrcRtHndSideData%PAngVelEX, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PAngVelEX, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PAngVelEX) + UB(1:3) = ubound(SrcRtHndSideData%PAngVelEX) if (.not. allocated(DstRtHndSideData%PAngVelEX)) then allocate(DstRtHndSideData%PAngVelEX(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3438,8 +3479,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngAccERt = SrcRtHndSideData%AngAccERt DstRtHndSideData%AngAccEXt = SrcRtHndSideData%AngAccEXt if (allocated(SrcRtHndSideData%AngAccEFt)) then - LB(1:2) = lbound(SrcRtHndSideData%AngAccEFt, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%AngAccEFt, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%AngAccEFt) + UB(1:2) = ubound(SrcRtHndSideData%AngAccEFt) if (.not. allocated(DstRtHndSideData%AngAccEFt)) then allocate(DstRtHndSideData%AngAccEFt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3450,8 +3491,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngAccEFt = SrcRtHndSideData%AngAccEFt end if if (allocated(SrcRtHndSideData%AngVelEF)) then - LB(1:2) = lbound(SrcRtHndSideData%AngVelEF, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%AngVelEF, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%AngVelEF) + UB(1:2) = ubound(SrcRtHndSideData%AngVelEF) if (.not. allocated(DstRtHndSideData%AngVelEF)) then allocate(DstRtHndSideData%AngVelEF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3462,8 +3503,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngVelEF = SrcRtHndSideData%AngVelEF end if if (allocated(SrcRtHndSideData%AngVelHM)) then - LB(1:3) = lbound(SrcRtHndSideData%AngVelHM, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%AngVelHM, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%AngVelHM) + UB(1:3) = ubound(SrcRtHndSideData%AngVelHM) if (.not. allocated(DstRtHndSideData%AngVelHM)) then allocate(DstRtHndSideData%AngVelHM(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3477,8 +3518,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%AngAccEGt = SrcRtHndSideData%AngAccEGt DstRtHndSideData%AngAccEHt = SrcRtHndSideData%AngAccEHt if (allocated(SrcRtHndSideData%AngAccEKt)) then - LB(1:3) = lbound(SrcRtHndSideData%AngAccEKt, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%AngAccEKt, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%AngAccEKt) + UB(1:3) = ubound(SrcRtHndSideData%AngAccEKt) if (.not. allocated(DstRtHndSideData%AngAccEKt)) then allocate(DstRtHndSideData%AngAccEKt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3496,8 +3537,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%LinAccEUt = SrcRtHndSideData%LinAccEUt DstRtHndSideData%LinAccEYt = SrcRtHndSideData%LinAccEYt if (allocated(SrcRtHndSideData%LinVelES)) then - LB(1:3) = lbound(SrcRtHndSideData%LinVelES, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%LinVelES, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%LinVelES) + UB(1:3) = ubound(SrcRtHndSideData%LinVelES) if (.not. allocated(DstRtHndSideData%LinVelES)) then allocate(DstRtHndSideData%LinVelES(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3509,8 +3550,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%LinVelEQ = SrcRtHndSideData%LinVelEQ if (allocated(SrcRtHndSideData%LinVelET)) then - LB(1:2) = lbound(SrcRtHndSideData%LinVelET, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%LinVelET, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%LinVelET) + UB(1:2) = ubound(SrcRtHndSideData%LinVelET) if (.not. allocated(DstRtHndSideData%LinVelET)) then allocate(DstRtHndSideData%LinVelET(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3521,8 +3562,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%LinVelET = SrcRtHndSideData%LinVelET end if if (allocated(SrcRtHndSideData%LinVelESm2)) then - LB(1:1) = lbound(SrcRtHndSideData%LinVelESm2, kind=B8Ki) - UB(1:1) = ubound(SrcRtHndSideData%LinVelESm2, kind=B8Ki) + LB(1:1) = lbound(SrcRtHndSideData%LinVelESm2) + UB(1:1) = ubound(SrcRtHndSideData%LinVelESm2) if (.not. allocated(DstRtHndSideData%LinVelESm2)) then allocate(DstRtHndSideData%LinVelESm2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3533,8 +3574,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%LinVelESm2 = SrcRtHndSideData%LinVelESm2 end if if (allocated(SrcRtHndSideData%PLinVelEIMU)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEIMU, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEIMU, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEIMU) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEIMU) if (.not. allocated(DstRtHndSideData%PLinVelEIMU)) then allocate(DstRtHndSideData%PLinVelEIMU(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3545,8 +3586,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEIMU = SrcRtHndSideData%PLinVelEIMU end if if (allocated(SrcRtHndSideData%PLinVelEO)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEO, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEO, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEO) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEO) if (.not. allocated(DstRtHndSideData%PLinVelEO)) then allocate(DstRtHndSideData%PLinVelEO(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3557,8 +3598,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEO = SrcRtHndSideData%PLinVelEO end if if (allocated(SrcRtHndSideData%PLinVelES)) then - LB(1:5) = lbound(SrcRtHndSideData%PLinVelES, kind=B8Ki) - UB(1:5) = ubound(SrcRtHndSideData%PLinVelES, kind=B8Ki) + LB(1:5) = lbound(SrcRtHndSideData%PLinVelES) + UB(1:5) = ubound(SrcRtHndSideData%PLinVelES) if (.not. allocated(DstRtHndSideData%PLinVelES)) then allocate(DstRtHndSideData%PLinVelES(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3569,8 +3610,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelES = SrcRtHndSideData%PLinVelES end if if (allocated(SrcRtHndSideData%PLinVelET)) then - LB(1:4) = lbound(SrcRtHndSideData%PLinVelET, kind=B8Ki) - UB(1:4) = ubound(SrcRtHndSideData%PLinVelET, kind=B8Ki) + LB(1:4) = lbound(SrcRtHndSideData%PLinVelET) + UB(1:4) = ubound(SrcRtHndSideData%PLinVelET) if (.not. allocated(DstRtHndSideData%PLinVelET)) then allocate(DstRtHndSideData%PLinVelET(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3581,8 +3622,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelET = SrcRtHndSideData%PLinVelET end if if (allocated(SrcRtHndSideData%PLinVelEZ)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEZ, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEZ, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEZ) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEZ) if (.not. allocated(DstRtHndSideData%PLinVelEZ)) then allocate(DstRtHndSideData%PLinVelEZ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3593,8 +3634,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEZ = SrcRtHndSideData%PLinVelEZ end if if (allocated(SrcRtHndSideData%PLinVelEC)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEC, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEC, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEC) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEC) if (.not. allocated(DstRtHndSideData%PLinVelEC)) then allocate(DstRtHndSideData%PLinVelEC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3605,8 +3646,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEC = SrcRtHndSideData%PLinVelEC end if if (allocated(SrcRtHndSideData%PLinVelED)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelED, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelED, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelED) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelED) if (.not. allocated(DstRtHndSideData%PLinVelED)) then allocate(DstRtHndSideData%PLinVelED(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3617,8 +3658,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelED = SrcRtHndSideData%PLinVelED end if if (allocated(SrcRtHndSideData%PLinVelEI)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEI, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEI, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEI) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEI) if (.not. allocated(DstRtHndSideData%PLinVelEI)) then allocate(DstRtHndSideData%PLinVelEI(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3629,8 +3670,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEI = SrcRtHndSideData%PLinVelEI end if if (allocated(SrcRtHndSideData%PLinVelEJ)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEJ, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEJ, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEJ) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEJ) if (.not. allocated(DstRtHndSideData%PLinVelEJ)) then allocate(DstRtHndSideData%PLinVelEJ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3641,8 +3682,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEJ = SrcRtHndSideData%PLinVelEJ end if if (allocated(SrcRtHndSideData%PLinVelEP)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEP, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEP, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEP) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEP) if (.not. allocated(DstRtHndSideData%PLinVelEP)) then allocate(DstRtHndSideData%PLinVelEP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3653,8 +3694,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEP = SrcRtHndSideData%PLinVelEP end if if (allocated(SrcRtHndSideData%PLinVelEQ)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEQ, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEQ, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEQ) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEQ) if (.not. allocated(DstRtHndSideData%PLinVelEQ)) then allocate(DstRtHndSideData%PLinVelEQ(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3665,8 +3706,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEQ = SrcRtHndSideData%PLinVelEQ end if if (allocated(SrcRtHndSideData%PLinVelEU)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEU, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEU, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEU) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEU) if (.not. allocated(DstRtHndSideData%PLinVelEU)) then allocate(DstRtHndSideData%PLinVelEU(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3677,8 +3718,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEU = SrcRtHndSideData%PLinVelEU end if if (allocated(SrcRtHndSideData%PLinVelEV)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEV, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEV, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEV) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEV) if (.not. allocated(DstRtHndSideData%PLinVelEV)) then allocate(DstRtHndSideData%PLinVelEV(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3689,8 +3730,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEV = SrcRtHndSideData%PLinVelEV end if if (allocated(SrcRtHndSideData%PLinVelEW)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEW, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEW, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEW) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEW) if (.not. allocated(DstRtHndSideData%PLinVelEW)) then allocate(DstRtHndSideData%PLinVelEW(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3701,8 +3742,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PLinVelEW = SrcRtHndSideData%PLinVelEW end if if (allocated(SrcRtHndSideData%PLinVelEY)) then - LB(1:3) = lbound(SrcRtHndSideData%PLinVelEY, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PLinVelEY, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PLinVelEY) + UB(1:3) = ubound(SrcRtHndSideData%PLinVelEY) if (.not. allocated(DstRtHndSideData%PLinVelEY)) then allocate(DstRtHndSideData%PLinVelEY(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3715,8 +3756,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%LinAccEIMUt = SrcRtHndSideData%LinAccEIMUt DstRtHndSideData%LinAccEOt = SrcRtHndSideData%LinAccEOt if (allocated(SrcRtHndSideData%LinAccESt)) then - LB(1:3) = lbound(SrcRtHndSideData%LinAccESt, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%LinAccESt, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%LinAccESt) + UB(1:3) = ubound(SrcRtHndSideData%LinAccESt) if (.not. allocated(DstRtHndSideData%LinAccESt)) then allocate(DstRtHndSideData%LinAccESt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3727,8 +3768,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%LinAccESt = SrcRtHndSideData%LinAccESt end if if (allocated(SrcRtHndSideData%LinAccETt)) then - LB(1:2) = lbound(SrcRtHndSideData%LinAccETt, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%LinAccETt, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%LinAccETt) + UB(1:2) = ubound(SrcRtHndSideData%LinAccETt) if (.not. allocated(DstRtHndSideData%LinAccETt)) then allocate(DstRtHndSideData%LinAccETt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3746,8 +3787,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%FrcONcRtt = SrcRtHndSideData%FrcONcRtt DstRtHndSideData%FrcPRott = SrcRtHndSideData%FrcPRott if (allocated(SrcRtHndSideData%FrcS0Bt)) then - LB(1:2) = lbound(SrcRtHndSideData%FrcS0Bt, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%FrcS0Bt, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%FrcS0Bt) + UB(1:2) = ubound(SrcRtHndSideData%FrcS0Bt) if (.not. allocated(DstRtHndSideData%FrcS0Bt)) then allocate(DstRtHndSideData%FrcS0Bt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3759,8 +3800,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%FrcT0Trbt = SrcRtHndSideData%FrcT0Trbt if (allocated(SrcRtHndSideData%FSAero)) then - LB(1:3) = lbound(SrcRtHndSideData%FSAero, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%FSAero, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%FSAero) + UB(1:3) = ubound(SrcRtHndSideData%FSAero) if (.not. allocated(DstRtHndSideData%FSAero)) then allocate(DstRtHndSideData%FSAero(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3771,8 +3812,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%FSAero = SrcRtHndSideData%FSAero end if if (allocated(SrcRtHndSideData%FSTipDrag)) then - LB(1:2) = lbound(SrcRtHndSideData%FSTipDrag, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%FSTipDrag, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%FSTipDrag) + UB(1:2) = ubound(SrcRtHndSideData%FSTipDrag) if (.not. allocated(DstRtHndSideData%FSTipDrag)) then allocate(DstRtHndSideData%FSTipDrag(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3783,8 +3824,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%FSTipDrag = SrcRtHndSideData%FSTipDrag end if if (allocated(SrcRtHndSideData%FTHydrot)) then - LB(1:2) = lbound(SrcRtHndSideData%FTHydrot, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%FTHydrot, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%FTHydrot) + UB(1:2) = ubound(SrcRtHndSideData%FTHydrot) if (.not. allocated(DstRtHndSideData%FTHydrot)) then allocate(DstRtHndSideData%FTHydrot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3796,8 +3837,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%FZHydrot = SrcRtHndSideData%FZHydrot if (allocated(SrcRtHndSideData%MFHydrot)) then - LB(1:2) = lbound(SrcRtHndSideData%MFHydrot, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%MFHydrot, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%MFHydrot) + UB(1:2) = ubound(SrcRtHndSideData%MFHydrot) if (.not. allocated(DstRtHndSideData%MFHydrot)) then allocate(DstRtHndSideData%MFHydrot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3809,8 +3850,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%MomBNcRtt = SrcRtHndSideData%MomBNcRtt if (allocated(SrcRtHndSideData%MomH0Bt)) then - LB(1:2) = lbound(SrcRtHndSideData%MomH0Bt, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%MomH0Bt, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%MomH0Bt) + UB(1:2) = ubound(SrcRtHndSideData%MomH0Bt) if (.not. allocated(DstRtHndSideData%MomH0Bt)) then allocate(DstRtHndSideData%MomH0Bt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3825,8 +3866,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%MomNTailt = SrcRtHndSideData%MomNTailt DstRtHndSideData%MomX0Trbt = SrcRtHndSideData%MomX0Trbt if (allocated(SrcRtHndSideData%MMAero)) then - LB(1:3) = lbound(SrcRtHndSideData%MMAero, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%MMAero, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%MMAero) + UB(1:3) = ubound(SrcRtHndSideData%MMAero) if (.not. allocated(DstRtHndSideData%MMAero)) then allocate(DstRtHndSideData%MMAero(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3838,8 +3879,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%MXHydrot = SrcRtHndSideData%MXHydrot if (allocated(SrcRtHndSideData%PFrcONcRt)) then - LB(1:2) = lbound(SrcRtHndSideData%PFrcONcRt, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PFrcONcRt, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PFrcONcRt) + UB(1:2) = ubound(SrcRtHndSideData%PFrcONcRt) if (.not. allocated(DstRtHndSideData%PFrcONcRt)) then allocate(DstRtHndSideData%PFrcONcRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3850,8 +3891,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcONcRt = SrcRtHndSideData%PFrcONcRt end if if (allocated(SrcRtHndSideData%PFrcPRot)) then - LB(1:2) = lbound(SrcRtHndSideData%PFrcPRot, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PFrcPRot, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PFrcPRot) + UB(1:2) = ubound(SrcRtHndSideData%PFrcPRot) if (.not. allocated(DstRtHndSideData%PFrcPRot)) then allocate(DstRtHndSideData%PFrcPRot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3862,8 +3903,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcPRot = SrcRtHndSideData%PFrcPRot end if if (allocated(SrcRtHndSideData%PFrcS0B)) then - LB(1:3) = lbound(SrcRtHndSideData%PFrcS0B, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PFrcS0B, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PFrcS0B) + UB(1:3) = ubound(SrcRtHndSideData%PFrcS0B) if (.not. allocated(DstRtHndSideData%PFrcS0B)) then allocate(DstRtHndSideData%PFrcS0B(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3874,8 +3915,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcS0B = SrcRtHndSideData%PFrcS0B end if if (allocated(SrcRtHndSideData%PFrcT0Trb)) then - LB(1:2) = lbound(SrcRtHndSideData%PFrcT0Trb, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PFrcT0Trb, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PFrcT0Trb) + UB(1:2) = ubound(SrcRtHndSideData%PFrcT0Trb) if (.not. allocated(DstRtHndSideData%PFrcT0Trb)) then allocate(DstRtHndSideData%PFrcT0Trb(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3886,8 +3927,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcT0Trb = SrcRtHndSideData%PFrcT0Trb end if if (allocated(SrcRtHndSideData%PFTHydro)) then - LB(1:3) = lbound(SrcRtHndSideData%PFTHydro, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PFTHydro, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PFTHydro) + UB(1:3) = ubound(SrcRtHndSideData%PFTHydro) if (.not. allocated(DstRtHndSideData%PFTHydro)) then allocate(DstRtHndSideData%PFTHydro(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3899,8 +3940,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta end if DstRtHndSideData%PFZHydro = SrcRtHndSideData%PFZHydro if (allocated(SrcRtHndSideData%PMFHydro)) then - LB(1:3) = lbound(SrcRtHndSideData%PMFHydro, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PMFHydro, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PMFHydro) + UB(1:3) = ubound(SrcRtHndSideData%PMFHydro) if (.not. allocated(DstRtHndSideData%PMFHydro)) then allocate(DstRtHndSideData%PMFHydro(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3911,8 +3952,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PMFHydro = SrcRtHndSideData%PMFHydro end if if (allocated(SrcRtHndSideData%PMomBNcRt)) then - LB(1:2) = lbound(SrcRtHndSideData%PMomBNcRt, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PMomBNcRt, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PMomBNcRt) + UB(1:2) = ubound(SrcRtHndSideData%PMomBNcRt) if (.not. allocated(DstRtHndSideData%PMomBNcRt)) then allocate(DstRtHndSideData%PMomBNcRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3923,8 +3964,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PMomBNcRt = SrcRtHndSideData%PMomBNcRt end if if (allocated(SrcRtHndSideData%PMomH0B)) then - LB(1:3) = lbound(SrcRtHndSideData%PMomH0B, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%PMomH0B, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%PMomH0B) + UB(1:3) = ubound(SrcRtHndSideData%PMomH0B) if (.not. allocated(DstRtHndSideData%PMomH0B)) then allocate(DstRtHndSideData%PMomH0B(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3935,8 +3976,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PMomH0B = SrcRtHndSideData%PMomH0B end if if (allocated(SrcRtHndSideData%PMomLPRot)) then - LB(1:2) = lbound(SrcRtHndSideData%PMomLPRot, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PMomLPRot, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PMomLPRot) + UB(1:2) = ubound(SrcRtHndSideData%PMomLPRot) if (.not. allocated(DstRtHndSideData%PMomLPRot)) then allocate(DstRtHndSideData%PMomLPRot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3947,8 +3988,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PMomLPRot = SrcRtHndSideData%PMomLPRot end if if (allocated(SrcRtHndSideData%PMomNGnRt)) then - LB(1:2) = lbound(SrcRtHndSideData%PMomNGnRt, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PMomNGnRt, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PMomNGnRt) + UB(1:2) = ubound(SrcRtHndSideData%PMomNGnRt) if (.not. allocated(DstRtHndSideData%PMomNGnRt)) then allocate(DstRtHndSideData%PMomNGnRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3959,8 +4000,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PMomNGnRt = SrcRtHndSideData%PMomNGnRt end if if (allocated(SrcRtHndSideData%PMomNTail)) then - LB(1:2) = lbound(SrcRtHndSideData%PMomNTail, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PMomNTail, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PMomNTail) + UB(1:2) = ubound(SrcRtHndSideData%PMomNTail) if (.not. allocated(DstRtHndSideData%PMomNTail)) then allocate(DstRtHndSideData%PMomNTail(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3971,8 +4012,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PMomNTail = SrcRtHndSideData%PMomNTail end if if (allocated(SrcRtHndSideData%PMomX0Trb)) then - LB(1:2) = lbound(SrcRtHndSideData%PMomX0Trb, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PMomX0Trb, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PMomX0Trb) + UB(1:2) = ubound(SrcRtHndSideData%PMomX0Trb) if (.not. allocated(DstRtHndSideData%PMomX0Trb)) then allocate(DstRtHndSideData%PMomX0Trb(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3989,8 +4030,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%FrcZAllt = SrcRtHndSideData%FrcZAllt DstRtHndSideData%MomXAllt = SrcRtHndSideData%MomXAllt if (allocated(SrcRtHndSideData%PFrcVGnRt)) then - LB(1:2) = lbound(SrcRtHndSideData%PFrcVGnRt, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PFrcVGnRt, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PFrcVGnRt) + UB(1:2) = ubound(SrcRtHndSideData%PFrcVGnRt) if (.not. allocated(DstRtHndSideData%PFrcVGnRt)) then allocate(DstRtHndSideData%PFrcVGnRt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4001,8 +4042,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcVGnRt = SrcRtHndSideData%PFrcVGnRt end if if (allocated(SrcRtHndSideData%PFrcWTail)) then - LB(1:2) = lbound(SrcRtHndSideData%PFrcWTail, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PFrcWTail, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PFrcWTail) + UB(1:2) = ubound(SrcRtHndSideData%PFrcWTail) if (.not. allocated(DstRtHndSideData%PFrcWTail)) then allocate(DstRtHndSideData%PFrcWTail(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4013,8 +4054,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcWTail = SrcRtHndSideData%PFrcWTail end if if (allocated(SrcRtHndSideData%PFrcZAll)) then - LB(1:2) = lbound(SrcRtHndSideData%PFrcZAll, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PFrcZAll, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PFrcZAll) + UB(1:2) = ubound(SrcRtHndSideData%PFrcZAll) if (.not. allocated(DstRtHndSideData%PFrcZAll)) then allocate(DstRtHndSideData%PFrcZAll(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4025,8 +4066,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%PFrcZAll = SrcRtHndSideData%PFrcZAll end if if (allocated(SrcRtHndSideData%PMomXAll)) then - LB(1:2) = lbound(SrcRtHndSideData%PMomXAll, kind=B8Ki) - UB(1:2) = ubound(SrcRtHndSideData%PMomXAll, kind=B8Ki) + LB(1:2) = lbound(SrcRtHndSideData%PMomXAll) + UB(1:2) = ubound(SrcRtHndSideData%PMomXAll) if (.not. allocated(DstRtHndSideData%PMomXAll)) then allocate(DstRtHndSideData%PMomXAll(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4041,8 +4082,8 @@ subroutine ED_CopyRtHndSide(SrcRtHndSideData, DstRtHndSideData, CtrlCode, ErrSta DstRtHndSideData%RFrlMom = SrcRtHndSideData%RFrlMom DstRtHndSideData%GBoxEffFac = SrcRtHndSideData%GBoxEffFac if (allocated(SrcRtHndSideData%rSAerCen)) then - LB(1:3) = lbound(SrcRtHndSideData%rSAerCen, kind=B8Ki) - UB(1:3) = ubound(SrcRtHndSideData%rSAerCen, kind=B8Ki) + LB(1:3) = lbound(SrcRtHndSideData%rSAerCen) + UB(1:3) = ubound(SrcRtHndSideData%rSAerCen) if (.not. allocated(DstRtHndSideData%rSAerCen)) then allocate(DstRtHndSideData%rSAerCen(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4427,7 +4468,7 @@ subroutine ED_UnPackRtHndSide(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_RtHndSide), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackRtHndSide' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -4583,14 +4624,14 @@ subroutine ED_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ED_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%QT)) then - LB(1:1) = lbound(SrcContStateData%QT, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%QT, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%QT) + UB(1:1) = ubound(SrcContStateData%QT) if (.not. allocated(DstContStateData%QT)) then allocate(DstContStateData%QT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4601,8 +4642,8 @@ subroutine ED_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta DstContStateData%QT = SrcContStateData%QT end if if (allocated(SrcContStateData%QDT)) then - LB(1:1) = lbound(SrcContStateData%QDT, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%QDT, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%QDT) + UB(1:1) = ubound(SrcContStateData%QDT) if (.not. allocated(DstContStateData%QDT)) then allocate(DstContStateData%QDT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4643,7 +4684,7 @@ subroutine ED_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackContState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -4733,24 +4774,24 @@ subroutine ED_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' DstOtherStateData%n = SrcOtherStateData%n - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call ED_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do if (allocated(SrcOtherStateData%IC)) then - LB(1:1) = lbound(SrcOtherStateData%IC, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%IC, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%IC) + UB(1:1) = ubound(SrcOtherStateData%IC) if (.not. allocated(DstOtherStateData%IC)) then allocate(DstOtherStateData%IC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4774,15 +4815,15 @@ subroutine ED_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(ED_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call ED_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4796,12 +4837,12 @@ subroutine ED_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(ED_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%n) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call ED_PackContState(RF, InData%xdot(i1)) end do @@ -4821,14 +4862,14 @@ subroutine ED_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return - LB(1:1) = lbound(OutData%xdot, kind=B8Ki) - UB(1:1) = ubound(OutData%xdot, kind=B8Ki) + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call ED_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do @@ -4843,567 +4884,253 @@ 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(B8Ki) :: 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) + 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 - if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) - if (.not. allocated(DstMiscData%AllOuts)) then - allocate(DstMiscData%AllOuts(LB(1):UB(1)), stat=ErrStat2) + 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%AllOuts.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%AllOuts = SrcMiscData%AllOuts + 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%AugMat)) then - LB(1:2) = lbound(SrcMiscData%AugMat, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%AugMat, kind=B8Ki) - if (.not. allocated(DstMiscData%AugMat)) then - allocate(DstMiscData%AugMat(LB(1):UB(1),LB(2):UB(2)), 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%AugMat.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CosPreC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%AugMat = SrcMiscData%AugMat + DstParamData%CosPreC = SrcParamData%CosPreC end if - if (allocated(SrcMiscData%AugMat_factor)) then - LB(1:2) = lbound(SrcMiscData%AugMat_factor, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%AugMat_factor, kind=B8Ki) - if (.not. allocated(DstMiscData%AugMat_factor)) then - allocate(DstMiscData%AugMat_factor(LB(1):UB(1),LB(2):UB(2)), 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%AugMat_factor.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SinPreC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%AugMat_factor = SrcMiscData%AugMat_factor + DstParamData%SinPreC = SrcParamData%SinPreC end if - if (allocated(SrcMiscData%SolnVec)) then - LB(1:1) = lbound(SrcMiscData%SolnVec, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SolnVec, kind=B8Ki) - if (.not. allocated(DstMiscData%SolnVec)) then - allocate(DstMiscData%SolnVec(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%SolnVec.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTFA.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%SolnVec = SrcMiscData%SolnVec + DstParamData%AxRedTFA = SrcParamData%AxRedTFA end if - if (allocated(SrcMiscData%AugMat_pivot)) then - LB(1:1) = lbound(SrcMiscData%AugMat_pivot, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AugMat_pivot, kind=B8Ki) - if (.not. allocated(DstMiscData%AugMat_pivot)) then - allocate(DstMiscData%AugMat_pivot(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%AxRedTSS)) then + LB(1:3) = lbound(SrcParamData%AxRedTSS) + UB(1:3) = ubound(SrcParamData%AxRedTSS) + if (.not. allocated(DstParamData%AxRedTSS)) then + allocate(DstParamData%AxRedTSS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AugMat_pivot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTSS.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%AugMat_pivot = SrcMiscData%AugMat_pivot + DstParamData%AxRedTSS = SrcParamData%AxRedTSS end if - if (allocated(SrcMiscData%OgnlGeAzRo)) then - LB(1:1) = lbound(SrcMiscData%OgnlGeAzRo, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%OgnlGeAzRo, kind=B8Ki) - if (.not. allocated(DstMiscData%OgnlGeAzRo)) then - allocate(DstMiscData%OgnlGeAzRo(LB(1):UB(1)), stat=ErrStat2) + DstParamData%CTFA = SrcParamData%CTFA + DstParamData%CTSS = SrcParamData%CTSS + if (allocated(SrcParamData%DHNodes)) then + LB(1:1) = lbound(SrcParamData%DHNodes) + UB(1:1) = ubound(SrcParamData%DHNodes) + if (.not. allocated(DstParamData%DHNodes)) then + allocate(DstParamData%DHNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%OgnlGeAzRo.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DHNodes.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%OgnlGeAzRo = SrcMiscData%OgnlGeAzRo + DstParamData%DHNodes = SrcParamData%DHNodes end if - if (allocated(SrcMiscData%QD2T)) then - LB(1:1) = lbound(SrcMiscData%QD2T, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%QD2T, kind=B8Ki) - if (.not. allocated(DstMiscData%QD2T)) then - allocate(DstMiscData%QD2T(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%HNodes)) then + LB(1:1) = lbound(SrcParamData%HNodes) + UB(1:1) = ubound(SrcParamData%HNodes) + if (.not. allocated(DstParamData%HNodes)) then + allocate(DstParamData%HNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%QD2T.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodes.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%QD2T = SrcMiscData%QD2T + DstParamData%HNodes = SrcParamData%HNodes end if - DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod - if (allocated(SrcMiscData%OgnlYawRow)) then - LB(1:1) = lbound(SrcMiscData%OgnlYawRow, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%OgnlYawRow, kind=B8Ki) - if (.not. allocated(DstMiscData%OgnlYawRow)) then - allocate(DstMiscData%OgnlYawRow(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%HNodesNorm)) then + LB(1:1) = lbound(SrcParamData%HNodesNorm) + UB(1:1) = ubound(SrcParamData%HNodesNorm) + if (.not. allocated(DstParamData%HNodesNorm)) then + allocate(DstParamData%HNodesNorm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%OgnlYawRow.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodesNorm.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%OgnlYawRow = SrcMiscData%OgnlYawRow - end if - DstMiscData%FrcONcRt = SrcMiscData%FrcONcRt - 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%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(B8Ki) :: 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%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(B8Ki) :: i1, i2, i3, i4, i5 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%PH, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PM, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%DOF_Flag, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%DOF_Desc, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%CosPreC, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%SinPreC, kind=B8Ki) - 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, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AxRedTFA, kind=B8Ki) - if (.not. allocated(DstParamData%AxRedTFA)) then - allocate(DstParamData%AxRedTFA(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTFA.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%AxRedTFA = SrcParamData%AxRedTFA - end if - if (allocated(SrcParamData%AxRedTSS)) then - LB(1:3) = lbound(SrcParamData%AxRedTSS, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AxRedTSS, kind=B8Ki) - if (.not. allocated(DstParamData%AxRedTSS)) then - allocate(DstParamData%AxRedTSS(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AxRedTSS.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%AxRedTSS = SrcParamData%AxRedTSS - end if - DstParamData%CTFA = SrcParamData%CTFA - DstParamData%CTSS = SrcParamData%CTSS - if (allocated(SrcParamData%DHNodes)) then - LB(1:1) = lbound(SrcParamData%DHNodes, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%DHNodes, kind=B8Ki) - if (.not. allocated(DstParamData%DHNodes)) then - allocate(DstParamData%DHNodes(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%DHNodes.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%DHNodes = SrcParamData%DHNodes - end if - if (allocated(SrcParamData%HNodes)) then - LB(1:1) = lbound(SrcParamData%HNodes, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%HNodes, kind=B8Ki) - if (.not. allocated(DstParamData%HNodes)) then - allocate(DstParamData%HNodes(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodes.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%HNodes = SrcParamData%HNodes - end if - if (allocated(SrcParamData%HNodesNorm)) then - LB(1:1) = lbound(SrcParamData%HNodesNorm, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%HNodesNorm, kind=B8Ki) - if (.not. allocated(DstParamData%HNodesNorm)) then - allocate(DstParamData%HNodesNorm(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%HNodesNorm.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%HNodesNorm = SrcParamData%HNodesNorm + DstParamData%HNodesNorm = SrcParamData%HNodesNorm end if DstParamData%KTFA = SrcParamData%KTFA DstParamData%KTSS = SrcParamData%KTSS if (allocated(SrcParamData%MassT)) then - LB(1:1) = lbound(SrcParamData%MassT, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%MassT, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%MassT) + UB(1:1) = ubound(SrcParamData%MassT) if (.not. allocated(DstParamData%MassT)) then allocate(DstParamData%MassT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5414,8 +5141,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%MassT = SrcParamData%MassT end if if (allocated(SrcParamData%StiffTSS)) then - LB(1:1) = lbound(SrcParamData%StiffTSS, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%StiffTSS, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%StiffTSS) + UB(1:1) = ubound(SrcParamData%StiffTSS) if (.not. allocated(DstParamData%StiffTSS)) then allocate(DstParamData%StiffTSS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5426,8 +5153,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%StiffTSS = SrcParamData%StiffTSS end if if (allocated(SrcParamData%TwrFASF)) then - LB(1:3) = lbound(SrcParamData%TwrFASF, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%TwrFASF, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%TwrFASF) + UB(1:3) = ubound(SrcParamData%TwrFASF) if (.not. allocated(DstParamData%TwrFASF)) then allocate(DstParamData%TwrFASF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5439,8 +5166,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%TwrFlexL = SrcParamData%TwrFlexL if (allocated(SrcParamData%TwrSSSF)) then - LB(1:3) = lbound(SrcParamData%TwrSSSF, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%TwrSSSF, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%TwrSSSF) + UB(1:3) = ubound(SrcParamData%TwrSSSF) if (.not. allocated(DstParamData%TwrSSSF)) then allocate(DstParamData%TwrSSSF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5454,8 +5181,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TwrNodes = SrcParamData%TwrNodes DstParamData%MHK = SrcParamData%MHK if (allocated(SrcParamData%StiffTFA)) then - LB(1:1) = lbound(SrcParamData%StiffTFA, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%StiffTFA, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%StiffTFA) + UB(1:1) = ubound(SrcParamData%StiffTFA) if (.not. allocated(DstParamData%StiffTFA)) then allocate(DstParamData%StiffTFA(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5467,8 +5194,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%AtfaIner = SrcParamData%AtfaIner if (allocated(SrcParamData%BldCG)) then - LB(1:1) = lbound(SrcParamData%BldCG, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BldCG, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%BldCG) + UB(1:1) = ubound(SrcParamData%BldCG) if (.not. allocated(DstParamData%BldCG)) then allocate(DstParamData%BldCG(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5479,8 +5206,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldCG = SrcParamData%BldCG end if if (allocated(SrcParamData%BldMass)) then - LB(1:1) = lbound(SrcParamData%BldMass, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BldMass, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%BldMass) + UB(1:1) = ubound(SrcParamData%BldMass) if (.not. allocated(DstParamData%BldMass)) then allocate(DstParamData%BldMass(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5492,8 +5219,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%BoomMass = SrcParamData%BoomMass if (allocated(SrcParamData%FirstMom)) then - LB(1:1) = lbound(SrcParamData%FirstMom, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%FirstMom, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%FirstMom) + UB(1:1) = ubound(SrcParamData%FirstMom) if (.not. allocated(DstParamData%FirstMom)) then allocate(DstParamData%FirstMom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5521,8 +5248,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%RotMass = SrcParamData%RotMass DstParamData%RrfaIner = SrcParamData%RrfaIner if (allocated(SrcParamData%SecondMom)) then - LB(1:1) = lbound(SrcParamData%SecondMom, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%SecondMom, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%SecondMom) + UB(1:1) = ubound(SrcParamData%SecondMom) if (.not. allocated(DstParamData%SecondMom)) then allocate(DstParamData%SecondMom(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5535,8 +5262,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TFinMass = SrcParamData%TFinMass DstParamData%TFrlIner = SrcParamData%TFrlIner if (allocated(SrcParamData%TipMass)) then - LB(1:1) = lbound(SrcParamData%TipMass, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%TipMass, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%TipMass) + UB(1:1) = ubound(SrcParamData%TipMass) if (.not. allocated(DstParamData%TipMass)) then allocate(DstParamData%TipMass(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5552,8 +5279,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%YawBrMass = SrcParamData%YawBrMass DstParamData%Gravity = SrcParamData%Gravity if (allocated(SrcParamData%PitchAxis)) then - LB(1:2) = lbound(SrcParamData%PitchAxis, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PitchAxis, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%PitchAxis) + UB(1:2) = ubound(SrcParamData%PitchAxis) if (.not. allocated(DstParamData%PitchAxis)) then allocate(DstParamData%PitchAxis(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5564,8 +5291,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%PitchAxis = SrcParamData%PitchAxis end if if (allocated(SrcParamData%AeroTwst)) then - LB(1:1) = lbound(SrcParamData%AeroTwst, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%AeroTwst, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%AeroTwst) + UB(1:1) = ubound(SrcParamData%AeroTwst) if (.not. allocated(DstParamData%AeroTwst)) then allocate(DstParamData%AeroTwst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5576,8 +5303,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AeroTwst = SrcParamData%AeroTwst end if if (allocated(SrcParamData%AxRedBld)) then - LB(1:4) = lbound(SrcParamData%AxRedBld, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%AxRedBld, kind=B8Ki) + LB(1:4) = lbound(SrcParamData%AxRedBld) + UB(1:4) = ubound(SrcParamData%AxRedBld) if (.not. allocated(DstParamData%AxRedBld)) then allocate(DstParamData%AxRedBld(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5588,8 +5315,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AxRedBld = SrcParamData%AxRedBld end if if (allocated(SrcParamData%BldEDamp)) then - LB(1:2) = lbound(SrcParamData%BldEDamp, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BldEDamp, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BldEDamp) + UB(1:2) = ubound(SrcParamData%BldEDamp) if (.not. allocated(DstParamData%BldEDamp)) then allocate(DstParamData%BldEDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5600,8 +5327,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldEDamp = SrcParamData%BldEDamp end if if (allocated(SrcParamData%BldFDamp)) then - LB(1:2) = lbound(SrcParamData%BldFDamp, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BldFDamp, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BldFDamp) + UB(1:2) = ubound(SrcParamData%BldFDamp) if (.not. allocated(DstParamData%BldFDamp)) then allocate(DstParamData%BldFDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5613,8 +5340,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%BldFlexL = SrcParamData%BldFlexL if (allocated(SrcParamData%CAeroTwst)) then - LB(1:1) = lbound(SrcParamData%CAeroTwst, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%CAeroTwst, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%CAeroTwst) + UB(1:1) = ubound(SrcParamData%CAeroTwst) if (.not. allocated(DstParamData%CAeroTwst)) then allocate(DstParamData%CAeroTwst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5625,8 +5352,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CAeroTwst = SrcParamData%CAeroTwst end if if (allocated(SrcParamData%CBE)) then - LB(1:3) = lbound(SrcParamData%CBE, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%CBE, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%CBE) + UB(1:3) = ubound(SrcParamData%CBE) if (.not. allocated(DstParamData%CBE)) then allocate(DstParamData%CBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5637,8 +5364,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CBE = SrcParamData%CBE end if if (allocated(SrcParamData%CBF)) then - LB(1:3) = lbound(SrcParamData%CBF, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%CBF, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%CBF) + UB(1:3) = ubound(SrcParamData%CBF) if (.not. allocated(DstParamData%CBF)) then allocate(DstParamData%CBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5649,8 +5376,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CBF = SrcParamData%CBF end if if (allocated(SrcParamData%Chord)) then - LB(1:1) = lbound(SrcParamData%Chord, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Chord, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Chord) + UB(1:1) = ubound(SrcParamData%Chord) if (.not. allocated(DstParamData%Chord)) then allocate(DstParamData%Chord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5661,8 +5388,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Chord = SrcParamData%Chord end if if (allocated(SrcParamData%CThetaS)) then - LB(1:2) = lbound(SrcParamData%CThetaS, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%CThetaS, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%CThetaS) + UB(1:2) = ubound(SrcParamData%CThetaS) if (.not. allocated(DstParamData%CThetaS)) then allocate(DstParamData%CThetaS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5673,8 +5400,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CThetaS = SrcParamData%CThetaS end if if (allocated(SrcParamData%DRNodes)) then - LB(1:1) = lbound(SrcParamData%DRNodes, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%DRNodes, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%DRNodes) + UB(1:1) = ubound(SrcParamData%DRNodes) if (.not. allocated(DstParamData%DRNodes)) then allocate(DstParamData%DRNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5685,8 +5412,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%DRNodes = SrcParamData%DRNodes end if if (allocated(SrcParamData%FStTunr)) then - LB(1:2) = lbound(SrcParamData%FStTunr, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%FStTunr, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%FStTunr) + UB(1:2) = ubound(SrcParamData%FStTunr) if (.not. allocated(DstParamData%FStTunr)) then allocate(DstParamData%FStTunr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5697,8 +5424,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%FStTunr = SrcParamData%FStTunr end if if (allocated(SrcParamData%KBE)) then - LB(1:3) = lbound(SrcParamData%KBE, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%KBE, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%KBE) + UB(1:3) = ubound(SrcParamData%KBE) if (.not. allocated(DstParamData%KBE)) then allocate(DstParamData%KBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5709,8 +5436,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%KBE = SrcParamData%KBE end if if (allocated(SrcParamData%KBF)) then - LB(1:3) = lbound(SrcParamData%KBF, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%KBF, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%KBF) + UB(1:3) = ubound(SrcParamData%KBF) if (.not. allocated(DstParamData%KBF)) then allocate(DstParamData%KBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5721,8 +5448,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%KBF = SrcParamData%KBF end if if (allocated(SrcParamData%MassB)) then - LB(1:2) = lbound(SrcParamData%MassB, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%MassB, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%MassB) + UB(1:2) = ubound(SrcParamData%MassB) if (.not. allocated(DstParamData%MassB)) then allocate(DstParamData%MassB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5733,8 +5460,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%MassB = SrcParamData%MassB end if if (allocated(SrcParamData%RNodes)) then - LB(1:1) = lbound(SrcParamData%RNodes, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%RNodes, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%RNodes) + UB(1:1) = ubound(SrcParamData%RNodes) if (.not. allocated(DstParamData%RNodes)) then allocate(DstParamData%RNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5745,8 +5472,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%RNodes = SrcParamData%RNodes end if if (allocated(SrcParamData%RNodesNorm)) then - LB(1:1) = lbound(SrcParamData%RNodesNorm, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%RNodesNorm, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%RNodesNorm) + UB(1:1) = ubound(SrcParamData%RNodesNorm) if (.not. allocated(DstParamData%RNodesNorm)) then allocate(DstParamData%RNodesNorm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5757,8 +5484,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%RNodesNorm = SrcParamData%RNodesNorm end if if (allocated(SrcParamData%rSAerCenn1)) then - LB(1:2) = lbound(SrcParamData%rSAerCenn1, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%rSAerCenn1, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%rSAerCenn1) + UB(1:2) = ubound(SrcParamData%rSAerCenn1) if (.not. allocated(DstParamData%rSAerCenn1)) then allocate(DstParamData%rSAerCenn1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5769,8 +5496,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rSAerCenn1 = SrcParamData%rSAerCenn1 end if if (allocated(SrcParamData%rSAerCenn2)) then - LB(1:2) = lbound(SrcParamData%rSAerCenn2, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%rSAerCenn2, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%rSAerCenn2) + UB(1:2) = ubound(SrcParamData%rSAerCenn2) if (.not. allocated(DstParamData%rSAerCenn2)) then allocate(DstParamData%rSAerCenn2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5781,8 +5508,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rSAerCenn2 = SrcParamData%rSAerCenn2 end if if (allocated(SrcParamData%SAeroTwst)) then - LB(1:1) = lbound(SrcParamData%SAeroTwst, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%SAeroTwst, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%SAeroTwst) + UB(1:1) = ubound(SrcParamData%SAeroTwst) if (.not. allocated(DstParamData%SAeroTwst)) then allocate(DstParamData%SAeroTwst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5793,8 +5520,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%SAeroTwst = SrcParamData%SAeroTwst end if if (allocated(SrcParamData%StiffBE)) then - LB(1:2) = lbound(SrcParamData%StiffBE, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%StiffBE, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%StiffBE) + UB(1:2) = ubound(SrcParamData%StiffBE) if (.not. allocated(DstParamData%StiffBE)) then allocate(DstParamData%StiffBE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5805,8 +5532,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%StiffBE = SrcParamData%StiffBE end if if (allocated(SrcParamData%StiffBF)) then - LB(1:2) = lbound(SrcParamData%StiffBF, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%StiffBF, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%StiffBF) + UB(1:2) = ubound(SrcParamData%StiffBF) if (.not. allocated(DstParamData%StiffBF)) then allocate(DstParamData%StiffBF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5817,8 +5544,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%StiffBF = SrcParamData%StiffBF end if if (allocated(SrcParamData%SThetaS)) then - LB(1:2) = lbound(SrcParamData%SThetaS, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%SThetaS, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%SThetaS) + UB(1:2) = ubound(SrcParamData%SThetaS) if (.not. allocated(DstParamData%SThetaS)) then allocate(DstParamData%SThetaS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5829,8 +5556,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%SThetaS = SrcParamData%SThetaS end if if (allocated(SrcParamData%ThetaS)) then - LB(1:2) = lbound(SrcParamData%ThetaS, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%ThetaS, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%ThetaS) + UB(1:2) = ubound(SrcParamData%ThetaS) if (.not. allocated(DstParamData%ThetaS)) then allocate(DstParamData%ThetaS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5841,8 +5568,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ThetaS = SrcParamData%ThetaS end if if (allocated(SrcParamData%TwistedSF)) then - LB(1:5) = lbound(SrcParamData%TwistedSF, kind=B8Ki) - UB(1:5) = ubound(SrcParamData%TwistedSF, kind=B8Ki) + LB(1:5) = lbound(SrcParamData%TwistedSF) + UB(1:5) = ubound(SrcParamData%TwistedSF) if (.not. allocated(DstParamData%TwistedSF)) then allocate(DstParamData%TwistedSF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5853,8 +5580,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%TwistedSF = SrcParamData%TwistedSF end if if (allocated(SrcParamData%BldFl1Sh)) then - LB(1:2) = lbound(SrcParamData%BldFl1Sh, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BldFl1Sh, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BldFl1Sh) + UB(1:2) = ubound(SrcParamData%BldFl1Sh) if (.not. allocated(DstParamData%BldFl1Sh)) then allocate(DstParamData%BldFl1Sh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5865,8 +5592,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldFl1Sh = SrcParamData%BldFl1Sh end if if (allocated(SrcParamData%BldFl2Sh)) then - LB(1:2) = lbound(SrcParamData%BldFl2Sh, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BldFl2Sh, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BldFl2Sh) + UB(1:2) = ubound(SrcParamData%BldFl2Sh) if (.not. allocated(DstParamData%BldFl2Sh)) then allocate(DstParamData%BldFl2Sh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5877,8 +5604,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldFl2Sh = SrcParamData%BldFl2Sh end if if (allocated(SrcParamData%BldEdgSh)) then - LB(1:2) = lbound(SrcParamData%BldEdgSh, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BldEdgSh, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BldEdgSh) + UB(1:2) = ubound(SrcParamData%BldEdgSh) if (.not. allocated(DstParamData%BldEdgSh)) then allocate(DstParamData%BldEdgSh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5889,8 +5616,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldEdgSh = SrcParamData%BldEdgSh end if if (allocated(SrcParamData%FreqBE)) then - LB(1:3) = lbound(SrcParamData%FreqBE, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%FreqBE, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%FreqBE) + UB(1:3) = ubound(SrcParamData%FreqBE) if (.not. allocated(DstParamData%FreqBE)) then allocate(DstParamData%FreqBE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5901,8 +5628,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%FreqBE = SrcParamData%FreqBE end if if (allocated(SrcParamData%FreqBF)) then - LB(1:3) = lbound(SrcParamData%FreqBF, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%FreqBF, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%FreqBF) + UB(1:3) = ubound(SrcParamData%FreqBF) if (.not. allocated(DstParamData%FreqBF)) then allocate(DstParamData%FreqBF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5955,8 +5682,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%RotSpeed = SrcParamData%RotSpeed DstParamData%RootName = SrcParamData%RootName if (allocated(SrcParamData%BElmntMass)) then - LB(1:2) = lbound(SrcParamData%BElmntMass, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BElmntMass, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BElmntMass) + UB(1:2) = ubound(SrcParamData%BElmntMass) if (.not. allocated(DstParamData%BElmntMass)) then allocate(DstParamData%BElmntMass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5967,8 +5694,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BElmntMass = SrcParamData%BElmntMass end if if (allocated(SrcParamData%TElmntMass)) then - LB(1:1) = lbound(SrcParamData%TElmntMass, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%TElmntMass, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%TElmntMass) + UB(1:1) = ubound(SrcParamData%TElmntMass) if (.not. allocated(DstParamData%TElmntMass)) then allocate(DstParamData%TElmntMass(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5990,8 +5717,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts if (allocated(SrcParamData%BldNd_OutParam)) then - LB(1:1) = lbound(SrcParamData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BldNd_OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%BldNd_OutParam) + UB(1:1) = ubound(SrcParamData%BldNd_OutParam) if (.not. allocated(DstParamData%BldNd_OutParam)) then allocate(DstParamData%BldNd_OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6006,15 +5733,9 @@ 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, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) + 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 @@ -6025,8 +5746,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx end if if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) + 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 @@ -6037,8 +5758,8 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%du = SrcParamData%du end if if (allocated(SrcParamData%dx)) then - LB(1:1) = lbound(SrcParamData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dx, kind=B8Ki) + 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 @@ -6061,8 +5782,8 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) type(ED_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4, i5 - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: i1, i2, i3, i4, i5 + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ED_DestroyParam' @@ -6083,8 +5804,8 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) call ED_DestroyActiveDOFs(ParamData%DOFs, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + 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) @@ -6239,18 +5960,14 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%TElmntMass) end if if (allocated(ParamData%BldNd_OutParam)) then - LB(1:1) = lbound(ParamData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%BldNd_OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%BldNd_OutParam) + UB(1:1) = ubound(ParamData%BldNd_OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%BldNd_OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(ParamData%BldNd_OutParam) end if - 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 @@ -6266,8 +5983,8 @@ subroutine ED_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(ED_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackParam' - integer(B8Ki) :: i1, i2, i3, i4, i5 - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: i1, i2, i3, i4, i5 + integer(B4Ki) :: LB(5), UB(5) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DT) call RegPack(RF, InData%DT24) @@ -6289,9 +6006,9 @@ subroutine ED_PackParam(RF, Indata) call RegPack(RF, InData%NTwGages) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + 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 @@ -6498,16 +6215,14 @@ subroutine ED_PackParam(RF, Indata) 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, kind=B8Ki), ubound(InData%BldNd_OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%BldNd_OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%BldNd_OutParam, kind=B8Ki) + 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 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) @@ -6525,8 +6240,8 @@ subroutine ED_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(ED_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ED_UnPackParam' - integer(B8Ki) :: i1, i2, i3, i4, i5 - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: i1, i2, i3, i4, i5 + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -6775,8 +6490,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 @@ -6795,16 +6508,16 @@ subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%BladePtLoads, kind=B8Ki) + 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 @@ -6834,8 +6547,8 @@ subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInputData%TwrAddedMass)) then - LB(1:3) = lbound(SrcInputData%TwrAddedMass, kind=B8Ki) - UB(1:3) = ubound(SrcInputData%TwrAddedMass, kind=B8Ki) + 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 @@ -6847,8 +6560,8 @@ subroutine ED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if DstInputData%PtfmAddedMass = SrcInputData%PtfmAddedMass if (allocated(SrcInputData%BlPitchCom)) then - LB(1:1) = lbound(SrcInputData%BlPitchCom, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%BlPitchCom, kind=B8Ki) + 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 @@ -6867,16 +6580,16 @@ subroutine ED_DestroyInput(InputData, ErrStat, ErrMsg) type(ED_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: 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_DestroyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InputData%BladePtLoads)) then - LB(1:1) = lbound(InputData%BladePtLoads, kind=B8Ki) - UB(1:1) = ubound(InputData%BladePtLoads, kind=B8Ki) + 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) @@ -6905,14 +6618,14 @@ subroutine ED_PackInput(RF, Indata) type(RegFile), intent(inout) :: RF type(ED_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ED_PackInput' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + 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, kind=B8Ki), ubound(InData%BladePtLoads, kind=B8Ki)) - LB(1:1) = lbound(InData%BladePtLoads, kind=B8Ki) - UB(1:1) = ubound(InData%BladePtLoads, kind=B8Ki) + 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 @@ -6931,329 +6644,566 @@ subroutine ED_PackInput(RF, Indata) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine ED_UnPackInput(RF, OutData) +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_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%BladeLn2Mesh)) then + LB(1:1) = lbound(SrcOutputData%BladeLn2Mesh) + UB(1:1) = ubound(SrcOutputData%BladeLn2Mesh) + if (.not. allocated(DstOutputData%BladeLn2Mesh)) then + allocate(DstOutputData%BladeLn2Mesh(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BladeLn2Mesh.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MeshCopy(SrcOutputData%BladeLn2Mesh(i1), DstOutputData%BladeLn2Mesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call MeshCopy(SrcOutputData%PlatformPtMesh, DstOutputData%PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%TowerLn2Mesh, DstOutputData%TowerLn2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%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 (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(SrcOutputData%TFinCMMotion, DstOutputData%TFinCMMotion, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + end if + if (allocated(SrcOutputData%BlPitch)) then + LB(1:1) = lbound(SrcOutputData%BlPitch) + UB(1:1) = ubound(SrcOutputData%BlPitch) + if (.not. allocated(DstOutputData%BlPitch)) then + allocate(DstOutputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%BlPitch.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%BlPitch = SrcOutputData%BlPitch + end if + DstOutputData%Yaw = SrcOutputData%Yaw + DstOutputData%YawRate = SrcOutputData%YawRate + DstOutputData%LSS_Spd = SrcOutputData%LSS_Spd + DstOutputData%HSS_Spd = SrcOutputData%HSS_Spd + DstOutputData%RotSpeed = SrcOutputData%RotSpeed + DstOutputData%TwrAccel = SrcOutputData%TwrAccel + DstOutputData%YawAngle = SrcOutputData%YawAngle + DstOutputData%RootMyc = SrcOutputData%RootMyc + DstOutputData%YawBrTAxp = SrcOutputData%YawBrTAxp + DstOutputData%YawBrTAyp = SrcOutputData%YawBrTAyp + DstOutputData%LSSTipPxa = SrcOutputData%LSSTipPxa + DstOutputData%RootMxc = SrcOutputData%RootMxc + DstOutputData%LSSTipMxa = SrcOutputData%LSSTipMxa + DstOutputData%LSSTipMya = SrcOutputData%LSSTipMya + DstOutputData%LSSTipMza = SrcOutputData%LSSTipMza + DstOutputData%LSSTipMys = SrcOutputData%LSSTipMys + DstOutputData%LSSTipMzs = SrcOutputData%LSSTipMzs + DstOutputData%YawBrMyn = SrcOutputData%YawBrMyn + DstOutputData%YawBrMzn = SrcOutputData%YawBrMzn + DstOutputData%NcIMURAxs = SrcOutputData%NcIMURAxs + DstOutputData%NcIMURAys = SrcOutputData%NcIMURAys + DstOutputData%NcIMURAzs = SrcOutputData%NcIMURAzs + DstOutputData%RotPwr = SrcOutputData%RotPwr + DstOutputData%LSShftFxa = SrcOutputData%LSShftFxa + DstOutputData%LSShftFys = SrcOutputData%LSShftFys + DstOutputData%LSShftFzs = SrcOutputData%LSShftFzs +end subroutine + +subroutine ED_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(ED_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'ED_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%BladeLn2Mesh)) then + LB(1:1) = lbound(OutputData%BladeLn2Mesh) + UB(1:1) = ubound(OutputData%BladeLn2Mesh) + do i1 = LB(1), UB(1) + call MeshDestroy( OutputData%BladeLn2Mesh(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(OutputData%BladeLn2Mesh) + end if + call MeshDestroy( OutputData%PlatformPtMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%TowerLn2Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%HubPtMotion, 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 SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%TFinCMMotion, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if + if (allocated(OutputData%BlPitch)) then + deallocate(OutputData%BlPitch) + end if +end subroutine + +subroutine ED_PackOutput(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) + 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) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF - type(ED_InputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'ED_UnPackInput' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: 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%BladePtLoads(LB(1):UB(1)),stat=stat) + allocate(OutData%BladeLn2Mesh(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%BladeLn2Mesh.', 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%BladeLn2Mesh(i1)) ! BladeLn2Mesh 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%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 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(B8Ki) :: i1 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BladeLn2Mesh, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BladeRootMotion, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BlPitch, kind=B8Ki) - 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%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(B8Ki) :: i1 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(OutputData%BladeLn2Mesh, kind=B8Ki) - 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 - call MeshDestroy( OutputData%PlatformPtMesh, ErrStat2, ErrMsg2) + 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 + 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, kind=B8Ki) - UB(1:1) = ubound(OutputData%BladeRootMotion, kind=B8Ki) - 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(B8Ki) :: i1 - integer(B8Ki) :: 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, kind=B8Ki), ubound(InData%BladeLn2Mesh, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeLn2Mesh, kind=B8Ki) - UB(1:1) = ubound(InData%BladeLn2Mesh, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(InData%BladeRootMotion, kind=B8Ki) - 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%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(B8Ki) :: i1 - integer(B8Ki) :: 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%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) @@ -7358,7 +7308,7 @@ SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) a2 = t_out/t(2) IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN - DO i1 = LBOUND(u_out%BladePtLoads,1, kind=B8Ki),UBOUND(u_out%BladePtLoads,1, kind=B8Ki) + do i1 = lbound(u_out%BladePtLoads,1),ubound(u_out%BladePtLoads,1) CALL MeshExtrapInterp1(u1%BladePtLoads(i1), u2%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -7378,7 +7328,7 @@ SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) END IF ! check if allocated u_out%PtfmAddedMass = a1*u1%PtfmAddedMass + a2*u2%PtfmAddedMass IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - DO i1 = LBOUND(u_out%BlPitchCom,1, kind=B8Ki),UBOUND(u_out%BlPitchCom,1, kind=B8Ki) + do i1 = lbound(u_out%BlPitchCom,1),ubound(u_out%BlPitchCom,1) CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) END DO END IF ! check if allocated @@ -7447,7 +7397,7 @@ SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN - DO i1 = LBOUND(u_out%BladePtLoads,1, kind=B8Ki),UBOUND(u_out%BladePtLoads,1, kind=B8Ki) + do i1 = lbound(u_out%BladePtLoads,1),ubound(u_out%BladePtLoads,1) CALL MeshExtrapInterp2(u1%BladePtLoads(i1), u2%BladePtLoads(i1), u3%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -7467,7 +7417,7 @@ SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM END IF ! check if allocated u_out%PtfmAddedMass = a1*u1%PtfmAddedMass + a2*u2%PtfmAddedMass + a3*u3%PtfmAddedMass IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - DO i1 = LBOUND(u_out%BlPitchCom,1, kind=B8Ki),UBOUND(u_out%BlPitchCom,1, kind=B8Ki) + do i1 = lbound(u_out%BlPitchCom,1),ubound(u_out%BlPitchCom,1) CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), u3%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) END DO END IF ! check if allocated @@ -7574,7 +7524,7 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN - DO i1 = LBOUND(y_out%BladeLn2Mesh,1, kind=B8Ki),UBOUND(y_out%BladeLn2Mesh,1, kind=B8Ki) + do i1 = lbound(y_out%BladeLn2Mesh,1),ubound(y_out%BladeLn2Mesh,1) CALL MeshExtrapInterp1(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -7586,7 +7536,7 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL MeshExtrapInterp1(y1%HubPtMotion, y2%HubPtMotion, tin, y_out%HubPtMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i1 = LBOUND(y_out%BladeRootMotion,1, kind=B8Ki),UBOUND(y_out%BladeRootMotion,1, kind=B8Ki) + do i1 = lbound(y_out%BladeRootMotion,1),ubound(y_out%BladeRootMotion,1) CALL MeshExtrapInterp1(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -7599,7 +7549,7 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput END IF ! check if allocated IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - DO i1 = LBOUND(y_out%BlPitch,1, kind=B8Ki),UBOUND(y_out%BlPitch,1, kind=B8Ki) + do i1 = lbound(y_out%BlPitch,1),ubound(y_out%BlPitch,1) CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) END DO END IF ! check if allocated @@ -7687,7 +7637,7 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN - DO i1 = LBOUND(y_out%BladeLn2Mesh,1, kind=B8Ki),UBOUND(y_out%BladeLn2Mesh,1, kind=B8Ki) + do i1 = lbound(y_out%BladeLn2Mesh,1),ubound(y_out%BladeLn2Mesh,1) CALL MeshExtrapInterp2(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), y3%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -7699,7 +7649,7 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL MeshExtrapInterp2(y1%HubPtMotion, y2%HubPtMotion, y3%HubPtMotion, tin, y_out%HubPtMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i1 = LBOUND(y_out%BladeRootMotion,1, kind=B8Ki),UBOUND(y_out%BladeRootMotion,1, kind=B8Ki) + do i1 = lbound(y_out%BladeRootMotion,1),ubound(y_out%BladeRootMotion,1) CALL MeshExtrapInterp2(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), y3%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -7712,7 +7662,7 @@ SUBROUTINE ED_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 IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - DO i1 = LBOUND(y_out%BlPitch,1, kind=B8Ki),UBOUND(y_out%BlPitch,1, kind=B8Ki) + do i1 = lbound(y_out%BlPitch,1),ubound(y_out%BlPitch,1) CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), y3%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) END DO END IF ! check if allocated @@ -7743,5 +7693,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 8aa7086020..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 @@ -302,9 +365,9 @@ SUBROUTINE ExtInfw_UpdateFlowField(p_FAST, ExtInfw, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" - ExtInfw%m%FlowField%Points%Vel(1:size(ExtInfw%y%u),1) = ExtInfw%y%u - ExtInfw%m%FlowField%Points%Vel(1:size(ExtInfw%y%v),2) = ExtInfw%y%v - ExtInfw%m%FlowField%Points%Vel(1:size(ExtInfw%y%w),3) = ExtInfw%y%w + ExtInfw%m%FlowField%Points%Vel(1,1:size(ExtInfw%y%u)) = ExtInfw%y%u + ExtInfw%m%FlowField%Points%Vel(2,1:size(ExtInfw%y%v)) = ExtInfw%y%v + ExtInfw%m%FlowField%Points%Vel(3,1:size(ExtInfw%y%w)) = ExtInfw%y%w END SUBROUTINE ExtInfw_UpdateFlowField !---------------------------------------------------------------------------------------------------------------------------------- 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 0ac5ebdb96..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 @@ -212,7 +237,7 @@ subroutine ExtInfw_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtInfw_CopyInitInput' ErrStat = ErrID_None @@ -222,8 +247,8 @@ subroutine ExtInfw_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%NumActForcePtsTower = SrcInitInputData%NumActForcePtsTower DstInitInputData%C_obj%NumActForcePtsTower = SrcInitInputData%C_obj%NumActForcePtsTower if (associated(SrcInitInputData%StructBldRNodes)) then - LB(1:1) = lbound(SrcInitInputData%StructBldRNodes, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%StructBldRNodes, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%StructBldRNodes) + UB(1:1) = ubound(SrcInitInputData%StructBldRNodes) if (.not. associated(DstInitInputData%StructBldRNodes)) then allocate(DstInitInputData%StructBldRNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -237,8 +262,8 @@ subroutine ExtInfw_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%StructBldRNodes = SrcInitInputData%StructBldRNodes end if if (associated(SrcInitInputData%StructTwrHNodes)) then - LB(1:1) = lbound(SrcInitInputData%StructTwrHNodes, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%StructTwrHNodes, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%StructTwrHNodes) + UB(1:1) = ubound(SrcInitInputData%StructTwrHNodes) if (.not. associated(DstInitInputData%StructTwrHNodes)) then allocate(DstInitInputData%StructTwrHNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -307,7 +332,7 @@ subroutine ExtInfw_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtInfw_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackInitInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -404,7 +429,7 @@ SUBROUTINE ExtInfw_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointe ELSE InitInputData%C_obj%StructBldRNodes_Len = SIZE(InitInputData%StructBldRNodes) IF (InitInputData%C_obj%StructBldRNodes_Len > 0) & - InitInputData%C_obj%StructBldRNodes = C_LOC(InitInputData%StructBldRNodes(LBOUND(InitInputData%StructBldRNodes,1, kind=B8Ki))) + InitInputData%C_obj%StructBldRNodes = C_LOC(InitInputData%StructBldRNodes(lbound(InitInputData%StructBldRNodes,1))) END IF END IF @@ -416,7 +441,7 @@ SUBROUTINE ExtInfw_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointe ELSE InitInputData%C_obj%StructTwrHNodes_Len = SIZE(InitInputData%StructTwrHNodes) IF (InitInputData%C_obj%StructTwrHNodes_Len > 0) & - InitInputData%C_obj%StructTwrHNodes = C_LOC(InitInputData%StructTwrHNodes(LBOUND(InitInputData%StructTwrHNodes,1, kind=B8Ki))) + InitInputData%C_obj%StructTwrHNodes = C_LOC(InitInputData%StructTwrHNodes(lbound(InitInputData%StructTwrHNodes,1))) END IF END IF InitInputData%C_obj%BladeLength = InitInputData%BladeLength @@ -431,15 +456,15 @@ subroutine ExtInfw_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtInfw_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -450,8 +475,8 @@ subroutine ExtInfw_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -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 @@ -514,7 +548,7 @@ subroutine ExtInfw_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtInfw_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -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) @@ -583,16 +635,19 @@ subroutine ExtInfw_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%ActForceMotionsPoints, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%ActForceMotionsPoints) + UB(1:1) = ubound(SrcMiscData%ActForceMotionsPoints) if (.not. allocated(DstMiscData%ActForceMotionsPoints)) then allocate(DstMiscData%ActForceMotionsPoints(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -607,8 +662,8 @@ subroutine ExtInfw_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%ActForceLoadsPoints)) then - LB(1:1) = lbound(SrcMiscData%ActForceLoadsPoints, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%ActForceLoadsPoints, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%ActForceLoadsPoints) + UB(1:1) = ubound(SrcMiscData%ActForceLoadsPoints) if (.not. allocated(DstMiscData%ActForceLoadsPoints)) then allocate(DstMiscData%ActForceLoadsPoints(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -623,8 +678,8 @@ subroutine ExtInfw_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%Line2_to_Point_Loads)) then - LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Loads, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Line2_to_Point_Loads, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Loads) + UB(1:1) = ubound(SrcMiscData%Line2_to_Point_Loads) if (.not. allocated(DstMiscData%Line2_to_Point_Loads)) then allocate(DstMiscData%Line2_to_Point_Loads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -639,8 +694,8 @@ subroutine ExtInfw_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%Line2_to_Point_Motions)) then - LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Motions, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Line2_to_Point_Motions, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%Line2_to_Point_Motions) + UB(1:1) = ubound(SrcMiscData%Line2_to_Point_Motions) if (.not. allocated(DstMiscData%Line2_to_Point_Motions)) then allocate(DstMiscData%Line2_to_Point_Motions(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -672,16 +727,18 @@ subroutine ExtInfw_DestroyMisc(MiscData, ErrStat, ErrMsg) type(ExtInfw_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 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, kind=B8Ki) - UB(1:1) = ubound(MiscData%ActForceMotionsPoints, kind=B8Ki) + LB(1:1) = lbound(MiscData%ActForceMotionsPoints) + UB(1:1) = ubound(MiscData%ActForceMotionsPoints) do i1 = LB(1), UB(1) call MeshDestroy( MiscData%ActForceMotionsPoints(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -689,8 +746,8 @@ subroutine ExtInfw_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%ActForceMotionsPoints) end if if (allocated(MiscData%ActForceLoadsPoints)) then - LB(1:1) = lbound(MiscData%ActForceLoadsPoints, kind=B8Ki) - UB(1:1) = ubound(MiscData%ActForceLoadsPoints, kind=B8Ki) + LB(1:1) = lbound(MiscData%ActForceLoadsPoints) + UB(1:1) = ubound(MiscData%ActForceLoadsPoints) do i1 = LB(1), UB(1) call MeshDestroy( MiscData%ActForceLoadsPoints(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -698,8 +755,8 @@ subroutine ExtInfw_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%ActForceLoadsPoints) end if if (allocated(MiscData%Line2_to_Point_Loads)) then - LB(1:1) = lbound(MiscData%Line2_to_Point_Loads, kind=B8Ki) - UB(1:1) = ubound(MiscData%Line2_to_Point_Loads, kind=B8Ki) + LB(1:1) = lbound(MiscData%Line2_to_Point_Loads) + UB(1:1) = ubound(MiscData%Line2_to_Point_Loads) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(MiscData%Line2_to_Point_Loads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -707,8 +764,8 @@ subroutine ExtInfw_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%Line2_to_Point_Loads) end if if (allocated(MiscData%Line2_to_Point_Motions)) then - LB(1:1) = lbound(MiscData%Line2_to_Point_Motions, kind=B8Ki) - UB(1:1) = ubound(MiscData%Line2_to_Point_Motions, kind=B8Ki) + LB(1:1) = lbound(MiscData%Line2_to_Point_Motions) + UB(1:1) = ubound(MiscData%Line2_to_Point_Motions) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(MiscData%Line2_to_Point_Motions(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -727,46 +784,47 @@ subroutine ExtInfw_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(ExtInfw_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtInfw_PackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) logical :: PtrInIndex 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 RegPack(RF, allocated(InData%ActForceMotionsPoints)) if (allocated(InData%ActForceMotionsPoints)) then - call RegPackBounds(RF, 1, lbound(InData%ActForceMotionsPoints, kind=B8Ki), ubound(InData%ActForceMotionsPoints, kind=B8Ki)) - LB(1:1) = lbound(InData%ActForceMotionsPoints, kind=B8Ki) - UB(1:1) = ubound(InData%ActForceMotionsPoints, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ActForceMotionsPoints), ubound(InData%ActForceMotionsPoints)) + LB(1:1) = lbound(InData%ActForceMotionsPoints) + UB(1:1) = ubound(InData%ActForceMotionsPoints) do i1 = LB(1), UB(1) call MeshPack(RF, InData%ActForceMotionsPoints(i1)) end do end if call RegPack(RF, allocated(InData%ActForceLoadsPoints)) if (allocated(InData%ActForceLoadsPoints)) then - call RegPackBounds(RF, 1, lbound(InData%ActForceLoadsPoints, kind=B8Ki), ubound(InData%ActForceLoadsPoints, kind=B8Ki)) - LB(1:1) = lbound(InData%ActForceLoadsPoints, kind=B8Ki) - UB(1:1) = ubound(InData%ActForceLoadsPoints, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ActForceLoadsPoints), ubound(InData%ActForceLoadsPoints)) + LB(1:1) = lbound(InData%ActForceLoadsPoints) + UB(1:1) = ubound(InData%ActForceLoadsPoints) do i1 = LB(1), UB(1) call MeshPack(RF, InData%ActForceLoadsPoints(i1)) end do end if call RegPack(RF, allocated(InData%Line2_to_Point_Loads)) if (allocated(InData%Line2_to_Point_Loads)) then - call RegPackBounds(RF, 1, lbound(InData%Line2_to_Point_Loads, kind=B8Ki), ubound(InData%Line2_to_Point_Loads, kind=B8Ki)) - LB(1:1) = lbound(InData%Line2_to_Point_Loads, kind=B8Ki) - UB(1:1) = ubound(InData%Line2_to_Point_Loads, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Line2_to_Point_Loads), ubound(InData%Line2_to_Point_Loads)) + LB(1:1) = lbound(InData%Line2_to_Point_Loads) + UB(1:1) = ubound(InData%Line2_to_Point_Loads) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%Line2_to_Point_Loads(i1)) end do end if call RegPack(RF, allocated(InData%Line2_to_Point_Motions)) if (allocated(InData%Line2_to_Point_Motions)) then - call RegPackBounds(RF, 1, lbound(InData%Line2_to_Point_Motions, kind=B8Ki), ubound(InData%Line2_to_Point_Motions, kind=B8Ki)) - LB(1:1) = lbound(InData%Line2_to_Point_Motions, kind=B8Ki) - UB(1:1) = ubound(InData%Line2_to_Point_Motions, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Line2_to_Point_Motions), ubound(InData%Line2_to_Point_Motions)) + LB(1:1) = lbound(InData%Line2_to_Point_Motions) + UB(1:1) = ubound(InData%Line2_to_Point_Motions) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%Line2_to_Point_Motions(i1)) end do @@ -785,13 +843,14 @@ subroutine ExtInfw_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtInfw_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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 + 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 @@ -904,11 +963,24 @@ subroutine ExtInfw_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + 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 @@ -924,8 +996,8 @@ subroutine ExtInfw_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%NnodesForceTower = SrcParamData%NnodesForceTower DstParamData%C_obj%NnodesForceTower = SrcParamData%C_obj%NnodesForceTower if (associated(SrcParamData%forceBldRnodes)) then - LB(1:1) = lbound(SrcParamData%forceBldRnodes, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%forceBldRnodes, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%forceBldRnodes) + UB(1:1) = ubound(SrcParamData%forceBldRnodes) if (.not. associated(DstParamData%forceBldRnodes)) then allocate(DstParamData%forceBldRnodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -939,8 +1011,8 @@ subroutine ExtInfw_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%forceBldRnodes = SrcParamData%forceBldRnodes end if if (associated(SrcParamData%forceTwrHnodes)) then - LB(1:1) = lbound(SrcParamData%forceTwrHnodes, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%forceTwrHnodes, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%forceTwrHnodes) + UB(1:1) = ubound(SrcParamData%forceTwrHnodes) if (.not. associated(DstParamData%forceTwrHnodes)) then allocate(DstParamData%forceTwrHnodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -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) @@ -1014,12 +1101,30 @@ subroutine ExtInfw_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtInfw_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackParam' - integer(B8Ki) :: LB(1), UB(1) + 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 OutData%C_obj%AirDens = OutData%AirDens call RegUnpack(RF, OutData%NumBl); if (RegCheckErr(RF, RoutineName)) return @@ -1131,7 +1236,7 @@ SUBROUTINE ExtInfw_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%forceBldRnodes_Len = SIZE(ParamData%forceBldRnodes) IF (ParamData%C_obj%forceBldRnodes_Len > 0) & - ParamData%C_obj%forceBldRnodes = C_LOC(ParamData%forceBldRnodes(LBOUND(ParamData%forceBldRnodes,1, kind=B8Ki))) + ParamData%C_obj%forceBldRnodes = C_LOC(ParamData%forceBldRnodes(lbound(ParamData%forceBldRnodes,1))) END IF END IF @@ -1143,7 +1248,7 @@ SUBROUTINE ExtInfw_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%forceTwrHnodes_Len = SIZE(ParamData%forceTwrHnodes) IF (ParamData%C_obj%forceTwrHnodes_Len > 0) & - ParamData%C_obj%forceTwrHnodes = C_LOC(ParamData%forceTwrHnodes(LBOUND(ParamData%forceTwrHnodes,1, kind=B8Ki))) + ParamData%C_obj%forceTwrHnodes = C_LOC(ParamData%forceTwrHnodes(lbound(ParamData%forceTwrHnodes,1))) END IF END IF ParamData%C_obj%BladeLength = ParamData%BladeLength @@ -1158,14 +1263,14 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtInfw_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcInputData%pxVel)) then - LB(1:1) = lbound(SrcInputData%pxVel, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%pxVel, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%pxVel) + UB(1:1) = ubound(SrcInputData%pxVel) if (.not. associated(DstInputData%pxVel)) then allocate(DstInputData%pxVel(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1179,8 +1284,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pxVel = SrcInputData%pxVel end if if (associated(SrcInputData%pyVel)) then - LB(1:1) = lbound(SrcInputData%pyVel, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%pyVel, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%pyVel) + UB(1:1) = ubound(SrcInputData%pyVel) if (.not. associated(DstInputData%pyVel)) then allocate(DstInputData%pyVel(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1194,8 +1299,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pyVel = SrcInputData%pyVel end if if (associated(SrcInputData%pzVel)) then - LB(1:1) = lbound(SrcInputData%pzVel, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%pzVel, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%pzVel) + UB(1:1) = ubound(SrcInputData%pzVel) if (.not. associated(DstInputData%pzVel)) then allocate(DstInputData%pzVel(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1209,8 +1314,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pzVel = SrcInputData%pzVel end if if (associated(SrcInputData%pxForce)) then - LB(1:1) = lbound(SrcInputData%pxForce, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%pxForce, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%pxForce) + UB(1:1) = ubound(SrcInputData%pxForce) if (.not. associated(DstInputData%pxForce)) then allocate(DstInputData%pxForce(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1224,8 +1329,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pxForce = SrcInputData%pxForce end if if (associated(SrcInputData%pyForce)) then - LB(1:1) = lbound(SrcInputData%pyForce, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%pyForce, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%pyForce) + UB(1:1) = ubound(SrcInputData%pyForce) if (.not. associated(DstInputData%pyForce)) then allocate(DstInputData%pyForce(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1239,8 +1344,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pyForce = SrcInputData%pyForce end if if (associated(SrcInputData%pzForce)) then - LB(1:1) = lbound(SrcInputData%pzForce, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%pzForce, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%pzForce) + UB(1:1) = ubound(SrcInputData%pzForce) if (.not. associated(DstInputData%pzForce)) then allocate(DstInputData%pzForce(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1254,8 +1359,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pzForce = SrcInputData%pzForce end if if (associated(SrcInputData%xdotForce)) then - LB(1:1) = lbound(SrcInputData%xdotForce, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%xdotForce, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%xdotForce) + UB(1:1) = ubound(SrcInputData%xdotForce) if (.not. associated(DstInputData%xdotForce)) then allocate(DstInputData%xdotForce(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1269,8 +1374,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%xdotForce = SrcInputData%xdotForce end if if (associated(SrcInputData%ydotForce)) then - LB(1:1) = lbound(SrcInputData%ydotForce, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%ydotForce, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%ydotForce) + UB(1:1) = ubound(SrcInputData%ydotForce) if (.not. associated(DstInputData%ydotForce)) then allocate(DstInputData%ydotForce(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1284,8 +1389,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%ydotForce = SrcInputData%ydotForce end if if (associated(SrcInputData%zdotForce)) then - LB(1:1) = lbound(SrcInputData%zdotForce, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%zdotForce, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%zdotForce) + UB(1:1) = ubound(SrcInputData%zdotForce) if (.not. associated(DstInputData%zdotForce)) then allocate(DstInputData%zdotForce(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1299,8 +1404,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%zdotForce = SrcInputData%zdotForce end if if (associated(SrcInputData%pOrientation)) then - LB(1:1) = lbound(SrcInputData%pOrientation, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%pOrientation, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%pOrientation) + UB(1:1) = ubound(SrcInputData%pOrientation) if (.not. associated(DstInputData%pOrientation)) then allocate(DstInputData%pOrientation(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1314,8 +1419,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%pOrientation = SrcInputData%pOrientation end if if (associated(SrcInputData%fx)) then - LB(1:1) = lbound(SrcInputData%fx, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%fx, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%fx) + UB(1:1) = ubound(SrcInputData%fx) if (.not. associated(DstInputData%fx)) then allocate(DstInputData%fx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1329,8 +1434,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%fx = SrcInputData%fx end if if (associated(SrcInputData%fy)) then - LB(1:1) = lbound(SrcInputData%fy, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%fy, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%fy) + UB(1:1) = ubound(SrcInputData%fy) if (.not. associated(DstInputData%fy)) then allocate(DstInputData%fy(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1344,8 +1449,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%fy = SrcInputData%fy end if if (associated(SrcInputData%fz)) then - LB(1:1) = lbound(SrcInputData%fz, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%fz, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%fz) + UB(1:1) = ubound(SrcInputData%fz) if (.not. associated(DstInputData%fz)) then allocate(DstInputData%fz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1359,8 +1464,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%fz = SrcInputData%fz end if if (associated(SrcInputData%momentx)) then - LB(1:1) = lbound(SrcInputData%momentx, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%momentx, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%momentx) + UB(1:1) = ubound(SrcInputData%momentx) if (.not. associated(DstInputData%momentx)) then allocate(DstInputData%momentx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1374,8 +1479,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%momentx = SrcInputData%momentx end if if (associated(SrcInputData%momenty)) then - LB(1:1) = lbound(SrcInputData%momenty, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%momenty, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%momenty) + UB(1:1) = ubound(SrcInputData%momenty) if (.not. associated(DstInputData%momenty)) then allocate(DstInputData%momenty(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1389,8 +1494,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%momenty = SrcInputData%momenty end if if (associated(SrcInputData%momentz)) then - LB(1:1) = lbound(SrcInputData%momentz, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%momentz, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%momentz) + UB(1:1) = ubound(SrcInputData%momentz) if (.not. associated(DstInputData%momentz)) then allocate(DstInputData%momentz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1404,8 +1509,8 @@ subroutine ExtInfw_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%momentz = SrcInputData%momentz end if if (associated(SrcInputData%forceNodesChord)) then - LB(1:1) = lbound(SrcInputData%forceNodesChord, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%forceNodesChord, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%forceNodesChord) + UB(1:1) = ubound(SrcInputData%forceNodesChord) if (.not. associated(DstInputData%forceNodesChord)) then allocate(DstInputData%forceNodesChord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1565,7 +1670,7 @@ subroutine ExtInfw_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtInfw_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1852,7 +1957,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pxVel_Len = SIZE(InputData%pxVel) IF (InputData%C_obj%pxVel_Len > 0) & - InputData%C_obj%pxVel = C_LOC(InputData%pxVel(LBOUND(InputData%pxVel,1, kind=B8Ki))) + InputData%C_obj%pxVel = C_LOC(InputData%pxVel(lbound(InputData%pxVel,1))) END IF END IF @@ -1864,7 +1969,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pyVel_Len = SIZE(InputData%pyVel) IF (InputData%C_obj%pyVel_Len > 0) & - InputData%C_obj%pyVel = C_LOC(InputData%pyVel(LBOUND(InputData%pyVel,1, kind=B8Ki))) + InputData%C_obj%pyVel = C_LOC(InputData%pyVel(lbound(InputData%pyVel,1))) END IF END IF @@ -1876,7 +1981,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pzVel_Len = SIZE(InputData%pzVel) IF (InputData%C_obj%pzVel_Len > 0) & - InputData%C_obj%pzVel = C_LOC(InputData%pzVel(LBOUND(InputData%pzVel,1, kind=B8Ki))) + InputData%C_obj%pzVel = C_LOC(InputData%pzVel(lbound(InputData%pzVel,1))) END IF END IF @@ -1888,7 +1993,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pxForce_Len = SIZE(InputData%pxForce) IF (InputData%C_obj%pxForce_Len > 0) & - InputData%C_obj%pxForce = C_LOC(InputData%pxForce(LBOUND(InputData%pxForce,1, kind=B8Ki))) + InputData%C_obj%pxForce = C_LOC(InputData%pxForce(lbound(InputData%pxForce,1))) END IF END IF @@ -1900,7 +2005,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pyForce_Len = SIZE(InputData%pyForce) IF (InputData%C_obj%pyForce_Len > 0) & - InputData%C_obj%pyForce = C_LOC(InputData%pyForce(LBOUND(InputData%pyForce,1, kind=B8Ki))) + InputData%C_obj%pyForce = C_LOC(InputData%pyForce(lbound(InputData%pyForce,1))) END IF END IF @@ -1912,7 +2017,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pzForce_Len = SIZE(InputData%pzForce) IF (InputData%C_obj%pzForce_Len > 0) & - InputData%C_obj%pzForce = C_LOC(InputData%pzForce(LBOUND(InputData%pzForce,1, kind=B8Ki))) + InputData%C_obj%pzForce = C_LOC(InputData%pzForce(lbound(InputData%pzForce,1))) END IF END IF @@ -1924,7 +2029,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%xdotForce_Len = SIZE(InputData%xdotForce) IF (InputData%C_obj%xdotForce_Len > 0) & - InputData%C_obj%xdotForce = C_LOC(InputData%xdotForce(LBOUND(InputData%xdotForce,1, kind=B8Ki))) + InputData%C_obj%xdotForce = C_LOC(InputData%xdotForce(lbound(InputData%xdotForce,1))) END IF END IF @@ -1936,7 +2041,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%ydotForce_Len = SIZE(InputData%ydotForce) IF (InputData%C_obj%ydotForce_Len > 0) & - InputData%C_obj%ydotForce = C_LOC(InputData%ydotForce(LBOUND(InputData%ydotForce,1, kind=B8Ki))) + InputData%C_obj%ydotForce = C_LOC(InputData%ydotForce(lbound(InputData%ydotForce,1))) END IF END IF @@ -1948,7 +2053,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%zdotForce_Len = SIZE(InputData%zdotForce) IF (InputData%C_obj%zdotForce_Len > 0) & - InputData%C_obj%zdotForce = C_LOC(InputData%zdotForce(LBOUND(InputData%zdotForce,1, kind=B8Ki))) + InputData%C_obj%zdotForce = C_LOC(InputData%zdotForce(lbound(InputData%zdotForce,1))) END IF END IF @@ -1960,7 +2065,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%pOrientation_Len = SIZE(InputData%pOrientation) IF (InputData%C_obj%pOrientation_Len > 0) & - InputData%C_obj%pOrientation = C_LOC(InputData%pOrientation(LBOUND(InputData%pOrientation,1, kind=B8Ki))) + InputData%C_obj%pOrientation = C_LOC(InputData%pOrientation(lbound(InputData%pOrientation,1))) END IF END IF @@ -1972,7 +2077,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%fx_Len = SIZE(InputData%fx) IF (InputData%C_obj%fx_Len > 0) & - InputData%C_obj%fx = C_LOC(InputData%fx(LBOUND(InputData%fx,1, kind=B8Ki))) + InputData%C_obj%fx = C_LOC(InputData%fx(lbound(InputData%fx,1))) END IF END IF @@ -1984,7 +2089,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%fy_Len = SIZE(InputData%fy) IF (InputData%C_obj%fy_Len > 0) & - InputData%C_obj%fy = C_LOC(InputData%fy(LBOUND(InputData%fy,1, kind=B8Ki))) + InputData%C_obj%fy = C_LOC(InputData%fy(lbound(InputData%fy,1))) END IF END IF @@ -1996,7 +2101,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%fz_Len = SIZE(InputData%fz) IF (InputData%C_obj%fz_Len > 0) & - InputData%C_obj%fz = C_LOC(InputData%fz(LBOUND(InputData%fz,1, kind=B8Ki))) + InputData%C_obj%fz = C_LOC(InputData%fz(lbound(InputData%fz,1))) END IF END IF @@ -2008,7 +2113,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%momentx_Len = SIZE(InputData%momentx) IF (InputData%C_obj%momentx_Len > 0) & - InputData%C_obj%momentx = C_LOC(InputData%momentx(LBOUND(InputData%momentx,1, kind=B8Ki))) + InputData%C_obj%momentx = C_LOC(InputData%momentx(lbound(InputData%momentx,1))) END IF END IF @@ -2020,7 +2125,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%momenty_Len = SIZE(InputData%momenty) IF (InputData%C_obj%momenty_Len > 0) & - InputData%C_obj%momenty = C_LOC(InputData%momenty(LBOUND(InputData%momenty,1, kind=B8Ki))) + InputData%C_obj%momenty = C_LOC(InputData%momenty(lbound(InputData%momenty,1))) END IF END IF @@ -2032,7 +2137,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%momentz_Len = SIZE(InputData%momentz) IF (InputData%C_obj%momentz_Len > 0) & - InputData%C_obj%momentz = C_LOC(InputData%momentz(LBOUND(InputData%momentz,1, kind=B8Ki))) + InputData%C_obj%momentz = C_LOC(InputData%momentz(lbound(InputData%momentz,1))) END IF END IF @@ -2044,7 +2149,7 @@ SUBROUTINE ExtInfw_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%forceNodesChord_Len = SIZE(InputData%forceNodesChord) IF (InputData%C_obj%forceNodesChord_Len > 0) & - InputData%C_obj%forceNodesChord = C_LOC(InputData%forceNodesChord(LBOUND(InputData%forceNodesChord,1, kind=B8Ki))) + InputData%C_obj%forceNodesChord = C_LOC(InputData%forceNodesChord(lbound(InputData%forceNodesChord,1))) END IF END IF END SUBROUTINE @@ -2055,14 +2160,14 @@ subroutine ExtInfw_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtInfw_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcOutputData%u)) then - LB(1:1) = lbound(SrcOutputData%u, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%u, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%u) + UB(1:1) = ubound(SrcOutputData%u) if (.not. associated(DstOutputData%u)) then allocate(DstOutputData%u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2076,8 +2181,8 @@ subroutine ExtInfw_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E DstOutputData%u = SrcOutputData%u end if if (associated(SrcOutputData%v)) then - LB(1:1) = lbound(SrcOutputData%v, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%v, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%v) + UB(1:1) = ubound(SrcOutputData%v) if (.not. associated(DstOutputData%v)) then allocate(DstOutputData%v(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2091,8 +2196,8 @@ subroutine ExtInfw_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E DstOutputData%v = SrcOutputData%v end if if (associated(SrcOutputData%w)) then - LB(1:1) = lbound(SrcOutputData%w, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%w, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%w) + UB(1:1) = ubound(SrcOutputData%w) if (.not. associated(DstOutputData%w)) then allocate(DstOutputData%w(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2106,8 +2211,8 @@ subroutine ExtInfw_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E DstOutputData%w = SrcOutputData%w end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -2170,7 +2275,7 @@ subroutine ExtInfw_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtInfw_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtInfw_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -2262,7 +2367,7 @@ SUBROUTINE ExtInfw_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%u_Len = SIZE(OutputData%u) IF (OutputData%C_obj%u_Len > 0) & - OutputData%C_obj%u = C_LOC(OutputData%u(LBOUND(OutputData%u,1, kind=B8Ki))) + OutputData%C_obj%u = C_LOC(OutputData%u(lbound(OutputData%u,1))) END IF END IF @@ -2274,7 +2379,7 @@ SUBROUTINE ExtInfw_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%v_Len = SIZE(OutputData%v) IF (OutputData%C_obj%v_Len > 0) & - OutputData%C_obj%v = C_LOC(OutputData%v(LBOUND(OutputData%v,1, kind=B8Ki))) + OutputData%C_obj%v = C_LOC(OutputData%v(lbound(OutputData%v,1))) END IF END IF @@ -2286,7 +2391,7 @@ SUBROUTINE ExtInfw_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%w_Len = SIZE(OutputData%w) IF (OutputData%C_obj%w_Len > 0) & - OutputData%C_obj%w = C_LOC(OutputData%w(LBOUND(OutputData%w,1, kind=B8Ki))) + OutputData%C_obj%w = C_LOC(OutputData%w(lbound(OutputData%w,1))) END IF END IF END SUBROUTINE @@ -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 0f98dbac18..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 @@ -125,14 +134,14 @@ subroutine ExtLdDX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtLdDX_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcInputData%twrDef)) then - LB(1:1) = lbound(SrcInputData%twrDef, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%twrDef, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%twrDef) + UB(1:1) = ubound(SrcInputData%twrDef) if (.not. associated(DstInputData%twrDef)) then allocate(DstInputData%twrDef(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -146,8 +155,8 @@ subroutine ExtLdDX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%twrDef = SrcInputData%twrDef end if if (associated(SrcInputData%bldDef)) then - LB(1:1) = lbound(SrcInputData%bldDef, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%bldDef, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%bldDef) + UB(1:1) = ubound(SrcInputData%bldDef) if (.not. associated(DstInputData%bldDef)) then allocate(DstInputData%bldDef(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -161,8 +170,8 @@ subroutine ExtLdDX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%bldDef = SrcInputData%bldDef end if if (associated(SrcInputData%hubDef)) then - LB(1:1) = lbound(SrcInputData%hubDef, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%hubDef, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%hubDef) + UB(1:1) = ubound(SrcInputData%hubDef) if (.not. associated(DstInputData%hubDef)) then allocate(DstInputData%hubDef(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -176,8 +185,8 @@ subroutine ExtLdDX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%hubDef = SrcInputData%hubDef end if if (associated(SrcInputData%nacDef)) then - LB(1:1) = lbound(SrcInputData%nacDef, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%nacDef, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%nacDef) + UB(1:1) = ubound(SrcInputData%nacDef) if (.not. associated(DstInputData%nacDef)) then allocate(DstInputData%nacDef(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -191,8 +200,8 @@ subroutine ExtLdDX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%nacDef = SrcInputData%nacDef end if if (associated(SrcInputData%bldRootDef)) then - LB(1:1) = lbound(SrcInputData%bldRootDef, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%bldRootDef, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%bldRootDef) + UB(1:1) = ubound(SrcInputData%bldRootDef) if (.not. associated(DstInputData%bldRootDef)) then allocate(DstInputData%bldRootDef(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -206,8 +215,8 @@ subroutine ExtLdDX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrM DstInputData%bldRootDef = SrcInputData%bldRootDef end if if (associated(SrcInputData%bldPitch)) then - LB(1:1) = lbound(SrcInputData%bldPitch, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%bldPitch, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%bldPitch) + UB(1:1) = ubound(SrcInputData%bldPitch) if (.not. associated(DstInputData%bldPitch)) then allocate(DstInputData%bldPitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -290,7 +299,7 @@ subroutine ExtLdDX_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLdDX_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtLdDX_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -423,7 +432,7 @@ SUBROUTINE ExtLdDX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%twrDef_Len = SIZE(InputData%twrDef) IF (InputData%C_obj%twrDef_Len > 0) & - InputData%C_obj%twrDef = C_LOC(InputData%twrDef(LBOUND(InputData%twrDef,1, kind=B8Ki))) + InputData%C_obj%twrDef = C_LOC(InputData%twrDef(lbound(InputData%twrDef,1))) END IF END IF @@ -435,7 +444,7 @@ SUBROUTINE ExtLdDX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%bldDef_Len = SIZE(InputData%bldDef) IF (InputData%C_obj%bldDef_Len > 0) & - InputData%C_obj%bldDef = C_LOC(InputData%bldDef(LBOUND(InputData%bldDef,1, kind=B8Ki))) + InputData%C_obj%bldDef = C_LOC(InputData%bldDef(lbound(InputData%bldDef,1))) END IF END IF @@ -447,7 +456,7 @@ SUBROUTINE ExtLdDX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%hubDef_Len = SIZE(InputData%hubDef) IF (InputData%C_obj%hubDef_Len > 0) & - InputData%C_obj%hubDef = C_LOC(InputData%hubDef(LBOUND(InputData%hubDef,1, kind=B8Ki))) + InputData%C_obj%hubDef = C_LOC(InputData%hubDef(lbound(InputData%hubDef,1))) END IF END IF @@ -459,7 +468,7 @@ SUBROUTINE ExtLdDX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%nacDef_Len = SIZE(InputData%nacDef) IF (InputData%C_obj%nacDef_Len > 0) & - InputData%C_obj%nacDef = C_LOC(InputData%nacDef(LBOUND(InputData%nacDef,1, kind=B8Ki))) + InputData%C_obj%nacDef = C_LOC(InputData%nacDef(lbound(InputData%nacDef,1))) END IF END IF @@ -471,7 +480,7 @@ SUBROUTINE ExtLdDX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%bldRootDef_Len = SIZE(InputData%bldRootDef) IF (InputData%C_obj%bldRootDef_Len > 0) & - InputData%C_obj%bldRootDef = C_LOC(InputData%bldRootDef(LBOUND(InputData%bldRootDef,1, kind=B8Ki))) + InputData%C_obj%bldRootDef = C_LOC(InputData%bldRootDef(lbound(InputData%bldRootDef,1))) END IF END IF @@ -483,7 +492,7 @@ SUBROUTINE ExtLdDX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%bldPitch_Len = SIZE(InputData%bldPitch) IF (InputData%C_obj%bldPitch_Len > 0) & - InputData%C_obj%bldPitch = C_LOC(InputData%bldPitch(LBOUND(InputData%bldPitch,1, kind=B8Ki))) + InputData%C_obj%bldPitch = C_LOC(InputData%bldPitch(lbound(InputData%bldPitch,1))) END IF END IF END SUBROUTINE @@ -494,14 +503,14 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtLdDX_CopyParam' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcParamData%nBlades)) then - LB(1:1) = lbound(SrcParamData%nBlades, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%nBlades, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%nBlades) + UB(1:1) = ubound(SrcParamData%nBlades) if (.not. associated(DstParamData%nBlades)) then allocate(DstParamData%nBlades(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -515,8 +524,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%nBlades = SrcParamData%nBlades end if if (associated(SrcParamData%nBladeNodes)) then - LB(1:1) = lbound(SrcParamData%nBladeNodes, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%nBladeNodes, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%nBladeNodes) + UB(1:1) = ubound(SrcParamData%nBladeNodes) if (.not. associated(DstParamData%nBladeNodes)) then allocate(DstParamData%nBladeNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -530,8 +539,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%nBladeNodes = SrcParamData%nBladeNodes end if if (associated(SrcParamData%nTowerNodes)) then - LB(1:1) = lbound(SrcParamData%nTowerNodes, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%nTowerNodes, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%nTowerNodes) + UB(1:1) = ubound(SrcParamData%nTowerNodes) if (.not. associated(DstParamData%nTowerNodes)) then allocate(DstParamData%nTowerNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -545,8 +554,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%nTowerNodes = SrcParamData%nTowerNodes end if if (associated(SrcParamData%twrRefPos)) then - LB(1:1) = lbound(SrcParamData%twrRefPos, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%twrRefPos, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%twrRefPos) + UB(1:1) = ubound(SrcParamData%twrRefPos) if (.not. associated(DstParamData%twrRefPos)) then allocate(DstParamData%twrRefPos(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -560,8 +569,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%twrRefPos = SrcParamData%twrRefPos end if if (associated(SrcParamData%bldRefPos)) then - LB(1:1) = lbound(SrcParamData%bldRefPos, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%bldRefPos, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%bldRefPos) + UB(1:1) = ubound(SrcParamData%bldRefPos) if (.not. associated(DstParamData%bldRefPos)) then allocate(DstParamData%bldRefPos(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -575,8 +584,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%bldRefPos = SrcParamData%bldRefPos end if if (associated(SrcParamData%hubRefPos)) then - LB(1:1) = lbound(SrcParamData%hubRefPos, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%hubRefPos, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%hubRefPos) + UB(1:1) = ubound(SrcParamData%hubRefPos) if (.not. associated(DstParamData%hubRefPos)) then allocate(DstParamData%hubRefPos(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -590,8 +599,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%hubRefPos = SrcParamData%hubRefPos end if if (associated(SrcParamData%nacRefPos)) then - LB(1:1) = lbound(SrcParamData%nacRefPos, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%nacRefPos, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%nacRefPos) + UB(1:1) = ubound(SrcParamData%nacRefPos) if (.not. associated(DstParamData%nacRefPos)) then allocate(DstParamData%nacRefPos(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -605,8 +614,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%nacRefPos = SrcParamData%nacRefPos end if if (associated(SrcParamData%bldRootRefPos)) then - LB(1:1) = lbound(SrcParamData%bldRootRefPos, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%bldRootRefPos, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%bldRootRefPos) + UB(1:1) = ubound(SrcParamData%bldRootRefPos) if (.not. associated(DstParamData%bldRootRefPos)) then allocate(DstParamData%bldRootRefPos(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -620,8 +629,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%bldRootRefPos = SrcParamData%bldRootRefPos end if if (associated(SrcParamData%bldChord)) then - LB(1:1) = lbound(SrcParamData%bldChord, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%bldChord, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%bldChord) + UB(1:1) = ubound(SrcParamData%bldChord) if (.not. associated(DstParamData%bldChord)) then allocate(DstParamData%bldChord(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -635,8 +644,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%bldChord = SrcParamData%bldChord end if if (associated(SrcParamData%bldRloc)) then - LB(1:1) = lbound(SrcParamData%bldRloc, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%bldRloc, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%bldRloc) + UB(1:1) = ubound(SrcParamData%bldRloc) if (.not. associated(DstParamData%bldRloc)) then allocate(DstParamData%bldRloc(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -650,8 +659,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%bldRloc = SrcParamData%bldRloc end if if (associated(SrcParamData%twrDia)) then - LB(1:1) = lbound(SrcParamData%twrDia, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%twrDia, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%twrDia) + UB(1:1) = ubound(SrcParamData%twrDia) if (.not. associated(DstParamData%twrDia)) then allocate(DstParamData%twrDia(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -665,8 +674,8 @@ subroutine ExtLdDX_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%twrDia = SrcParamData%twrDia end if if (associated(SrcParamData%twrHloc)) then - LB(1:1) = lbound(SrcParamData%twrHloc, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%twrHloc, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%twrHloc) + UB(1:1) = ubound(SrcParamData%twrHloc) if (.not. associated(DstParamData%twrHloc)) then allocate(DstParamData%twrHloc(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -791,7 +800,7 @@ subroutine ExtLdDX_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLdDX_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtLdDX_UnPackParam' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1008,7 +1017,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%nBlades_Len = SIZE(ParamData%nBlades) IF (ParamData%C_obj%nBlades_Len > 0) & - ParamData%C_obj%nBlades = C_LOC(ParamData%nBlades(LBOUND(ParamData%nBlades,1, kind=B8Ki))) + ParamData%C_obj%nBlades = C_LOC(ParamData%nBlades(lbound(ParamData%nBlades,1))) END IF END IF @@ -1020,7 +1029,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%nBladeNodes_Len = SIZE(ParamData%nBladeNodes) IF (ParamData%C_obj%nBladeNodes_Len > 0) & - ParamData%C_obj%nBladeNodes = C_LOC(ParamData%nBladeNodes(LBOUND(ParamData%nBladeNodes,1, kind=B8Ki))) + ParamData%C_obj%nBladeNodes = C_LOC(ParamData%nBladeNodes(lbound(ParamData%nBladeNodes,1))) END IF END IF @@ -1032,7 +1041,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%nTowerNodes_Len = SIZE(ParamData%nTowerNodes) IF (ParamData%C_obj%nTowerNodes_Len > 0) & - ParamData%C_obj%nTowerNodes = C_LOC(ParamData%nTowerNodes(LBOUND(ParamData%nTowerNodes,1, kind=B8Ki))) + ParamData%C_obj%nTowerNodes = C_LOC(ParamData%nTowerNodes(lbound(ParamData%nTowerNodes,1))) END IF END IF @@ -1044,7 +1053,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%twrRefPos_Len = SIZE(ParamData%twrRefPos) IF (ParamData%C_obj%twrRefPos_Len > 0) & - ParamData%C_obj%twrRefPos = C_LOC(ParamData%twrRefPos(LBOUND(ParamData%twrRefPos,1, kind=B8Ki))) + ParamData%C_obj%twrRefPos = C_LOC(ParamData%twrRefPos(lbound(ParamData%twrRefPos,1))) END IF END IF @@ -1056,7 +1065,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%bldRefPos_Len = SIZE(ParamData%bldRefPos) IF (ParamData%C_obj%bldRefPos_Len > 0) & - ParamData%C_obj%bldRefPos = C_LOC(ParamData%bldRefPos(LBOUND(ParamData%bldRefPos,1, kind=B8Ki))) + ParamData%C_obj%bldRefPos = C_LOC(ParamData%bldRefPos(lbound(ParamData%bldRefPos,1))) END IF END IF @@ -1068,7 +1077,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%hubRefPos_Len = SIZE(ParamData%hubRefPos) IF (ParamData%C_obj%hubRefPos_Len > 0) & - ParamData%C_obj%hubRefPos = C_LOC(ParamData%hubRefPos(LBOUND(ParamData%hubRefPos,1, kind=B8Ki))) + ParamData%C_obj%hubRefPos = C_LOC(ParamData%hubRefPos(lbound(ParamData%hubRefPos,1))) END IF END IF @@ -1080,7 +1089,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%nacRefPos_Len = SIZE(ParamData%nacRefPos) IF (ParamData%C_obj%nacRefPos_Len > 0) & - ParamData%C_obj%nacRefPos = C_LOC(ParamData%nacRefPos(LBOUND(ParamData%nacRefPos,1, kind=B8Ki))) + ParamData%C_obj%nacRefPos = C_LOC(ParamData%nacRefPos(lbound(ParamData%nacRefPos,1))) END IF END IF @@ -1092,7 +1101,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%bldRootRefPos_Len = SIZE(ParamData%bldRootRefPos) IF (ParamData%C_obj%bldRootRefPos_Len > 0) & - ParamData%C_obj%bldRootRefPos = C_LOC(ParamData%bldRootRefPos(LBOUND(ParamData%bldRootRefPos,1, kind=B8Ki))) + ParamData%C_obj%bldRootRefPos = C_LOC(ParamData%bldRootRefPos(lbound(ParamData%bldRootRefPos,1))) END IF END IF @@ -1104,7 +1113,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%bldChord_Len = SIZE(ParamData%bldChord) IF (ParamData%C_obj%bldChord_Len > 0) & - ParamData%C_obj%bldChord = C_LOC(ParamData%bldChord(LBOUND(ParamData%bldChord,1, kind=B8Ki))) + ParamData%C_obj%bldChord = C_LOC(ParamData%bldChord(lbound(ParamData%bldChord,1))) END IF END IF @@ -1116,7 +1125,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%bldRloc_Len = SIZE(ParamData%bldRloc) IF (ParamData%C_obj%bldRloc_Len > 0) & - ParamData%C_obj%bldRloc = C_LOC(ParamData%bldRloc(LBOUND(ParamData%bldRloc,1, kind=B8Ki))) + ParamData%C_obj%bldRloc = C_LOC(ParamData%bldRloc(lbound(ParamData%bldRloc,1))) END IF END IF @@ -1128,7 +1137,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%twrDia_Len = SIZE(ParamData%twrDia) IF (ParamData%C_obj%twrDia_Len > 0) & - ParamData%C_obj%twrDia = C_LOC(ParamData%twrDia(LBOUND(ParamData%twrDia,1, kind=B8Ki))) + ParamData%C_obj%twrDia = C_LOC(ParamData%twrDia(lbound(ParamData%twrDia,1))) END IF END IF @@ -1140,7 +1149,7 @@ SUBROUTINE ExtLdDX_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%twrHloc_Len = SIZE(ParamData%twrHloc) IF (ParamData%C_obj%twrHloc_Len > 0) & - ParamData%C_obj%twrHloc = C_LOC(ParamData%twrHloc(LBOUND(ParamData%twrHloc,1, kind=B8Ki))) + ParamData%C_obj%twrHloc = C_LOC(ParamData%twrHloc(lbound(ParamData%twrHloc,1))) END IF END IF END SUBROUTINE @@ -1151,14 +1160,14 @@ subroutine ExtLdDX_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtLdDX_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcOutputData%twrLd)) then - LB(1:1) = lbound(SrcOutputData%twrLd, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%twrLd, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%twrLd) + UB(1:1) = ubound(SrcOutputData%twrLd) if (.not. associated(DstOutputData%twrLd)) then allocate(DstOutputData%twrLd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1172,8 +1181,8 @@ subroutine ExtLdDX_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E DstOutputData%twrLd = SrcOutputData%twrLd end if if (associated(SrcOutputData%bldLd)) then - LB(1:1) = lbound(SrcOutputData%bldLd, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%bldLd, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%bldLd) + UB(1:1) = ubound(SrcOutputData%bldLd) if (.not. associated(DstOutputData%bldLd)) then allocate(DstOutputData%bldLd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1228,7 +1237,7 @@ subroutine ExtLdDX_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLdDX_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtLdDX_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1305,7 +1314,7 @@ SUBROUTINE ExtLdDX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%twrLd_Len = SIZE(OutputData%twrLd) IF (OutputData%C_obj%twrLd_Len > 0) & - OutputData%C_obj%twrLd = C_LOC(OutputData%twrLd(LBOUND(OutputData%twrLd,1, kind=B8Ki))) + OutputData%C_obj%twrLd = C_LOC(OutputData%twrLd(lbound(OutputData%twrLd,1))) END IF END IF @@ -1317,7 +1326,7 @@ SUBROUTINE ExtLdDX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%bldLd_Len = SIZE(OutputData%bldLd) IF (OutputData%C_obj%bldLd_Len > 0) & - OutputData%C_obj%bldLd = C_LOC(OutputData%bldLd(LBOUND(OutputData%bldLd,1, kind=B8Ki))) + OutputData%C_obj%bldLd = C_LOC(OutputData%bldLd(lbound(OutputData%bldLd,1))) END IF END IF END SUBROUTINE @@ -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 be9a970f7e..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 @@ -135,15 +157,15 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtLd_CopyInitInput' ErrStat = ErrID_None ErrMsg = '' DstInitInputData%NumBlades = SrcInitInputData%NumBlades if (allocated(SrcInitInputData%NumBldNodes)) then - LB(1:1) = lbound(SrcInitInputData%NumBldNodes, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%NumBldNodes, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%NumBldNodes) + UB(1:1) = ubound(SrcInitInputData%NumBldNodes) if (.not. allocated(DstInitInputData%NumBldNodes)) then allocate(DstInitInputData%NumBldNodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -160,8 +182,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%NacellePos = SrcInitInputData%NacellePos DstInitInputData%NacelleOrient = SrcInitInputData%NacelleOrient if (allocated(SrcInitInputData%BldRootPos)) then - LB(1:2) = lbound(SrcInitInputData%BldRootPos, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%BldRootPos, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%BldRootPos) + UB(1:2) = ubound(SrcInitInputData%BldRootPos) if (.not. allocated(DstInitInputData%BldRootPos)) then allocate(DstInitInputData%BldRootPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -172,8 +194,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%BldRootPos = SrcInitInputData%BldRootPos end if if (allocated(SrcInitInputData%BldRootOrient)) then - LB(1:3) = lbound(SrcInitInputData%BldRootOrient, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%BldRootOrient, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%BldRootOrient) + UB(1:3) = ubound(SrcInitInputData%BldRootOrient) if (.not. allocated(DstInitInputData%BldRootOrient)) then allocate(DstInitInputData%BldRootOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -184,8 +206,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%BldRootOrient = SrcInitInputData%BldRootOrient end if if (allocated(SrcInitInputData%BldPos)) then - LB(1:3) = lbound(SrcInitInputData%BldPos, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%BldPos, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%BldPos) + UB(1:3) = ubound(SrcInitInputData%BldPos) if (.not. allocated(DstInitInputData%BldPos)) then allocate(DstInitInputData%BldPos(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -196,8 +218,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%BldPos = SrcInitInputData%BldPos end if if (allocated(SrcInitInputData%BldOrient)) then - LB(1:4) = lbound(SrcInitInputData%BldOrient, kind=B8Ki) - UB(1:4) = ubound(SrcInitInputData%BldOrient, kind=B8Ki) + LB(1:4) = lbound(SrcInitInputData%BldOrient) + UB(1:4) = ubound(SrcInitInputData%BldOrient) if (.not. allocated(DstInitInputData%BldOrient)) then allocate(DstInitInputData%BldOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -208,8 +230,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%BldOrient = SrcInitInputData%BldOrient end if if (allocated(SrcInitInputData%TwrPos)) then - LB(1:2) = lbound(SrcInitInputData%TwrPos, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%TwrPos, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%TwrPos) + UB(1:2) = ubound(SrcInitInputData%TwrPos) if (.not. allocated(DstInitInputData%TwrPos)) then allocate(DstInitInputData%TwrPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -220,8 +242,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%TwrPos = SrcInitInputData%TwrPos end if if (allocated(SrcInitInputData%TwrOrient)) then - LB(1:3) = lbound(SrcInitInputData%TwrOrient, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%TwrOrient, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%TwrOrient) + UB(1:3) = ubound(SrcInitInputData%TwrOrient) if (.not. allocated(DstInitInputData%TwrOrient)) then allocate(DstInitInputData%TwrOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -234,8 +256,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%az_blend_mean = SrcInitInputData%az_blend_mean DstInitInputData%az_blend_delta = SrcInitInputData%az_blend_delta if (allocated(SrcInitInputData%BldChord)) then - LB(1:2) = lbound(SrcInitInputData%BldChord, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%BldChord, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%BldChord) + UB(1:2) = ubound(SrcInitInputData%BldChord) if (.not. allocated(DstInitInputData%BldChord)) then allocate(DstInitInputData%BldChord(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -246,8 +268,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%BldChord = SrcInitInputData%BldChord end if if (allocated(SrcInitInputData%BldRloc)) then - LB(1:2) = lbound(SrcInitInputData%BldRloc, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%BldRloc, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%BldRloc) + UB(1:2) = ubound(SrcInitInputData%BldRloc) if (.not. allocated(DstInitInputData%BldRloc)) then allocate(DstInitInputData%BldRloc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -258,8 +280,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%BldRloc = SrcInitInputData%BldRloc end if if (allocated(SrcInitInputData%TwrDia)) then - LB(1:1) = lbound(SrcInitInputData%TwrDia, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%TwrDia, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%TwrDia) + UB(1:1) = ubound(SrcInitInputData%TwrDia) if (.not. allocated(DstInitInputData%TwrDia)) then allocate(DstInitInputData%TwrDia(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -270,8 +292,8 @@ subroutine ExtLd_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%TwrDia = SrcInitInputData%TwrDia end if if (allocated(SrcInitInputData%TwrHloc)) then - LB(1:1) = lbound(SrcInitInputData%TwrHloc, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%TwrHloc, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%TwrHloc) + UB(1:1) = ubound(SrcInitInputData%TwrHloc) if (.not. allocated(DstInitInputData%TwrHloc)) then allocate(DstInitInputData%TwrHloc(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -359,7 +381,7 @@ subroutine ExtLd_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLd_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtLd_UnPackInitInput' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -392,15 +414,15 @@ subroutine ExtLd_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtLd_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -411,8 +433,8 @@ subroutine ExtLd_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -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 @@ -463,14 +495,34 @@ subroutine ExtLd_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLd_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtLd_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + 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(B8Ki) :: 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(B8Ki) :: 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) @@ -726,19 +735,31 @@ subroutine ExtLd_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 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 DstParamData%NumBlds = SrcParamData%NumBlds if (allocated(SrcParamData%NumBldNds)) then - LB(1:1) = lbound(SrcParamData%NumBldNds, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NumBldNds, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%NumBldNds) + UB(1:1) = ubound(SrcParamData%NumBldNds) if (.not. allocated(DstParamData%NumBldNds)) then allocate(DstParamData%NumBldNds(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -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) @@ -791,10 +826,30 @@ subroutine ExtLd_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLd_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtLd_UnPackParam' - integer(B8Ki) :: LB(1), UB(1) + 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 @@ -811,8 +866,8 @@ subroutine ExtLd_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtLd_CopyInput' @@ -832,8 +887,8 @@ subroutine ExtLd_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInputData%BladeRootMotion)) then - LB(1:1) = lbound(SrcInputData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%BladeRootMotion, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%BladeRootMotion) + UB(1:1) = ubound(SrcInputData%BladeRootMotion) if (.not. allocated(DstInputData%BladeRootMotion)) then allocate(DstInputData%BladeRootMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -848,8 +903,8 @@ subroutine ExtLd_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg end do end if if (allocated(SrcInputData%BladeMotion)) then - LB(1:1) = lbound(SrcInputData%BladeMotion, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%BladeMotion, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%BladeMotion) + UB(1:1) = ubound(SrcInputData%BladeMotion) if (.not. allocated(DstInputData%BladeMotion)) then allocate(DstInputData%BladeMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -863,14 +918,33 @@ 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) type(ExtLd_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtLd_DestroyInput' @@ -885,8 +959,8 @@ subroutine ExtLd_DestroyInput(InputData, ErrStat, ErrMsg) call MeshDestroy( InputData%NacelleMotion, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InputData%BladeRootMotion)) then - LB(1:1) = lbound(InputData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(InputData%BladeRootMotion, kind=B8Ki) + LB(1:1) = lbound(InputData%BladeRootMotion) + UB(1:1) = ubound(InputData%BladeRootMotion) do i1 = LB(1), UB(1) call MeshDestroy( InputData%BladeRootMotion(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -894,22 +968,33 @@ subroutine ExtLd_DestroyInput(InputData, ErrStat, ErrMsg) deallocate(InputData%BladeRootMotion) end if if (allocated(InputData%BladeMotion)) then - LB(1:1) = lbound(InputData%BladeMotion, kind=B8Ki) - UB(1:1) = ubound(InputData%BladeMotion, kind=B8Ki) + LB(1:1) = lbound(InputData%BladeMotion) + UB(1:1) = ubound(InputData%BladeMotion) do i1 = LB(1), UB(1) call MeshDestroy( InputData%BladeMotion(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) 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) type(RegFile), intent(inout) :: RF type(ExtLd_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtLd_PackInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call ExtLdDX_PackInput(RF, InData%DX_u) call RegPack(RF, InData%az) @@ -918,22 +1003,32 @@ subroutine ExtLd_PackInput(RF, Indata) call MeshPack(RF, InData%NacelleMotion) call RegPack(RF, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then - call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(InData%BladeRootMotion, kind=B8Ki) + 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 RegPack(RF, allocated(InData%BladeMotion)) if (allocated(InData%BladeMotion)) then - call RegPackBounds(RF, 1, lbound(InData%BladeMotion, kind=B8Ki), ubound(InData%BladeMotion, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeMotion, kind=B8Ki) - UB(1:1) = ubound(InData%BladeMotion, kind=B8Ki) + 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%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 @@ -941,8 +1036,8 @@ subroutine ExtLd_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLd_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtLd_UnPackInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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) @@ -985,8 +1094,8 @@ subroutine ExtLd_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtLd_CopyOutput' @@ -999,8 +1108,8 @@ subroutine ExtLd_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%BladeLoad)) then - LB(1:1) = lbound(SrcOutputData%BladeLoad, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BladeLoad, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%BladeLoad) + UB(1:1) = ubound(SrcOutputData%BladeLoad) if (.not. allocated(DstOutputData%BladeLoad)) then allocate(DstOutputData%BladeLoad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1014,33 +1123,14 @@ 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, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BladeLoadAD, kind=B8Ki) - 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) type(ExtLd_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtLd_DestroyOutput' @@ -1051,55 +1141,34 @@ subroutine ExtLd_DestroyOutput(OutputData, ErrStat, ErrMsg) call MeshDestroy( OutputData%TowerLoad, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OutputData%BladeLoad)) then - LB(1:1) = lbound(OutputData%BladeLoad, kind=B8Ki) - UB(1:1) = ubound(OutputData%BladeLoad, kind=B8Ki) + LB(1:1) = lbound(OutputData%BladeLoad) + UB(1:1) = ubound(OutputData%BladeLoad) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%BladeLoad(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) 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, kind=B8Ki) - UB(1:1) = ubound(OutputData%BladeLoadAD, kind=B8Ki) - 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) type(RegFile), intent(inout) :: RF type(ExtLd_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtLd_PackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call ExtLdDX_PackOutput(RF, InData%DX_y) call MeshPack(RF, InData%TowerLoad) call RegPack(RF, allocated(InData%BladeLoad)) if (allocated(InData%BladeLoad)) then - call RegPackBounds(RF, 1, lbound(InData%BladeLoad, kind=B8Ki), ubound(InData%BladeLoad, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeLoad, kind=B8Ki) - UB(1:1) = ubound(InData%BladeLoad, kind=B8Ki) + 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%TowerLoadAD) - call RegPack(RF, allocated(InData%BladeLoadAD)) - if (allocated(InData%BladeLoadAD)) then - call RegPackBounds(RF, 1, lbound(InData%BladeLoadAD, kind=B8Ki), ubound(InData%BladeLoadAD, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeLoadAD, kind=B8Ki) - UB(1:1) = ubound(InData%BladeLoadAD, kind=B8Ki) - do i1 = LB(1), UB(1) - call MeshPack(RF, InData%BladeLoadAD(i1)) - end do - end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1107,8 +1176,8 @@ subroutine ExtLd_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLd_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtLd_UnPackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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) @@ -1250,17 +1305,25 @@ SUBROUTINE ExtLd_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs CALL MeshExtrapInterp1(u1%NacelleMotion, u2%NacelleMotion, tin, u_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%BladeRootMotion) .AND. ALLOCATED(u1%BladeRootMotion)) THEN - DO i1 = LBOUND(u_out%BladeRootMotion,1, kind=B8Ki),UBOUND(u_out%BladeRootMotion,1, kind=B8Ki) + do i1 = lbound(u_out%BladeRootMotion,1),ubound(u_out%BladeRootMotion,1) CALL MeshExtrapInterp1(u1%BladeRootMotion(i1), u2%BladeRootMotion(i1), tin, u_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(u_out%BladeMotion) .AND. ALLOCATED(u1%BladeMotion)) THEN - DO i1 = LBOUND(u_out%BladeMotion,1, kind=B8Ki),UBOUND(u_out%BladeMotion,1, kind=B8Ki) + do i1 = lbound(u_out%BladeMotion,1),ubound(u_out%BladeMotion,1) CALL MeshExtrapInterp1(u1%BladeMotion(i1), u2%BladeMotion(i1), tin, u_out%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) 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 ) @@ -1328,17 +1391,25 @@ SUBROUTINE ExtLd_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E CALL MeshExtrapInterp2(u1%NacelleMotion, u2%NacelleMotion, u3%NacelleMotion, tin, u_out%NacelleMotion, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%BladeRootMotion) .AND. ALLOCATED(u1%BladeRootMotion)) THEN - DO i1 = LBOUND(u_out%BladeRootMotion,1, kind=B8Ki),UBOUND(u_out%BladeRootMotion,1, kind=B8Ki) + do i1 = lbound(u_out%BladeRootMotion,1),ubound(u_out%BladeRootMotion,1) CALL MeshExtrapInterp2(u1%BladeRootMotion(i1), u2%BladeRootMotion(i1), u3%BladeRootMotion(i1), tin, u_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(u_out%BladeMotion) .AND. ALLOCATED(u1%BladeMotion)) THEN - DO i1 = LBOUND(u_out%BladeMotion,1, kind=B8Ki),UBOUND(u_out%BladeMotion,1, kind=B8Ki) + do i1 = lbound(u_out%BladeMotion,1),ubound(u_out%BladeMotion,1) CALL MeshExtrapInterp2(u1%BladeMotion(i1), u2%BladeMotion(i1), u3%BladeMotion(i1), tin, u_out%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) 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) @@ -1443,19 +1514,11 @@ SUBROUTINE ExtLd_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM CALL MeshExtrapInterp1(y1%TowerLoad, y2%TowerLoad, tin, y_out%TowerLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%BladeLoad) .AND. ALLOCATED(y1%BladeLoad)) THEN - DO i1 = LBOUND(y_out%BladeLoad,1, kind=B8Ki),UBOUND(y_out%BladeLoad,1, kind=B8Ki) + do i1 = lbound(y_out%BladeLoad,1),ubound(y_out%BladeLoad,1) CALL MeshExtrapInterp1(y1%BladeLoad(i1), y2%BladeLoad(i1), tin, y_out%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) 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, kind=B8Ki),UBOUND(y_out%BladeLoadAD,1, kind=B8Ki) - 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 ) @@ -1518,19 +1581,397 @@ SUBROUTINE ExtLd_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL MeshExtrapInterp2(y1%TowerLoad, y2%TowerLoad, y3%TowerLoad, tin, y_out%TowerLoad, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%BladeLoad) .AND. ALLOCATED(y1%BladeLoad)) THEN - DO i1 = LBOUND(y_out%BladeLoad,1, kind=B8Ki),UBOUND(y_out%BladeLoad,1, kind=B8Ki) + do i1 = lbound(y_out%BladeLoad,1),ubound(y_out%BladeLoad,1) CALL MeshExtrapInterp2(y1%BladeLoad(i1), y2%BladeLoad(i1), y3%BladeLoad(i1), tin, y_out%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) 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, kind=B8Ki),UBOUND(y_out%BladeLoadAD,1, kind=B8Ki) - 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 17debf3902..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 @@ -209,7 +222,7 @@ subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyInputFile' ErrStat = ErrID_None @@ -221,8 +234,8 @@ subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, E DstInputFileData%RedFileCst = SrcInputFileData%RedFileCst DstInputFileData%EquilStart = SrcInputFileData%EquilStart if (allocated(SrcInputFileData%ActiveCBDOF)) then - LB(1:1) = lbound(SrcInputFileData%ActiveCBDOF, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%ActiveCBDOF, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%ActiveCBDOF) + UB(1:1) = ubound(SrcInputFileData%ActiveCBDOF) if (.not. allocated(DstInputFileData%ActiveCBDOF)) then allocate(DstInputFileData%ActiveCBDOF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -233,8 +246,8 @@ subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, E DstInputFileData%ActiveCBDOF = SrcInputFileData%ActiveCBDOF end if if (allocated(SrcInputFileData%InitPosList)) then - LB(1:1) = lbound(SrcInputFileData%InitPosList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%InitPosList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%InitPosList) + UB(1:1) = ubound(SrcInputFileData%InitPosList) if (.not. allocated(DstInputFileData%InitPosList)) then allocate(DstInputFileData%InitPosList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -245,8 +258,8 @@ subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, E DstInputFileData%InitPosList = SrcInputFileData%InitPosList end if if (allocated(SrcInputFileData%InitVelList)) then - LB(1:1) = lbound(SrcInputFileData%InitVelList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%InitVelList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%InitVelList) + UB(1:1) = ubound(SrcInputFileData%InitVelList) if (.not. allocated(DstInputFileData%InitVelList)) then allocate(DstInputFileData%InitVelList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -263,8 +276,8 @@ subroutine ExtPtfm_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, E DstInputFileData%Tstart = SrcInputFileData%Tstart DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -325,7 +338,7 @@ subroutine ExtPtfm_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtPtfm_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInputFile' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -353,7 +366,7 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyInitOutput' @@ -363,8 +376,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -375,8 +388,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -387,8 +400,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt end if if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) + 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 @@ -399,8 +412,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -411,8 +424,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) + 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 @@ -423,8 +436,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + 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 @@ -435,8 +448,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -447,8 +460,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + 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 @@ -459,8 +472,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + 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 @@ -471,8 +484,8 @@ subroutine ExtPtfm_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -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 @@ -550,7 +569,7 @@ subroutine ExtPtfm_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtPtfm_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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) @@ -573,14 +593,14 @@ subroutine ExtPtfm_CopyContState(SrcContStateData, DstContStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%qm)) then - LB(1:1) = lbound(SrcContStateData%qm, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%qm, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%qm) + UB(1:1) = ubound(SrcContStateData%qm) if (.not. allocated(DstContStateData%qm)) then allocate(DstContStateData%qm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -591,8 +611,8 @@ subroutine ExtPtfm_CopyContState(SrcContStateData, DstContStateData, CtrlCode, E DstContStateData%qm = SrcContStateData%qm end if if (allocated(SrcContStateData%qmdot)) then - LB(1:1) = lbound(SrcContStateData%qmdot, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%qmdot, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%qmdot) + UB(1:1) = ubound(SrcContStateData%qmdot) if (.not. allocated(DstContStateData%qmdot)) then allocate(DstContStateData%qmdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -633,7 +653,7 @@ subroutine ExtPtfm_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtPtfm_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackContState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -723,16 +743,16 @@ subroutine ExtPtfm_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%xdot)) then - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) if (.not. allocated(DstOtherStateData%xdot)) then allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -753,16 +773,16 @@ subroutine ExtPtfm_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(ExtPtfm_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%xdot)) then - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call ExtPtfm_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -775,14 +795,14 @@ subroutine ExtPtfm_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(ExtPtfm_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%xdot)) if (allocated(InData%xdot)) then - call RegPackBounds(RF, 1, lbound(InData%xdot, kind=B8Ki), ubound(InData%xdot, kind=B8Ki)) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xdot), ubound(InData%xdot)) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call ExtPtfm_PackContState(RF, InData%xdot(i1)) end do @@ -795,8 +815,8 @@ subroutine ExtPtfm_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtPtfm_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -816,122 +836,22 @@ 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(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%xFlat, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_at_t, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) - 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(B8Ki) :: 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 integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcParamData%Mass)) then - LB(1:2) = lbound(SrcParamData%Mass, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Mass, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Mass) + UB(1:2) = ubound(SrcParamData%Mass) if (.not. allocated(DstParamData%Mass)) then allocate(DstParamData%Mass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -942,8 +862,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%Mass = SrcParamData%Mass end if if (allocated(SrcParamData%Damp)) then - LB(1:2) = lbound(SrcParamData%Damp, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Damp, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Damp) + UB(1:2) = ubound(SrcParamData%Damp) if (.not. allocated(DstParamData%Damp)) then allocate(DstParamData%Damp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -954,8 +874,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%Damp = SrcParamData%Damp end if if (allocated(SrcParamData%Stff)) then - LB(1:2) = lbound(SrcParamData%Stff, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Stff, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Stff) + UB(1:2) = ubound(SrcParamData%Stff) if (.not. allocated(DstParamData%Stff)) then allocate(DstParamData%Stff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -966,8 +886,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%Stff = SrcParamData%Stff end if if (allocated(SrcParamData%Forces)) then - LB(1:2) = lbound(SrcParamData%Forces, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Forces, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Forces) + UB(1:2) = ubound(SrcParamData%Forces) if (.not. allocated(DstParamData%Forces)) then allocate(DstParamData%Forces(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -978,8 +898,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%Forces = SrcParamData%Forces end if if (allocated(SrcParamData%times)) then - LB(1:1) = lbound(SrcParamData%times, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%times, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%times) + UB(1:1) = ubound(SrcParamData%times) if (.not. allocated(DstParamData%times)) then allocate(DstParamData%times(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -990,8 +910,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%times = SrcParamData%times end if if (allocated(SrcParamData%AMat)) then - LB(1:2) = lbound(SrcParamData%AMat, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%AMat, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%AMat) + UB(1:2) = ubound(SrcParamData%AMat) if (.not. allocated(DstParamData%AMat)) then allocate(DstParamData%AMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1002,8 +922,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%AMat = SrcParamData%AMat end if if (allocated(SrcParamData%BMat)) then - LB(1:2) = lbound(SrcParamData%BMat, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BMat, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BMat) + UB(1:2) = ubound(SrcParamData%BMat) if (.not. allocated(DstParamData%BMat)) then allocate(DstParamData%BMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1014,8 +934,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%BMat = SrcParamData%BMat end if if (allocated(SrcParamData%CMat)) then - LB(1:2) = lbound(SrcParamData%CMat, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%CMat, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%CMat) + UB(1:2) = ubound(SrcParamData%CMat) if (.not. allocated(DstParamData%CMat)) then allocate(DstParamData%CMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1026,8 +946,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%CMat = SrcParamData%CMat end if if (allocated(SrcParamData%DMat)) then - LB(1:2) = lbound(SrcParamData%DMat, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%DMat, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%DMat) + UB(1:2) = ubound(SrcParamData%DMat) if (.not. allocated(DstParamData%DMat)) then allocate(DstParamData%DMat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1038,8 +958,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%DMat = SrcParamData%DMat end if if (allocated(SrcParamData%FX)) then - LB(1:1) = lbound(SrcParamData%FX, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%FX, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%FX) + UB(1:1) = ubound(SrcParamData%FX) if (.not. allocated(DstParamData%FX)) then allocate(DstParamData%FX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1050,8 +970,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%FX = SrcParamData%FX end if if (allocated(SrcParamData%FY)) then - LB(1:1) = lbound(SrcParamData%FY, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%FY, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%FY) + UB(1:1) = ubound(SrcParamData%FY) if (.not. allocated(DstParamData%FY)) then allocate(DstParamData%FY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1062,8 +982,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%FY = SrcParamData%FY end if if (allocated(SrcParamData%M11)) then - LB(1:2) = lbound(SrcParamData%M11, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%M11, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%M11) + UB(1:2) = ubound(SrcParamData%M11) if (.not. allocated(DstParamData%M11)) then allocate(DstParamData%M11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1074,8 +994,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%M11 = SrcParamData%M11 end if if (allocated(SrcParamData%M12)) then - LB(1:2) = lbound(SrcParamData%M12, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%M12, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%M12) + UB(1:2) = ubound(SrcParamData%M12) if (.not. allocated(DstParamData%M12)) then allocate(DstParamData%M12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1086,8 +1006,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%M12 = SrcParamData%M12 end if if (allocated(SrcParamData%M22)) then - LB(1:2) = lbound(SrcParamData%M22, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%M22, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%M22) + UB(1:2) = ubound(SrcParamData%M22) if (.not. allocated(DstParamData%M22)) then allocate(DstParamData%M22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1098,8 +1018,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%M22 = SrcParamData%M22 end if if (allocated(SrcParamData%M21)) then - LB(1:2) = lbound(SrcParamData%M21, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%M21, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%M21) + UB(1:2) = ubound(SrcParamData%M21) if (.not. allocated(DstParamData%M21)) then allocate(DstParamData%M21(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1110,8 +1030,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%M21 = SrcParamData%M21 end if if (allocated(SrcParamData%K11)) then - LB(1:2) = lbound(SrcParamData%K11, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%K11, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%K11) + UB(1:2) = ubound(SrcParamData%K11) if (.not. allocated(DstParamData%K11)) then allocate(DstParamData%K11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1122,8 +1042,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%K11 = SrcParamData%K11 end if if (allocated(SrcParamData%K22)) then - LB(1:2) = lbound(SrcParamData%K22, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%K22, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%K22) + UB(1:2) = ubound(SrcParamData%K22) if (.not. allocated(DstParamData%K22)) then allocate(DstParamData%K22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1134,8 +1054,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%K22 = SrcParamData%K22 end if if (allocated(SrcParamData%C11)) then - LB(1:2) = lbound(SrcParamData%C11, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C11, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%C11) + UB(1:2) = ubound(SrcParamData%C11) if (.not. allocated(DstParamData%C11)) then allocate(DstParamData%C11(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1146,8 +1066,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%C11 = SrcParamData%C11 end if if (allocated(SrcParamData%C12)) then - LB(1:2) = lbound(SrcParamData%C12, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C12, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%C12) + UB(1:2) = ubound(SrcParamData%C12) if (.not. allocated(DstParamData%C12)) then allocate(DstParamData%C12(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1158,8 +1078,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%C12 = SrcParamData%C12 end if if (allocated(SrcParamData%C22)) then - LB(1:2) = lbound(SrcParamData%C22, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C22, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%C22) + UB(1:2) = ubound(SrcParamData%C22) if (.not. allocated(DstParamData%C22)) then allocate(DstParamData%C22(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1170,8 +1090,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%C22 = SrcParamData%C22 end if if (allocated(SrcParamData%C21)) then - LB(1:2) = lbound(SrcParamData%C21, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C21, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%C21) + UB(1:2) = ubound(SrcParamData%C21) if (.not. allocated(DstParamData%C21)) then allocate(DstParamData%C21(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1189,8 +1109,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%NumOuts = SrcParamData%NumOuts DstParamData%IntMethod = SrcParamData%IntMethod if (allocated(SrcParamData%ActiveCBDOF)) then - LB(1:1) = lbound(SrcParamData%ActiveCBDOF, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ActiveCBDOF, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ActiveCBDOF) + UB(1:1) = ubound(SrcParamData%ActiveCBDOF) if (.not. allocated(DstParamData%ActiveCBDOF)) then allocate(DstParamData%ActiveCBDOF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1201,8 +1121,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%ActiveCBDOF = SrcParamData%ActiveCBDOF end if if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + 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 @@ -1217,8 +1137,8 @@ subroutine ExtPtfm_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end do end if if (allocated(SrcParamData%OutParamLinIndx)) then - LB(1:2) = lbound(SrcParamData%OutParamLinIndx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%OutParamLinIndx, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%OutParamLinIndx) + UB(1:2) = ubound(SrcParamData%OutParamLinIndx) if (.not. allocated(DstParamData%OutParamLinIndx)) then allocate(DstParamData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1234,8 +1154,8 @@ subroutine ExtPtfm_DestroyParam(ParamData, ErrStat, ErrMsg) type(ExtPtfm_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_DestroyParam' @@ -1308,8 +1228,8 @@ subroutine ExtPtfm_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%ActiveCBDOF) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + 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) @@ -1325,8 +1245,8 @@ subroutine ExtPtfm_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(ExtPtfm_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'ExtPtfm_PackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%Mass) call RegPackAlloc(RF, InData%Damp) @@ -1359,9 +1279,9 @@ subroutine ExtPtfm_PackParam(RF, Indata) call RegPackAlloc(RF, InData%ActiveCBDOF) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + 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 @@ -1374,8 +1294,8 @@ subroutine ExtPtfm_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtPtfm_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1476,7 +1396,7 @@ subroutine ExtPtfm_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'ExtPtfm_CopyOutput' @@ -1486,8 +1406,8 @@ subroutine ExtPtfm_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -1529,7 +1449,7 @@ subroutine ExtPtfm_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtPtfm_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'ExtPtfm_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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 a96fa832aa..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 @@ -231,15 +244,15 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FEAM_CopyInputFile' ErrStat = ErrID_None ErrMsg = '' DstInputFileData%DT = SrcInputFileData%DT if (allocated(SrcInputFileData%LineCI)) then - LB(1:1) = lbound(SrcInputFileData%LineCI, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LineCI, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LineCI) + UB(1:1) = ubound(SrcInputFileData%LineCI) if (.not. allocated(DstInputFileData%LineCI)) then allocate(DstInputFileData%LineCI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -250,8 +263,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LineCI = SrcInputFileData%LineCI end if if (allocated(SrcInputFileData%LineCD)) then - LB(1:1) = lbound(SrcInputFileData%LineCD, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LineCD, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LineCD) + UB(1:1) = ubound(SrcInputFileData%LineCD) if (.not. allocated(DstInputFileData%LineCD)) then allocate(DstInputFileData%LineCD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -262,8 +275,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LineCD = SrcInputFileData%LineCD end if if (allocated(SrcInputFileData%LEAStiff)) then - LB(1:1) = lbound(SrcInputFileData%LEAStiff, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LEAStiff, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LEAStiff) + UB(1:1) = ubound(SrcInputFileData%LEAStiff) if (.not. allocated(DstInputFileData%LEAStiff)) then allocate(DstInputFileData%LEAStiff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -274,8 +287,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LEAStiff = SrcInputFileData%LEAStiff end if if (allocated(SrcInputFileData%LMassDen)) then - LB(1:1) = lbound(SrcInputFileData%LMassDen, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LMassDen, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LMassDen) + UB(1:1) = ubound(SrcInputFileData%LMassDen) if (.not. allocated(DstInputFileData%LMassDen)) then allocate(DstInputFileData%LMassDen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -286,8 +299,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LMassDen = SrcInputFileData%LMassDen end if if (allocated(SrcInputFileData%LDMassDen)) then - LB(1:1) = lbound(SrcInputFileData%LDMassDen, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LDMassDen, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LDMassDen) + UB(1:1) = ubound(SrcInputFileData%LDMassDen) if (.not. allocated(DstInputFileData%LDMassDen)) then allocate(DstInputFileData%LDMassDen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -298,8 +311,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LDMassDen = SrcInputFileData%LDMassDen end if if (allocated(SrcInputFileData%BottmStiff)) then - LB(1:1) = lbound(SrcInputFileData%BottmStiff, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%BottmStiff, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%BottmStiff) + UB(1:1) = ubound(SrcInputFileData%BottmStiff) if (.not. allocated(DstInputFileData%BottmStiff)) then allocate(DstInputFileData%BottmStiff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -310,8 +323,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%BottmStiff = SrcInputFileData%BottmStiff end if if (allocated(SrcInputFileData%LRadAnch)) then - LB(1:1) = lbound(SrcInputFileData%LRadAnch, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LRadAnch, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LRadAnch) + UB(1:1) = ubound(SrcInputFileData%LRadAnch) if (.not. allocated(DstInputFileData%LRadAnch)) then allocate(DstInputFileData%LRadAnch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -322,8 +335,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LRadAnch = SrcInputFileData%LRadAnch end if if (allocated(SrcInputFileData%LAngAnch)) then - LB(1:1) = lbound(SrcInputFileData%LAngAnch, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LAngAnch, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LAngAnch) + UB(1:1) = ubound(SrcInputFileData%LAngAnch) if (.not. allocated(DstInputFileData%LAngAnch)) then allocate(DstInputFileData%LAngAnch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -334,8 +347,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LAngAnch = SrcInputFileData%LAngAnch end if if (allocated(SrcInputFileData%LDpthAnch)) then - LB(1:1) = lbound(SrcInputFileData%LDpthAnch, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LDpthAnch, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LDpthAnch) + UB(1:1) = ubound(SrcInputFileData%LDpthAnch) if (.not. allocated(DstInputFileData%LDpthAnch)) then allocate(DstInputFileData%LDpthAnch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -346,8 +359,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LDpthAnch = SrcInputFileData%LDpthAnch end if if (allocated(SrcInputFileData%LRadFair)) then - LB(1:1) = lbound(SrcInputFileData%LRadFair, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LRadFair, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LRadFair) + UB(1:1) = ubound(SrcInputFileData%LRadFair) if (.not. allocated(DstInputFileData%LRadFair)) then allocate(DstInputFileData%LRadFair(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -358,8 +371,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LRadFair = SrcInputFileData%LRadFair end if if (allocated(SrcInputFileData%LAngFair)) then - LB(1:1) = lbound(SrcInputFileData%LAngFair, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LAngFair, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LAngFair) + UB(1:1) = ubound(SrcInputFileData%LAngFair) if (.not. allocated(DstInputFileData%LAngFair)) then allocate(DstInputFileData%LAngFair(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -370,8 +383,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LAngFair = SrcInputFileData%LAngFair end if if (allocated(SrcInputFileData%LDrftFair)) then - LB(1:1) = lbound(SrcInputFileData%LDrftFair, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LDrftFair, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LDrftFair) + UB(1:1) = ubound(SrcInputFileData%LDrftFair) if (.not. allocated(DstInputFileData%LDrftFair)) then allocate(DstInputFileData%LDrftFair(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -382,8 +395,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LDrftFair = SrcInputFileData%LDrftFair end if if (allocated(SrcInputFileData%LUnstrLen)) then - LB(1:1) = lbound(SrcInputFileData%LUnstrLen, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LUnstrLen, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LUnstrLen) + UB(1:1) = ubound(SrcInputFileData%LUnstrLen) if (.not. allocated(DstInputFileData%LUnstrLen)) then allocate(DstInputFileData%LUnstrLen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -394,8 +407,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LUnstrLen = SrcInputFileData%LUnstrLen end if if (allocated(SrcInputFileData%Tension)) then - LB(1:1) = lbound(SrcInputFileData%Tension, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%Tension, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%Tension) + UB(1:1) = ubound(SrcInputFileData%Tension) if (.not. allocated(DstInputFileData%Tension)) then allocate(DstInputFileData%Tension(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -406,8 +419,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%Tension = SrcInputFileData%Tension end if if (allocated(SrcInputFileData%GSL)) then - LB(1:3) = lbound(SrcInputFileData%GSL, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%GSL, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%GSL) + UB(1:3) = ubound(SrcInputFileData%GSL) if (.not. allocated(DstInputFileData%GSL)) then allocate(DstInputFileData%GSL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -418,8 +431,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%GSL = SrcInputFileData%GSL end if if (allocated(SrcInputFileData%GSR)) then - LB(1:2) = lbound(SrcInputFileData%GSR, kind=B8Ki) - UB(1:2) = ubound(SrcInputFileData%GSR, kind=B8Ki) + LB(1:2) = lbound(SrcInputFileData%GSR) + UB(1:2) = ubound(SrcInputFileData%GSR) if (.not. allocated(DstInputFileData%GSR)) then allocate(DstInputFileData%GSR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -430,8 +443,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%GSR = SrcInputFileData%GSR end if if (allocated(SrcInputFileData%GE)) then - LB(1:3) = lbound(SrcInputFileData%GE, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%GE, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%GE) + UB(1:3) = ubound(SrcInputFileData%GE) if (.not. allocated(DstInputFileData%GE)) then allocate(DstInputFileData%GE(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -454,8 +467,8 @@ subroutine FEAM_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%Tstart = SrcInputFileData%Tstart DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -573,7 +586,7 @@ subroutine FEAM_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(FEAM_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackInputFile' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -616,7 +629,7 @@ subroutine FEAM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FEAM_CopyInitInput' ErrStat = ErrID_None @@ -626,8 +639,8 @@ subroutine FEAM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%PtfmInit = SrcInitInputData%PtfmInit DstInitInputData%NStepWave = SrcInitInputData%NStepWave if (allocated(SrcInitInputData%WaveAcc0)) then - LB(1:3) = lbound(SrcInitInputData%WaveAcc0, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%WaveAcc0, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%WaveAcc0) + UB(1:3) = ubound(SrcInitInputData%WaveAcc0) if (.not. allocated(DstInitInputData%WaveAcc0)) then allocate(DstInitInputData%WaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -638,8 +651,8 @@ subroutine FEAM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%WaveAcc0 = SrcInitInputData%WaveAcc0 end if if (allocated(SrcInitInputData%WaveTime)) then - LB(1:1) = lbound(SrcInitInputData%WaveTime, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%WaveTime, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%WaveTime) + UB(1:1) = ubound(SrcInitInputData%WaveTime) if (.not. allocated(DstInitInputData%WaveTime)) then allocate(DstInitInputData%WaveTime(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -650,8 +663,8 @@ subroutine FEAM_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%WaveTime = SrcInitInputData%WaveTime end if if (allocated(SrcInitInputData%WaveVel0)) then - LB(1:3) = lbound(SrcInitInputData%WaveVel0, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%WaveVel0, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%WaveVel0) + UB(1:3) = ubound(SrcInitInputData%WaveVel0) if (.not. allocated(DstInitInputData%WaveVel0)) then allocate(DstInitInputData%WaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -704,7 +717,7 @@ subroutine FEAM_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(FEAM_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackInitInput' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -725,15 +738,15 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FEAM_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -744,8 +757,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -758,9 +771,10 @@ 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, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LAnchxi, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LAnchxi) + UB(1:1) = ubound(SrcInitOutputData%LAnchxi) if (.not. allocated(DstInitOutputData%LAnchxi)) then allocate(DstInitOutputData%LAnchxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -771,8 +785,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LAnchxi = SrcInitOutputData%LAnchxi end if if (allocated(SrcInitOutputData%LAnchyi)) then - LB(1:1) = lbound(SrcInitOutputData%LAnchyi, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LAnchyi, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LAnchyi) + UB(1:1) = ubound(SrcInitOutputData%LAnchyi) if (.not. allocated(DstInitOutputData%LAnchyi)) then allocate(DstInitOutputData%LAnchyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -783,8 +797,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LAnchyi = SrcInitOutputData%LAnchyi end if if (allocated(SrcInitOutputData%LAnchzi)) then - LB(1:1) = lbound(SrcInitOutputData%LAnchzi, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LAnchzi, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LAnchzi) + UB(1:1) = ubound(SrcInitOutputData%LAnchzi) if (.not. allocated(DstInitOutputData%LAnchzi)) then allocate(DstInitOutputData%LAnchzi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -795,8 +809,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LAnchzi = SrcInitOutputData%LAnchzi end if if (allocated(SrcInitOutputData%LFairxt)) then - LB(1:1) = lbound(SrcInitOutputData%LFairxt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LFairxt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LFairxt) + UB(1:1) = ubound(SrcInitOutputData%LFairxt) if (.not. allocated(DstInitOutputData%LFairxt)) then allocate(DstInitOutputData%LFairxt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -807,8 +821,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LFairxt = SrcInitOutputData%LFairxt end if if (allocated(SrcInitOutputData%LFairyt)) then - LB(1:1) = lbound(SrcInitOutputData%LFairyt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LFairyt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LFairyt) + UB(1:1) = ubound(SrcInitOutputData%LFairyt) if (.not. allocated(DstInitOutputData%LFairyt)) then allocate(DstInitOutputData%LFairyt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -819,8 +833,8 @@ subroutine FEAM_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LFairyt = SrcInitOutputData%LFairyt end if if (allocated(SrcInitOutputData%LFairzt)) then - LB(1:1) = lbound(SrcInitOutputData%LFairzt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LFairzt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LFairzt) + UB(1:1) = ubound(SrcInitOutputData%LFairzt) if (.not. allocated(DstInitOutputData%LFairzt)) then allocate(DstInitOutputData%LFairzt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -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) @@ -890,13 +913,33 @@ subroutine FEAM_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(FEAM_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + 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 @@ -911,14 +954,14 @@ subroutine FEAM_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FEAM_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%GLU)) then - LB(1:2) = lbound(SrcContStateData%GLU, kind=B8Ki) - UB(1:2) = ubound(SrcContStateData%GLU, kind=B8Ki) + LB(1:2) = lbound(SrcContStateData%GLU) + UB(1:2) = ubound(SrcContStateData%GLU) if (.not. allocated(DstContStateData%GLU)) then allocate(DstContStateData%GLU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -929,8 +972,8 @@ subroutine FEAM_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS DstContStateData%GLU = SrcContStateData%GLU end if if (allocated(SrcContStateData%GLDU)) then - LB(1:2) = lbound(SrcContStateData%GLDU, kind=B8Ki) - UB(1:2) = ubound(SrcContStateData%GLDU, kind=B8Ki) + LB(1:2) = lbound(SrcContStateData%GLDU) + UB(1:2) = ubound(SrcContStateData%GLDU) if (.not. allocated(DstContStateData%GLDU)) then allocate(DstContStateData%GLDU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -971,7 +1014,7 @@ subroutine FEAM_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(FEAM_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackContState' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1064,14 +1107,14 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FEAM_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%GLU0)) then - LB(1:2) = lbound(SrcOtherStateData%GLU0, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%GLU0, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%GLU0) + UB(1:2) = ubound(SrcOtherStateData%GLU0) if (.not. allocated(DstOtherStateData%GLU0)) then allocate(DstOtherStateData%GLU0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1082,8 +1125,8 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%GLU0 = SrcOtherStateData%GLU0 end if if (allocated(SrcOtherStateData%GLDDU)) then - LB(1:2) = lbound(SrcOtherStateData%GLDDU, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%GLDDU, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%GLDDU) + UB(1:2) = ubound(SrcOtherStateData%GLDDU) if (.not. allocated(DstOtherStateData%GLDDU)) then allocate(DstOtherStateData%GLDDU(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1095,8 +1138,8 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end if DstOtherStateData%BottomTouch = SrcOtherStateData%BottomTouch if (allocated(SrcOtherStateData%GFORC0)) then - LB(1:3) = lbound(SrcOtherStateData%GFORC0, kind=B8Ki) - UB(1:3) = ubound(SrcOtherStateData%GFORC0, kind=B8Ki) + LB(1:3) = lbound(SrcOtherStateData%GFORC0) + UB(1:3) = ubound(SrcOtherStateData%GFORC0) if (.not. allocated(DstOtherStateData%GFORC0)) then allocate(DstOtherStateData%GFORC0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1107,8 +1150,8 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%GFORC0 = SrcOtherStateData%GFORC0 end if if (allocated(SrcOtherStateData%GMASS0)) then - LB(1:4) = lbound(SrcOtherStateData%GMASS0, kind=B8Ki) - UB(1:4) = ubound(SrcOtherStateData%GMASS0, kind=B8Ki) + LB(1:4) = lbound(SrcOtherStateData%GMASS0) + UB(1:4) = ubound(SrcOtherStateData%GMASS0) if (.not. allocated(DstOtherStateData%GMASS0)) then allocate(DstOtherStateData%GMASS0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1119,8 +1162,8 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%GMASS0 = SrcOtherStateData%GMASS0 end if if (allocated(SrcOtherStateData%FAST_FPA)) then - LB(1:2) = lbound(SrcOtherStateData%FAST_FPA, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%FAST_FPA, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%FAST_FPA) + UB(1:2) = ubound(SrcOtherStateData%FAST_FPA) if (.not. allocated(DstOtherStateData%FAST_FPA)) then allocate(DstOtherStateData%FAST_FPA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1131,8 +1174,8 @@ subroutine FEAM_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%FAST_FPA = SrcOtherStateData%FAST_FPA end if if (allocated(SrcOtherStateData%FAST_RP)) then - LB(1:2) = lbound(SrcOtherStateData%FAST_RP, kind=B8Ki) - UB(1:2) = ubound(SrcOtherStateData%FAST_RP, kind=B8Ki) + LB(1:2) = lbound(SrcOtherStateData%FAST_RP) + UB(1:2) = ubound(SrcOtherStateData%FAST_RP) if (.not. allocated(DstOtherStateData%FAST_RP)) then allocate(DstOtherStateData%FAST_RP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1198,7 +1241,7 @@ subroutine FEAM_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(FEAM_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackOtherState' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1221,14 +1264,18 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + 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, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%GLF, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%GLF) + UB(1:2) = ubound(SrcMiscData%GLF) if (.not. allocated(DstMiscData%GLF)) then allocate(DstMiscData%GLF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1239,8 +1286,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%GLF = SrcMiscData%GLF end if if (allocated(SrcMiscData%GLK)) then - LB(1:3) = lbound(SrcMiscData%GLK, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%GLK, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%GLK) + UB(1:3) = ubound(SrcMiscData%GLK) if (.not. allocated(DstMiscData%GLK)) then allocate(DstMiscData%GLK(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1253,8 +1300,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%EMASS = SrcMiscData%EMASS DstMiscData%ESTIF = SrcMiscData%ESTIF if (allocated(SrcMiscData%FAST_FP)) then - LB(1:2) = lbound(SrcMiscData%FAST_FP, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%FAST_FP, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%FAST_FP) + UB(1:2) = ubound(SrcMiscData%FAST_FP) if (.not. allocated(DstMiscData%FAST_FP)) then allocate(DstMiscData%FAST_FP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1276,8 +1323,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%SLIN = SrcMiscData%SLIN DstMiscData%STIFR = SrcMiscData%STIFR if (allocated(SrcMiscData%FAIR_ANG)) then - LB(1:2) = lbound(SrcMiscData%FAIR_ANG, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%FAIR_ANG, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%FAIR_ANG) + UB(1:2) = ubound(SrcMiscData%FAIR_ANG) if (.not. allocated(DstMiscData%FAIR_ANG)) then allocate(DstMiscData%FAIR_ANG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1288,8 +1335,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FAIR_ANG = SrcMiscData%FAIR_ANG end if if (allocated(SrcMiscData%FAIR_T)) then - LB(1:1) = lbound(SrcMiscData%FAIR_T, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FAIR_T, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%FAIR_T) + UB(1:1) = ubound(SrcMiscData%FAIR_T) if (.not. allocated(DstMiscData%FAIR_T)) then allocate(DstMiscData%FAIR_T(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1300,8 +1347,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FAIR_T = SrcMiscData%FAIR_T end if if (allocated(SrcMiscData%ANCH_ANG)) then - LB(1:2) = lbound(SrcMiscData%ANCH_ANG, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%ANCH_ANG, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%ANCH_ANG) + UB(1:2) = ubound(SrcMiscData%ANCH_ANG) if (.not. allocated(DstMiscData%ANCH_ANG)) then allocate(DstMiscData%ANCH_ANG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1312,8 +1359,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%ANCH_ANG = SrcMiscData%ANCH_ANG end if if (allocated(SrcMiscData%ANCH_T)) then - LB(1:1) = lbound(SrcMiscData%ANCH_T, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%ANCH_T, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%ANCH_T) + UB(1:1) = ubound(SrcMiscData%ANCH_T) if (.not. allocated(DstMiscData%ANCH_T)) then allocate(DstMiscData%ANCH_T(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1324,8 +1371,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%ANCH_T = SrcMiscData%ANCH_T end if if (allocated(SrcMiscData%Line_Coordinate)) then - LB(1:3) = lbound(SrcMiscData%Line_Coordinate, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%Line_Coordinate, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%Line_Coordinate) + UB(1:3) = ubound(SrcMiscData%Line_Coordinate) if (.not. allocated(DstMiscData%Line_Coordinate)) then allocate(DstMiscData%Line_Coordinate(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1336,8 +1383,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Line_Coordinate = SrcMiscData%Line_Coordinate end if if (allocated(SrcMiscData%Line_Tangent)) then - LB(1:3) = lbound(SrcMiscData%Line_Tangent, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%Line_Tangent, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%Line_Tangent) + UB(1:3) = ubound(SrcMiscData%Line_Tangent) if (.not. allocated(DstMiscData%Line_Tangent)) then allocate(DstMiscData%Line_Tangent(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1348,8 +1395,8 @@ subroutine FEAM_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Line_Tangent = SrcMiscData%Line_Tangent end if if (allocated(SrcMiscData%F_Lines)) then - LB(1:2) = lbound(SrcMiscData%F_Lines, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_Lines, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_Lines) + UB(1:2) = ubound(SrcMiscData%F_Lines) if (.not. allocated(DstMiscData%F_Lines)) then allocate(DstMiscData%F_Lines(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -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) @@ -1437,10 +1489,11 @@ subroutine FEAM_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(FEAM_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackMisc' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) 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 @@ -1473,8 +1526,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FEAM_CopyParam' @@ -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 @@ -1489,8 +1554,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NHBD = SrcParamData%NHBD DstParamData%NDIM = SrcParamData%NDIM if (allocated(SrcParamData%NEQ)) then - LB(1:1) = lbound(SrcParamData%NEQ, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NEQ, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%NEQ) + UB(1:1) = ubound(SrcParamData%NEQ) if (.not. allocated(DstParamData%NEQ)) then allocate(DstParamData%NEQ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1505,8 +1570,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumElems = SrcParamData%NumElems DstParamData%NumNodes = SrcParamData%NumNodes if (allocated(SrcParamData%GSL)) then - LB(1:3) = lbound(SrcParamData%GSL, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%GSL, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%GSL) + UB(1:3) = ubound(SrcParamData%GSL) if (.not. allocated(DstParamData%GSL)) then allocate(DstParamData%GSL(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1517,8 +1582,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%GSL = SrcParamData%GSL end if if (allocated(SrcParamData%GP)) then - LB(1:2) = lbound(SrcParamData%GP, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%GP, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%GP) + UB(1:2) = ubound(SrcParamData%GP) if (.not. allocated(DstParamData%GP)) then allocate(DstParamData%GP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1529,8 +1594,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%GP = SrcParamData%GP end if if (allocated(SrcParamData%Elength)) then - LB(1:1) = lbound(SrcParamData%Elength, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Elength, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Elength) + UB(1:1) = ubound(SrcParamData%Elength) if (.not. allocated(DstParamData%Elength)) then allocate(DstParamData%Elength(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1541,8 +1606,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Elength = SrcParamData%Elength end if if (allocated(SrcParamData%BottmElev)) then - LB(1:1) = lbound(SrcParamData%BottmElev, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BottmElev, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%BottmElev) + UB(1:1) = ubound(SrcParamData%BottmElev) if (.not. allocated(DstParamData%BottmElev)) then allocate(DstParamData%BottmElev(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1553,8 +1618,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BottmElev = SrcParamData%BottmElev end if if (allocated(SrcParamData%BottmStiff)) then - LB(1:1) = lbound(SrcParamData%BottmStiff, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BottmStiff, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%BottmStiff) + UB(1:1) = ubound(SrcParamData%BottmStiff) if (.not. allocated(DstParamData%BottmStiff)) then allocate(DstParamData%BottmStiff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1565,8 +1630,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%BottmStiff = SrcParamData%BottmStiff end if if (allocated(SrcParamData%LMassDen)) then - LB(1:1) = lbound(SrcParamData%LMassDen, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%LMassDen, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%LMassDen) + UB(1:1) = ubound(SrcParamData%LMassDen) if (.not. allocated(DstParamData%LMassDen)) then allocate(DstParamData%LMassDen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1577,8 +1642,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%LMassDen = SrcParamData%LMassDen end if if (allocated(SrcParamData%LDMassDen)) then - LB(1:1) = lbound(SrcParamData%LDMassDen, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%LDMassDen, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%LDMassDen) + UB(1:1) = ubound(SrcParamData%LDMassDen) if (.not. allocated(DstParamData%LDMassDen)) then allocate(DstParamData%LDMassDen(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1589,8 +1654,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%LDMassDen = SrcParamData%LDMassDen end if if (allocated(SrcParamData%LEAStiff)) then - LB(1:1) = lbound(SrcParamData%LEAStiff, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%LEAStiff, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%LEAStiff) + UB(1:1) = ubound(SrcParamData%LEAStiff) if (.not. allocated(DstParamData%LEAStiff)) then allocate(DstParamData%LEAStiff(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1601,8 +1666,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%LEAStiff = SrcParamData%LEAStiff end if if (allocated(SrcParamData%LineCI)) then - LB(1:1) = lbound(SrcParamData%LineCI, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%LineCI, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%LineCI) + UB(1:1) = ubound(SrcParamData%LineCI) if (.not. allocated(DstParamData%LineCI)) then allocate(DstParamData%LineCI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1613,8 +1678,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%LineCI = SrcParamData%LineCI end if if (allocated(SrcParamData%LineCD)) then - LB(1:1) = lbound(SrcParamData%LineCD, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%LineCD, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%LineCD) + UB(1:1) = ubound(SrcParamData%LineCD) if (.not. allocated(DstParamData%LineCD)) then allocate(DstParamData%LineCD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1625,8 +1690,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%LineCD = SrcParamData%LineCD end if if (allocated(SrcParamData%Bvp)) then - LB(1:2) = lbound(SrcParamData%Bvp, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Bvp, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Bvp) + UB(1:2) = ubound(SrcParamData%Bvp) if (.not. allocated(DstParamData%Bvp)) then allocate(DstParamData%Bvp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1637,8 +1702,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Bvp = SrcParamData%Bvp end if if (allocated(SrcParamData%WaveAcc0)) then - LB(1:3) = lbound(SrcParamData%WaveAcc0, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%WaveAcc0, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%WaveAcc0) + UB(1:3) = ubound(SrcParamData%WaveAcc0) if (.not. allocated(DstParamData%WaveAcc0)) then allocate(DstParamData%WaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1649,8 +1714,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WaveAcc0 = SrcParamData%WaveAcc0 end if if (allocated(SrcParamData%WaveTime)) then - LB(1:1) = lbound(SrcParamData%WaveTime, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WaveTime, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WaveTime) + UB(1:1) = ubound(SrcParamData%WaveTime) if (.not. allocated(DstParamData%WaveTime)) then allocate(DstParamData%WaveTime(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1661,8 +1726,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WaveTime = SrcParamData%WaveTime end if if (allocated(SrcParamData%WaveVel0)) then - LB(1:3) = lbound(SrcParamData%WaveVel0, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%WaveVel0, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%WaveVel0) + UB(1:3) = ubound(SrcParamData%WaveVel0) if (.not. allocated(DstParamData%WaveVel0)) then allocate(DstParamData%WaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1694,8 +1759,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumOuts = SrcParamData%NumOuts DstParamData%RootName = SrcParamData%RootName if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + 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 @@ -1711,8 +1776,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%Delim = SrcParamData%Delim if (allocated(SrcParamData%GLUZR)) then - LB(1:3) = lbound(SrcParamData%GLUZR, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%GLUZR, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%GLUZR) + UB(1:3) = ubound(SrcParamData%GLUZR) if (.not. allocated(DstParamData%GLUZR)) then allocate(DstParamData%GLUZR(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1723,8 +1788,8 @@ subroutine FEAM_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%GLUZR = SrcParamData%GLUZR end if if (allocated(SrcParamData%GTZER)) then - LB(1:2) = lbound(SrcParamData%GTZER, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%GTZER, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%GTZER) + UB(1:2) = ubound(SrcParamData%GTZER) if (.not. allocated(DstParamData%GTZER)) then allocate(DstParamData%GTZER(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1740,13 +1805,19 @@ subroutine FEAM_DestroyParam(ParamData, ErrStat, ErrMsg) type(FEAM_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 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 @@ -1793,8 +1864,8 @@ subroutine FEAM_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%WaveVel0) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + 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) @@ -1813,11 +1884,19 @@ subroutine FEAM_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(FEAM_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'FEAM_PackParam' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + 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) @@ -1866,9 +1945,9 @@ subroutine FEAM_PackParam(RF, Indata) call RegPack(RF, InData%RootName) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + 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 @@ -1883,13 +1962,33 @@ subroutine FEAM_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(FEAM_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackParam' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: i1, i2, i3, i4 + 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 @@ -2013,15 +2112,15 @@ subroutine FEAM_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FEAM_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -2072,7 +2171,7 @@ subroutine FEAM_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(FEAM_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FEAM_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) 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 4b47ee2a95..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 @@ -106,7 +111,7 @@ subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyInitInput' ErrStat = ErrID_None @@ -117,8 +122,8 @@ subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%HighFreq = SrcInitInputData%HighFreq DstInitInputData%WAMITFile = SrcInitInputData%WAMITFile if (allocated(SrcInitInputData%HdroAddMs)) then - LB(1:3) = lbound(SrcInitInputData%HdroAddMs, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%HdroAddMs, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%HdroAddMs) + UB(1:3) = ubound(SrcInitInputData%HdroAddMs) if (.not. allocated(DstInitInputData%HdroAddMs)) then allocate(DstInitInputData%HdroAddMs(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -129,8 +134,8 @@ subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%HdroAddMs = SrcInitInputData%HdroAddMs end if if (allocated(SrcInitInputData%HdroFreq)) then - LB(1:1) = lbound(SrcInitInputData%HdroFreq, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%HdroFreq, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%HdroFreq) + UB(1:1) = ubound(SrcInitInputData%HdroFreq) if (.not. allocated(DstInitInputData%HdroFreq)) then allocate(DstInitInputData%HdroFreq(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -141,8 +146,8 @@ subroutine Conv_Rdtn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%HdroFreq = SrcInitInputData%HdroFreq end if if (allocated(SrcInitInputData%HdroDmpng)) then - LB(1:3) = lbound(SrcInitInputData%HdroDmpng, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%HdroDmpng, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%HdroDmpng) + UB(1:3) = ubound(SrcInitInputData%HdroDmpng) if (.not. allocated(DstInitInputData%HdroDmpng)) then allocate(DstInitInputData%HdroDmpng(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -196,7 +201,7 @@ subroutine Conv_Rdtn_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(Conv_Rdtn_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackInitInput' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -294,14 +299,14 @@ subroutine Conv_Rdtn_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%XDHistory)) then - LB(1:2) = lbound(SrcDiscStateData%XDHistory, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%XDHistory, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%XDHistory) + UB(1:2) = ubound(SrcDiscStateData%XDHistory) if (.not. allocated(DstDiscStateData%XDHistory)) then allocate(DstDiscStateData%XDHistory(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -340,7 +345,7 @@ subroutine Conv_Rdtn_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(Conv_Rdtn_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackDiscState' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -468,7 +473,7 @@ subroutine Conv_Rdtn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyParam' ErrStat = ErrID_None @@ -477,8 +482,8 @@ subroutine Conv_Rdtn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Er DstParamData%RdtnDT = SrcParamData%RdtnDT DstParamData%NBody = SrcParamData%NBody if (allocated(SrcParamData%RdtnKrnl)) then - LB(1:3) = lbound(SrcParamData%RdtnKrnl, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%RdtnKrnl, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%RdtnKrnl) + UB(1:3) = ubound(SrcParamData%RdtnKrnl) if (.not. allocated(DstParamData%RdtnKrnl)) then allocate(DstParamData%RdtnKrnl(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -522,7 +527,7 @@ subroutine Conv_Rdtn_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(Conv_Rdtn_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackParam' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -540,14 +545,14 @@ subroutine Conv_Rdtn_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%Velocity)) then - LB(1:1) = lbound(SrcInputData%Velocity, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%Velocity, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%Velocity) + UB(1:1) = ubound(SrcInputData%Velocity) if (.not. allocated(DstInputData%Velocity)) then allocate(DstInputData%Velocity(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -584,7 +589,7 @@ subroutine Conv_Rdtn_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(Conv_Rdtn_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -597,14 +602,14 @@ subroutine Conv_Rdtn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Conv_Rdtn_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%F_Rdtn)) then - LB(1:1) = lbound(SrcOutputData%F_Rdtn, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%F_Rdtn, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%F_Rdtn) + UB(1:1) = ubound(SrcOutputData%F_Rdtn) if (.not. allocated(DstOutputData%F_Rdtn)) then allocate(DstOutputData%F_Rdtn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -641,7 +646,7 @@ subroutine Conv_Rdtn_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(Conv_Rdtn_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Conv_Rdtn_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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 2bd7a8ab6e..c6caee100e 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 !---------------------------------------------------------------------------------------------------------------------------------- @@ -293,6 +293,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I p%vecMultiplier = InputFileData%vecMultiplier ! Multiply all vectors and matrices row/column lengths by NBody InputFileData%WAMIT%NBodyMod = InputFileData%NBodyMod InputFileData%WAMIT%Gravity = InitInp%Gravity + InputFileData%WAMIT%PlatformPos = InitInp%PlatformPos ! Initial platform/HD origin position p%NBody = InputFileData%NBody p%NBodyMod = InputFileData%NBodyMod call AllocAry( m%F_PtfmAdd, 6*InputFileData%NBody, "m%F_PtfmAdd", ErrStat2, ErrMsg2 ); call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -639,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 @@ -837,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! @@ -932,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. @@ -1259,7 +1408,7 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, END IF IF ( (ABS( WrapToPi(PRPRotation(3)-PtfmRefY) ) > LrgAngle) .AND. FrstWarn_LrgY ) THEN ErrStat2 = ErrID_Severe - ErrMsg2 = 'Yaw angle at PRP relative to the reference yaw position (PtfmRefY) violated the small angle assumption. The solution might be inaccurate. Consider using PtfmYMod=1 and adjust PtfmYCutoff in ElastoDyn. Simulation continuing, but future warnings will be suppressed.' + ErrMsg2 = 'Yaw angle at PRP relative to the reference yaw position (PtfmRefY) violated the small angle assumption. The solution might be inaccurate. Consider using PtfmYMod=1 and adjust PtfmYCutoff. Simulation continuing, but future warnings will be suppressed.' call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FrstWarn_LrgY = .FALSE. END IF @@ -1601,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 @@ -1627,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 @@ -1755,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, @@ -1812,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 @@ -1840,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 @@ -1850,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 @@ -1891,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 @@ -2029,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 @@ -2074,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 @@ -2144,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 42014e9639..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) @@ -71,17 +76,18 @@ typedef HydroDyn/HydroDyn InitInputType CHARACTER(1 typedef ^ ^ LOGICAL UseInputFile - .TRUE. - "Supplied by Driver: .TRUE. if using a input file, .FALSE. if all inputs are being passed in by the caller" - typedef ^ ^ FileInfoType PassedFileData - - - "If we don't use the input file, pass everything through this" - typedef ^ ^ CHARACTER(1024) OutRootName - - - "Supplied by Driver: The name of the root file (without extension) including the full path" - -typedef ^ ^ Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - +typedef ^ ^ Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - typedef ^ ^ ReKi Gravity - - - "Supplied by Driver: Gravitational acceleration" "(m/s^2)" typedef ^ ^ DbKi TMax - - - "Supplied by Driver: The total simulation time" "(sec)" typedef ^ ^ logical VisMeshes - .false. - "Output visualization meshes" - -# typedef ^ ^ LOGICAL InvalidWithSSExctn - - - "Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2)" (-) typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to SeaState wave field" - +typedef ^ ^ ReKi PlatformPos {6} - - "Initial platform position (6 DOFs)" # # # 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 1502bbace3..4c2ccf61bb 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -240,23 +240,6 @@ PROGRAM HydroDynDriver CALL SetHDInputs(0.0_R8Ki, n, u(1), mappingData, drvrData, ErrStat, ErrMsg); CALL CheckError() END IF - ! Set the initial low-pass-filtered displacements of potential-flow bodies if ExctnDisp = 2 - IF ( p%PotMod == 1_IntKi ) THEN - IF ( p%WAMIT(1)%ExctnDisp == 2_IntKi ) THEN - IF (p%NBodyMod .EQ. 1_IntKi) THEN ! One instance of WAMIT with NBody - DO i = 1,p%NBody - xd%WAMIT(1)%BdyPosFilt(1,i,:) = u(1)%WAMITMesh%TranslationDisp(1,i) - xd%WAMIT(1)%BdyPosFilt(2,i,:) = u(1)%WAMITMesh%TranslationDisp(2,i) - END DO - ELSE IF (p%NBodyMod > 1_IntKi) THEN ! NBody instances of WAMIT with one body each - DO i = 1,p%NBody - xd%WAMIT(i)%BdyPosFilt(1,1,:) = u(1)%WAMITMesh%TranslationDisp(1,i) - xd%WAMIT(i)%BdyPosFilt(2,1,:) = u(1)%WAMITMesh%TranslationDisp(2,i) - END DO - END IF - END IF - END IF - !............................................................................................................................... ! --- Linearization !............................................................................................................................... @@ -348,6 +331,12 @@ subroutine SetHD_InitInputs() InitInData_HD%WaveField => InitOutData_SeaSt%WaveField + IF (( drvrData%PRPInputsMod /= 2 ) .AND. ( drvrData%PRPInputsMod >= 0 )) THEN + InitInData_HD%PlatformPos = drvrData%uPRPInSteady + ELSE + InitInData_HD%PlatformPos = drvrData%PRPin(1,1:6) + END IF + end subroutine SetHD_InitInputs !---------------------------------------------------------------------------------------------------------------------------------- subroutine CheckError() 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 b7aff180f5..67b443815a 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -157,7 +157,7 @@ SUBROUTINE HydroDyn_ParseInput( InputFileName, OutRootName, FileInfo_In, InputFi call ParseVar( FileInfo_In, CurLine, 'PtfmYCutOff', InputFileData%PtfmYCutOff, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return - ! NExctnHdg - Number of PRP headings/yaw offset evenly distributed in the range of [-180, 180) deg to precompute [used only when PtfmYMod = 1 in the HD driver or ElastoDyn] + ! NExctnHdg - Number of PRP headings/yaw offset evenly distributed in the range of [-180, 180) deg to precompute [used only when PtfmYMod = 1] call ParseVar( FileInfo_In, CurLine, 'NExctnHdg', InputFileData%WAMIT%NExctnHdg, ErrStat2, ErrMsg2, UnEc ) if (Failed()) return; InputFileData%WAMIT2%NExctnHdg = InputFileData%WAMIT%NExctnHdg @@ -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; @@ -1911,19 +1911,19 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS RETURN END IF IF ( InputFileData%Morison%CoefMembers(I)%MemberAxCa1 < 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberCa1 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberAxCa1 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) RETURN END IF IF ( InputFileData%Morison%CoefMembers(I)%MemberAxCa2 < 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberCa2 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberAxCa2 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) RETURN END IF IF ( InputFileData%Morison%CoefMembers(I)%MemberAxCaMG1 < 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberCaMG1 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberAxCaMG1 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) RETURN END IF IF ( InputFileData%Morison%CoefMembers(I)%MemberAxCaMG2 < 0 ) THEN - CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberCaMG2 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) + CALL SetErrStat( ErrID_Fatal,'In the member-based hydrodynamic coefficients table, MemberAxCaMG2 must be greater or equal to zero.',ErrStat,ErrMsg,RoutineName) RETURN END IF IF ( InputFileData%Morison%CoefMembers(I)%MemberCb1 < 0 ) THEN @@ -2226,11 +2226,11 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS CALL SetErrStat( ErrID_Fatal, 'PtfmYCutOff must be greater than 0 Hz.',ErrStat,ErrMsg,RoutineName) end if if ( InputFileData%Morison%WaveDisp == 0 .AND. InputFileData%Morison%NMembers > 0 ) then - call SetErrStat( ErrID_Fatal,'Dynamic reference yaw offset (PtfmYMod=1) in ElastoDyn or HydroDyn driver cannot be used with WaveDisp=0. Set WaveDisp=1.',ErrStat,ErrMsg,RoutineName) + call SetErrStat( ErrID_Fatal,'Dynamic reference yaw offset (PtfmYMod=1) cannot be used with WaveDisp=0. Set WaveDisp=1.',ErrStat,ErrMsg,RoutineName) return end if if ( InputFileData%PotMod > 0 .AND. InputFileData%WAMIT%ExctnMod == 2 ) then - call SetErrStat( ErrID_Fatal, 'Dynamic reference yaw offset (PtfmYMod=1) in ElastoDyn or HydroDyn driver cannot be used with State-space wave excitations. Set ExctnMod=0 or 1.', ErrStat, ErrMsg, RoutineName ) + call SetErrStat( ErrID_Fatal,'Dynamic reference yaw offset (PtfmYMod=1) cannot be used with state-space wave excitations. Set ExctnMod=0 or 1.', ErrStat, ErrMsg, RoutineName ) return end if if ( InputFileData%PotMod > 0 .AND. InputFileData%WAMIT%NExctnHdg < 2 ) then @@ -2238,7 +2238,7 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS return end if if ( InputFileData%WAMIT2%SumQTFF .OR. InputFileData%WAMIT2%DiffQTFF ) then - call SetErrStat( ErrID_Fatal, 'Dynamic reference yaw offset (PtfmYMod=1) in ElastoDyn or HydroDyn driver cannot be used with full sum-frequency or difference-frequency QTFs. Set SumQTF and DiffQTF to 0.', ErrStat, ErrMsg, RoutineName ) + call SetErrStat( ErrID_Fatal, 'Dynamic reference yaw offset (PtfmYMod=1) cannot be used with full sum-frequency or difference-frequency QTFs. Set SumQTF and DiffQTF to 0.', ErrStat, ErrMsg, RoutineName ) return end if END IF diff --git a/modules/hydrodyn/src/HydroDyn_Output.f90 b/modules/hydrodyn/src/HydroDyn_Output.f90 index 7a971b36b2..45a7450afa 100644 --- a/modules/hydrodyn/src/HydroDyn_Output.f90 +++ b/modules/hydrodyn/src/HydroDyn_Output.f90 @@ -855,7 +855,7 @@ SUBROUTINE HDOut_MapOutputs( p, y, m_WAMIT, m_WAMIT2, F_Add, F_Waves, F_Hydro, P ! Need to use individual components of force for output reporting, the y%mesh data has total forces from all contributions if ( p%potMod == 1 ) then if ( p%NBodyMod == 1 .or. p%NBody == 1 ) then - do iBody = 1,p%NBody + do iBody = 1,min(p%NBody,9) ! Can only output the first 9 bodies for now startIndx = 6*(iBody-1) + 1 endIndx = startIndx + 5 AllOuts(FWaves1 (:,iBody)) = m_WAMIT(1)%F_Waves1(startIndx:endIndx) @@ -873,7 +873,7 @@ SUBROUTINE HDOut_MapOutputs( p, y, m_WAMIT, m_WAMIT2, F_Add, F_Waves, F_Hydro, P ! This happens when NBodyMod > 1, in which case, each WAMIT object is for a single body, but there may be multiple bodies in the HydroDyn model, ! so we need to use BodyID to determine the index into the complete HydroDyn list of WAMIT bodies - do iBody = 1,p%NBody + do iBody = 1,min(p%NBody,9) ! Can only output the first 9 bodies for now startIndx = 6*(iBody-1) + 1 endIndx = startIndx + 5 AllOuts(FWaves1 (:,iBody)) = m_WAMIT(iBody)%F_Waves1 diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index bd0e1cac49..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 [-] @@ -94,10 +98,12 @@ MODULE HydroDyn_Types LOGICAL :: VisMeshes = .false. !< Output visualization meshes [-] LOGICAL :: InvalidWithSSExctn = .false. !< Whether SeaState configuration is invalid with HydroDyn's state-space excitation (ExctnMod=2) [(-)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to SeaState wave field [-] + REAL(ReKi) , DIMENSION(1:6) :: PlatformPos = 0.0_ReKi !< Initial platform position (6 DOFs) [-] END TYPE HydroDyn_InitInputType ! ======================= ! ========= 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) [-] @@ -141,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 [-] @@ -210,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 @@ -218,7 +249,7 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyInputFile' @@ -226,8 +257,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrMsg = '' DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag if (allocated(SrcInputFileData%AddF0)) then - LB(1:2) = lbound(SrcInputFileData%AddF0, kind=B8Ki) - UB(1:2) = ubound(SrcInputFileData%AddF0, kind=B8Ki) + LB(1:2) = lbound(SrcInputFileData%AddF0) + UB(1:2) = ubound(SrcInputFileData%AddF0) if (.not. allocated(DstInputFileData%AddF0)) then allocate(DstInputFileData%AddF0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -238,8 +269,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%AddF0 = SrcInputFileData%AddF0 end if if (allocated(SrcInputFileData%AddCLin)) then - LB(1:3) = lbound(SrcInputFileData%AddCLin, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%AddCLin, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%AddCLin) + UB(1:3) = ubound(SrcInputFileData%AddCLin) if (.not. allocated(DstInputFileData%AddCLin)) then allocate(DstInputFileData%AddCLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -250,8 +281,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%AddCLin = SrcInputFileData%AddCLin end if if (allocated(SrcInputFileData%AddBLin)) then - LB(1:3) = lbound(SrcInputFileData%AddBLin, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%AddBLin, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%AddBLin) + UB(1:3) = ubound(SrcInputFileData%AddBLin) if (.not. allocated(DstInputFileData%AddBLin)) then allocate(DstInputFileData%AddBLin(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -262,8 +293,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%AddBLin = SrcInputFileData%AddBLin end if if (allocated(SrcInputFileData%AddBQuad)) then - LB(1:3) = lbound(SrcInputFileData%AddBQuad, kind=B8Ki) - UB(1:3) = ubound(SrcInputFileData%AddBQuad, kind=B8Ki) + LB(1:3) = lbound(SrcInputFileData%AddBQuad) + UB(1:3) = ubound(SrcInputFileData%AddBQuad) if (.not. allocated(DstInputFileData%AddBQuad)) then allocate(DstInputFileData%AddBQuad(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -274,8 +305,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%AddBQuad = SrcInputFileData%AddBQuad end if if (allocated(SrcInputFileData%PotFile)) then - LB(1:1) = lbound(SrcInputFileData%PotFile, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%PotFile, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%PotFile) + UB(1:1) = ubound(SrcInputFileData%PotFile) if (.not. allocated(DstInputFileData%PotFile)) then allocate(DstInputFileData%PotFile(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -290,8 +321,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%NBody = SrcInputFileData%NBody DstInputFileData%NBodyMod = SrcInputFileData%NBodyMod if (allocated(SrcInputFileData%PtfmVol0)) then - LB(1:1) = lbound(SrcInputFileData%PtfmVol0, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%PtfmVol0, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%PtfmVol0) + UB(1:1) = ubound(SrcInputFileData%PtfmVol0) if (.not. allocated(DstInputFileData%PtfmVol0)) then allocate(DstInputFileData%PtfmVol0(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -303,8 +334,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, end if DstInputFileData%HasWAMIT = SrcInputFileData%HasWAMIT if (allocated(SrcInputFileData%WAMITULEN)) then - LB(1:1) = lbound(SrcInputFileData%WAMITULEN, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%WAMITULEN, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%WAMITULEN) + UB(1:1) = ubound(SrcInputFileData%WAMITULEN) if (.not. allocated(DstInputFileData%WAMITULEN)) then allocate(DstInputFileData%WAMITULEN(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -315,8 +346,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%WAMITULEN = SrcInputFileData%WAMITULEN end if if (allocated(SrcInputFileData%PtfmRefxt)) then - LB(1:1) = lbound(SrcInputFileData%PtfmRefxt, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%PtfmRefxt, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%PtfmRefxt) + UB(1:1) = ubound(SrcInputFileData%PtfmRefxt) if (.not. allocated(DstInputFileData%PtfmRefxt)) then allocate(DstInputFileData%PtfmRefxt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -327,8 +358,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%PtfmRefxt = SrcInputFileData%PtfmRefxt end if if (allocated(SrcInputFileData%PtfmRefyt)) then - LB(1:1) = lbound(SrcInputFileData%PtfmRefyt, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%PtfmRefyt, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%PtfmRefyt) + UB(1:1) = ubound(SrcInputFileData%PtfmRefyt) if (.not. allocated(DstInputFileData%PtfmRefyt)) then allocate(DstInputFileData%PtfmRefyt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -339,8 +370,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%PtfmRefyt = SrcInputFileData%PtfmRefyt end if if (allocated(SrcInputFileData%PtfmRefzt)) then - LB(1:1) = lbound(SrcInputFileData%PtfmRefzt, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%PtfmRefzt, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%PtfmRefzt) + UB(1:1) = ubound(SrcInputFileData%PtfmRefzt) if (.not. allocated(DstInputFileData%PtfmRefzt)) then allocate(DstInputFileData%PtfmRefzt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -351,8 +382,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%PtfmRefzt = SrcInputFileData%PtfmRefzt end if if (allocated(SrcInputFileData%PtfmRefztRot)) then - LB(1:1) = lbound(SrcInputFileData%PtfmRefztRot, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%PtfmRefztRot, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%PtfmRefztRot) + UB(1:1) = ubound(SrcInputFileData%PtfmRefztRot) if (.not. allocated(DstInputFileData%PtfmRefztRot)) then allocate(DstInputFileData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -363,8 +394,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%PtfmRefztRot = SrcInputFileData%PtfmRefztRot end if if (allocated(SrcInputFileData%PtfmCOBxt)) then - LB(1:1) = lbound(SrcInputFileData%PtfmCOBxt, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%PtfmCOBxt, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%PtfmCOBxt) + UB(1:1) = ubound(SrcInputFileData%PtfmCOBxt) if (.not. allocated(DstInputFileData%PtfmCOBxt)) then allocate(DstInputFileData%PtfmCOBxt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -375,8 +406,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%PtfmCOBxt = SrcInputFileData%PtfmCOBxt end if if (allocated(SrcInputFileData%PtfmCOByt)) then - LB(1:1) = lbound(SrcInputFileData%PtfmCOByt, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%PtfmCOByt, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%PtfmCOByt) + UB(1:1) = ubound(SrcInputFileData%PtfmCOByt) if (.not. allocated(DstInputFileData%PtfmCOByt)) then allocate(DstInputFileData%PtfmCOByt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -399,8 +430,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%PotMod = SrcInputFileData%PotMod DstInputFileData%NUserOutputs = SrcInputFileData%NUserOutputs if (allocated(SrcInputFileData%UserOutputs)) then - LB(1:1) = lbound(SrcInputFileData%UserOutputs, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%UserOutputs, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%UserOutputs) + UB(1:1) = ubound(SrcInputFileData%UserOutputs) if (.not. allocated(DstInputFileData%UserOutputs)) then allocate(DstInputFileData%UserOutputs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -414,8 +445,8 @@ subroutine HydroDyn_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, DstInputFileData%OutAll = SrcInputFileData%OutAll DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -545,7 +576,7 @@ subroutine HydroDyn_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(HydroDyn_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackInputFile' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -594,7 +625,7 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(0), UB(0) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyInitInput' @@ -612,6 +643,7 @@ subroutine HydroDyn_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, DstInitInputData%VisMeshes = SrcInitInputData%VisMeshes DstInitInputData%InvalidWithSSExctn = SrcInitInputData%InvalidWithSSExctn DstInitInputData%WaveField => SrcInitInputData%WaveField + DstInitInputData%PlatformPos = SrcInitInputData%PlatformPos end subroutine subroutine HydroDyn_DestroyInitInput(InitInputData, ErrStat, ErrMsg) @@ -650,6 +682,7 @@ subroutine HydroDyn_PackInitInput(RF, Indata) call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if + call RegPack(RF, InData%PlatformPos) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -657,7 +690,7 @@ subroutine HydroDyn_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(HydroDyn_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackInitInput' - integer(B8Ki) :: LB(0), UB(0) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -690,6 +723,7 @@ subroutine HydroDyn_UnPackInitInput(RF, OutData) else OutData%WaveField => null() end if + call RegUnpack(RF, OutData%PlatformPos); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -698,18 +732,21 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 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 if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -720,8 +757,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -735,8 +772,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) + 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 @@ -747,8 +784,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -759,8 +796,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) + 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 @@ -771,8 +808,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -783,8 +820,8 @@ subroutine HydroDyn_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCod DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + 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 @@ -805,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 @@ -837,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) @@ -853,10 +893,11 @@ subroutine HydroDyn_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(HydroDyn_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) 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 @@ -934,16 +975,16 @@ subroutine HydroDyn_CopyContState(SrcContStateData, DstContStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%WAMIT)) then - LB(1:1) = lbound(SrcContStateData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%WAMIT, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%WAMIT) + UB(1:1) = ubound(SrcContStateData%WAMIT) if (.not. allocated(DstContStateData%WAMIT)) then allocate(DstContStateData%WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -966,16 +1007,16 @@ subroutine HydroDyn_DestroyContState(ContStateData, ErrStat, ErrMsg) type(HydroDyn_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%WAMIT)) then - LB(1:1) = lbound(ContStateData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(ContStateData%WAMIT, kind=B8Ki) + LB(1:1) = lbound(ContStateData%WAMIT) + UB(1:1) = ubound(ContStateData%WAMIT) do i1 = LB(1), UB(1) call WAMIT_DestroyContState(ContStateData%WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -990,14 +1031,14 @@ subroutine HydroDyn_PackContState(RF, Indata) type(RegFile), intent(inout) :: RF type(HydroDyn_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) + 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_PackContState(RF, InData%WAMIT(i1)) end do @@ -1010,8 +1051,8 @@ subroutine HydroDyn_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(HydroDyn_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1037,16 +1078,16 @@ subroutine HydroDyn_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%WAMIT)) then - LB(1:1) = lbound(SrcDiscStateData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%WAMIT, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%WAMIT) + UB(1:1) = ubound(SrcDiscStateData%WAMIT) if (.not. allocated(DstDiscStateData%WAMIT)) then allocate(DstDiscStateData%WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1064,8 +1105,8 @@ subroutine HydroDyn_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcDiscStateData%PtfmRefY)) then - LB(1:1) = lbound(SrcDiscStateData%PtfmRefY, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%PtfmRefY, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%PtfmRefY) + UB(1:1) = ubound(SrcDiscStateData%PtfmRefY) if (.not. allocated(DstDiscStateData%PtfmRefY)) then allocate(DstDiscStateData%PtfmRefY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1081,16 +1122,16 @@ subroutine HydroDyn_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) type(HydroDyn_DiscreteStateType), intent(inout) :: DiscStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(DiscStateData%WAMIT)) then - LB(1:1) = lbound(DiscStateData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(DiscStateData%WAMIT, kind=B8Ki) + LB(1:1) = lbound(DiscStateData%WAMIT) + UB(1:1) = ubound(DiscStateData%WAMIT) do i1 = LB(1), UB(1) call WAMIT_DestroyDiscState(DiscStateData%WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1108,14 +1149,14 @@ subroutine HydroDyn_PackDiscState(RF, Indata) type(RegFile), intent(inout) :: RF type(HydroDyn_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) + 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_PackDiscState(RF, InData%WAMIT(i1)) end do @@ -1129,8 +1170,8 @@ subroutine HydroDyn_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(HydroDyn_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1210,16 +1251,16 @@ subroutine HydroDyn_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCod integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%WAMIT)) then - LB(1:1) = lbound(SrcOtherStateData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%WAMIT, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%WAMIT) + UB(1:1) = ubound(SrcOtherStateData%WAMIT) if (.not. allocated(DstOtherStateData%WAMIT)) then allocate(DstOtherStateData%WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1242,16 +1283,16 @@ subroutine HydroDyn_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(HydroDyn_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%WAMIT)) then - LB(1:1) = lbound(OtherStateData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%WAMIT, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%WAMIT) + UB(1:1) = ubound(OtherStateData%WAMIT) do i1 = LB(1), UB(1) call WAMIT_DestroyOtherState(OtherStateData%WAMIT(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1266,14 +1307,14 @@ subroutine HydroDyn_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(HydroDyn_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) + 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_PackOtherState(RF, InData%WAMIT(i1)) end do @@ -1286,8 +1327,8 @@ subroutine HydroDyn_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(HydroDyn_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1307,268 +1348,14 @@ 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 - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'HydroDyn_CopyMisc' - ErrStat = ErrID_None - ErrMsg = '' - call MeshCopy(SrcMiscData%AllHdroOrigin, DstMiscData%AllHdroOrigin, CtrlCode, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call HydroDyn_CopyHD_ModuleMapType(SrcMiscData%HD_MeshMap, DstMiscData%HD_MeshMap, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - DstMiscData%Decimate = SrcMiscData%Decimate - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - if (allocated(SrcMiscData%F_PtfmAdd)) then - LB(1:1) = lbound(SrcMiscData%F_PtfmAdd, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_PtfmAdd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_Waves, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%WAMIT, kind=B8Ki) - if (.not. allocated(DstMiscData%WAMIT)) then - allocate(DstMiscData%WAMIT(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call WAMIT_CopyMisc(SrcMiscData%WAMIT(i1), DstMiscData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - if (allocated(SrcMiscData%WAMIT2)) then - LB(1:1) = lbound(SrcMiscData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%WAMIT2, kind=B8Ki) - if (.not. allocated(DstMiscData%WAMIT2)) then - allocate(DstMiscData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT2.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call WAMIT2_CopyMisc(SrcMiscData%WAMIT2(i1), DstMiscData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if - call Morison_CopyMisc(SrcMiscData%Morison, DstMiscData%Morison, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcMiscData%u_WAMIT)) then - LB(1:1) = lbound(SrcMiscData%u_WAMIT, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%u_WAMIT, kind=B8Ki) - if (.not. allocated(DstMiscData%u_WAMIT)) then - allocate(DstMiscData%u_WAMIT(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_WAMIT.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call WAMIT_CopyInput(SrcMiscData%u_WAMIT(i1), DstMiscData%u_WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if -end subroutine - -subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) - type(HydroDyn_MiscVarType), intent(inout) :: MiscData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'HydroDyn_DestroyMisc' - ErrStat = ErrID_None - ErrMsg = '' - call MeshDestroy( MiscData%AllHdroOrigin, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call HydroDyn_DestroyHD_ModuleMapType(MiscData%HD_MeshMap, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MiscData%F_PtfmAdd)) then - deallocate(MiscData%F_PtfmAdd) - end if - if (allocated(MiscData%F_Waves)) then - deallocate(MiscData%F_Waves) - end if - if (allocated(MiscData%WAMIT)) then - LB(1:1) = lbound(MiscData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(MiscData%WAMIT, kind=B8Ki) - do i1 = LB(1), UB(1) - call WAMIT_DestroyMisc(MiscData%WAMIT(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%WAMIT) - end if - if (allocated(MiscData%WAMIT2)) then - LB(1:1) = lbound(MiscData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(MiscData%WAMIT2, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(MiscData%u_WAMIT, kind=B8Ki) - 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(B8Ki) :: i1 - integer(B8Ki) :: 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, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%WAMIT2, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT2, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%u_WAMIT, kind=B8Ki)) - LB(1:1) = lbound(InData%u_WAMIT, kind=B8Ki) - UB(1:1) = ubound(InData%u_WAMIT, kind=B8Ki) - 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(B8Ki) :: i1 - integer(B8Ki) :: 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(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyParam' @@ -1577,8 +1364,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%nWAMITObj = SrcParamData%nWAMITObj DstParamData%vecMultiplier = SrcParamData%vecMultiplier if (allocated(SrcParamData%WAMIT)) then - LB(1:1) = lbound(SrcParamData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WAMIT, kind=B8Ki) + 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 @@ -1593,8 +1380,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err end do end if if (allocated(SrcParamData%WAMIT2)) then - LB(1:1) = lbound(SrcParamData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WAMIT2, kind=B8Ki) + 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 @@ -1619,8 +1406,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%totalExctnStates = SrcParamData%totalExctnStates DstParamData%totalRdtnStates = SrcParamData%totalRdtnStates if (allocated(SrcParamData%AddF0)) then - LB(1:2) = lbound(SrcParamData%AddF0, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%AddF0, kind=B8Ki) + 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 @@ -1631,8 +1418,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%AddF0 = SrcParamData%AddF0 end if if (allocated(SrcParamData%AddCLin)) then - LB(1:3) = lbound(SrcParamData%AddCLin, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AddCLin, kind=B8Ki) + 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 @@ -1643,8 +1430,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%AddCLin = SrcParamData%AddCLin end if if (allocated(SrcParamData%AddBLin)) then - LB(1:3) = lbound(SrcParamData%AddBLin, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AddBLin, kind=B8Ki) + 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 @@ -1655,8 +1442,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%AddBLin = SrcParamData%AddBLin end if if (allocated(SrcParamData%AddBQuad)) then - LB(1:3) = lbound(SrcParamData%AddBQuad, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AddBQuad, kind=B8Ki) + 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 @@ -1668,8 +1455,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err end if DstParamData%DT = SrcParamData%DT if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + 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 @@ -1692,8 +1479,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%UnOutFile = SrcParamData%UnOutFile DstParamData%OutDec = SrcParamData%OutDec if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) + 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 @@ -1704,8 +1491,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx end if if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) + 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 @@ -1716,8 +1503,8 @@ subroutine HydroDyn_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, Err DstParamData%du = SrcParamData%du end if if (allocated(SrcParamData%dx)) then - LB(1:1) = lbound(SrcParamData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dx, kind=B8Ki) + 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 @@ -1738,16 +1525,16 @@ subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) type(HydroDyn_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + 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, kind=B8Ki) - UB(1:1) = ubound(ParamData%WAMIT, kind=B8Ki) + 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) @@ -1755,8 +1542,8 @@ subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%WAMIT) end if if (allocated(ParamData%WAMIT2)) then - LB(1:1) = lbound(ParamData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(ParamData%WAMIT2, kind=B8Ki) + LB(1:1) = lbound(ParamData%WAMIT2) + UB(1:1) = ubound(ParamData%WAMIT2) do i1 = LB(1), UB(1) call WAMIT2_DestroyParam(ParamData%WAMIT2(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1778,8 +1565,8 @@ subroutine HydroDyn_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%AddBQuad) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + 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) @@ -1802,26 +1589,26 @@ subroutine HydroDyn_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(HydroDyn_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%nWAMITObj) call RegPack(RF, InData%vecMultiplier) call RegPack(RF, allocated(InData%WAMIT)) if (allocated(InData%WAMIT)) then - call RegPackBounds(RF, 1, lbound(InData%WAMIT, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) + 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_PackParam(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, kind=B8Ki), ubound(InData%WAMIT2, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT2, kind=B8Ki) + 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_PackParam(RF, InData%WAMIT2(i1)) end do @@ -1841,9 +1628,9 @@ subroutine HydroDyn_PackParam(RF, Indata) call RegPack(RF, InData%DT) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + 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 @@ -1877,8 +1664,8 @@ subroutine HydroDyn_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(HydroDyn_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -2039,16 +1826,16 @@ subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'HydroDyn_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%WAMIT)) then - LB(1:1) = lbound(SrcOutputData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WAMIT, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WAMIT) + UB(1:1) = ubound(SrcOutputData%WAMIT) if (.not. allocated(DstOutputData%WAMIT)) then allocate(DstOutputData%WAMIT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2063,8 +1850,8 @@ subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, end do end if if (allocated(SrcOutputData%WAMIT2)) then - LB(1:1) = lbound(SrcOutputData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WAMIT2, kind=B8Ki) + 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 @@ -2085,8 +1872,8 @@ subroutine HydroDyn_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -2102,16 +1889,16 @@ subroutine HydroDyn_DestroyOutput(OutputData, ErrStat, ErrMsg) type(HydroDyn_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki) - UB(1:1) = ubound(OutputData%WAMIT, kind=B8Ki) + 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) @@ -2119,8 +1906,8 @@ subroutine HydroDyn_DestroyOutput(OutputData, ErrStat, ErrMsg) deallocate(OutputData%WAMIT) end if if (allocated(OutputData%WAMIT2)) then - LB(1:1) = lbound(OutputData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(OutputData%WAMIT2, kind=B8Ki) + 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) @@ -2140,23 +1927,23 @@ subroutine HydroDyn_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(HydroDyn_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'HydroDyn_PackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki), ubound(InData%WAMIT, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT, kind=B8Ki) + 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, kind=B8Ki), ubound(InData%WAMIT2, kind=B8Ki)) - LB(1:1) = lbound(InData%WAMIT2, kind=B8Ki) - UB(1:1) = ubound(InData%WAMIT2, kind=B8Ki) + 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 @@ -2171,8 +1958,8 @@ subroutine HydroDyn_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(HydroDyn_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'HydroDyn_UnPackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2207,7 +1994,296 @@ subroutine HydroDyn_UnPackOutput(RF, OutData) call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine HydroDyn_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) +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_CopyMisc(SrcMiscData%WAMIT(i1), DstMiscData%WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcMiscData%WAMIT2)) then + LB(1:1) = lbound(SrcMiscData%WAMIT2) + UB(1:1) = ubound(SrcMiscData%WAMIT2) + if (.not. allocated(DstMiscData%WAMIT2)) then + allocate(DstMiscData%WAMIT2(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%WAMIT2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT2_CopyMisc(SrcMiscData%WAMIT2(i1), DstMiscData%WAMIT2(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + call Morison_CopyMisc(SrcMiscData%Morison, DstMiscData%Morison, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMiscData%u_WAMIT)) then + LB(1:1) = lbound(SrcMiscData%u_WAMIT) + UB(1:1) = ubound(SrcMiscData%u_WAMIT) + if (.not. allocated(DstMiscData%u_WAMIT)) then + allocate(DstMiscData%u_WAMIT(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_WAMIT.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call WAMIT_CopyInput(SrcMiscData%u_WAMIT(i1), DstMiscData%u_WAMIT(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if +end subroutine + +subroutine HydroDyn_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(HydroDyn_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'HydroDyn_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + 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_DestroyMisc(MiscData%WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%WAMIT) + end if + if (allocated(MiscData%WAMIT2)) then + LB(1:1) = lbound(MiscData%WAMIT2) + UB(1:1) = ubound(MiscData%WAMIT2) + do i1 = LB(1), UB(1) + call WAMIT2_DestroyMisc(MiscData%WAMIT2(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%WAMIT2) + end if + call Morison_DestroyMisc(MiscData%Morison, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(MiscData%u_WAMIT)) then + LB(1:1) = lbound(MiscData%u_WAMIT) + UB(1:1) = ubound(MiscData%u_WAMIT) + do i1 = LB(1), UB(1) + call WAMIT_DestroyInput(MiscData%u_WAMIT(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%u_WAMIT) + end if +end subroutine + +subroutine HydroDyn_PackMisc(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 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_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 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 + 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_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg) ! ! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time ! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u @@ -2469,13 +2545,13 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, E a2 = t_out/t(2) IF (ALLOCATED(y_out%WAMIT) .AND. ALLOCATED(y1%WAMIT)) THEN - DO i1 = LBOUND(y_out%WAMIT,1, kind=B8Ki),UBOUND(y_out%WAMIT,1, kind=B8Ki) + do i1 = lbound(y_out%WAMIT,1),ubound(y_out%WAMIT,1) CALL WAMIT_Output_ExtrapInterp1( y1%WAMIT(i1), y2%WAMIT(i1), tin, y_out%WAMIT(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%WAMIT2) .AND. ALLOCATED(y1%WAMIT2)) THEN - DO i1 = LBOUND(y_out%WAMIT2,1, kind=B8Ki),UBOUND(y_out%WAMIT2,1, kind=B8Ki) + do i1 = lbound(y_out%WAMIT2,1),ubound(y_out%WAMIT2,1) CALL WAMIT2_Output_ExtrapInterp1( y1%WAMIT2(i1), y2%WAMIT2(i1), tin, y_out%WAMIT2(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -2545,13 +2621,13 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSta a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%WAMIT) .AND. ALLOCATED(y1%WAMIT)) THEN - DO i1 = LBOUND(y_out%WAMIT,1, kind=B8Ki),UBOUND(y_out%WAMIT,1, kind=B8Ki) + do i1 = lbound(y_out%WAMIT,1),ubound(y_out%WAMIT,1) CALL WAMIT_Output_ExtrapInterp2( y1%WAMIT(i1), y2%WAMIT(i1), y3%WAMIT(i1), tin, y_out%WAMIT(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%WAMIT2) .AND. ALLOCATED(y1%WAMIT2)) THEN - DO i1 = LBOUND(y_out%WAMIT2,1, kind=B8Ki),UBOUND(y_out%WAMIT2,1, kind=B8Ki) + do i1 = lbound(y_out%WAMIT2,1),ubound(y_out%WAMIT2,1) CALL WAMIT2_Output_ExtrapInterp2( y1%WAMIT2(i1), y2%WAMIT2(i1), y3%WAMIT2(i1), tin, y_out%WAMIT2(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -2564,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 29c47031c9..e14918f844 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -1111,9 +1111,9 @@ SUBROUTINE SetDepthBasedCoefs( z, tMG, NCoefDpth, CoefDpths, Cd, Ca, Cp, AxCd, A Cd = CoefDpths(indx1)%DpthCd*(1-s) + CoefDpths(indx2)%DpthCd*s Ca = CoefDpths(indx1)%DpthCa*(1-s) + CoefDpths(indx2)%DpthCa*s Cp = CoefDpths(indx1)%DpthCp*(1-s) + CoefDpths(indx2)%DpthCp*s - AxCd = CoefDpths(indx1)%DpthCd*(1-s) + CoefDpths(indx2)%DpthAxCd*s - AxCa = CoefDpths(indx1)%DpthCa*(1-s) + CoefDpths(indx2)%DpthAxCa*s - AxCp = CoefDpths(indx1)%DpthCp*(1-s) + CoefDpths(indx2)%DpthAxCp*s + AxCd = CoefDpths(indx1)%DpthAxCd*(1-s) + CoefDpths(indx2)%DpthAxCd*s + AxCa = CoefDpths(indx1)%DpthAxCa*(1-s) + CoefDpths(indx2)%DpthAxCa*s + AxCp = CoefDpths(indx1)%DpthAxCp*(1-s) + CoefDpths(indx2)%DpthAxCp*s Cb = CoefDpths(indx1)%DpthCb*(1-s) + CoefDpths(indx2)%DpthCb*s end if @@ -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 @@ -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 diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index 0fe65d6c83..bc47ce9be3 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -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 @@ -541,15 +549,15 @@ subroutine Morison_CopyFilledGroupType(SrcFilledGroupTypeData, DstFilledGroupTyp integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyFilledGroupType' ErrStat = ErrID_None ErrMsg = '' DstFilledGroupTypeData%FillNumM = SrcFilledGroupTypeData%FillNumM if (allocated(SrcFilledGroupTypeData%FillMList)) then - LB(1:1) = lbound(SrcFilledGroupTypeData%FillMList, kind=B8Ki) - UB(1:1) = ubound(SrcFilledGroupTypeData%FillMList, kind=B8Ki) + LB(1:1) = lbound(SrcFilledGroupTypeData%FillMList) + UB(1:1) = ubound(SrcFilledGroupTypeData%FillMList) if (.not. allocated(DstFilledGroupTypeData%FillMList)) then allocate(DstFilledGroupTypeData%FillMList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -593,7 +601,7 @@ subroutine Morison_UnPackFilledGroupType(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_FilledGroupType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackFilledGroupType' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -749,15 +757,15 @@ subroutine Morison_CopyMemberInputType(SrcMemberInputTypeData, DstMemberInputTyp integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyMemberInputType' ErrStat = ErrID_None ErrMsg = '' DstMemberInputTypeData%MemberID = SrcMemberInputTypeData%MemberID if (allocated(SrcMemberInputTypeData%NodeIndx)) then - LB(1:1) = lbound(SrcMemberInputTypeData%NodeIndx, kind=B8Ki) - UB(1:1) = ubound(SrcMemberInputTypeData%NodeIndx, kind=B8Ki) + LB(1:1) = lbound(SrcMemberInputTypeData%NodeIndx) + UB(1:1) = ubound(SrcMemberInputTypeData%NodeIndx) if (.not. allocated(DstMemberInputTypeData%NodeIndx)) then allocate(DstMemberInputTypeData%NodeIndx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -831,7 +839,7 @@ subroutine Morison_UnPackMemberInputType(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_MemberInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMemberInputType' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -943,14 +951,14 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyMemberType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMemberTypeData%NodeIndx)) then - LB(1:1) = lbound(SrcMemberTypeData%NodeIndx, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%NodeIndx, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%NodeIndx) + UB(1:1) = ubound(SrcMemberTypeData%NodeIndx) if (.not. allocated(DstMemberTypeData%NodeIndx)) then allocate(DstMemberTypeData%NodeIndx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -969,8 +977,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%kkt = SrcMemberTypeData%kkt DstMemberTypeData%Ak = SrcMemberTypeData%Ak if (allocated(SrcMemberTypeData%R)) then - LB(1:1) = lbound(SrcMemberTypeData%R, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%R, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%R) + UB(1:1) = ubound(SrcMemberTypeData%R) if (.not. allocated(DstMemberTypeData%R)) then allocate(DstMemberTypeData%R(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -981,8 +989,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%R = SrcMemberTypeData%R end if if (allocated(SrcMemberTypeData%RMG)) then - LB(1:1) = lbound(SrcMemberTypeData%RMG, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%RMG, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%RMG) + UB(1:1) = ubound(SrcMemberTypeData%RMG) if (.not. allocated(DstMemberTypeData%RMG)) then allocate(DstMemberTypeData%RMG(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -993,8 +1001,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%RMG = SrcMemberTypeData%RMG end if if (allocated(SrcMemberTypeData%RMGB)) then - LB(1:1) = lbound(SrcMemberTypeData%RMGB, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%RMGB, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%RMGB) + UB(1:1) = ubound(SrcMemberTypeData%RMGB) if (.not. allocated(DstMemberTypeData%RMGB)) then allocate(DstMemberTypeData%RMGB(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1005,8 +1013,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%RMGB = SrcMemberTypeData%RMGB end if if (allocated(SrcMemberTypeData%Rin)) then - LB(1:1) = lbound(SrcMemberTypeData%Rin, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%Rin, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%Rin) + UB(1:1) = ubound(SrcMemberTypeData%Rin) if (.not. allocated(DstMemberTypeData%Rin)) then allocate(DstMemberTypeData%Rin(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1017,8 +1025,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Rin = SrcMemberTypeData%Rin end if if (allocated(SrcMemberTypeData%tMG)) then - LB(1:1) = lbound(SrcMemberTypeData%tMG, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%tMG, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%tMG) + UB(1:1) = ubound(SrcMemberTypeData%tMG) if (.not. allocated(DstMemberTypeData%tMG)) then allocate(DstMemberTypeData%tMG(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1029,8 +1037,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%tMG = SrcMemberTypeData%tMG end if if (allocated(SrcMemberTypeData%MGdensity)) then - LB(1:1) = lbound(SrcMemberTypeData%MGdensity, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%MGdensity, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%MGdensity) + UB(1:1) = ubound(SrcMemberTypeData%MGdensity) if (.not. allocated(DstMemberTypeData%MGdensity)) then allocate(DstMemberTypeData%MGdensity(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1041,8 +1049,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%MGdensity = SrcMemberTypeData%MGdensity end if if (allocated(SrcMemberTypeData%dRdl_mg)) then - LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%dRdl_mg, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg) + UB(1:1) = ubound(SrcMemberTypeData%dRdl_mg) if (.not. allocated(DstMemberTypeData%dRdl_mg)) then allocate(DstMemberTypeData%dRdl_mg(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1053,8 +1061,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%dRdl_mg = SrcMemberTypeData%dRdl_mg end if if (allocated(SrcMemberTypeData%dRdl_mg_b)) then - LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg_b, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%dRdl_mg_b, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%dRdl_mg_b) + UB(1:1) = ubound(SrcMemberTypeData%dRdl_mg_b) if (.not. allocated(DstMemberTypeData%dRdl_mg_b)) then allocate(DstMemberTypeData%dRdl_mg_b(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1065,8 +1073,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%dRdl_mg_b = SrcMemberTypeData%dRdl_mg_b end if if (allocated(SrcMemberTypeData%dRdl_in)) then - LB(1:1) = lbound(SrcMemberTypeData%dRdl_in, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%dRdl_in, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%dRdl_in) + UB(1:1) = ubound(SrcMemberTypeData%dRdl_in) if (.not. allocated(DstMemberTypeData%dRdl_in)) then allocate(DstMemberTypeData%dRdl_in(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1088,8 +1096,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%doEndBuoyancy = SrcMemberTypeData%doEndBuoyancy DstMemberTypeData%memfloodstatus = SrcMemberTypeData%memfloodstatus if (allocated(SrcMemberTypeData%floodstatus)) then - LB(1:1) = lbound(SrcMemberTypeData%floodstatus, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%floodstatus, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%floodstatus) + UB(1:1) = ubound(SrcMemberTypeData%floodstatus) if (.not. allocated(DstMemberTypeData%floodstatus)) then allocate(DstMemberTypeData%floodstatus(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1100,8 +1108,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%floodstatus = SrcMemberTypeData%floodstatus end if if (allocated(SrcMemberTypeData%alpha)) then - LB(1:1) = lbound(SrcMemberTypeData%alpha, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%alpha, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%alpha) + UB(1:1) = ubound(SrcMemberTypeData%alpha) if (.not. allocated(DstMemberTypeData%alpha)) then allocate(DstMemberTypeData%alpha(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1112,8 +1120,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%alpha = SrcMemberTypeData%alpha end if if (allocated(SrcMemberTypeData%alpha_fb)) then - LB(1:1) = lbound(SrcMemberTypeData%alpha_fb, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%alpha_fb, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%alpha_fb) + UB(1:1) = ubound(SrcMemberTypeData%alpha_fb) if (.not. allocated(DstMemberTypeData%alpha_fb)) then allocate(DstMemberTypeData%alpha_fb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1124,8 +1132,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%alpha_fb = SrcMemberTypeData%alpha_fb end if if (allocated(SrcMemberTypeData%alpha_fb_star)) then - LB(1:1) = lbound(SrcMemberTypeData%alpha_fb_star, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%alpha_fb_star, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%alpha_fb_star) + UB(1:1) = ubound(SrcMemberTypeData%alpha_fb_star) if (.not. allocated(DstMemberTypeData%alpha_fb_star)) then allocate(DstMemberTypeData%alpha_fb_star(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1136,8 +1144,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%alpha_fb_star = SrcMemberTypeData%alpha_fb_star end if if (allocated(SrcMemberTypeData%Cd)) then - LB(1:1) = lbound(SrcMemberTypeData%Cd, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%Cd, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%Cd) + UB(1:1) = ubound(SrcMemberTypeData%Cd) if (.not. allocated(DstMemberTypeData%Cd)) then allocate(DstMemberTypeData%Cd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1148,8 +1156,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Cd = SrcMemberTypeData%Cd end if if (allocated(SrcMemberTypeData%Ca)) then - LB(1:1) = lbound(SrcMemberTypeData%Ca, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%Ca, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%Ca) + UB(1:1) = ubound(SrcMemberTypeData%Ca) if (.not. allocated(DstMemberTypeData%Ca)) then allocate(DstMemberTypeData%Ca(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1160,8 +1168,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Ca = SrcMemberTypeData%Ca end if if (allocated(SrcMemberTypeData%Cp)) then - LB(1:1) = lbound(SrcMemberTypeData%Cp, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%Cp, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%Cp) + UB(1:1) = ubound(SrcMemberTypeData%Cp) if (.not. allocated(DstMemberTypeData%Cp)) then allocate(DstMemberTypeData%Cp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1172,8 +1180,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Cp = SrcMemberTypeData%Cp end if if (allocated(SrcMemberTypeData%AxCd)) then - LB(1:1) = lbound(SrcMemberTypeData%AxCd, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%AxCd, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%AxCd) + UB(1:1) = ubound(SrcMemberTypeData%AxCd) if (.not. allocated(DstMemberTypeData%AxCd)) then allocate(DstMemberTypeData%AxCd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1184,8 +1192,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%AxCd = SrcMemberTypeData%AxCd end if if (allocated(SrcMemberTypeData%AxCa)) then - LB(1:1) = lbound(SrcMemberTypeData%AxCa, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%AxCa, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%AxCa) + UB(1:1) = ubound(SrcMemberTypeData%AxCa) if (.not. allocated(DstMemberTypeData%AxCa)) then allocate(DstMemberTypeData%AxCa(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1196,8 +1204,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%AxCa = SrcMemberTypeData%AxCa end if if (allocated(SrcMemberTypeData%AxCp)) then - LB(1:1) = lbound(SrcMemberTypeData%AxCp, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%AxCp, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%AxCp) + UB(1:1) = ubound(SrcMemberTypeData%AxCp) if (.not. allocated(DstMemberTypeData%AxCp)) then allocate(DstMemberTypeData%AxCp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1208,8 +1216,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%AxCp = SrcMemberTypeData%AxCp end if if (allocated(SrcMemberTypeData%Cb)) then - LB(1:1) = lbound(SrcMemberTypeData%Cb, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%Cb, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%Cb) + UB(1:1) = ubound(SrcMemberTypeData%Cb) if (.not. allocated(DstMemberTypeData%Cb)) then allocate(DstMemberTypeData%Cb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1220,8 +1228,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Cb = SrcMemberTypeData%Cb end if if (allocated(SrcMemberTypeData%m_fb_l)) then - LB(1:1) = lbound(SrcMemberTypeData%m_fb_l, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%m_fb_l, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%m_fb_l) + UB(1:1) = ubound(SrcMemberTypeData%m_fb_l) if (.not. allocated(DstMemberTypeData%m_fb_l)) then allocate(DstMemberTypeData%m_fb_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1232,8 +1240,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%m_fb_l = SrcMemberTypeData%m_fb_l end if if (allocated(SrcMemberTypeData%m_fb_u)) then - LB(1:1) = lbound(SrcMemberTypeData%m_fb_u, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%m_fb_u, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%m_fb_u) + UB(1:1) = ubound(SrcMemberTypeData%m_fb_u) if (.not. allocated(DstMemberTypeData%m_fb_u)) then allocate(DstMemberTypeData%m_fb_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1244,8 +1252,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%m_fb_u = SrcMemberTypeData%m_fb_u end if if (allocated(SrcMemberTypeData%h_cfb_l)) then - LB(1:1) = lbound(SrcMemberTypeData%h_cfb_l, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%h_cfb_l, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%h_cfb_l) + UB(1:1) = ubound(SrcMemberTypeData%h_cfb_l) if (.not. allocated(DstMemberTypeData%h_cfb_l)) then allocate(DstMemberTypeData%h_cfb_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1256,8 +1264,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%h_cfb_l = SrcMemberTypeData%h_cfb_l end if if (allocated(SrcMemberTypeData%h_cfb_u)) then - LB(1:1) = lbound(SrcMemberTypeData%h_cfb_u, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%h_cfb_u, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%h_cfb_u) + UB(1:1) = ubound(SrcMemberTypeData%h_cfb_u) if (.not. allocated(DstMemberTypeData%h_cfb_u)) then allocate(DstMemberTypeData%h_cfb_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1268,8 +1276,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%h_cfb_u = SrcMemberTypeData%h_cfb_u end if if (allocated(SrcMemberTypeData%I_lfb_l)) then - LB(1:1) = lbound(SrcMemberTypeData%I_lfb_l, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%I_lfb_l, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%I_lfb_l) + UB(1:1) = ubound(SrcMemberTypeData%I_lfb_l) if (.not. allocated(DstMemberTypeData%I_lfb_l)) then allocate(DstMemberTypeData%I_lfb_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1280,8 +1288,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_lfb_l = SrcMemberTypeData%I_lfb_l end if if (allocated(SrcMemberTypeData%I_lfb_u)) then - LB(1:1) = lbound(SrcMemberTypeData%I_lfb_u, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%I_lfb_u, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%I_lfb_u) + UB(1:1) = ubound(SrcMemberTypeData%I_lfb_u) if (.not. allocated(DstMemberTypeData%I_lfb_u)) then allocate(DstMemberTypeData%I_lfb_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1292,8 +1300,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_lfb_u = SrcMemberTypeData%I_lfb_u end if if (allocated(SrcMemberTypeData%I_rfb_l)) then - LB(1:1) = lbound(SrcMemberTypeData%I_rfb_l, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%I_rfb_l, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%I_rfb_l) + UB(1:1) = ubound(SrcMemberTypeData%I_rfb_l) if (.not. allocated(DstMemberTypeData%I_rfb_l)) then allocate(DstMemberTypeData%I_rfb_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1304,8 +1312,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_rfb_l = SrcMemberTypeData%I_rfb_l end if if (allocated(SrcMemberTypeData%I_rfb_u)) then - LB(1:1) = lbound(SrcMemberTypeData%I_rfb_u, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%I_rfb_u, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%I_rfb_u) + UB(1:1) = ubound(SrcMemberTypeData%I_rfb_u) if (.not. allocated(DstMemberTypeData%I_rfb_u)) then allocate(DstMemberTypeData%I_rfb_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1316,8 +1324,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_rfb_u = SrcMemberTypeData%I_rfb_u end if if (allocated(SrcMemberTypeData%m_mg_l)) then - LB(1:1) = lbound(SrcMemberTypeData%m_mg_l, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%m_mg_l, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%m_mg_l) + UB(1:1) = ubound(SrcMemberTypeData%m_mg_l) if (.not. allocated(DstMemberTypeData%m_mg_l)) then allocate(DstMemberTypeData%m_mg_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1328,8 +1336,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%m_mg_l = SrcMemberTypeData%m_mg_l end if if (allocated(SrcMemberTypeData%m_mg_u)) then - LB(1:1) = lbound(SrcMemberTypeData%m_mg_u, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%m_mg_u, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%m_mg_u) + UB(1:1) = ubound(SrcMemberTypeData%m_mg_u) if (.not. allocated(DstMemberTypeData%m_mg_u)) then allocate(DstMemberTypeData%m_mg_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1340,8 +1348,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%m_mg_u = SrcMemberTypeData%m_mg_u end if if (allocated(SrcMemberTypeData%h_cmg_l)) then - LB(1:1) = lbound(SrcMemberTypeData%h_cmg_l, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%h_cmg_l, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%h_cmg_l) + UB(1:1) = ubound(SrcMemberTypeData%h_cmg_l) if (.not. allocated(DstMemberTypeData%h_cmg_l)) then allocate(DstMemberTypeData%h_cmg_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1352,8 +1360,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%h_cmg_l = SrcMemberTypeData%h_cmg_l end if if (allocated(SrcMemberTypeData%h_cmg_u)) then - LB(1:1) = lbound(SrcMemberTypeData%h_cmg_u, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%h_cmg_u, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%h_cmg_u) + UB(1:1) = ubound(SrcMemberTypeData%h_cmg_u) if (.not. allocated(DstMemberTypeData%h_cmg_u)) then allocate(DstMemberTypeData%h_cmg_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1364,8 +1372,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%h_cmg_u = SrcMemberTypeData%h_cmg_u end if if (allocated(SrcMemberTypeData%I_lmg_l)) then - LB(1:1) = lbound(SrcMemberTypeData%I_lmg_l, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%I_lmg_l, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%I_lmg_l) + UB(1:1) = ubound(SrcMemberTypeData%I_lmg_l) if (.not. allocated(DstMemberTypeData%I_lmg_l)) then allocate(DstMemberTypeData%I_lmg_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1376,8 +1384,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_lmg_l = SrcMemberTypeData%I_lmg_l end if if (allocated(SrcMemberTypeData%I_lmg_u)) then - LB(1:1) = lbound(SrcMemberTypeData%I_lmg_u, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%I_lmg_u, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%I_lmg_u) + UB(1:1) = ubound(SrcMemberTypeData%I_lmg_u) if (.not. allocated(DstMemberTypeData%I_lmg_u)) then allocate(DstMemberTypeData%I_lmg_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1388,8 +1396,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_lmg_u = SrcMemberTypeData%I_lmg_u end if if (allocated(SrcMemberTypeData%I_rmg_l)) then - LB(1:1) = lbound(SrcMemberTypeData%I_rmg_l, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%I_rmg_l, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%I_rmg_l) + UB(1:1) = ubound(SrcMemberTypeData%I_rmg_l) if (.not. allocated(DstMemberTypeData%I_rmg_l)) then allocate(DstMemberTypeData%I_rmg_l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1400,8 +1408,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_rmg_l = SrcMemberTypeData%I_rmg_l end if if (allocated(SrcMemberTypeData%I_rmg_u)) then - LB(1:1) = lbound(SrcMemberTypeData%I_rmg_u, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%I_rmg_u, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%I_rmg_u) + UB(1:1) = ubound(SrcMemberTypeData%I_rmg_u) if (.not. allocated(DstMemberTypeData%I_rmg_u)) then allocate(DstMemberTypeData%I_rmg_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1412,8 +1420,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%I_rmg_u = SrcMemberTypeData%I_rmg_u end if if (allocated(SrcMemberTypeData%Cfl_fb)) then - LB(1:1) = lbound(SrcMemberTypeData%Cfl_fb, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%Cfl_fb, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%Cfl_fb) + UB(1:1) = ubound(SrcMemberTypeData%Cfl_fb) if (.not. allocated(DstMemberTypeData%Cfl_fb)) then allocate(DstMemberTypeData%Cfl_fb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1424,8 +1432,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Cfl_fb = SrcMemberTypeData%Cfl_fb end if if (allocated(SrcMemberTypeData%Cfr_fb)) then - LB(1:1) = lbound(SrcMemberTypeData%Cfr_fb, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%Cfr_fb, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%Cfr_fb) + UB(1:1) = ubound(SrcMemberTypeData%Cfr_fb) if (.not. allocated(DstMemberTypeData%Cfr_fb)) then allocate(DstMemberTypeData%Cfr_fb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1436,8 +1444,8 @@ subroutine Morison_CopyMemberType(SrcMemberTypeData, DstMemberTypeData, CtrlCode DstMemberTypeData%Cfr_fb = SrcMemberTypeData%Cfr_fb end if if (allocated(SrcMemberTypeData%CM0_fb)) then - LB(1:1) = lbound(SrcMemberTypeData%CM0_fb, kind=B8Ki) - UB(1:1) = ubound(SrcMemberTypeData%CM0_fb, kind=B8Ki) + LB(1:1) = lbound(SrcMemberTypeData%CM0_fb) + UB(1:1) = ubound(SrcMemberTypeData%CM0_fb) if (.not. allocated(DstMemberTypeData%CM0_fb)) then allocate(DstMemberTypeData%CM0_fb(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1671,7 +1679,7 @@ subroutine Morison_UnPackMemberType(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_MemberType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMemberType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1753,14 +1761,14 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyMemberLoads' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMemberLoadsData%F_D)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_D, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%F_D, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%F_D) + UB(1:2) = ubound(SrcMemberLoadsData%F_D) if (.not. allocated(DstMemberLoadsData%F_D)) then allocate(DstMemberLoadsData%F_D(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1771,8 +1779,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_D = SrcMemberLoadsData%F_D end if if (allocated(SrcMemberLoadsData%F_I)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_I, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%F_I, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%F_I) + UB(1:2) = ubound(SrcMemberLoadsData%F_I) if (.not. allocated(DstMemberLoadsData%F_I)) then allocate(DstMemberLoadsData%F_I(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1783,8 +1791,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_I = SrcMemberLoadsData%F_I end if if (allocated(SrcMemberLoadsData%F_A)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_A, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%F_A, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%F_A) + UB(1:2) = ubound(SrcMemberLoadsData%F_A) if (.not. allocated(DstMemberLoadsData%F_A)) then allocate(DstMemberLoadsData%F_A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1795,8 +1803,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_A = SrcMemberLoadsData%F_A end if if (allocated(SrcMemberLoadsData%F_B)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_B, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%F_B, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%F_B) + UB(1:2) = ubound(SrcMemberLoadsData%F_B) if (.not. allocated(DstMemberLoadsData%F_B)) then allocate(DstMemberLoadsData%F_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1807,8 +1815,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_B = SrcMemberLoadsData%F_B end if if (allocated(SrcMemberLoadsData%F_BF)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_BF, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%F_BF, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%F_BF) + UB(1:2) = ubound(SrcMemberLoadsData%F_BF) if (.not. allocated(DstMemberLoadsData%F_BF)) then allocate(DstMemberLoadsData%F_BF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1819,8 +1827,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_BF = SrcMemberLoadsData%F_BF end if if (allocated(SrcMemberLoadsData%F_If)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_If, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%F_If, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%F_If) + UB(1:2) = ubound(SrcMemberLoadsData%F_If) if (.not. allocated(DstMemberLoadsData%F_If)) then allocate(DstMemberLoadsData%F_If(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1831,8 +1839,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_If = SrcMemberLoadsData%F_If end if if (allocated(SrcMemberLoadsData%F_WMG)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_WMG, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%F_WMG, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%F_WMG) + UB(1:2) = ubound(SrcMemberLoadsData%F_WMG) if (.not. allocated(DstMemberLoadsData%F_WMG)) then allocate(DstMemberLoadsData%F_WMG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1843,8 +1851,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_WMG = SrcMemberLoadsData%F_WMG end if if (allocated(SrcMemberLoadsData%F_IMG)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_IMG, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%F_IMG, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%F_IMG) + UB(1:2) = ubound(SrcMemberLoadsData%F_IMG) if (.not. allocated(DstMemberLoadsData%F_IMG)) then allocate(DstMemberLoadsData%F_IMG(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1855,8 +1863,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%F_IMG = SrcMemberLoadsData%F_IMG end if if (allocated(SrcMemberLoadsData%FV)) then - LB(1:2) = lbound(SrcMemberLoadsData%FV, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%FV, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%FV) + UB(1:2) = ubound(SrcMemberLoadsData%FV) if (.not. allocated(DstMemberLoadsData%FV)) then allocate(DstMemberLoadsData%FV(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1867,8 +1875,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%FV = SrcMemberLoadsData%FV end if if (allocated(SrcMemberLoadsData%FA)) then - LB(1:2) = lbound(SrcMemberLoadsData%FA, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%FA, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%FA) + UB(1:2) = ubound(SrcMemberLoadsData%FA) if (.not. allocated(DstMemberLoadsData%FA)) then allocate(DstMemberLoadsData%FA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1879,8 +1887,8 @@ subroutine Morison_CopyMemberLoads(SrcMemberLoadsData, DstMemberLoadsData, CtrlC DstMemberLoadsData%FA = SrcMemberLoadsData%FA end if if (allocated(SrcMemberLoadsData%F_DP)) then - LB(1:2) = lbound(SrcMemberLoadsData%F_DP, kind=B8Ki) - UB(1:2) = ubound(SrcMemberLoadsData%F_DP, kind=B8Ki) + LB(1:2) = lbound(SrcMemberLoadsData%F_DP) + UB(1:2) = ubound(SrcMemberLoadsData%F_DP) if (.not. allocated(DstMemberLoadsData%F_DP)) then allocate(DstMemberLoadsData%F_DP(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1957,7 +1965,7 @@ subroutine Morison_UnPackMemberLoads(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_MemberLoads), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMemberLoads' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2149,7 +2157,7 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyMOutput' ErrStat = ErrID_None @@ -2157,8 +2165,8 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat DstMOutputData%MemberID = SrcMOutputData%MemberID DstMOutputData%NOutLoc = SrcMOutputData%NOutLoc if (allocated(SrcMOutputData%NodeLocs)) then - LB(1:1) = lbound(SrcMOutputData%NodeLocs, kind=B8Ki) - UB(1:1) = ubound(SrcMOutputData%NodeLocs, kind=B8Ki) + LB(1:1) = lbound(SrcMOutputData%NodeLocs) + UB(1:1) = ubound(SrcMOutputData%NodeLocs) if (.not. allocated(DstMOutputData%NodeLocs)) then allocate(DstMOutputData%NodeLocs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2170,8 +2178,8 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat end if DstMOutputData%MemberIDIndx = SrcMOutputData%MemberIDIndx if (allocated(SrcMOutputData%MeshIndx1)) then - LB(1:1) = lbound(SrcMOutputData%MeshIndx1, kind=B8Ki) - UB(1:1) = ubound(SrcMOutputData%MeshIndx1, kind=B8Ki) + LB(1:1) = lbound(SrcMOutputData%MeshIndx1) + UB(1:1) = ubound(SrcMOutputData%MeshIndx1) if (.not. allocated(DstMOutputData%MeshIndx1)) then allocate(DstMOutputData%MeshIndx1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2182,8 +2190,8 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat DstMOutputData%MeshIndx1 = SrcMOutputData%MeshIndx1 end if if (allocated(SrcMOutputData%MeshIndx2)) then - LB(1:1) = lbound(SrcMOutputData%MeshIndx2, kind=B8Ki) - UB(1:1) = ubound(SrcMOutputData%MeshIndx2, kind=B8Ki) + LB(1:1) = lbound(SrcMOutputData%MeshIndx2) + UB(1:1) = ubound(SrcMOutputData%MeshIndx2) if (.not. allocated(DstMOutputData%MeshIndx2)) then allocate(DstMOutputData%MeshIndx2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2194,8 +2202,8 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat DstMOutputData%MeshIndx2 = SrcMOutputData%MeshIndx2 end if if (allocated(SrcMOutputData%MemberIndx1)) then - LB(1:1) = lbound(SrcMOutputData%MemberIndx1, kind=B8Ki) - UB(1:1) = ubound(SrcMOutputData%MemberIndx1, kind=B8Ki) + LB(1:1) = lbound(SrcMOutputData%MemberIndx1) + UB(1:1) = ubound(SrcMOutputData%MemberIndx1) if (.not. allocated(DstMOutputData%MemberIndx1)) then allocate(DstMOutputData%MemberIndx1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2206,8 +2214,8 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat DstMOutputData%MemberIndx1 = SrcMOutputData%MemberIndx1 end if if (allocated(SrcMOutputData%MemberIndx2)) then - LB(1:1) = lbound(SrcMOutputData%MemberIndx2, kind=B8Ki) - UB(1:1) = ubound(SrcMOutputData%MemberIndx2, kind=B8Ki) + LB(1:1) = lbound(SrcMOutputData%MemberIndx2) + UB(1:1) = ubound(SrcMOutputData%MemberIndx2) if (.not. allocated(DstMOutputData%MemberIndx2)) then allocate(DstMOutputData%MemberIndx2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2218,8 +2226,8 @@ subroutine Morison_CopyMOutput(SrcMOutputData, DstMOutputData, CtrlCode, ErrStat DstMOutputData%MemberIndx2 = SrcMOutputData%MemberIndx2 end if if (allocated(SrcMOutputData%s)) then - LB(1:1) = lbound(SrcMOutputData%s, kind=B8Ki) - UB(1:1) = ubound(SrcMOutputData%s, kind=B8Ki) + LB(1:1) = lbound(SrcMOutputData%s) + UB(1:1) = ubound(SrcMOutputData%s) if (.not. allocated(DstMOutputData%s)) then allocate(DstMOutputData%s(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2279,7 +2287,7 @@ subroutine Morison_UnPackMOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_MOutput), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2341,8 +2349,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_CopyInitInput' @@ -2354,8 +2362,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%NJoints = SrcInitInputData%NJoints DstInitInputData%NNodes = SrcInitInputData%NNodes if (allocated(SrcInitInputData%InpJoints)) then - LB(1:1) = lbound(SrcInitInputData%InpJoints, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%InpJoints, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%InpJoints) + UB(1:1) = ubound(SrcInitInputData%InpJoints) if (.not. allocated(DstInitInputData%InpJoints)) then allocate(DstInitInputData%InpJoints(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2370,8 +2378,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end do end if if (allocated(SrcInitInputData%Nodes)) then - LB(1:1) = lbound(SrcInitInputData%Nodes, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%Nodes, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%Nodes) + UB(1:1) = ubound(SrcInitInputData%Nodes) if (.not. allocated(DstInitInputData%Nodes)) then allocate(DstInitInputData%Nodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2387,8 +2395,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NAxCoefs = SrcInitInputData%NAxCoefs if (allocated(SrcInitInputData%AxialCoefs)) then - LB(1:1) = lbound(SrcInitInputData%AxialCoefs, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%AxialCoefs, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%AxialCoefs) + UB(1:1) = ubound(SrcInitInputData%AxialCoefs) if (.not. allocated(DstInitInputData%AxialCoefs)) then allocate(DstInitInputData%AxialCoefs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2404,8 +2412,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NPropSets = SrcInitInputData%NPropSets if (allocated(SrcInitInputData%MPropSets)) then - LB(1:1) = lbound(SrcInitInputData%MPropSets, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%MPropSets, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%MPropSets) + UB(1:1) = ubound(SrcInitInputData%MPropSets) if (.not. allocated(DstInitInputData%MPropSets)) then allocate(DstInitInputData%MPropSets(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2436,8 +2444,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%SimplMCF = SrcInitInputData%SimplMCF DstInitInputData%NCoefDpth = SrcInitInputData%NCoefDpth if (allocated(SrcInitInputData%CoefDpths)) then - LB(1:1) = lbound(SrcInitInputData%CoefDpths, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%CoefDpths, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%CoefDpths) + UB(1:1) = ubound(SrcInitInputData%CoefDpths) if (.not. allocated(DstInitInputData%CoefDpths)) then allocate(DstInitInputData%CoefDpths(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2453,8 +2461,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NCoefMembers = SrcInitInputData%NCoefMembers if (allocated(SrcInitInputData%CoefMembers)) then - LB(1:1) = lbound(SrcInitInputData%CoefMembers, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%CoefMembers, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%CoefMembers) + UB(1:1) = ubound(SrcInitInputData%CoefMembers) if (.not. allocated(DstInitInputData%CoefMembers)) then allocate(DstInitInputData%CoefMembers(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2470,8 +2478,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NMembers = SrcInitInputData%NMembers if (allocated(SrcInitInputData%InpMembers)) then - LB(1:1) = lbound(SrcInitInputData%InpMembers, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%InpMembers, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%InpMembers) + UB(1:1) = ubound(SrcInitInputData%InpMembers) if (.not. allocated(DstInitInputData%InpMembers)) then allocate(DstInitInputData%InpMembers(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2487,8 +2495,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NFillGroups = SrcInitInputData%NFillGroups if (allocated(SrcInitInputData%FilledGroups)) then - LB(1:1) = lbound(SrcInitInputData%FilledGroups, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%FilledGroups, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%FilledGroups) + UB(1:1) = ubound(SrcInitInputData%FilledGroups) if (.not. allocated(DstInitInputData%FilledGroups)) then allocate(DstInitInputData%FilledGroups(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2504,8 +2512,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NMGDepths = SrcInitInputData%NMGDepths if (allocated(SrcInitInputData%MGDepths)) then - LB(1:1) = lbound(SrcInitInputData%MGDepths, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%MGDepths, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%MGDepths) + UB(1:1) = ubound(SrcInitInputData%MGDepths) if (.not. allocated(DstInitInputData%MGDepths)) then allocate(DstInitInputData%MGDepths(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2523,8 +2531,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%MGBottom = SrcInitInputData%MGBottom DstInitInputData%NMOutputs = SrcInitInputData%NMOutputs if (allocated(SrcInitInputData%MOutLst)) then - LB(1:1) = lbound(SrcInitInputData%MOutLst, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%MOutLst, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%MOutLst) + UB(1:1) = ubound(SrcInitInputData%MOutLst) if (.not. allocated(DstInitInputData%MOutLst)) then allocate(DstInitInputData%MOutLst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2540,8 +2548,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end if DstInitInputData%NJOutputs = SrcInitInputData%NJOutputs if (allocated(SrcInitInputData%JOutLst)) then - LB(1:1) = lbound(SrcInitInputData%JOutLst, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%JOutLst, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%JOutLst) + UB(1:1) = ubound(SrcInitInputData%JOutLst) if (.not. allocated(DstInitInputData%JOutLst)) then allocate(DstInitInputData%JOutLst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2556,8 +2564,8 @@ subroutine Morison_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E end do end if if (allocated(SrcInitInputData%OutList)) then - LB(1:1) = lbound(SrcInitInputData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%OutList) + UB(1:1) = ubound(SrcInitInputData%OutList) if (.not. allocated(DstInitInputData%OutList)) then allocate(DstInitInputData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2578,16 +2586,16 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) type(Morison_InitInputType), intent(inout) :: InitInputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InitInputData%InpJoints)) then - LB(1:1) = lbound(InitInputData%InpJoints, kind=B8Ki) - UB(1:1) = ubound(InitInputData%InpJoints, kind=B8Ki) + LB(1:1) = lbound(InitInputData%InpJoints) + UB(1:1) = ubound(InitInputData%InpJoints) do i1 = LB(1), UB(1) call Morison_DestroyJointType(InitInputData%InpJoints(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2595,8 +2603,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%InpJoints) end if if (allocated(InitInputData%Nodes)) then - LB(1:1) = lbound(InitInputData%Nodes, kind=B8Ki) - UB(1:1) = ubound(InitInputData%Nodes, kind=B8Ki) + LB(1:1) = lbound(InitInputData%Nodes) + UB(1:1) = ubound(InitInputData%Nodes) do i1 = LB(1), UB(1) call Morison_DestroyNodeType(InitInputData%Nodes(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2604,8 +2612,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%Nodes) end if if (allocated(InitInputData%AxialCoefs)) then - LB(1:1) = lbound(InitInputData%AxialCoefs, kind=B8Ki) - UB(1:1) = ubound(InitInputData%AxialCoefs, kind=B8Ki) + LB(1:1) = lbound(InitInputData%AxialCoefs) + UB(1:1) = ubound(InitInputData%AxialCoefs) do i1 = LB(1), UB(1) call Morison_DestroyAxialCoefType(InitInputData%AxialCoefs(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2613,8 +2621,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%AxialCoefs) end if if (allocated(InitInputData%MPropSets)) then - LB(1:1) = lbound(InitInputData%MPropSets, kind=B8Ki) - UB(1:1) = ubound(InitInputData%MPropSets, kind=B8Ki) + LB(1:1) = lbound(InitInputData%MPropSets) + UB(1:1) = ubound(InitInputData%MPropSets) do i1 = LB(1), UB(1) call Morison_DestroyMemberPropType(InitInputData%MPropSets(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2622,8 +2630,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%MPropSets) end if if (allocated(InitInputData%CoefDpths)) then - LB(1:1) = lbound(InitInputData%CoefDpths, kind=B8Ki) - UB(1:1) = ubound(InitInputData%CoefDpths, kind=B8Ki) + LB(1:1) = lbound(InitInputData%CoefDpths) + UB(1:1) = ubound(InitInputData%CoefDpths) do i1 = LB(1), UB(1) call Morison_DestroyCoefDpths(InitInputData%CoefDpths(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2631,8 +2639,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%CoefDpths) end if if (allocated(InitInputData%CoefMembers)) then - LB(1:1) = lbound(InitInputData%CoefMembers, kind=B8Ki) - UB(1:1) = ubound(InitInputData%CoefMembers, kind=B8Ki) + LB(1:1) = lbound(InitInputData%CoefMembers) + UB(1:1) = ubound(InitInputData%CoefMembers) do i1 = LB(1), UB(1) call Morison_DestroyCoefMembers(InitInputData%CoefMembers(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2640,8 +2648,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%CoefMembers) end if if (allocated(InitInputData%InpMembers)) then - LB(1:1) = lbound(InitInputData%InpMembers, kind=B8Ki) - UB(1:1) = ubound(InitInputData%InpMembers, kind=B8Ki) + LB(1:1) = lbound(InitInputData%InpMembers) + UB(1:1) = ubound(InitInputData%InpMembers) do i1 = LB(1), UB(1) call Morison_DestroyMemberInputType(InitInputData%InpMembers(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2649,8 +2657,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%InpMembers) end if if (allocated(InitInputData%FilledGroups)) then - LB(1:1) = lbound(InitInputData%FilledGroups, kind=B8Ki) - UB(1:1) = ubound(InitInputData%FilledGroups, kind=B8Ki) + LB(1:1) = lbound(InitInputData%FilledGroups) + UB(1:1) = ubound(InitInputData%FilledGroups) do i1 = LB(1), UB(1) call Morison_DestroyFilledGroupType(InitInputData%FilledGroups(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2658,8 +2666,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%FilledGroups) end if if (allocated(InitInputData%MGDepths)) then - LB(1:1) = lbound(InitInputData%MGDepths, kind=B8Ki) - UB(1:1) = ubound(InitInputData%MGDepths, kind=B8Ki) + LB(1:1) = lbound(InitInputData%MGDepths) + UB(1:1) = ubound(InitInputData%MGDepths) do i1 = LB(1), UB(1) call Morison_DestroyMGDepthsType(InitInputData%MGDepths(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2667,8 +2675,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%MGDepths) end if if (allocated(InitInputData%MOutLst)) then - LB(1:1) = lbound(InitInputData%MOutLst, kind=B8Ki) - UB(1:1) = ubound(InitInputData%MOutLst, kind=B8Ki) + LB(1:1) = lbound(InitInputData%MOutLst) + UB(1:1) = ubound(InitInputData%MOutLst) do i1 = LB(1), UB(1) call Morison_DestroyMOutput(InitInputData%MOutLst(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2676,8 +2684,8 @@ subroutine Morison_DestroyInitInput(InitInputData, ErrStat, ErrMsg) deallocate(InitInputData%MOutLst) end if if (allocated(InitInputData%JOutLst)) then - LB(1:1) = lbound(InitInputData%JOutLst, kind=B8Ki) - UB(1:1) = ubound(InitInputData%JOutLst, kind=B8Ki) + LB(1:1) = lbound(InitInputData%JOutLst) + UB(1:1) = ubound(InitInputData%JOutLst) do i1 = LB(1), UB(1) call Morison_DestroyJOutput(InitInputData%JOutLst(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2694,8 +2702,8 @@ subroutine Morison_PackInitInput(RF, Indata) type(RegFile), intent(inout) :: RF type(Morison_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackInitInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%Gravity) @@ -2705,18 +2713,18 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NNodes) call RegPack(RF, allocated(InData%InpJoints)) if (allocated(InData%InpJoints)) then - call RegPackBounds(RF, 1, lbound(InData%InpJoints, kind=B8Ki), ubound(InData%InpJoints, kind=B8Ki)) - LB(1:1) = lbound(InData%InpJoints, kind=B8Ki) - UB(1:1) = ubound(InData%InpJoints, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%InpJoints), ubound(InData%InpJoints)) + LB(1:1) = lbound(InData%InpJoints) + UB(1:1) = ubound(InData%InpJoints) do i1 = LB(1), UB(1) call Morison_PackJointType(RF, InData%InpJoints(i1)) end do end if call RegPack(RF, allocated(InData%Nodes)) if (allocated(InData%Nodes)) then - call RegPackBounds(RF, 1, lbound(InData%Nodes, kind=B8Ki), ubound(InData%Nodes, kind=B8Ki)) - LB(1:1) = lbound(InData%Nodes, kind=B8Ki) - UB(1:1) = ubound(InData%Nodes, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Nodes), ubound(InData%Nodes)) + LB(1:1) = lbound(InData%Nodes) + UB(1:1) = ubound(InData%Nodes) do i1 = LB(1), UB(1) call Morison_PackNodeType(RF, InData%Nodes(i1)) end do @@ -2724,9 +2732,9 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NAxCoefs) call RegPack(RF, allocated(InData%AxialCoefs)) if (allocated(InData%AxialCoefs)) then - call RegPackBounds(RF, 1, lbound(InData%AxialCoefs, kind=B8Ki), ubound(InData%AxialCoefs, kind=B8Ki)) - LB(1:1) = lbound(InData%AxialCoefs, kind=B8Ki) - UB(1:1) = ubound(InData%AxialCoefs, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%AxialCoefs), ubound(InData%AxialCoefs)) + LB(1:1) = lbound(InData%AxialCoefs) + UB(1:1) = ubound(InData%AxialCoefs) do i1 = LB(1), UB(1) call Morison_PackAxialCoefType(RF, InData%AxialCoefs(i1)) end do @@ -2734,9 +2742,9 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NPropSets) call RegPack(RF, allocated(InData%MPropSets)) if (allocated(InData%MPropSets)) then - call RegPackBounds(RF, 1, lbound(InData%MPropSets, kind=B8Ki), ubound(InData%MPropSets, kind=B8Ki)) - LB(1:1) = lbound(InData%MPropSets, kind=B8Ki) - UB(1:1) = ubound(InData%MPropSets, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MPropSets), ubound(InData%MPropSets)) + LB(1:1) = lbound(InData%MPropSets) + UB(1:1) = ubound(InData%MPropSets) do i1 = LB(1), UB(1) call Morison_PackMemberPropType(RF, InData%MPropSets(i1)) end do @@ -2759,9 +2767,9 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NCoefDpth) call RegPack(RF, allocated(InData%CoefDpths)) if (allocated(InData%CoefDpths)) then - call RegPackBounds(RF, 1, lbound(InData%CoefDpths, kind=B8Ki), ubound(InData%CoefDpths, kind=B8Ki)) - LB(1:1) = lbound(InData%CoefDpths, kind=B8Ki) - UB(1:1) = ubound(InData%CoefDpths, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%CoefDpths), ubound(InData%CoefDpths)) + LB(1:1) = lbound(InData%CoefDpths) + UB(1:1) = ubound(InData%CoefDpths) do i1 = LB(1), UB(1) call Morison_PackCoefDpths(RF, InData%CoefDpths(i1)) end do @@ -2769,9 +2777,9 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NCoefMembers) call RegPack(RF, allocated(InData%CoefMembers)) if (allocated(InData%CoefMembers)) then - call RegPackBounds(RF, 1, lbound(InData%CoefMembers, kind=B8Ki), ubound(InData%CoefMembers, kind=B8Ki)) - LB(1:1) = lbound(InData%CoefMembers, kind=B8Ki) - UB(1:1) = ubound(InData%CoefMembers, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%CoefMembers), ubound(InData%CoefMembers)) + LB(1:1) = lbound(InData%CoefMembers) + UB(1:1) = ubound(InData%CoefMembers) do i1 = LB(1), UB(1) call Morison_PackCoefMembers(RF, InData%CoefMembers(i1)) end do @@ -2779,9 +2787,9 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NMembers) call RegPack(RF, allocated(InData%InpMembers)) if (allocated(InData%InpMembers)) then - call RegPackBounds(RF, 1, lbound(InData%InpMembers, kind=B8Ki), ubound(InData%InpMembers, kind=B8Ki)) - LB(1:1) = lbound(InData%InpMembers, kind=B8Ki) - UB(1:1) = ubound(InData%InpMembers, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%InpMembers), ubound(InData%InpMembers)) + LB(1:1) = lbound(InData%InpMembers) + UB(1:1) = ubound(InData%InpMembers) do i1 = LB(1), UB(1) call Morison_PackMemberInputType(RF, InData%InpMembers(i1)) end do @@ -2789,9 +2797,9 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NFillGroups) call RegPack(RF, allocated(InData%FilledGroups)) if (allocated(InData%FilledGroups)) then - call RegPackBounds(RF, 1, lbound(InData%FilledGroups, kind=B8Ki), ubound(InData%FilledGroups, kind=B8Ki)) - LB(1:1) = lbound(InData%FilledGroups, kind=B8Ki) - UB(1:1) = ubound(InData%FilledGroups, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%FilledGroups), ubound(InData%FilledGroups)) + LB(1:1) = lbound(InData%FilledGroups) + UB(1:1) = ubound(InData%FilledGroups) do i1 = LB(1), UB(1) call Morison_PackFilledGroupType(RF, InData%FilledGroups(i1)) end do @@ -2799,9 +2807,9 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NMGDepths) call RegPack(RF, allocated(InData%MGDepths)) if (allocated(InData%MGDepths)) then - call RegPackBounds(RF, 1, lbound(InData%MGDepths, kind=B8Ki), ubound(InData%MGDepths, kind=B8Ki)) - LB(1:1) = lbound(InData%MGDepths, kind=B8Ki) - UB(1:1) = ubound(InData%MGDepths, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MGDepths), ubound(InData%MGDepths)) + LB(1:1) = lbound(InData%MGDepths) + UB(1:1) = ubound(InData%MGDepths) do i1 = LB(1), UB(1) call Morison_PackMGDepthsType(RF, InData%MGDepths(i1)) end do @@ -2811,9 +2819,9 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NMOutputs) call RegPack(RF, allocated(InData%MOutLst)) if (allocated(InData%MOutLst)) then - call RegPackBounds(RF, 1, lbound(InData%MOutLst, kind=B8Ki), ubound(InData%MOutLst, kind=B8Ki)) - LB(1:1) = lbound(InData%MOutLst, kind=B8Ki) - UB(1:1) = ubound(InData%MOutLst, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MOutLst), ubound(InData%MOutLst)) + LB(1:1) = lbound(InData%MOutLst) + UB(1:1) = ubound(InData%MOutLst) do i1 = LB(1), UB(1) call Morison_PackMOutput(RF, InData%MOutLst(i1)) end do @@ -2821,9 +2829,9 @@ subroutine Morison_PackInitInput(RF, Indata) call RegPack(RF, InData%NJOutputs) call RegPack(RF, allocated(InData%JOutLst)) if (allocated(InData%JOutLst)) then - call RegPackBounds(RF, 1, lbound(InData%JOutLst, kind=B8Ki), ubound(InData%JOutLst, kind=B8Ki)) - LB(1:1) = lbound(InData%JOutLst, kind=B8Ki) - UB(1:1) = ubound(InData%JOutLst, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%JOutLst), ubound(InData%JOutLst)) + LB(1:1) = lbound(InData%JOutLst) + UB(1:1) = ubound(InData%JOutLst) do i1 = LB(1), UB(1) call Morison_PackJOutput(RF, InData%JOutLst(i1)) end do @@ -2847,8 +2855,8 @@ subroutine Morison_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackInitInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -3059,14 +3067,14 @@ subroutine Morison_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%MorisonVisRad)) then - LB(1:1) = lbound(SrcInitOutputData%MorisonVisRad, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%MorisonVisRad, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%MorisonVisRad) + UB(1:1) = ubound(SrcInitOutputData%MorisonVisRad) if (.not. allocated(DstInitOutputData%MorisonVisRad)) then allocate(DstInitOutputData%MorisonVisRad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3077,8 +3085,8 @@ subroutine Morison_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%MorisonVisRad = SrcInitOutputData%MorisonVisRad end if if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3089,8 +3097,8 @@ subroutine Morison_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3135,7 +3143,7 @@ subroutine Morison_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3188,14 +3196,14 @@ subroutine Morison_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Morison_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%V_rel_n_FiltStat)) then - LB(1:1) = lbound(SrcDiscStateData%V_rel_n_FiltStat, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%V_rel_n_FiltStat, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%V_rel_n_FiltStat) + UB(1:1) = ubound(SrcDiscStateData%V_rel_n_FiltStat) if (.not. allocated(DstDiscStateData%V_rel_n_FiltStat)) then allocate(DstDiscStateData%V_rel_n_FiltStat(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3232,7 +3240,7 @@ subroutine Morison_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackDiscState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3321,16 +3329,16 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%DispNodePosHdn)) then - LB(1:2) = lbound(SrcMiscData%DispNodePosHdn, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%DispNodePosHdn, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%DispNodePosHdn) + UB(1:2) = ubound(SrcMiscData%DispNodePosHdn) if (.not. allocated(DstMiscData%DispNodePosHdn)) then allocate(DstMiscData%DispNodePosHdn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3341,8 +3349,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DispNodePosHdn = SrcMiscData%DispNodePosHdn end if if (allocated(SrcMiscData%DispNodePosHst)) then - LB(1:2) = lbound(SrcMiscData%DispNodePosHst, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%DispNodePosHst, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%DispNodePosHst) + UB(1:2) = ubound(SrcMiscData%DispNodePosHst) if (.not. allocated(DstMiscData%DispNodePosHst)) then allocate(DstMiscData%DispNodePosHst(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3353,8 +3361,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%DispNodePosHst = SrcMiscData%DispNodePosHst end if if (allocated(SrcMiscData%FV)) then - LB(1:2) = lbound(SrcMiscData%FV, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%FV, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%FV) + UB(1:2) = ubound(SrcMiscData%FV) if (.not. allocated(DstMiscData%FV)) then allocate(DstMiscData%FV(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3365,8 +3373,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FV = SrcMiscData%FV end if if (allocated(SrcMiscData%FA)) then - LB(1:2) = lbound(SrcMiscData%FA, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%FA, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%FA) + UB(1:2) = ubound(SrcMiscData%FA) if (.not. allocated(DstMiscData%FA)) then allocate(DstMiscData%FA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3377,8 +3385,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FA = SrcMiscData%FA end if if (allocated(SrcMiscData%FAMCF)) then - LB(1:2) = lbound(SrcMiscData%FAMCF, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%FAMCF, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%FAMCF) + UB(1:2) = ubound(SrcMiscData%FAMCF) if (.not. allocated(DstMiscData%FAMCF)) then allocate(DstMiscData%FAMCF(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3389,8 +3397,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FAMCF = SrcMiscData%FAMCF end if if (allocated(SrcMiscData%FDynP)) then - LB(1:1) = lbound(SrcMiscData%FDynP, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FDynP, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%FDynP) + UB(1:1) = ubound(SrcMiscData%FDynP) if (.not. allocated(DstMiscData%FDynP)) then allocate(DstMiscData%FDynP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3401,8 +3409,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%FDynP = SrcMiscData%FDynP end if if (allocated(SrcMiscData%WaveElev)) then - LB(1:1) = lbound(SrcMiscData%WaveElev, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%WaveElev, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%WaveElev) + UB(1:1) = ubound(SrcMiscData%WaveElev) if (.not. allocated(DstMiscData%WaveElev)) then allocate(DstMiscData%WaveElev(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3413,8 +3421,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%WaveElev = SrcMiscData%WaveElev end if if (allocated(SrcMiscData%WaveElev1)) then - LB(1:1) = lbound(SrcMiscData%WaveElev1, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%WaveElev1, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%WaveElev1) + UB(1:1) = ubound(SrcMiscData%WaveElev1) if (.not. allocated(DstMiscData%WaveElev1)) then allocate(DstMiscData%WaveElev1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3425,8 +3433,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%WaveElev1 = SrcMiscData%WaveElev1 end if if (allocated(SrcMiscData%WaveElev2)) then - LB(1:1) = lbound(SrcMiscData%WaveElev2, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%WaveElev2, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%WaveElev2) + UB(1:1) = ubound(SrcMiscData%WaveElev2) if (.not. allocated(DstMiscData%WaveElev2)) then allocate(DstMiscData%WaveElev2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3437,8 +3445,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%WaveElev2 = SrcMiscData%WaveElev2 end if if (allocated(SrcMiscData%vrel)) then - LB(1:2) = lbound(SrcMiscData%vrel, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%vrel, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%vrel) + UB(1:2) = ubound(SrcMiscData%vrel) if (.not. allocated(DstMiscData%vrel)) then allocate(DstMiscData%vrel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3449,8 +3457,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vrel = SrcMiscData%vrel end if if (allocated(SrcMiscData%nodeInWater)) then - LB(1:1) = lbound(SrcMiscData%nodeInWater, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%nodeInWater, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%nodeInWater) + UB(1:1) = ubound(SrcMiscData%nodeInWater) if (.not. allocated(DstMiscData%nodeInWater)) then allocate(DstMiscData%nodeInWater(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3461,8 +3469,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%nodeInWater = SrcMiscData%nodeInWater end if if (allocated(SrcMiscData%memberLoads)) then - LB(1:1) = lbound(SrcMiscData%memberLoads, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%memberLoads, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%memberLoads) + UB(1:1) = ubound(SrcMiscData%memberLoads) if (.not. allocated(DstMiscData%memberLoads)) then allocate(DstMiscData%memberLoads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3477,8 +3485,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%F_B_End)) then - LB(1:2) = lbound(SrcMiscData%F_B_End, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_B_End, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_B_End) + UB(1:2) = ubound(SrcMiscData%F_B_End) if (.not. allocated(DstMiscData%F_B_End)) then allocate(DstMiscData%F_B_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3489,8 +3497,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_B_End = SrcMiscData%F_B_End end if if (allocated(SrcMiscData%F_D_End)) then - LB(1:2) = lbound(SrcMiscData%F_D_End, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_D_End, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_D_End) + UB(1:2) = ubound(SrcMiscData%F_D_End) if (.not. allocated(DstMiscData%F_D_End)) then allocate(DstMiscData%F_D_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3501,8 +3509,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_D_End = SrcMiscData%F_D_End end if if (allocated(SrcMiscData%F_I_End)) then - LB(1:2) = lbound(SrcMiscData%F_I_End, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_I_End, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_I_End) + UB(1:2) = ubound(SrcMiscData%F_I_End) if (.not. allocated(DstMiscData%F_I_End)) then allocate(DstMiscData%F_I_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3513,8 +3521,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_I_End = SrcMiscData%F_I_End end if if (allocated(SrcMiscData%F_IMG_End)) then - LB(1:2) = lbound(SrcMiscData%F_IMG_End, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_IMG_End, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_IMG_End) + UB(1:2) = ubound(SrcMiscData%F_IMG_End) if (.not. allocated(DstMiscData%F_IMG_End)) then allocate(DstMiscData%F_IMG_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3525,8 +3533,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_IMG_End = SrcMiscData%F_IMG_End end if if (allocated(SrcMiscData%F_A_End)) then - LB(1:2) = lbound(SrcMiscData%F_A_End, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_A_End, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_A_End) + UB(1:2) = ubound(SrcMiscData%F_A_End) if (.not. allocated(DstMiscData%F_A_End)) then allocate(DstMiscData%F_A_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3537,8 +3545,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_A_End = SrcMiscData%F_A_End end if if (allocated(SrcMiscData%F_BF_End)) then - LB(1:2) = lbound(SrcMiscData%F_BF_End, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_BF_End, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_BF_End) + UB(1:2) = ubound(SrcMiscData%F_BF_End) if (.not. allocated(DstMiscData%F_BF_End)) then allocate(DstMiscData%F_BF_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3549,8 +3557,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_BF_End = SrcMiscData%F_BF_End end if if (allocated(SrcMiscData%V_rel_n)) then - LB(1:1) = lbound(SrcMiscData%V_rel_n, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%V_rel_n, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%V_rel_n) + UB(1:1) = ubound(SrcMiscData%V_rel_n) if (.not. allocated(DstMiscData%V_rel_n)) then allocate(DstMiscData%V_rel_n(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3561,8 +3569,8 @@ subroutine Morison_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%V_rel_n = SrcMiscData%V_rel_n end if if (allocated(SrcMiscData%V_rel_n_HiPass)) then - LB(1:1) = lbound(SrcMiscData%V_rel_n_HiPass, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%V_rel_n_HiPass, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%V_rel_n_HiPass) + UB(1:1) = ubound(SrcMiscData%V_rel_n_HiPass) if (.not. allocated(DstMiscData%V_rel_n_HiPass)) then allocate(DstMiscData%V_rel_n_HiPass(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3584,8 +3592,8 @@ subroutine Morison_DestroyMisc(MiscData, ErrStat, ErrMsg) type(Morison_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_DestroyMisc' @@ -3625,8 +3633,8 @@ subroutine Morison_DestroyMisc(MiscData, ErrStat, ErrMsg) deallocate(MiscData%nodeInWater) end if if (allocated(MiscData%memberLoads)) then - LB(1:1) = lbound(MiscData%memberLoads, kind=B8Ki) - UB(1:1) = ubound(MiscData%memberLoads, kind=B8Ki) + LB(1:1) = lbound(MiscData%memberLoads) + UB(1:1) = ubound(MiscData%memberLoads) do i1 = LB(1), UB(1) call Morison_DestroyMemberLoads(MiscData%memberLoads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3667,8 +3675,8 @@ subroutine Morison_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF type(Morison_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%DispNodePosHdn) call RegPackAlloc(RF, InData%DispNodePosHst) @@ -3683,9 +3691,9 @@ subroutine Morison_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%nodeInWater) call RegPack(RF, allocated(InData%memberLoads)) if (allocated(InData%memberLoads)) then - call RegPackBounds(RF, 1, lbound(InData%memberLoads, kind=B8Ki), ubound(InData%memberLoads, kind=B8Ki)) - LB(1:1) = lbound(InData%memberLoads, kind=B8Ki) - UB(1:1) = ubound(InData%memberLoads, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%memberLoads), ubound(InData%memberLoads)) + LB(1:1) = lbound(InData%memberLoads) + UB(1:1) = ubound(InData%memberLoads) do i1 = LB(1), UB(1) call Morison_PackMemberLoads(RF, InData%memberLoads(i1)) end do @@ -3707,8 +3715,8 @@ subroutine Morison_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3754,8 +3762,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_CopyParam' @@ -3767,8 +3775,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%AMMod = SrcParamData%AMMod DstParamData%NMembers = SrcParamData%NMembers if (allocated(SrcParamData%Members)) then - LB(1:1) = lbound(SrcParamData%Members, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Members, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Members) + UB(1:1) = ubound(SrcParamData%Members) if (.not. allocated(DstParamData%Members)) then allocate(DstParamData%Members(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3785,8 +3793,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%NNodes = SrcParamData%NNodes DstParamData%NJoints = SrcParamData%NJoints if (allocated(SrcParamData%I_MG_End)) then - LB(1:3) = lbound(SrcParamData%I_MG_End, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%I_MG_End, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%I_MG_End) + UB(1:3) = ubound(SrcParamData%I_MG_End) if (.not. allocated(DstParamData%I_MG_End)) then allocate(DstParamData%I_MG_End(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3797,8 +3805,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%I_MG_End = SrcParamData%I_MG_End end if if (allocated(SrcParamData%An_End)) then - LB(1:2) = lbound(SrcParamData%An_End, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%An_End, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%An_End) + UB(1:2) = ubound(SrcParamData%An_End) if (.not. allocated(DstParamData%An_End)) then allocate(DstParamData%An_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3809,8 +3817,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%An_End = SrcParamData%An_End end if if (allocated(SrcParamData%DragConst_End)) then - LB(1:1) = lbound(SrcParamData%DragConst_End, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%DragConst_End, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%DragConst_End) + UB(1:1) = ubound(SrcParamData%DragConst_End) if (.not. allocated(DstParamData%DragConst_End)) then allocate(DstParamData%DragConst_End(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3821,8 +3829,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%DragConst_End = SrcParamData%DragConst_End end if if (allocated(SrcParamData%VRelNFiltConst)) then - LB(1:1) = lbound(SrcParamData%VRelNFiltConst, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%VRelNFiltConst, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%VRelNFiltConst) + UB(1:1) = ubound(SrcParamData%VRelNFiltConst) if (.not. allocated(DstParamData%VRelNFiltConst)) then allocate(DstParamData%VRelNFiltConst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3833,8 +3841,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%VRelNFiltConst = SrcParamData%VRelNFiltConst end if if (allocated(SrcParamData%DragMod_End)) then - LB(1:1) = lbound(SrcParamData%DragMod_End, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%DragMod_End, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%DragMod_End) + UB(1:1) = ubound(SrcParamData%DragMod_End) if (.not. allocated(DstParamData%DragMod_End)) then allocate(DstParamData%DragMod_End(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3845,8 +3853,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%DragMod_End = SrcParamData%DragMod_End end if if (allocated(SrcParamData%DragLoFSc_End)) then - LB(1:1) = lbound(SrcParamData%DragLoFSc_End, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%DragLoFSc_End, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%DragLoFSc_End) + UB(1:1) = ubound(SrcParamData%DragLoFSc_End) if (.not. allocated(DstParamData%DragLoFSc_End)) then allocate(DstParamData%DragLoFSc_End(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3857,8 +3865,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%DragLoFSc_End = SrcParamData%DragLoFSc_End end if if (allocated(SrcParamData%F_WMG_End)) then - LB(1:2) = lbound(SrcParamData%F_WMG_End, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%F_WMG_End, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%F_WMG_End) + UB(1:2) = ubound(SrcParamData%F_WMG_End) if (.not. allocated(DstParamData%F_WMG_End)) then allocate(DstParamData%F_WMG_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3869,8 +3877,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%F_WMG_End = SrcParamData%F_WMG_End end if if (allocated(SrcParamData%DP_Const_End)) then - LB(1:2) = lbound(SrcParamData%DP_Const_End, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%DP_Const_End, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%DP_Const_End) + UB(1:2) = ubound(SrcParamData%DP_Const_End) if (.not. allocated(DstParamData%DP_Const_End)) then allocate(DstParamData%DP_Const_End(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3881,8 +3889,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%DP_Const_End = SrcParamData%DP_Const_End end if if (allocated(SrcParamData%Mass_MG_End)) then - LB(1:1) = lbound(SrcParamData%Mass_MG_End, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Mass_MG_End, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Mass_MG_End) + UB(1:1) = ubound(SrcParamData%Mass_MG_End) if (.not. allocated(DstParamData%Mass_MG_End)) then allocate(DstParamData%Mass_MG_End(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3893,8 +3901,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%Mass_MG_End = SrcParamData%Mass_MG_End end if if (allocated(SrcParamData%AM_End)) then - LB(1:3) = lbound(SrcParamData%AM_End, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%AM_End, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%AM_End) + UB(1:3) = ubound(SrcParamData%AM_End) if (.not. allocated(DstParamData%AM_End)) then allocate(DstParamData%AM_End(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3906,8 +3914,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if DstParamData%NMOutputs = SrcParamData%NMOutputs if (allocated(SrcParamData%MOutLst)) then - LB(1:1) = lbound(SrcParamData%MOutLst, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%MOutLst, kind=B8Ki) + 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 @@ -3923,8 +3931,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end if DstParamData%NJOutputs = SrcParamData%NJOutputs if (allocated(SrcParamData%JOutLst)) then - LB(1:1) = lbound(SrcParamData%JOutLst, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%JOutLst, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%JOutLst) + UB(1:1) = ubound(SrcParamData%JOutLst) if (.not. allocated(DstParamData%JOutLst)) then allocate(DstParamData%JOutLst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3939,8 +3947,8 @@ subroutine Morison_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM end do end if if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + 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 @@ -3964,16 +3972,16 @@ subroutine Morison_DestroyParam(ParamData, ErrStat, ErrMsg) type(Morison_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_DestroyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(ParamData%Members)) then - LB(1:1) = lbound(ParamData%Members, kind=B8Ki) - UB(1:1) = ubound(ParamData%Members, kind=B8Ki) + LB(1:1) = lbound(ParamData%Members) + UB(1:1) = ubound(ParamData%Members) do i1 = LB(1), UB(1) call Morison_DestroyMemberType(ParamData%Members(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4011,8 +4019,8 @@ subroutine Morison_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%AM_End) end if if (allocated(ParamData%MOutLst)) then - LB(1:1) = lbound(ParamData%MOutLst, kind=B8Ki) - UB(1:1) = ubound(ParamData%MOutLst, kind=B8Ki) + LB(1:1) = lbound(ParamData%MOutLst) + UB(1:1) = ubound(ParamData%MOutLst) do i1 = LB(1), UB(1) call Morison_DestroyMOutput(ParamData%MOutLst(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4020,8 +4028,8 @@ subroutine Morison_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%MOutLst) end if if (allocated(ParamData%JOutLst)) then - LB(1:1) = lbound(ParamData%JOutLst, kind=B8Ki) - UB(1:1) = ubound(ParamData%JOutLst, kind=B8Ki) + LB(1:1) = lbound(ParamData%JOutLst) + UB(1:1) = ubound(ParamData%JOutLst) do i1 = LB(1), UB(1) call Morison_DestroyJOutput(ParamData%JOutLst(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4029,8 +4037,8 @@ subroutine Morison_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%JOutLst) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + 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) @@ -4044,8 +4052,8 @@ subroutine Morison_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(Morison_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'Morison_PackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DT) @@ -4055,9 +4063,9 @@ subroutine Morison_PackParam(RF, Indata) call RegPack(RF, InData%NMembers) call RegPack(RF, allocated(InData%Members)) if (allocated(InData%Members)) then - call RegPackBounds(RF, 1, lbound(InData%Members, kind=B8Ki), ubound(InData%Members, kind=B8Ki)) - LB(1:1) = lbound(InData%Members, kind=B8Ki) - UB(1:1) = ubound(InData%Members, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Members), ubound(InData%Members)) + LB(1:1) = lbound(InData%Members) + UB(1:1) = ubound(InData%Members) do i1 = LB(1), UB(1) call Morison_PackMemberType(RF, InData%Members(i1)) end do @@ -4077,9 +4085,9 @@ subroutine Morison_PackParam(RF, Indata) call RegPack(RF, InData%NMOutputs) call RegPack(RF, allocated(InData%MOutLst)) if (allocated(InData%MOutLst)) then - call RegPackBounds(RF, 1, lbound(InData%MOutLst, kind=B8Ki), ubound(InData%MOutLst, kind=B8Ki)) - LB(1:1) = lbound(InData%MOutLst, kind=B8Ki) - UB(1:1) = ubound(InData%MOutLst, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MOutLst), ubound(InData%MOutLst)) + LB(1:1) = lbound(InData%MOutLst) + UB(1:1) = ubound(InData%MOutLst) do i1 = LB(1), UB(1) call Morison_PackMOutput(RF, InData%MOutLst(i1)) end do @@ -4087,18 +4095,18 @@ subroutine Morison_PackParam(RF, Indata) call RegPack(RF, InData%NJOutputs) call RegPack(RF, allocated(InData%JOutLst)) if (allocated(InData%JOutLst)) then - call RegPackBounds(RF, 1, lbound(InData%JOutLst, kind=B8Ki), ubound(InData%JOutLst, kind=B8Ki)) - LB(1:1) = lbound(InData%JOutLst, kind=B8Ki) - UB(1:1) = ubound(InData%JOutLst, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%JOutLst), ubound(InData%JOutLst)) + LB(1:1) = lbound(InData%JOutLst) + UB(1:1) = ubound(InData%JOutLst) do i1 = LB(1), UB(1) call Morison_PackJOutput(RF, InData%JOutLst(i1)) end do end if call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + 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 @@ -4120,8 +4128,8 @@ subroutine Morison_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -4276,7 +4284,7 @@ subroutine Morison_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Morison_CopyOutput' @@ -4289,8 +4297,8 @@ subroutine Morison_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -4335,7 +4343,7 @@ subroutine Morison_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(Morison_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Morison_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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 3e7179fe5a..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 @@ -109,7 +115,7 @@ subroutine SS_Exc_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Exc_CopyInitInput' @@ -119,8 +125,8 @@ subroutine SS_Exc_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%NBody = SrcInitInputData%NBody DstInitInputData%ExctnDisp = SrcInitInputData%ExctnDisp if (allocated(SrcInitInputData%PtfmRefztRot)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) if (.not. allocated(DstInitInputData%PtfmRefztRot)) then allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -172,7 +178,7 @@ subroutine SS_Exc_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Exc_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackInitInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -208,14 +214,14 @@ subroutine SS_Exc_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Exc_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -226,8 +232,8 @@ subroutine SS_Exc_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -268,7 +274,7 @@ subroutine SS_Exc_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Exc_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -282,14 +288,14 @@ subroutine SS_Exc_CopyContState(SrcContStateData, DstContStateData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Exc_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%x)) then - LB(1:1) = lbound(SrcContStateData%x, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%x, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%x) + UB(1:1) = ubound(SrcContStateData%x) if (.not. allocated(DstContStateData%x)) then allocate(DstContStateData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -326,7 +332,7 @@ subroutine SS_Exc_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Exc_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackContState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -415,16 +421,16 @@ subroutine SS_Exc_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Exc_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' DstOtherStateData%n = SrcOtherStateData%n - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call SS_Exc_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -436,15 +442,15 @@ subroutine SS_Exc_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(SS_Exc_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Exc_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call SS_Exc_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -455,12 +461,12 @@ subroutine SS_Exc_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(SS_Exc_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Exc_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%n) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call SS_Exc_PackContState(RF, InData%xdot(i1)) end do @@ -471,12 +477,12 @@ subroutine SS_Exc_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Exc_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return - LB(1:1) = lbound(OutData%xdot, kind=B8Ki) - UB(1:1) = ubound(OutData%xdot, kind=B8Ki) + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call SS_Exc_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do @@ -537,7 +543,7 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Exc_CopyParam' @@ -547,8 +553,8 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%NBody = SrcParamData%NBody DstParamData%ExctnDisp = SrcParamData%ExctnDisp if (allocated(SrcParamData%spDOF)) then - LB(1:1) = lbound(SrcParamData%spDOF, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%spDOF, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%spDOF) + UB(1:1) = ubound(SrcParamData%spDOF) if (.not. allocated(DstParamData%spDOF)) then allocate(DstParamData%spDOF(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -559,8 +565,8 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%spDOF = SrcParamData%spDOF end if if (allocated(SrcParamData%A)) then - LB(1:2) = lbound(SrcParamData%A, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%A, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%A) + UB(1:2) = ubound(SrcParamData%A) if (.not. allocated(DstParamData%A)) then allocate(DstParamData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -571,8 +577,8 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%A = SrcParamData%A end if if (allocated(SrcParamData%B)) then - LB(1:1) = lbound(SrcParamData%B, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%B, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%B) + UB(1:1) = ubound(SrcParamData%B) if (.not. allocated(DstParamData%B)) then allocate(DstParamData%B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -583,8 +589,8 @@ subroutine SS_Exc_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%B = SrcParamData%B end if if (allocated(SrcParamData%C)) then - LB(1:2) = lbound(SrcParamData%C, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%C) + UB(1:2) = ubound(SrcParamData%C) if (.not. allocated(DstParamData%C)) then allocate(DstParamData%C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -652,7 +658,7 @@ subroutine SS_Exc_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Exc_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackParam' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -693,14 +699,14 @@ subroutine SS_Exc_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Exc_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%PtfmPos)) then - LB(1:2) = lbound(SrcInputData%PtfmPos, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%PtfmPos, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%PtfmPos) + UB(1:2) = ubound(SrcInputData%PtfmPos) if (.not. allocated(DstInputData%PtfmPos)) then allocate(DstInputData%PtfmPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -737,7 +743,7 @@ subroutine SS_Exc_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Exc_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackInput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -750,14 +756,14 @@ subroutine SS_Exc_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Exc_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%y)) then - LB(1:1) = lbound(SrcOutputData%y, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%y, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%y) + UB(1:1) = ubound(SrcOutputData%y) if (.not. allocated(DstOutputData%y)) then allocate(DstOutputData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -768,8 +774,8 @@ subroutine SS_Exc_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er DstOutputData%y = SrcOutputData%y end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -810,7 +816,7 @@ subroutine SS_Exc_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Exc_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Exc_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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 1c91b852e4..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 @@ -103,15 +109,15 @@ subroutine SS_Rad_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Rad_CopyInitInput' ErrStat = ErrID_None ErrMsg = '' DstInitInputData%InputFile = SrcInitInputData%InputFile if (allocated(SrcInitInputData%enabledDOFs)) then - LB(1:1) = lbound(SrcInitInputData%enabledDOFs, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%enabledDOFs, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%enabledDOFs) + UB(1:1) = ubound(SrcInitInputData%enabledDOFs) if (.not. allocated(DstInitInputData%enabledDOFs)) then allocate(DstInitInputData%enabledDOFs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -123,8 +129,8 @@ subroutine SS_Rad_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er end if DstInitInputData%NBody = SrcInitInputData%NBody if (allocated(SrcInitInputData%PtfmRefztRot)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) if (.not. allocated(DstInitInputData%PtfmRefztRot)) then allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -167,7 +173,7 @@ subroutine SS_Rad_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Rad_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackInitInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -183,14 +189,14 @@ subroutine SS_Rad_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Rad_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -201,8 +207,8 @@ subroutine SS_Rad_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -243,7 +249,7 @@ subroutine SS_Rad_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Rad_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -257,14 +263,14 @@ subroutine SS_Rad_CopyContState(SrcContStateData, DstContStateData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Rad_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%x)) then - LB(1:1) = lbound(SrcContStateData%x, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%x, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%x) + UB(1:1) = ubound(SrcContStateData%x) if (.not. allocated(DstContStateData%x)) then allocate(DstContStateData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -301,7 +307,7 @@ subroutine SS_Rad_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Rad_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackContState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -390,16 +396,16 @@ subroutine SS_Rad_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Rad_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' DstOtherStateData%n = SrcOtherStateData%n - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call SS_Rad_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -411,15 +417,15 @@ subroutine SS_Rad_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(SS_Rad_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SS_Rad_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call SS_Rad_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -430,12 +436,12 @@ subroutine SS_Rad_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(SS_Rad_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SS_Rad_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%n) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call SS_Rad_PackContState(RF, InData%xdot(i1)) end do @@ -446,12 +452,12 @@ subroutine SS_Rad_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Rad_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return - LB(1:1) = lbound(OutData%xdot, kind=B8Ki) - UB(1:1) = ubound(OutData%xdot, kind=B8Ki) + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call SS_Rad_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do @@ -501,15 +507,15 @@ subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Rad_CopyParam' ErrStat = ErrID_None ErrMsg = '' DstParamData%DT = SrcParamData%DT if (allocated(SrcParamData%A)) then - LB(1:2) = lbound(SrcParamData%A, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%A, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%A) + UB(1:2) = ubound(SrcParamData%A) if (.not. allocated(DstParamData%A)) then allocate(DstParamData%A(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -520,8 +526,8 @@ subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%A = SrcParamData%A end if if (allocated(SrcParamData%B)) then - LB(1:2) = lbound(SrcParamData%B, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%B, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%B) + UB(1:2) = ubound(SrcParamData%B) if (.not. allocated(DstParamData%B)) then allocate(DstParamData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -532,8 +538,8 @@ subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%B = SrcParamData%B end if if (allocated(SrcParamData%C)) then - LB(1:2) = lbound(SrcParamData%C, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%C) + UB(1:2) = ubound(SrcParamData%C) if (.not. allocated(DstParamData%C)) then allocate(DstParamData%C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -545,8 +551,8 @@ subroutine SS_Rad_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs end if DstParamData%numStates = SrcParamData%numStates if (allocated(SrcParamData%spdof)) then - LB(1:1) = lbound(SrcParamData%spdof, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%spdof, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%spdof) + UB(1:1) = ubound(SrcParamData%spdof) if (.not. allocated(DstParamData%spdof)) then allocate(DstParamData%spdof(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -599,7 +605,7 @@ subroutine SS_Rad_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Rad_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackParam' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -618,14 +624,14 @@ subroutine SS_Rad_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Rad_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%dq)) then - LB(1:1) = lbound(SrcInputData%dq, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%dq, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%dq) + UB(1:1) = ubound(SrcInputData%dq) if (.not. allocated(DstInputData%dq)) then allocate(DstInputData%dq(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -662,7 +668,7 @@ subroutine SS_Rad_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Rad_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -675,14 +681,14 @@ subroutine SS_Rad_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SS_Rad_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%y)) then - LB(1:1) = lbound(SrcOutputData%y, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%y, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%y) + UB(1:1) = ubound(SrcOutputData%y) if (.not. allocated(DstOutputData%y)) then allocate(DstOutputData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -693,8 +699,8 @@ subroutine SS_Rad_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Er DstOutputData%y = SrcOutputData%y end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -735,7 +741,7 @@ subroutine SS_Rad_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SS_Rad_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SS_Rad_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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/WAMIT.f90 b/modules/hydrodyn/src/WAMIT.f90 index 34b16fdc49..d04c5a823b 100644 --- a/modules/hydrodyn/src/WAMIT.f90 +++ b/modules/hydrodyn/src/WAMIT.f90 @@ -164,7 +164,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS REAL(ReKi), ALLOCATABLE :: WAMITPer (:) ! Period components as ordered in the WAMIT output files (sec ) REAL(ReKi), ALLOCATABLE :: WAMITWvDir(:) ! Wave direction components as ordered in the WAMIT output files (degrees) - INTEGER :: I,iGrid,iX,iY,iHdg,iBdy ! Generic index + INTEGER :: I,iGrid,iX,iY,iHdg,iBdy,iStp ! Generic index INTEGER :: InsertInd ! The lowest sorted index whose associated frequency component is higher than the current frequency component -- this is to sort the frequency components from lowest to highest INTEGER :: J ! Generic index INTEGER :: K ! Generic index @@ -190,6 +190,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using integer(IntKi) :: iSub, jSub ! indices into the 6x6 sub-matrices used to redimensionalize the WAMIT data (Needed because NBodyMod=1 could have WAMIT matrices which are 6N x 6N) integer(IntKi) :: iBody ! WAMIT body index + real(ReKi) :: BdyPos0(3) ! Initial translational displacement of the WAMIT body real(R8Ki) :: orientation(3,3) ! Initial orientation of the WAMIT body real(R8Ki) :: theta(3) ! Euler angle rotations of the WAMIT body real(ReKi) :: WaveNmbr ! Frequency-dependent wave number @@ -1025,7 +1026,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS END DO ELSE IF ( InitInp%PtfmYMod == 1 ) THEN IF ( (.not. EqualRealNos( HdroWvDir(1),REAL(-180,SiKi))) .OR. (.not. EqualRealNos( HdroWvDir(NInpWvDir),REAL(180,SiKi))) ) THEN - ErrMsg2 = 'With PtfmYMod=1 in ElastoDyn or HydroDyn driver, we need the lowest and highest wave headings to be exactly -180 deg and 180 deg, respectively, in "' & + ErrMsg2 = 'With PtfmYMod=1, we need the lowest and highest wave headings to be exactly -180 deg and 180 deg, respectively, in "' & //TRIM(InitInp%WAMITFile)//'.3" (inclusive).' CALL SetErrStat( ErrID_Fatal, ErrMsg2, ErrStat, ErrMsg, RoutineName) CALL Cleanup() @@ -1371,7 +1372,7 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS end if end if - IF ( (p%ExctnMod>0) .AND. (p%ExctnDisp==2) ) THEN ! Allocate array for filtered potential-flow body positions + IF ( (p%ExctnMod>0) .AND. (p%ExctnDisp==2) ) THEN ! Allocate and initialize array for filtered potential-flow body positions p%ExctnFiltConst = exp(-2.0*Pi*p%ExctnCutOff * Interval) ALLOCATE ( xd%BdyPosFilt(1:2, 1:p%NBody, 1:3) , STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN @@ -1379,7 +1380,16 @@ SUBROUTINE WAMIT_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ErrS CALL Cleanup() RETURN END IF - xd%BdyPosFilt = 0.0_ReKi + orientation = EulerConstructZYX(InitInp%PlatformPos(4:6)); + DO iBdy = 1,p%NBody + ! Initial WAMIT body position + BdyPos0 = InitInp%PlatformPos(1:3) & + + matmul((/InitInp%PtfmRefxt(iBdy),InitInp%PtfmRefyt(iBdy),InitInp%PtfmRefzt(iBdy)/),orientation) & + - (/InitInp%PtfmRefxt(iBdy),InitInp%PtfmRefyt(iBdy),InitInp%PtfmRefzt(iBdy)/) + DO iStp = 1,3 + xd%BdyPosFilt(1:2,iBdy,iStp) = BdyPos0(1:2) + END DO + END DO END IF ENDSELECT @@ -1985,7 +1995,7 @@ SUBROUTINE WAMIT_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er END IF IF ( (ABS( WrapToPi(rotDisp(3)-u%PtfmRefY) ) > LrgAngle) .AND. FrstWarn_LrgY ) THEN ErrStat2 = ErrID_Severe - ErrMsg2 = 'Yaw angle of a potential-flow body relative to the reference yaw position (PtfmRefY) violated the small angle assumption. The solution might be inaccurate. Consider using PtfmYMod=1 and adjust PtfmYCutoff in ElastoDyn. Simulation continuing, but future warnings will be suppressed.' + ErrMsg2 = 'Yaw angle of a potential-flow body relative to the reference yaw position (PtfmRefY) violated the small angle assumption. The solution might be inaccurate. Consider using PtfmYMod=1 and adjust PtfmYCutoff. Simulation continuing, but future warnings will be suppressed.' call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FrstWarn_LrgY = .FALSE. END IF diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index df76292930..0d07cfe542 100644 --- a/modules/hydrodyn/src/WAMIT.txt +++ b/modules/hydrodyn/src/WAMIT.txt @@ -34,13 +34,14 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER ExctnMod - - - "" - typedef ^ ^ INTEGER ExctnDisp - - - "0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0]" - typedef ^ ^ ReKi ExctnCutOff - - - "Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] " Hz -typedef ^ ^ IntKi NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1 in the HydroDyn driver or in ElastoDyn]" +typedef ^ ^ IntKi NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1]" typedef ^ ^ DbKi RdtnTMax - - - "" - typedef ^ ^ CHARACTER(1024) WAMITFile - - - "" - typedef ^ ^ Conv_Rdtn_InitInputType Conv_Rdtn - - - "" - typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" typedef ^ ^ INTEGER PtfmYMod - - - "Large yaw model" - typedef ^ ^ ReKi PtfmRefY - - - "Initial reference yaw offset" (rad) +typedef ^ ^ ReKi PlatformPos {6} - - "Initial platform position (6 DOFs)" # # # Define outputs from the initialization routine here: @@ -109,7 +110,7 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER ExctnMod - - - "" - typedef ^ ^ INTEGER ExctnDisp - - - "0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0]" - typedef ^ ^ ReKi ExctnCutOff - - - "Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] " Hz -typedef ^ ^ IntKi NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1 in the HydroDyn driver or in ElastoDyn]" +typedef ^ ^ IntKi NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1]" typedef ^ ^ ReKi ExctnFiltConst - - - "Low-pass time filter constant computed from ExctnCutOff" typedef ^ ^ SiKi WaveExctn {:}{:}{:} - - "" - typedef ^ ^ SiKi WaveExctnGrid {:}{:}{:}{:}{:} - - "WaveExctnGrid dimensions are: 1st: wavetime, 2nd: X, 3rd: Y, 4th: PRP Yaw, 5th: Force component for eac WAMIT Body" - diff --git a/modules/hydrodyn/src/WAMIT2.txt b/modules/hydrodyn/src/WAMIT2.txt index c2b948f610..ad3ec0d6f3 100644 --- a/modules/hydrodyn/src/WAMIT2.txt +++ b/modules/hydrodyn/src/WAMIT2.txt @@ -33,7 +33,7 @@ typedef ^ ^ ReKi Gravity typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" typedef ^ ^ INTEGER PtfmYMod - - - "Large yaw model" - typedef ^ ^ ReKi PtfmRefY - - - "Initial reference yaw offset" (rad) -typedef ^ ^ IntKi NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1 in the HydroDyn driver or in ElastoDyn]" +typedef ^ ^ IntKi NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1]" #[note: only one of MnDriff / NewmanApp / DiffQTF can be non-zero typedef ^ ^ INTEGER MnDrift - - - "Calculate the mean drift force {0: no mean drift; [7,8,9,10,11, or 12]: WAMIT file to use}" - @@ -74,7 +74,7 @@ typedef ^ ^ LOGICAL NewmanAppF typedef ^ ^ LOGICAL DiffQTFF - - - "Flag indicating the full difference QTF should be calculated" - typedef ^ ^ LOGICAL SumQTFF - - - "Flag indicating the full sum QTF should be calculated" - typedef ^ ^ INTEGER PtfmYMod - - - "Large yaw model" - -typedef ^ ^ INTEGER NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1 in the HydroDyn driver or in ElastoDyn]" +typedef ^ ^ INTEGER NExctnHdg - - - "Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1]" # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 11ccaf43c7..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 [-] @@ -50,7 +50,7 @@ MODULE WAMIT2_Types TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] INTEGER(IntKi) :: PtfmYMod = 0_IntKi !< Large yaw model [-] REAL(ReKi) :: PtfmRefY = 0.0_ReKi !< Initial reference yaw offset [(rad)] - INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1 in the HydroDyn driver or in ElastoDyn] [-] + INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1] [-] INTEGER(IntKi) :: MnDrift = 0_IntKi !< Calculate the mean drift force {0: no mean drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] INTEGER(IntKi) :: NewmanApp = 0_IntKi !< Slow drift forces computed with Newman approximation from WAMIT file:{0: No slow drift; [7,8,9,10,11, or 12]: WAMIT file to use} [-] INTEGER(IntKi) :: DiffQTF = 0_IntKi !< Full Difference-Frequency forces computed with full QTF's from WAMIT file: {0: No diff-QTF; [10,11, or 12]: WAMIT file to use} [-] @@ -83,7 +83,7 @@ MODULE WAMIT2_Types LOGICAL :: DiffQTFF = .false. !< Flag indicating the full difference QTF should be calculated [-] LOGICAL :: SumQTFF = .false. !< Flag indicating the full sum QTF should be calculated [-] INTEGER(IntKi) :: PtfmYMod = 0_IntKi !< Large yaw model [-] - INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1 in the HydroDyn driver or in ElastoDyn] [-] + INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1] [-] END TYPE WAMIT2_ParameterType ! ======================= ! ========= WAMIT2_OutputType ======= @@ -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 @@ -99,7 +101,7 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT2_CopyInitInput' @@ -110,8 +112,8 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%NBody = SrcInitInputData%NBody DstInitInputData%NBodyMod = SrcInitInputData%NBodyMod if (allocated(SrcInitInputData%PtfmRefxt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefxt, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefxt, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefxt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefxt) if (.not. allocated(DstInitInputData%PtfmRefxt)) then allocate(DstInitInputData%PtfmRefxt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -122,8 +124,8 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt end if if (allocated(SrcInitInputData%PtfmRefyt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefyt, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefyt, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefyt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefyt) if (.not. allocated(DstInitInputData%PtfmRefyt)) then allocate(DstInitInputData%PtfmRefyt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -134,8 +136,8 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt end if if (allocated(SrcInitInputData%PtfmRefzt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefzt, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefzt, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefzt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefzt) if (.not. allocated(DstInitInputData%PtfmRefzt)) then allocate(DstInitInputData%PtfmRefzt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -146,8 +148,8 @@ subroutine WAMIT2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt end if if (allocated(SrcInitInputData%PtfmRefztRot)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) if (.not. allocated(DstInitInputData%PtfmRefztRot)) then allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -238,7 +240,7 @@ subroutine WAMIT2_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(WAMIT2_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT2_UnPackInitInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -291,15 +293,15 @@ subroutine WAMIT2_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT2_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%LastIndWave)) then - LB(1:1) = lbound(SrcMiscData%LastIndWave, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LastIndWave, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%LastIndWave) + UB(1:1) = ubound(SrcMiscData%LastIndWave) if (.not. allocated(DstMiscData%LastIndWave)) then allocate(DstMiscData%LastIndWave(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -310,8 +312,8 @@ subroutine WAMIT2_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%LastIndWave = SrcMiscData%LastIndWave end if if (allocated(SrcMiscData%F_Waves2)) then - LB(1:1) = lbound(SrcMiscData%F_Waves2, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_Waves2, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%F_Waves2) + UB(1:1) = ubound(SrcMiscData%F_Waves2) if (.not. allocated(DstMiscData%F_Waves2)) then allocate(DstMiscData%F_Waves2(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -360,7 +362,7 @@ subroutine WAMIT2_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(WAMIT2_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT2_UnPackMisc' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -375,7 +377,7 @@ subroutine WAMIT2_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT2_CopyParam' @@ -384,8 +386,8 @@ subroutine WAMIT2_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMs DstParamData%NBody = SrcParamData%NBody DstParamData%NBodyMod = SrcParamData%NBodyMod if (allocated(SrcParamData%WaveExctn2Grid)) then - LB(1:5) = lbound(SrcParamData%WaveExctn2Grid, kind=B8Ki) - UB(1:5) = ubound(SrcParamData%WaveExctn2Grid, kind=B8Ki) + LB(1:5) = lbound(SrcParamData%WaveExctn2Grid) + UB(1:5) = ubound(SrcParamData%WaveExctn2Grid) if (.not. allocated(DstParamData%WaveExctn2Grid)) then allocate(DstParamData%WaveExctn2Grid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -452,7 +454,7 @@ subroutine WAMIT2_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(WAMIT2_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT2_UnPackParam' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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 4878ae1e85..761b3130e2 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -54,13 +54,14 @@ MODULE WAMIT_Types INTEGER(IntKi) :: ExctnMod = 0_IntKi !< [-] INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] REAL(ReKi) :: ExctnCutOff = 0.0_ReKi !< Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [Hz] - INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1 in the HydroDyn driver or in ElastoDyn] [-] + INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1] [-] REAL(DbKi) :: RdtnTMax = 0.0_R8Ki !< [-] CHARACTER(1024) :: WAMITFile !< [-] TYPE(Conv_Rdtn_InitInputType) :: Conv_Rdtn !< [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] INTEGER(IntKi) :: PtfmYMod = 0_IntKi !< Large yaw model [-] REAL(ReKi) :: PtfmRefY = 0.0_ReKi !< Initial reference yaw offset [(rad)] + REAL(ReKi) , DIMENSION(1:6) :: PlatformPos = 0.0_ReKi !< Initial platform position (6 DOFs) [-] END TYPE WAMIT_InitInputType ! ======================= ! ========= WAMIT_ContinuousStateType ======= @@ -122,7 +123,7 @@ MODULE WAMIT_Types INTEGER(IntKi) :: ExctnMod = 0_IntKi !< [-] INTEGER(IntKi) :: ExctnDisp = 0_IntKi !< 0: use undisplaced position, 1: use displaced position, 2: use low-pass filtered displaced position) [only used when PotMod=1 and ExctnMod>0] [-] REAL(ReKi) :: ExctnCutOff = 0.0_ReKi !< Cutoff (corner) frequency of the low-pass time-filtered displaced position (Hz) [>0.0] [Hz] - INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1 in the HydroDyn driver or in ElastoDyn] [-] + INTEGER(IntKi) :: NExctnHdg = 0_IntKi !< Number of PRP headings/yaw offset evenly distributed over the region [-180, 180) deg to be used when precomputing the wave excitation [only used when PtfmYMod=1] [-] REAL(ReKi) :: ExctnFiltConst = 0.0_ReKi !< Low-pass time filter constant computed from ExctnCutOff [-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveExctn !< [-] REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: WaveExctnGrid !< WaveExctnGrid dimensions are: 1st: wavetime, 2nd: X, 3rd: Y, 4th: PRP Yaw, 5th: Force component for eac WAMIT Body [-] @@ -146,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 @@ -154,7 +165,7 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT_CopyInitInput' @@ -164,8 +175,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%NBodyMod = SrcInitInputData%NBodyMod DstInitInputData%Gravity = SrcInitInputData%Gravity if (allocated(SrcInitInputData%PtfmVol0)) then - LB(1:1) = lbound(SrcInitInputData%PtfmVol0, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmVol0, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmVol0) + UB(1:1) = ubound(SrcInitInputData%PtfmVol0) if (.not. allocated(DstInitInputData%PtfmVol0)) then allocate(DstInitInputData%PtfmVol0(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -178,8 +189,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%HasWAMIT = SrcInitInputData%HasWAMIT DstInitInputData%WAMITULEN = SrcInitInputData%WAMITULEN if (allocated(SrcInitInputData%PtfmRefxt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefxt, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefxt, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefxt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefxt) if (.not. allocated(DstInitInputData%PtfmRefxt)) then allocate(DstInitInputData%PtfmRefxt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -190,8 +201,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%PtfmRefxt = SrcInitInputData%PtfmRefxt end if if (allocated(SrcInitInputData%PtfmRefyt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefyt, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefyt, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefyt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefyt) if (.not. allocated(DstInitInputData%PtfmRefyt)) then allocate(DstInitInputData%PtfmRefyt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -202,8 +213,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%PtfmRefyt = SrcInitInputData%PtfmRefyt end if if (allocated(SrcInitInputData%PtfmRefzt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefzt, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefzt, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefzt) + UB(1:1) = ubound(SrcInitInputData%PtfmRefzt) if (.not. allocated(DstInitInputData%PtfmRefzt)) then allocate(DstInitInputData%PtfmRefzt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -214,8 +225,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%PtfmRefzt = SrcInitInputData%PtfmRefzt end if if (allocated(SrcInitInputData%PtfmRefztRot)) then - LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmRefztRot) + UB(1:1) = ubound(SrcInitInputData%PtfmRefztRot) if (.not. allocated(DstInitInputData%PtfmRefztRot)) then allocate(DstInitInputData%PtfmRefztRot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -226,8 +237,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%PtfmRefztRot = SrcInitInputData%PtfmRefztRot end if if (allocated(SrcInitInputData%PtfmCOBxt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmCOBxt, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmCOBxt, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmCOBxt) + UB(1:1) = ubound(SrcInitInputData%PtfmCOBxt) if (.not. allocated(DstInitInputData%PtfmCOBxt)) then allocate(DstInitInputData%PtfmCOBxt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -238,8 +249,8 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%PtfmCOBxt = SrcInitInputData%PtfmCOBxt end if if (allocated(SrcInitInputData%PtfmCOByt)) then - LB(1:1) = lbound(SrcInitInputData%PtfmCOByt, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%PtfmCOByt, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%PtfmCOByt) + UB(1:1) = ubound(SrcInitInputData%PtfmCOByt) if (.not. allocated(DstInitInputData%PtfmCOByt)) then allocate(DstInitInputData%PtfmCOByt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -262,6 +273,7 @@ subroutine WAMIT_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WaveField => SrcInitInputData%WaveField DstInitInputData%PtfmYMod = SrcInitInputData%PtfmYMod DstInitInputData%PtfmRefY = SrcInitInputData%PtfmRefY + DstInitInputData%PlatformPos = SrcInitInputData%PlatformPos end subroutine subroutine WAMIT_DestroyInitInput(InitInputData, ErrStat, ErrMsg) @@ -334,6 +346,7 @@ subroutine WAMIT_PackInitInput(RF, Indata) end if call RegPack(RF, InData%PtfmYMod) call RegPack(RF, InData%PtfmRefY) + call RegPack(RF, InData%PlatformPos) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -341,7 +354,7 @@ subroutine WAMIT_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(WAMIT_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackInitInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -387,6 +400,7 @@ subroutine WAMIT_UnPackInitInput(RF, OutData) end if call RegUnpack(RF, OutData%PtfmYMod); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%PtfmRefY); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PlatformPos); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine WAMIT_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -455,7 +469,7 @@ subroutine WAMIT_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT_CopyDiscState' @@ -471,8 +485,8 @@ subroutine WAMIT_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcDiscStateData%BdyPosFilt)) then - LB(1:3) = lbound(SrcDiscStateData%BdyPosFilt, kind=B8Ki) - UB(1:3) = ubound(SrcDiscStateData%BdyPosFilt, kind=B8Ki) + LB(1:3) = lbound(SrcDiscStateData%BdyPosFilt) + UB(1:3) = ubound(SrcDiscStateData%BdyPosFilt) if (.not. allocated(DstDiscStateData%BdyPosFilt)) then allocate(DstDiscStateData%BdyPosFilt(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -520,7 +534,7 @@ subroutine WAMIT_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(WAMIT_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackDiscState' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -656,7 +670,7 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT_CopyMisc' @@ -664,8 +678,8 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) ErrMsg = '' DstMiscData%LastIndWave = SrcMiscData%LastIndWave if (allocated(SrcMiscData%F_HS)) then - LB(1:1) = lbound(SrcMiscData%F_HS, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_HS, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%F_HS) + UB(1:1) = ubound(SrcMiscData%F_HS) if (.not. allocated(DstMiscData%F_HS)) then allocate(DstMiscData%F_HS(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -676,8 +690,8 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_HS = SrcMiscData%F_HS end if if (allocated(SrcMiscData%F_Waves1)) then - LB(1:1) = lbound(SrcMiscData%F_Waves1, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_Waves1, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%F_Waves1) + UB(1:1) = ubound(SrcMiscData%F_Waves1) if (.not. allocated(DstMiscData%F_Waves1)) then allocate(DstMiscData%F_Waves1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -688,8 +702,8 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_Waves1 = SrcMiscData%F_Waves1 end if if (allocated(SrcMiscData%F_Rdtn)) then - LB(1:1) = lbound(SrcMiscData%F_Rdtn, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_Rdtn, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%F_Rdtn) + UB(1:1) = ubound(SrcMiscData%F_Rdtn) if (.not. allocated(DstMiscData%F_Rdtn)) then allocate(DstMiscData%F_Rdtn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -700,8 +714,8 @@ subroutine WAMIT_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_Rdtn = SrcMiscData%F_Rdtn end if if (allocated(SrcMiscData%F_PtfmAM)) then - LB(1:1) = lbound(SrcMiscData%F_PtfmAM, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_PtfmAM, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%F_PtfmAM) + UB(1:1) = ubound(SrcMiscData%F_PtfmAM) if (.not. allocated(DstMiscData%F_PtfmAM)) then allocate(DstMiscData%F_PtfmAM(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -813,7 +827,7 @@ subroutine WAMIT_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(WAMIT_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackMisc' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -840,7 +854,7 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WAMIT_CopyParam' @@ -849,8 +863,8 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%NBody = SrcParamData%NBody DstParamData%NBodyMod = SrcParamData%NBodyMod if (allocated(SrcParamData%F_HS_Moment_Offset)) then - LB(1:2) = lbound(SrcParamData%F_HS_Moment_Offset, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%F_HS_Moment_Offset, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%F_HS_Moment_Offset) + UB(1:2) = ubound(SrcParamData%F_HS_Moment_Offset) if (.not. allocated(DstParamData%F_HS_Moment_Offset)) then allocate(DstParamData%F_HS_Moment_Offset(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -861,8 +875,8 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%F_HS_Moment_Offset = SrcParamData%F_HS_Moment_Offset end if if (allocated(SrcParamData%HdroAdMsI)) then - LB(1:2) = lbound(SrcParamData%HdroAdMsI, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%HdroAdMsI, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%HdroAdMsI) + UB(1:2) = ubound(SrcParamData%HdroAdMsI) if (.not. allocated(DstParamData%HdroAdMsI)) then allocate(DstParamData%HdroAdMsI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -873,8 +887,8 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%HdroAdMsI = SrcParamData%HdroAdMsI end if if (allocated(SrcParamData%HdroSttc)) then - LB(1:2) = lbound(SrcParamData%HdroSttc, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%HdroSttc, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%HdroSttc) + UB(1:2) = ubound(SrcParamData%HdroSttc) if (.not. allocated(DstParamData%HdroSttc)) then allocate(DstParamData%HdroSttc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -891,8 +905,8 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%NExctnHdg = SrcParamData%NExctnHdg DstParamData%ExctnFiltConst = SrcParamData%ExctnFiltConst if (allocated(SrcParamData%WaveExctn)) then - LB(1:3) = lbound(SrcParamData%WaveExctn, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%WaveExctn, kind=B8Ki) + LB(1:3) = lbound(SrcParamData%WaveExctn) + UB(1:3) = ubound(SrcParamData%WaveExctn) if (.not. allocated(DstParamData%WaveExctn)) then allocate(DstParamData%WaveExctn(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -903,8 +917,8 @@ subroutine WAMIT_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveExctn = SrcParamData%WaveExctn end if if (allocated(SrcParamData%WaveExctnGrid)) then - LB(1:5) = lbound(SrcParamData%WaveExctnGrid, kind=B8Ki) - UB(1:5) = ubound(SrcParamData%WaveExctnGrid, kind=B8Ki) + LB(1:5) = lbound(SrcParamData%WaveExctnGrid) + UB(1:5) = ubound(SrcParamData%WaveExctnGrid) if (.not. allocated(DstParamData%WaveExctnGrid)) then allocate(DstParamData%WaveExctnGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1005,7 +1019,7 @@ subroutine WAMIT_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(WAMIT_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WAMIT_UnPackParam' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1458,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 c62479cd44..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 @@ -232,7 +245,7 @@ subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IceD_CopyInputFile' ErrStat = ErrID_None @@ -249,8 +262,8 @@ subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%Seed2 = SrcInputFileData%Seed2 DstInputFileData%NumLegs = SrcInputFileData%NumLegs if (allocated(SrcInputFileData%LegPosX)) then - LB(1:1) = lbound(SrcInputFileData%LegPosX, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LegPosX, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LegPosX) + UB(1:1) = ubound(SrcInputFileData%LegPosX) if (.not. allocated(DstInputFileData%LegPosX)) then allocate(DstInputFileData%LegPosX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -261,8 +274,8 @@ subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LegPosX = SrcInputFileData%LegPosX end if if (allocated(SrcInputFileData%LegPosY)) then - LB(1:1) = lbound(SrcInputFileData%LegPosY, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%LegPosY, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%LegPosY) + UB(1:1) = ubound(SrcInputFileData%LegPosY) if (.not. allocated(DstInputFileData%LegPosY)) then allocate(DstInputFileData%LegPosY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -273,8 +286,8 @@ subroutine IceD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%LegPosY = SrcInputFileData%LegPosY end if if (allocated(SrcInputFileData%StrWd)) then - LB(1:1) = lbound(SrcInputFileData%StrWd, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%StrWd, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%StrWd) + UB(1:1) = ubound(SrcInputFileData%StrWd) if (.not. allocated(DstInputFileData%StrWd)) then allocate(DstInputFileData%StrWd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -422,7 +435,7 @@ subroutine IceD_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(IceD_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackInputFile' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -550,15 +563,15 @@ subroutine IceD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'IceD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -569,8 +582,8 @@ subroutine IceD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -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 @@ -621,7 +640,7 @@ subroutine IceD_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(IceD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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) @@ -754,8 +774,8 @@ subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'IceD_CopyOtherState' @@ -763,8 +783,8 @@ subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E ErrMsg = '' DstOtherStateData%IceTthNo2 = SrcOtherStateData%IceTthNo2 if (allocated(SrcOtherStateData%Nc)) then - LB(1:1) = lbound(SrcOtherStateData%Nc, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Nc, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Nc) + UB(1:1) = ubound(SrcOtherStateData%Nc) if (.not. allocated(DstOtherStateData%Nc)) then allocate(DstOtherStateData%Nc(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -775,8 +795,8 @@ subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%Nc = SrcOtherStateData%Nc end if if (allocated(SrcOtherStateData%Psum)) then - LB(1:1) = lbound(SrcOtherStateData%Psum, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Psum, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Psum) + UB(1:1) = ubound(SrcOtherStateData%Psum) if (.not. allocated(DstOtherStateData%Psum)) then allocate(DstOtherStateData%Psum(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -787,8 +807,8 @@ subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%Psum = SrcOtherStateData%Psum end if if (allocated(SrcOtherStateData%IceTthNo)) then - LB(1:1) = lbound(SrcOtherStateData%IceTthNo, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%IceTthNo, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%IceTthNo) + UB(1:1) = ubound(SrcOtherStateData%IceTthNo) if (.not. allocated(DstOtherStateData%IceTthNo)) then allocate(DstOtherStateData%IceTthNo(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -803,8 +823,8 @@ subroutine IceD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%Splitf = SrcOtherStateData%Splitf DstOtherStateData%dxc = SrcOtherStateData%dxc if (allocated(SrcOtherStateData%xdot)) then - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) if (.not. allocated(DstOtherStateData%xdot)) then allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -825,8 +845,8 @@ subroutine IceD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(IceD_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'IceD_DestroyOtherState' @@ -842,8 +862,8 @@ subroutine IceD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) deallocate(OtherStateData%IceTthNo) end if if (allocated(OtherStateData%xdot)) then - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call IceD_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -856,8 +876,8 @@ subroutine IceD_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(IceD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'IceD_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%IceTthNo2) call RegPackAlloc(RF, InData%Nc) @@ -869,9 +889,9 @@ subroutine IceD_PackOtherState(RF, Indata) call RegPack(RF, InData%dxc) call RegPack(RF, allocated(InData%xdot)) if (allocated(InData%xdot)) then - call RegPackBounds(RF, 1, lbound(InData%xdot, kind=B8Ki), ubound(InData%xdot, kind=B8Ki)) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xdot), ubound(InData%xdot)) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call IceD_PackContState(RF, InData%xdot(i1)) end do @@ -884,8 +904,8 @@ subroutine IceD_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(IceD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -913,51 +933,13 @@ 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 integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IceD_CopyParam' ErrStat = ErrID_None @@ -977,8 +959,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%method = SrcParamData%method DstParamData%TmStep = SrcParamData%TmStep if (allocated(SrcParamData%OutName)) then - LB(1:1) = lbound(SrcParamData%OutName, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutName, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutName) + UB(1:1) = ubound(SrcParamData%OutName) if (.not. allocated(DstParamData%OutName)) then allocate(DstParamData%OutName(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -989,8 +971,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%OutName = SrcParamData%OutName end if if (allocated(SrcParamData%OutUnit)) then - LB(1:1) = lbound(SrcParamData%OutUnit, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutUnit, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%OutUnit) + UB(1:1) = ubound(SrcParamData%OutUnit) if (.not. allocated(DstParamData%OutUnit)) then allocate(DstParamData%OutUnit(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1014,8 +996,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Pitch = SrcParamData%Pitch DstParamData%Kice2 = SrcParamData%Kice2 if (allocated(SrcParamData%rdmFm)) then - LB(1:1) = lbound(SrcParamData%rdmFm, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rdmFm, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rdmFm) + UB(1:1) = ubound(SrcParamData%rdmFm) if (.not. allocated(DstParamData%rdmFm)) then allocate(DstParamData%rdmFm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1026,8 +1008,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rdmFm = SrcParamData%rdmFm end if if (allocated(SrcParamData%rdmt0)) then - LB(1:1) = lbound(SrcParamData%rdmt0, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rdmt0, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rdmt0) + UB(1:1) = ubound(SrcParamData%rdmt0) if (.not. allocated(DstParamData%rdmt0)) then allocate(DstParamData%rdmt0(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1038,8 +1020,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rdmt0 = SrcParamData%rdmt0 end if if (allocated(SrcParamData%rdmtm)) then - LB(1:1) = lbound(SrcParamData%rdmtm, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rdmtm, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rdmtm) + UB(1:1) = ubound(SrcParamData%rdmtm) if (.not. allocated(DstParamData%rdmtm)) then allocate(DstParamData%rdmtm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1050,8 +1032,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rdmtm = SrcParamData%rdmtm end if if (allocated(SrcParamData%rdmDm)) then - LB(1:1) = lbound(SrcParamData%rdmDm, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rdmDm, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rdmDm) + UB(1:1) = ubound(SrcParamData%rdmDm) if (.not. allocated(DstParamData%rdmDm)) then allocate(DstParamData%rdmDm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1062,8 +1044,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rdmDm = SrcParamData%rdmDm end if if (allocated(SrcParamData%rdmP)) then - LB(1:1) = lbound(SrcParamData%rdmP, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rdmP, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rdmP) + UB(1:1) = ubound(SrcParamData%rdmP) if (.not. allocated(DstParamData%rdmP)) then allocate(DstParamData%rdmP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1074,8 +1056,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rdmP = SrcParamData%rdmP end if if (allocated(SrcParamData%rdmKi)) then - LB(1:1) = lbound(SrcParamData%rdmKi, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rdmKi, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%rdmKi) + UB(1:1) = ubound(SrcParamData%rdmKi) if (.not. allocated(DstParamData%rdmKi)) then allocate(DstParamData%rdmKi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1089,8 +1071,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Kice = SrcParamData%Kice DstParamData%Delmax = SrcParamData%Delmax if (allocated(SrcParamData%Y0)) then - LB(1:1) = lbound(SrcParamData%Y0, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Y0, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Y0) + UB(1:1) = ubound(SrcParamData%Y0) if (.not. allocated(DstParamData%Y0)) then allocate(DstParamData%Y0(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1101,8 +1083,8 @@ subroutine IceD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Y0 = SrcParamData%Y0 end if if (allocated(SrcParamData%ContPrfl)) then - LB(1:1) = lbound(SrcParamData%ContPrfl, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ContPrfl, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ContPrfl) + UB(1:1) = ubound(SrcParamData%ContPrfl) if (.not. allocated(DstParamData%ContPrfl)) then allocate(DstParamData%ContPrfl(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1241,7 +1223,7 @@ subroutine IceD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(IceD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackParam' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1357,7 +1339,7 @@ subroutine IceD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'IceD_CopyOutput' @@ -1367,8 +1349,8 @@ subroutine IceD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -1410,7 +1392,7 @@ subroutine IceD_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(IceD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceD_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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 41cffbc0de..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 @@ -166,15 +178,15 @@ subroutine IceFloe_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'IceFloe_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -185,8 +197,8 @@ subroutine IceFloe_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -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 @@ -235,13 +253,14 @@ subroutine IceFloe_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(IceFloe_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc 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 NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars end subroutine subroutine IceFloe_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -396,58 +415,20 @@ 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 integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IceFloe_CopyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcParamData%loadSeries)) then - LB(1:2) = lbound(SrcParamData%loadSeries, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%loadSeries, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%loadSeries) + UB(1:2) = ubound(SrcParamData%loadSeries) if (.not. allocated(DstParamData%loadSeries)) then allocate(DstParamData%loadSeries(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -468,8 +449,8 @@ subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%dt = SrcParamData%dt DstParamData%rampTime = SrcParamData%rampTime if (allocated(SrcParamData%legX)) then - LB(1:1) = lbound(SrcParamData%legX, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%legX, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%legX) + UB(1:1) = ubound(SrcParamData%legX) if (.not. allocated(DstParamData%legX)) then allocate(DstParamData%legX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -480,8 +461,8 @@ subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%legX = SrcParamData%legX end if if (allocated(SrcParamData%legY)) then - LB(1:1) = lbound(SrcParamData%legY, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%legY, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%legY) + UB(1:1) = ubound(SrcParamData%legY) if (.not. allocated(DstParamData%legY)) then allocate(DstParamData%legY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -492,8 +473,8 @@ subroutine IceFloe_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrM DstParamData%legY = SrcParamData%legY end if if (allocated(SrcParamData%ks)) then - LB(1:1) = lbound(SrcParamData%ks, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ks, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ks) + UB(1:1) = ubound(SrcParamData%ks) if (.not. allocated(DstParamData%ks)) then allocate(DstParamData%ks(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -562,7 +543,7 @@ subroutine IceFloe_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(IceFloe_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackParam' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -639,7 +620,7 @@ subroutine IceFloe_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'IceFloe_CopyOutput' @@ -649,8 +630,8 @@ subroutine IceFloe_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -692,7 +673,7 @@ subroutine IceFloe_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(IceFloe_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IceFloe_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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 9861a9692c..1bc8209fb4 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 74f0df30d9..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 @@ -172,7 +173,7 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IfW_FlowField_CopyUniformFieldType' ErrStat = ErrID_None @@ -181,8 +182,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%RefLength = SrcUniformFieldTypeData%RefLength DstUniformFieldTypeData%DataSize = SrcUniformFieldTypeData%DataSize if (allocated(SrcUniformFieldTypeData%Time)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%Time, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%Time, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%Time) + UB(1:1) = ubound(SrcUniformFieldTypeData%Time) if (.not. allocated(DstUniformFieldTypeData%Time)) then allocate(DstUniformFieldTypeData%Time(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -193,8 +194,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%Time = SrcUniformFieldTypeData%Time end if if (allocated(SrcUniformFieldTypeData%VelH)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%VelH, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%VelH, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%VelH) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelH) if (.not. allocated(DstUniformFieldTypeData%VelH)) then allocate(DstUniformFieldTypeData%VelH(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -205,8 +206,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%VelH = SrcUniformFieldTypeData%VelH end if if (allocated(SrcUniformFieldTypeData%VelHDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%VelHDot, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%VelHDot, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%VelHDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelHDot) if (.not. allocated(DstUniformFieldTypeData%VelHDot)) then allocate(DstUniformFieldTypeData%VelHDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -217,8 +218,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%VelHDot = SrcUniformFieldTypeData%VelHDot end if if (allocated(SrcUniformFieldTypeData%VelV)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%VelV, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%VelV, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%VelV) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelV) if (.not. allocated(DstUniformFieldTypeData%VelV)) then allocate(DstUniformFieldTypeData%VelV(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -229,8 +230,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%VelV = SrcUniformFieldTypeData%VelV end if if (allocated(SrcUniformFieldTypeData%VelVDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%VelVDot, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%VelVDot, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%VelVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelVDot) if (.not. allocated(DstUniformFieldTypeData%VelVDot)) then allocate(DstUniformFieldTypeData%VelVDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -241,8 +242,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%VelVDot = SrcUniformFieldTypeData%VelVDot end if if (allocated(SrcUniformFieldTypeData%VelGust)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%VelGust, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%VelGust, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%VelGust) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelGust) if (.not. allocated(DstUniformFieldTypeData%VelGust)) then allocate(DstUniformFieldTypeData%VelGust(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -253,8 +254,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%VelGust = SrcUniformFieldTypeData%VelGust end if if (allocated(SrcUniformFieldTypeData%VelGustDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%VelGustDot, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%VelGustDot, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%VelGustDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%VelGustDot) if (.not. allocated(DstUniformFieldTypeData%VelGustDot)) then allocate(DstUniformFieldTypeData%VelGustDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -265,8 +266,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%VelGustDot = SrcUniformFieldTypeData%VelGustDot end if if (allocated(SrcUniformFieldTypeData%AngleH)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%AngleH, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%AngleH, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleH) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleH) if (.not. allocated(DstUniformFieldTypeData%AngleH)) then allocate(DstUniformFieldTypeData%AngleH(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -277,8 +278,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%AngleH = SrcUniformFieldTypeData%AngleH end if if (allocated(SrcUniformFieldTypeData%AngleHDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%AngleHDot, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%AngleHDot, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleHDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleHDot) if (.not. allocated(DstUniformFieldTypeData%AngleHDot)) then allocate(DstUniformFieldTypeData%AngleHDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -289,8 +290,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%AngleHDot = SrcUniformFieldTypeData%AngleHDot end if if (allocated(SrcUniformFieldTypeData%AngleV)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%AngleV, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%AngleV, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleV) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleV) if (.not. allocated(DstUniformFieldTypeData%AngleV)) then allocate(DstUniformFieldTypeData%AngleV(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -301,8 +302,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%AngleV = SrcUniformFieldTypeData%AngleV end if if (allocated(SrcUniformFieldTypeData%AngleVDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%AngleVDot, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%AngleVDot, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%AngleVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%AngleVDot) if (.not. allocated(DstUniformFieldTypeData%AngleVDot)) then allocate(DstUniformFieldTypeData%AngleVDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -313,8 +314,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%AngleVDot = SrcUniformFieldTypeData%AngleVDot end if if (allocated(SrcUniformFieldTypeData%ShrH)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%ShrH, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%ShrH, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrH) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrH) if (.not. allocated(DstUniformFieldTypeData%ShrH)) then allocate(DstUniformFieldTypeData%ShrH(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -325,8 +326,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%ShrH = SrcUniformFieldTypeData%ShrH end if if (allocated(SrcUniformFieldTypeData%ShrHDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%ShrHDot, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%ShrHDot, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrHDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrHDot) if (.not. allocated(DstUniformFieldTypeData%ShrHDot)) then allocate(DstUniformFieldTypeData%ShrHDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -337,8 +338,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%ShrHDot = SrcUniformFieldTypeData%ShrHDot end if if (allocated(SrcUniformFieldTypeData%ShrV)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%ShrV, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%ShrV, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrV) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrV) if (.not. allocated(DstUniformFieldTypeData%ShrV)) then allocate(DstUniformFieldTypeData%ShrV(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -349,8 +350,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%ShrV = SrcUniformFieldTypeData%ShrV end if if (allocated(SrcUniformFieldTypeData%ShrVDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%ShrVDot, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%ShrVDot, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%ShrVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%ShrVDot) if (.not. allocated(DstUniformFieldTypeData%ShrVDot)) then allocate(DstUniformFieldTypeData%ShrVDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -361,8 +362,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%ShrVDot = SrcUniformFieldTypeData%ShrVDot end if if (allocated(SrcUniformFieldTypeData%LinShrV)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrV, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%LinShrV, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrV) + UB(1:1) = ubound(SrcUniformFieldTypeData%LinShrV) if (.not. allocated(DstUniformFieldTypeData%LinShrV)) then allocate(DstUniformFieldTypeData%LinShrV(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -373,8 +374,8 @@ subroutine IfW_FlowField_CopyUniformFieldType(SrcUniformFieldTypeData, DstUnifor DstUniformFieldTypeData%LinShrV = SrcUniformFieldTypeData%LinShrV end if if (allocated(SrcUniformFieldTypeData%LinShrVDot)) then - LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrVDot, kind=B8Ki) - UB(1:1) = ubound(SrcUniformFieldTypeData%LinShrVDot, kind=B8Ki) + LB(1:1) = lbound(SrcUniformFieldTypeData%LinShrVDot) + UB(1:1) = ubound(SrcUniformFieldTypeData%LinShrVDot) if (.not. allocated(DstUniformFieldTypeData%LinShrVDot)) then allocate(DstUniformFieldTypeData%LinShrVDot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -478,7 +479,7 @@ subroutine IfW_FlowField_UnPackUniformFieldType(RF, OutData) type(RegFile), intent(inout) :: RF type(UniformFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackUniformFieldType' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -605,7 +606,7 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IfW_FlowField_CopyGrid3DFieldType' ErrStat = ErrID_None @@ -618,8 +619,8 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi DstGrid3DFieldTypeData%RefHeight = SrcGrid3DFieldTypeData%RefHeight DstGrid3DFieldTypeData%RefLength = SrcGrid3DFieldTypeData%RefLength if (allocated(SrcGrid3DFieldTypeData%Vel)) then - LB(1:4) = lbound(SrcGrid3DFieldTypeData%Vel, kind=B8Ki) - UB(1:4) = ubound(SrcGrid3DFieldTypeData%Vel, kind=B8Ki) + LB(1:4) = lbound(SrcGrid3DFieldTypeData%Vel) + UB(1:4) = ubound(SrcGrid3DFieldTypeData%Vel) if (.not. allocated(DstGrid3DFieldTypeData%Vel)) then allocate(DstGrid3DFieldTypeData%Vel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -630,8 +631,8 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi DstGrid3DFieldTypeData%Vel = SrcGrid3DFieldTypeData%Vel end if if (allocated(SrcGrid3DFieldTypeData%Acc)) then - LB(1:4) = lbound(SrcGrid3DFieldTypeData%Acc, kind=B8Ki) - UB(1:4) = ubound(SrcGrid3DFieldTypeData%Acc, kind=B8Ki) + LB(1:4) = lbound(SrcGrid3DFieldTypeData%Acc) + UB(1:4) = ubound(SrcGrid3DFieldTypeData%Acc) if (.not. allocated(DstGrid3DFieldTypeData%Acc)) then allocate(DstGrid3DFieldTypeData%Acc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -642,8 +643,8 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi DstGrid3DFieldTypeData%Acc = SrcGrid3DFieldTypeData%Acc end if if (allocated(SrcGrid3DFieldTypeData%VelTower)) then - LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelTower, kind=B8Ki) - UB(1:3) = ubound(SrcGrid3DFieldTypeData%VelTower, kind=B8Ki) + LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelTower) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%VelTower) if (.not. allocated(DstGrid3DFieldTypeData%VelTower)) then allocate(DstGrid3DFieldTypeData%VelTower(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -654,8 +655,8 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi DstGrid3DFieldTypeData%VelTower = SrcGrid3DFieldTypeData%VelTower end if if (allocated(SrcGrid3DFieldTypeData%AccTower)) then - LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccTower, kind=B8Ki) - UB(1:3) = ubound(SrcGrid3DFieldTypeData%AccTower, kind=B8Ki) + LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccTower) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%AccTower) if (.not. allocated(DstGrid3DFieldTypeData%AccTower)) then allocate(DstGrid3DFieldTypeData%AccTower(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -666,8 +667,8 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi DstGrid3DFieldTypeData%AccTower = SrcGrid3DFieldTypeData%AccTower end if if (allocated(SrcGrid3DFieldTypeData%VelAvg)) then - LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelAvg, kind=B8Ki) - UB(1:3) = ubound(SrcGrid3DFieldTypeData%VelAvg, kind=B8Ki) + LB(1:3) = lbound(SrcGrid3DFieldTypeData%VelAvg) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%VelAvg) if (.not. allocated(DstGrid3DFieldTypeData%VelAvg)) then allocate(DstGrid3DFieldTypeData%VelAvg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -678,8 +679,8 @@ subroutine IfW_FlowField_CopyGrid3DFieldType(SrcGrid3DFieldTypeData, DstGrid3DFi DstGrid3DFieldTypeData%VelAvg = SrcGrid3DFieldTypeData%VelAvg end if if (allocated(SrcGrid3DFieldTypeData%AccAvg)) then - LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccAvg, kind=B8Ki) - UB(1:3) = ubound(SrcGrid3DFieldTypeData%AccAvg, kind=B8Ki) + LB(1:3) = lbound(SrcGrid3DFieldTypeData%AccAvg) + UB(1:3) = ubound(SrcGrid3DFieldTypeData%AccAvg) if (.not. allocated(DstGrid3DFieldTypeData%AccAvg)) then allocate(DstGrid3DFieldTypeData%AccAvg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -787,7 +788,7 @@ subroutine IfW_FlowField_UnPackGrid3DFieldType(RF, OutData) type(RegFile), intent(inout) :: RF type(Grid3DFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackGrid3DFieldType' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -834,7 +835,7 @@ subroutine IfW_FlowField_CopyGrid4DFieldType(SrcGrid4DFieldTypeData, DstGrid4DFi integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IfW_FlowField_CopyGrid4DFieldType' ErrStat = ErrID_None @@ -876,7 +877,7 @@ subroutine IfW_FlowField_UnPackGrid4DFieldType(RF, OutData) type(RegFile), intent(inout) :: RF type(Grid4DFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackGrid4DFieldType' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -896,14 +897,14 @@ subroutine IfW_FlowField_CopyPointsFieldType(SrcPointsFieldTypeData, DstPointsFi integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'IfW_FlowField_CopyPointsFieldType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcPointsFieldTypeData%Vel)) then - LB(1:2) = lbound(SrcPointsFieldTypeData%Vel, kind=B8Ki) - UB(1:2) = ubound(SrcPointsFieldTypeData%Vel, kind=B8Ki) + LB(1:2) = lbound(SrcPointsFieldTypeData%Vel) + UB(1:2) = ubound(SrcPointsFieldTypeData%Vel) if (.not. allocated(DstPointsFieldTypeData%Vel)) then allocate(DstPointsFieldTypeData%Vel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -940,7 +941,7 @@ subroutine IfW_FlowField_UnPackPointsFieldType(RF, OutData) type(RegFile), intent(inout) :: RF type(PointsFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'IfW_FlowField_UnPackPointsFieldType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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 14ac13d755..12e359cf6b 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 !==================================================================================================== @@ -449,6 +450,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 !---------------------------------------------------------------------------- @@ -530,6 +538,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 @@ -679,7 +765,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 @@ -696,20 +783,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 @@ -717,54 +805,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 @@ -853,7 +946,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 @@ -874,7 +968,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 @@ -888,7 +981,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 @@ -909,8 +1003,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 @@ -924,7 +1016,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 @@ -945,8 +1038,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 @@ -956,78 +1047,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 3dd63debae..a8269167ab 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) @@ -113,7 +120,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 ................................................................................................................ @@ -169,3 +177,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_IO.f90 b/modules/inflowwind/src/InflowWind_IO.f90 index 35fbd4d6dc..302133043f 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, & @@ -86,7 +87,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 @@ -151,6 +152,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 @@ -177,7 +245,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 ce89bad165..0832c35c71 100644 --- a/modules/inflowwind/src/InflowWind_IO_Types.f90 +++ b/modules/inflowwind/src/InflowWind_IO_Types.f90 @@ -140,7 +140,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 @@ -650,7 +651,7 @@ subroutine InflowWind_IO_CopyGrid4D_InitInputType(SrcGrid4D_InitInputTypeData, D integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'InflowWind_IO_CopyGrid4D_InitInputType' ErrStat = ErrID_None @@ -688,7 +689,7 @@ subroutine InflowWind_IO_UnPackGrid4D_InitInputType(RF, OutData) type(RegFile), intent(inout) :: RF type(Grid4D_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_IO_UnPackGrid4D_InitInputType' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -737,5 +738,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 1b8d4e4dc1..3cf9eddfb0 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 [-] @@ -134,6 +140,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 ======= @@ -199,9 +206,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 @@ -209,7 +238,7 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_CopyInputFile' @@ -222,8 +251,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%VelInterpCubic = SrcInputFileData%VelInterpCubic DstInputFileData%NWindVel = SrcInputFileData%NWindVel if (allocated(SrcInputFileData%WindVxiList)) then - LB(1:1) = lbound(SrcInputFileData%WindVxiList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%WindVxiList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%WindVxiList) + UB(1:1) = ubound(SrcInputFileData%WindVxiList) if (.not. allocated(DstInputFileData%WindVxiList)) then allocate(DstInputFileData%WindVxiList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -234,8 +263,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%WindVxiList = SrcInputFileData%WindVxiList end if if (allocated(SrcInputFileData%WindVyiList)) then - LB(1:1) = lbound(SrcInputFileData%WindVyiList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%WindVyiList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%WindVyiList) + UB(1:1) = ubound(SrcInputFileData%WindVyiList) if (.not. allocated(DstInputFileData%WindVyiList)) then allocate(DstInputFileData%WindVyiList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -246,8 +275,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%WindVyiList = SrcInputFileData%WindVyiList end if if (allocated(SrcInputFileData%WindVziList)) then - LB(1:1) = lbound(SrcInputFileData%WindVziList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%WindVziList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%WindVziList) + UB(1:1) = ubound(SrcInputFileData%WindVziList) if (.not. allocated(DstInputFileData%WindVziList)) then allocate(DstInputFileData%WindVziList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -281,8 +310,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%SumPrint = SrcInputFileData%SumPrint DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -297,8 +326,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%NumPulseGate = SrcInputFileData%NumPulseGate DstInputFileData%RotorApexOffsetPos = SrcInputFileData%RotorApexOffsetPos if (allocated(SrcInputFileData%FocalDistanceX)) then - LB(1:1) = lbound(SrcInputFileData%FocalDistanceX, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%FocalDistanceX, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%FocalDistanceX) + UB(1:1) = ubound(SrcInputFileData%FocalDistanceX) if (.not. allocated(DstInputFileData%FocalDistanceX)) then allocate(DstInputFileData%FocalDistanceX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -309,8 +338,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%FocalDistanceX = SrcInputFileData%FocalDistanceX end if if (allocated(SrcInputFileData%FocalDistanceY)) then - LB(1:1) = lbound(SrcInputFileData%FocalDistanceY, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%FocalDistanceY, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%FocalDistanceY) + UB(1:1) = ubound(SrcInputFileData%FocalDistanceY) if (.not. allocated(DstInputFileData%FocalDistanceY)) then allocate(DstInputFileData%FocalDistanceY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -321,8 +350,8 @@ subroutine InflowWind_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode DstInputFileData%FocalDistanceY = SrcInputFileData%FocalDistanceY end if if (allocated(SrcInputFileData%FocalDistanceZ)) then - LB(1:1) = lbound(SrcInputFileData%FocalDistanceZ, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%FocalDistanceZ, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%FocalDistanceZ) + UB(1:1) = ubound(SrcInputFileData%FocalDistanceZ) if (.not. allocated(DstInputFileData%FocalDistanceZ)) then allocate(DstInputFileData%FocalDistanceZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -434,7 +463,7 @@ subroutine InflowWind_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(InflowWind_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackInputFile' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -611,15 +640,15 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -630,8 +659,8 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -648,8 +677,8 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) + 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 @@ -660,8 +689,8 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) + 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 @@ -672,8 +701,8 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + 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 @@ -684,8 +713,8 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + 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 @@ -696,8 +725,8 @@ subroutine InflowWind_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlC DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + 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 @@ -708,6 +737,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) @@ -745,6 +777,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) @@ -769,6 +803,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 @@ -776,7 +811,7 @@ subroutine InflowWind_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(InflowWind_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -809,6 +844,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) @@ -817,8 +853,8 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_CopyParam' @@ -827,8 +863,8 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E DstParamData%RootFileName = SrcParamData%RootFileName DstParamData%DT = SrcParamData%DT if (allocated(SrcParamData%WindViXYZprime)) then - LB(1:2) = lbound(SrcParamData%WindViXYZprime, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%WindViXYZprime, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%WindViXYZprime) + UB(1:2) = ubound(SrcParamData%WindViXYZprime) if (.not. allocated(DstParamData%WindViXYZprime)) then allocate(DstParamData%WindViXYZprime(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -839,8 +875,8 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E DstParamData%WindViXYZprime = SrcParamData%WindViXYZprime end if if (allocated(SrcParamData%WindViXYZ)) then - LB(1:2) = lbound(SrcParamData%WindViXYZ, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%WindViXYZ, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%WindViXYZ) + UB(1:2) = ubound(SrcParamData%WindViXYZ) if (.not. allocated(DstParamData%WindViXYZ)) then allocate(DstParamData%WindViXYZ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -863,8 +899,8 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E if (ErrStat >= AbortErrLev) return end if if (allocated(SrcParamData%PositionAvg)) then - LB(1:2) = lbound(SrcParamData%PositionAvg, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PositionAvg, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%PositionAvg) + UB(1:2) = ubound(SrcParamData%PositionAvg) if (.not. allocated(DstParamData%PositionAvg)) then allocate(DstParamData%PositionAvg(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -877,8 +913,8 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E DstParamData%NWindVel = SrcParamData%NWindVel DstParamData%NumOuts = SrcParamData%NumOuts if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + 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 @@ -893,8 +929,8 @@ subroutine InflowWind_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, E end do end if if (allocated(SrcParamData%OutParamLinIndx)) then - LB(1:2) = lbound(SrcParamData%OutParamLinIndx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%OutParamLinIndx, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%OutParamLinIndx) + UB(1:2) = ubound(SrcParamData%OutParamLinIndx) if (.not. allocated(DstParamData%OutParamLinIndx)) then allocate(DstParamData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -914,8 +950,8 @@ subroutine InflowWind_DestroyParam(ParamData, ErrStat, ErrMsg) type(InflowWind_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_DestroyParam' @@ -937,8 +973,8 @@ subroutine InflowWind_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%PositionAvg) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + 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) @@ -956,8 +992,8 @@ subroutine InflowWind_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(InflowWind_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'InflowWind_PackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%RootFileName) @@ -976,9 +1012,9 @@ subroutine InflowWind_PackParam(RF, Indata) call RegPack(RF, InData%NumOuts) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + 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 @@ -993,8 +1029,8 @@ subroutine InflowWind_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(InflowWind_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1049,15 +1085,15 @@ subroutine InflowWind_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%PositionXYZ)) then - LB(1:2) = lbound(SrcInputData%PositionXYZ, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%PositionXYZ, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%PositionXYZ) + UB(1:2) = ubound(SrcInputData%PositionXYZ) if (.not. allocated(DstInputData%PositionXYZ)) then allocate(DstInputData%PositionXYZ(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1106,7 +1142,7 @@ subroutine InflowWind_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(InflowWind_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackInput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1122,15 +1158,15 @@ subroutine InflowWind_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%VelocityUVW)) then - LB(1:2) = lbound(SrcOutputData%VelocityUVW, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%VelocityUVW, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%VelocityUVW) + UB(1:2) = ubound(SrcOutputData%VelocityUVW) if (.not. allocated(DstOutputData%VelocityUVW)) then allocate(DstOutputData%VelocityUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1141,8 +1177,8 @@ subroutine InflowWind_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat DstOutputData%VelocityUVW = SrcOutputData%VelocityUVW end if if (allocated(SrcOutputData%AccelUVW)) then - LB(1:2) = lbound(SrcOutputData%AccelUVW, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%AccelUVW, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%AccelUVW) + UB(1:2) = ubound(SrcOutputData%AccelUVW) if (.not. allocated(DstOutputData%AccelUVW)) then allocate(DstOutputData%AccelUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1153,8 +1189,8 @@ subroutine InflowWind_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat DstOutputData%AccelUVW = SrcOutputData%AccelUVW end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -1211,7 +1247,7 @@ subroutine InflowWind_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(InflowWind_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackOutput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1381,15 +1417,15 @@ subroutine InflowWind_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'InflowWind_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) + 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 @@ -1400,8 +1436,8 @@ subroutine InflowWind_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrM DstMiscData%AllOuts = SrcMiscData%AllOuts end if if (allocated(SrcMiscData%WindViUVW)) then - LB(1:2) = lbound(SrcMiscData%WindViUVW, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%WindViUVW, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%WindViUVW) + UB(1:2) = ubound(SrcMiscData%WindViUVW) if (.not. allocated(DstMiscData%WindViUVW)) then allocate(DstMiscData%WindViUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1412,8 +1448,8 @@ subroutine InflowWind_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrM DstMiscData%WindViUVW = SrcMiscData%WindViUVW end if if (allocated(SrcMiscData%WindAiUVW)) then - LB(1:2) = lbound(SrcMiscData%WindAiUVW, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%WindAiUVW, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%WindAiUVW) + UB(1:2) = ubound(SrcMiscData%WindAiUVW) if (.not. allocated(DstMiscData%WindAiUVW)) then allocate(DstMiscData%WindAiUVW(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1435,6 +1471,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) @@ -1463,6 +1502,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) @@ -1477,6 +1518,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 @@ -1484,7 +1526,7 @@ subroutine InflowWind_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(InflowWind_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'InflowWind_UnPackMisc' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1495,6 +1537,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) @@ -1856,5 +1899,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 bb71c0ad4b..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 @@ -222,7 +235,7 @@ subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Lidar_CopyParam' ErrStat = ErrID_None @@ -243,8 +256,8 @@ subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%DisplacementLidarZ = SrcParamData%DisplacementLidarZ DstParamData%NumBeam = SrcParamData%NumBeam if (allocated(SrcParamData%FocalDistanceX)) then - LB(1:1) = lbound(SrcParamData%FocalDistanceX, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%FocalDistanceX, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%FocalDistanceX) + UB(1:1) = ubound(SrcParamData%FocalDistanceX) if (.not. allocated(DstParamData%FocalDistanceX)) then allocate(DstParamData%FocalDistanceX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -255,8 +268,8 @@ subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%FocalDistanceX = SrcParamData%FocalDistanceX end if if (allocated(SrcParamData%FocalDistanceY)) then - LB(1:1) = lbound(SrcParamData%FocalDistanceY, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%FocalDistanceY, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%FocalDistanceY) + UB(1:1) = ubound(SrcParamData%FocalDistanceY) if (.not. allocated(DstParamData%FocalDistanceY)) then allocate(DstParamData%FocalDistanceY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -267,8 +280,8 @@ subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%FocalDistanceY = SrcParamData%FocalDistanceY end if if (allocated(SrcParamData%FocalDistanceZ)) then - LB(1:1) = lbound(SrcParamData%FocalDistanceZ, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%FocalDistanceZ, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%FocalDistanceZ) + UB(1:1) = ubound(SrcParamData%FocalDistanceZ) if (.not. allocated(DstParamData%FocalDistanceZ)) then allocate(DstParamData%FocalDistanceZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -279,8 +292,8 @@ subroutine Lidar_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%FocalDistanceZ = SrcParamData%FocalDistanceZ end if if (allocated(SrcParamData%MsrPosition)) then - LB(1:2) = lbound(SrcParamData%MsrPosition, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%MsrPosition, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%MsrPosition) + UB(1:2) = ubound(SrcParamData%MsrPosition) if (.not. allocated(DstParamData%MsrPosition)) then allocate(DstParamData%MsrPosition(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -354,7 +367,7 @@ subroutine Lidar_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(Lidar_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackParam' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -630,14 +643,14 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Lidar_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%LidSpeed)) then - LB(1:1) = lbound(SrcOutputData%LidSpeed, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%LidSpeed, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%LidSpeed) + UB(1:1) = ubound(SrcOutputData%LidSpeed) if (.not. allocated(DstOutputData%LidSpeed)) then allocate(DstOutputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -648,8 +661,8 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%LidSpeed = SrcOutputData%LidSpeed end if if (allocated(SrcOutputData%WtTrunc)) then - LB(1:1) = lbound(SrcOutputData%WtTrunc, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WtTrunc, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%WtTrunc) + UB(1:1) = ubound(SrcOutputData%WtTrunc) if (.not. allocated(DstOutputData%WtTrunc)) then allocate(DstOutputData%WtTrunc(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -660,8 +673,8 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%WtTrunc = SrcOutputData%WtTrunc end if if (allocated(SrcOutputData%MsrPositionsX)) then - LB(1:1) = lbound(SrcOutputData%MsrPositionsX, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%MsrPositionsX, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%MsrPositionsX) + UB(1:1) = ubound(SrcOutputData%MsrPositionsX) if (.not. allocated(DstOutputData%MsrPositionsX)) then allocate(DstOutputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -672,8 +685,8 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%MsrPositionsX = SrcOutputData%MsrPositionsX end if if (allocated(SrcOutputData%MsrPositionsY)) then - LB(1:1) = lbound(SrcOutputData%MsrPositionsY, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%MsrPositionsY, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%MsrPositionsY) + UB(1:1) = ubound(SrcOutputData%MsrPositionsY) if (.not. allocated(DstOutputData%MsrPositionsY)) then allocate(DstOutputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -684,8 +697,8 @@ subroutine Lidar_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%MsrPositionsY = SrcOutputData%MsrPositionsY end if if (allocated(SrcOutputData%MsrPositionsZ)) then - LB(1:1) = lbound(SrcOutputData%MsrPositionsZ, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%MsrPositionsZ, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%MsrPositionsZ) + UB(1:1) = ubound(SrcOutputData%MsrPositionsZ) if (.not. allocated(DstOutputData%MsrPositionsZ)) then allocate(DstOutputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -738,7 +751,7 @@ subroutine Lidar_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(Lidar_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Lidar_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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 ebaaa657a2..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 @@ -131,7 +137,7 @@ subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'LD_CopyInitInput' ErrStat = ErrID_None @@ -139,8 +145,8 @@ subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%dt = SrcInitInputData%dt DstInitInputData%IntMethod = SrcInitInputData%IntMethod if (allocated(SrcInitInputData%MM)) then - LB(1:2) = lbound(SrcInitInputData%MM, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%MM, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%MM) + UB(1:2) = ubound(SrcInitInputData%MM) if (.not. allocated(DstInitInputData%MM)) then allocate(DstInitInputData%MM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -151,8 +157,8 @@ subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%MM = SrcInitInputData%MM end if if (allocated(SrcInitInputData%CC)) then - LB(1:2) = lbound(SrcInitInputData%CC, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%CC, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%CC) + UB(1:2) = ubound(SrcInitInputData%CC) if (.not. allocated(DstInitInputData%CC)) then allocate(DstInitInputData%CC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -163,8 +169,8 @@ subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%CC = SrcInitInputData%CC end if if (allocated(SrcInitInputData%KK)) then - LB(1:2) = lbound(SrcInitInputData%KK, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%KK, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%KK) + UB(1:2) = ubound(SrcInitInputData%KK) if (.not. allocated(DstInitInputData%KK)) then allocate(DstInitInputData%KK(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -175,8 +181,8 @@ subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%KK = SrcInitInputData%KK end if if (allocated(SrcInitInputData%x0)) then - LB(1:1) = lbound(SrcInitInputData%x0, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%x0, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%x0) + UB(1:1) = ubound(SrcInitInputData%x0) if (.not. allocated(DstInitInputData%x0)) then allocate(DstInitInputData%x0(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -187,8 +193,8 @@ subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%x0 = SrcInitInputData%x0 end if if (allocated(SrcInitInputData%xd0)) then - LB(1:1) = lbound(SrcInitInputData%xd0, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%xd0, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%xd0) + UB(1:1) = ubound(SrcInitInputData%xd0) if (.not. allocated(DstInitInputData%xd0)) then allocate(DstInitInputData%xd0(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -199,8 +205,8 @@ subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%xd0 = SrcInitInputData%xd0 end if if (allocated(SrcInitInputData%activeDOFs)) then - LB(1:1) = lbound(SrcInitInputData%activeDOFs, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%activeDOFs, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%activeDOFs) + UB(1:1) = ubound(SrcInitInputData%activeDOFs) if (.not. allocated(DstInitInputData%activeDOFs)) then allocate(DstInitInputData%activeDOFs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -212,8 +218,8 @@ subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta end if DstInitInputData%prefix = SrcInitInputData%prefix if (allocated(SrcInitInputData%DOFsNames)) then - LB(1:1) = lbound(SrcInitInputData%DOFsNames, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%DOFsNames, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%DOFsNames) + UB(1:1) = ubound(SrcInitInputData%DOFsNames) if (.not. allocated(DstInitInputData%DOFsNames)) then allocate(DstInitInputData%DOFsNames(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -224,8 +230,8 @@ subroutine LD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%DOFsNames = SrcInitInputData%DOFsNames end if if (allocated(SrcInitInputData%DOFsUnits)) then - LB(1:1) = lbound(SrcInitInputData%DOFsUnits, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%DOFsUnits, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%DOFsUnits) + UB(1:1) = ubound(SrcInitInputData%DOFsUnits) if (.not. allocated(DstInitInputData%DOFsUnits)) then allocate(DstInitInputData%DOFsUnits(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -297,7 +303,7 @@ subroutine LD_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(LD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'LD_UnPackInitInput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -322,7 +328,7 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'LD_CopyInitOutput' @@ -332,8 +338,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -344,8 +350,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -356,8 +362,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt end if if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) + 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 @@ -368,8 +374,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -380,8 +386,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) + 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 @@ -392,8 +398,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + 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 @@ -404,8 +410,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -416,8 +422,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + 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 @@ -428,8 +434,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + 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 @@ -440,8 +446,8 @@ subroutine LD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -519,7 +525,7 @@ subroutine LD_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(LD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'LD_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -542,14 +548,14 @@ subroutine LD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'LD_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%q)) then - LB(1:1) = lbound(SrcContStateData%q, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%q, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%q) + UB(1:1) = ubound(SrcContStateData%q) if (.not. allocated(DstContStateData%q)) then allocate(DstContStateData%q(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -586,7 +592,7 @@ subroutine LD_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(LD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'LD_UnPackContState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -675,16 +681,16 @@ subroutine LD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'LD_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%xdot)) then - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) if (.not. allocated(DstOtherStateData%xdot)) then allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -706,16 +712,16 @@ subroutine LD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(LD_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'LD_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%xdot)) then - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call LD_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -728,14 +734,14 @@ subroutine LD_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(LD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'LD_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%xdot)) if (allocated(InData%xdot)) then - call RegPackBounds(RF, 1, lbound(InData%xdot, kind=B8Ki), ubound(InData%xdot, kind=B8Ki)) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xdot), ubound(InData%xdot)) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call LD_PackContState(RF, InData%xdot(i1)) end do @@ -749,8 +755,8 @@ subroutine LD_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(LD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'LD_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -777,15 +783,15 @@ subroutine LD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'LD_CopyMisc' ErrStat = ErrID_None ErrMsg = '' DstMiscData%Dummy = SrcMiscData%Dummy if (allocated(SrcMiscData%qPrescribed)) then - LB(1:1) = lbound(SrcMiscData%qPrescribed, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%qPrescribed, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%qPrescribed) + UB(1:1) = ubound(SrcMiscData%qPrescribed) if (.not. allocated(DstMiscData%qPrescribed)) then allocate(DstMiscData%qPrescribed(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -823,7 +829,7 @@ subroutine LD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(LD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'LD_UnPackMisc' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -837,8 +843,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'LD_CopyParam' @@ -849,8 +855,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%nx = SrcParamData%nx DstParamData%nq = SrcParamData%nq if (allocated(SrcParamData%MM)) then - LB(1:2) = lbound(SrcParamData%MM, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%MM, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%MM) + UB(1:2) = ubound(SrcParamData%MM) if (.not. allocated(DstParamData%MM)) then allocate(DstParamData%MM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -861,8 +867,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%MM = SrcParamData%MM end if if (allocated(SrcParamData%CC)) then - LB(1:2) = lbound(SrcParamData%CC, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%CC, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%CC) + UB(1:2) = ubound(SrcParamData%CC) if (.not. allocated(DstParamData%CC)) then allocate(DstParamData%CC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -873,8 +879,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%CC = SrcParamData%CC end if if (allocated(SrcParamData%KK)) then - LB(1:2) = lbound(SrcParamData%KK, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%KK, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%KK) + UB(1:2) = ubound(SrcParamData%KK) if (.not. allocated(DstParamData%KK)) then allocate(DstParamData%KK(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -885,8 +891,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%KK = SrcParamData%KK end if if (allocated(SrcParamData%Minv)) then - LB(1:2) = lbound(SrcParamData%Minv, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Minv, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%Minv) + UB(1:2) = ubound(SrcParamData%Minv) if (.not. allocated(DstParamData%Minv)) then allocate(DstParamData%Minv(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -897,8 +903,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%Minv = SrcParamData%Minv end if if (allocated(SrcParamData%activeDOFs)) then - LB(1:1) = lbound(SrcParamData%activeDOFs, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%activeDOFs, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%activeDOFs) + UB(1:1) = ubound(SrcParamData%activeDOFs) if (.not. allocated(DstParamData%activeDOFs)) then allocate(DstParamData%activeDOFs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -909,8 +915,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%activeDOFs = SrcParamData%activeDOFs end if if (allocated(SrcParamData%AA)) then - LB(1:2) = lbound(SrcParamData%AA, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%AA, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%AA) + UB(1:2) = ubound(SrcParamData%AA) if (.not. allocated(DstParamData%AA)) then allocate(DstParamData%AA(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -921,8 +927,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%AA = SrcParamData%AA end if if (allocated(SrcParamData%BB)) then - LB(1:2) = lbound(SrcParamData%BB, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%BB, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%BB) + UB(1:2) = ubound(SrcParamData%BB) if (.not. allocated(DstParamData%BB)) then allocate(DstParamData%BB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -934,8 +940,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%NumOuts = SrcParamData%NumOuts if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + 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 @@ -950,8 +956,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcParamData%OutParamLinIndx)) then - LB(1:2) = lbound(SrcParamData%OutParamLinIndx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%OutParamLinIndx, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%OutParamLinIndx) + UB(1:2) = ubound(SrcParamData%OutParamLinIndx) if (.not. allocated(DstParamData%OutParamLinIndx)) then allocate(DstParamData%OutParamLinIndx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -962,8 +968,8 @@ subroutine LD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%OutParamLinIndx = SrcParamData%OutParamLinIndx end if if (allocated(SrcParamData%PrescribedValues)) then - LB(1:2) = lbound(SrcParamData%PrescribedValues, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PrescribedValues, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%PrescribedValues) + UB(1:2) = ubound(SrcParamData%PrescribedValues) if (.not. allocated(DstParamData%PrescribedValues)) then allocate(DstParamData%PrescribedValues(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -979,8 +985,8 @@ subroutine LD_DestroyParam(ParamData, ErrStat, ErrMsg) type(LD_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'LD_DestroyParam' @@ -1008,8 +1014,8 @@ subroutine LD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%BB) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + 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) @@ -1028,8 +1034,8 @@ subroutine LD_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(LD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'LD_PackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%dt) call RegPack(RF, InData%IntMethod) @@ -1045,9 +1051,9 @@ subroutine LD_PackParam(RF, Indata) call RegPack(RF, InData%NumOuts) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + 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 @@ -1061,8 +1067,8 @@ subroutine LD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(LD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'LD_UnPackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1101,14 +1107,14 @@ subroutine LD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'LD_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%Fext)) then - LB(1:1) = lbound(SrcInputData%Fext, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%Fext, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%Fext) + UB(1:1) = ubound(SrcInputData%Fext) if (.not. allocated(DstInputData%Fext)) then allocate(DstInputData%Fext(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1145,7 +1151,7 @@ subroutine LD_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(LD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'LD_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1158,14 +1164,14 @@ subroutine LD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'LD_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%xdd)) then - LB(1:1) = lbound(SrcOutputData%xdd, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%xdd, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%xdd) + UB(1:1) = ubound(SrcOutputData%xdd) if (.not. allocated(DstOutputData%xdd)) then allocate(DstOutputData%xdd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1176,8 +1182,8 @@ subroutine LD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%xdd = SrcOutputData%xdd end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -1218,7 +1224,7 @@ subroutine LD_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(LD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'LD_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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 9b9535205d..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,19 +34,18 @@ 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( mappplib PUBLIC - $ + $/include/mappp/MAP_Types.h> $ - $ + $/include/mappp/mapsys.h> $ - $ + $/include/mappp/maperror.h> $ - $ + $/include/mappp/mapapi.h> $ ) target_link_libraries(mappplib nwtclibs) 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_Fortran_Types.f90 b/modules/map/src/MAP_Fortran_Types.f90 index 76bc63b701..ced2d55d68 100644 --- a/modules/map/src/MAP_Fortran_Types.f90 +++ b/modules/map/src/MAP_Fortran_Types.f90 @@ -98,14 +98,14 @@ subroutine MAP_Fortran_CopyLin_InitOutputType(SrcLin_InitOutputTypeData, DstLin_ integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MAP_Fortran_CopyLin_InitOutputType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcLin_InitOutputTypeData%LinNames_y)) then - LB(1:1) = lbound(SrcLin_InitOutputTypeData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcLin_InitOutputTypeData%LinNames_y, kind=B8Ki) + LB(1:1) = lbound(SrcLin_InitOutputTypeData%LinNames_y) + UB(1:1) = ubound(SrcLin_InitOutputTypeData%LinNames_y) if (.not. allocated(DstLin_InitOutputTypeData%LinNames_y)) then allocate(DstLin_InitOutputTypeData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -116,8 +116,8 @@ subroutine MAP_Fortran_CopyLin_InitOutputType(SrcLin_InitOutputTypeData, DstLin_ DstLin_InitOutputTypeData%LinNames_y = SrcLin_InitOutputTypeData%LinNames_y end if if (allocated(SrcLin_InitOutputTypeData%LinNames_u)) then - LB(1:1) = lbound(SrcLin_InitOutputTypeData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcLin_InitOutputTypeData%LinNames_u, kind=B8Ki) + LB(1:1) = lbound(SrcLin_InitOutputTypeData%LinNames_u) + UB(1:1) = ubound(SrcLin_InitOutputTypeData%LinNames_u) if (.not. allocated(DstLin_InitOutputTypeData%LinNames_u)) then allocate(DstLin_InitOutputTypeData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -128,8 +128,8 @@ subroutine MAP_Fortran_CopyLin_InitOutputType(SrcLin_InitOutputTypeData, DstLin_ DstLin_InitOutputTypeData%LinNames_u = SrcLin_InitOutputTypeData%LinNames_u end if if (allocated(SrcLin_InitOutputTypeData%IsLoad_u)) then - LB(1:1) = lbound(SrcLin_InitOutputTypeData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcLin_InitOutputTypeData%IsLoad_u, kind=B8Ki) + LB(1:1) = lbound(SrcLin_InitOutputTypeData%IsLoad_u) + UB(1:1) = ubound(SrcLin_InitOutputTypeData%IsLoad_u) if (.not. allocated(DstLin_InitOutputTypeData%IsLoad_u)) then allocate(DstLin_InitOutputTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -174,7 +174,7 @@ subroutine MAP_Fortran_UnPackLin_InitOutputType(RF, OutData) type(RegFile), intent(inout) :: RF type(Lin_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_InitOutputType' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -189,14 +189,14 @@ subroutine MAP_Fortran_CopyLin_ParamType(SrcLin_ParamTypeData, DstLin_ParamTypeD integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MAP_Fortran_CopyLin_ParamType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcLin_ParamTypeData%Jac_u_indx)) then - LB(1:2) = lbound(SrcLin_ParamTypeData%Jac_u_indx, kind=B8Ki) - UB(1:2) = ubound(SrcLin_ParamTypeData%Jac_u_indx, kind=B8Ki) + LB(1:2) = lbound(SrcLin_ParamTypeData%Jac_u_indx) + UB(1:2) = ubound(SrcLin_ParamTypeData%Jac_u_indx) if (.not. allocated(DstLin_ParamTypeData%Jac_u_indx)) then allocate(DstLin_ParamTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -237,7 +237,7 @@ subroutine MAP_Fortran_UnPackLin_ParamType(RF, OutData) type(RegFile), intent(inout) :: RF type(Lin_ParamType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_Fortran_UnPackLin_ParamType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return 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 d9ce9ca53f..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) @@ -400,7 +423,7 @@ subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MAP_CopyInitOutput' @@ -413,8 +436,8 @@ subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%compilingData = SrcInitOutputData%compilingData DstInitOutputData%C_obj%compilingData = SrcInitOutputData%C_obj%compilingData if (allocated(SrcInitOutputData%writeOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%writeOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%writeOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%writeOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%writeOutputHdr) if (.not. allocated(DstInitOutputData%writeOutputHdr)) then allocate(DstInitOutputData%writeOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -425,8 +448,8 @@ subroutine MAP_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%writeOutputHdr = SrcInitOutputData%writeOutputHdr end if if (allocated(SrcInitOutputData%writeOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%writeOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%writeOutputUnt) if (.not. allocated(DstInitOutputData%writeOutputUnt)) then allocate(DstInitOutputData%writeOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -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 @@ -488,7 +511,7 @@ subroutine MAP_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(MAP_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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) @@ -710,14 +733,14 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MAP_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcOtherStateData%H)) then - LB(1:1) = lbound(SrcOtherStateData%H, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%H, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%H) + UB(1:1) = ubound(SrcOtherStateData%H) if (.not. associated(DstOtherStateData%H)) then allocate(DstOtherStateData%H(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -731,8 +754,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%H = SrcOtherStateData%H end if if (associated(SrcOtherStateData%V)) then - LB(1:1) = lbound(SrcOtherStateData%V, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%V, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%V) + UB(1:1) = ubound(SrcOtherStateData%V) if (.not. associated(DstOtherStateData%V)) then allocate(DstOtherStateData%V(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -746,8 +769,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%V = SrcOtherStateData%V end if if (associated(SrcOtherStateData%Ha)) then - LB(1:1) = lbound(SrcOtherStateData%Ha, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Ha, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Ha) + UB(1:1) = ubound(SrcOtherStateData%Ha) if (.not. associated(DstOtherStateData%Ha)) then allocate(DstOtherStateData%Ha(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -761,8 +784,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Ha = SrcOtherStateData%Ha end if if (associated(SrcOtherStateData%Va)) then - LB(1:1) = lbound(SrcOtherStateData%Va, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Va, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Va) + UB(1:1) = ubound(SrcOtherStateData%Va) if (.not. associated(DstOtherStateData%Va)) then allocate(DstOtherStateData%Va(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -776,8 +799,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Va = SrcOtherStateData%Va end if if (associated(SrcOtherStateData%x)) then - LB(1:1) = lbound(SrcOtherStateData%x, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%x, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%x) + UB(1:1) = ubound(SrcOtherStateData%x) if (.not. associated(DstOtherStateData%x)) then allocate(DstOtherStateData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -791,8 +814,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%x = SrcOtherStateData%x end if if (associated(SrcOtherStateData%y)) then - LB(1:1) = lbound(SrcOtherStateData%y, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%y, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%y) + UB(1:1) = ubound(SrcOtherStateData%y) if (.not. associated(DstOtherStateData%y)) then allocate(DstOtherStateData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -806,8 +829,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%y = SrcOtherStateData%y end if if (associated(SrcOtherStateData%z)) then - LB(1:1) = lbound(SrcOtherStateData%z, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%z, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%z) + UB(1:1) = ubound(SrcOtherStateData%z) if (.not. associated(DstOtherStateData%z)) then allocate(DstOtherStateData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -821,8 +844,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%z = SrcOtherStateData%z end if if (associated(SrcOtherStateData%xa)) then - LB(1:1) = lbound(SrcOtherStateData%xa, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xa, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xa) + UB(1:1) = ubound(SrcOtherStateData%xa) if (.not. associated(DstOtherStateData%xa)) then allocate(DstOtherStateData%xa(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -836,8 +859,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%xa = SrcOtherStateData%xa end if if (associated(SrcOtherStateData%ya)) then - LB(1:1) = lbound(SrcOtherStateData%ya, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%ya, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%ya) + UB(1:1) = ubound(SrcOtherStateData%ya) if (.not. associated(DstOtherStateData%ya)) then allocate(DstOtherStateData%ya(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -851,8 +874,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%ya = SrcOtherStateData%ya end if if (associated(SrcOtherStateData%za)) then - LB(1:1) = lbound(SrcOtherStateData%za, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%za, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%za) + UB(1:1) = ubound(SrcOtherStateData%za) if (.not. associated(DstOtherStateData%za)) then allocate(DstOtherStateData%za(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -866,8 +889,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%za = SrcOtherStateData%za end if if (associated(SrcOtherStateData%Fx_connect)) then - LB(1:1) = lbound(SrcOtherStateData%Fx_connect, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Fx_connect, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Fx_connect) + UB(1:1) = ubound(SrcOtherStateData%Fx_connect) if (.not. associated(DstOtherStateData%Fx_connect)) then allocate(DstOtherStateData%Fx_connect(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -881,8 +904,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fx_connect = SrcOtherStateData%Fx_connect end if if (associated(SrcOtherStateData%Fy_connect)) then - LB(1:1) = lbound(SrcOtherStateData%Fy_connect, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Fy_connect, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Fy_connect) + UB(1:1) = ubound(SrcOtherStateData%Fy_connect) if (.not. associated(DstOtherStateData%Fy_connect)) then allocate(DstOtherStateData%Fy_connect(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -896,8 +919,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fy_connect = SrcOtherStateData%Fy_connect end if if (associated(SrcOtherStateData%Fz_connect)) then - LB(1:1) = lbound(SrcOtherStateData%Fz_connect, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Fz_connect, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Fz_connect) + UB(1:1) = ubound(SrcOtherStateData%Fz_connect) if (.not. associated(DstOtherStateData%Fz_connect)) then allocate(DstOtherStateData%Fz_connect(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -911,8 +934,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fz_connect = SrcOtherStateData%Fz_connect end if if (associated(SrcOtherStateData%Fx_anchor)) then - LB(1:1) = lbound(SrcOtherStateData%Fx_anchor, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Fx_anchor, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Fx_anchor) + UB(1:1) = ubound(SrcOtherStateData%Fx_anchor) if (.not. associated(DstOtherStateData%Fx_anchor)) then allocate(DstOtherStateData%Fx_anchor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -926,8 +949,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fx_anchor = SrcOtherStateData%Fx_anchor end if if (associated(SrcOtherStateData%Fy_anchor)) then - LB(1:1) = lbound(SrcOtherStateData%Fy_anchor, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Fy_anchor, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Fy_anchor) + UB(1:1) = ubound(SrcOtherStateData%Fy_anchor) if (.not. associated(DstOtherStateData%Fy_anchor)) then allocate(DstOtherStateData%Fy_anchor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -941,8 +964,8 @@ subroutine MAP_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er DstOtherStateData%Fy_anchor = SrcOtherStateData%Fy_anchor end if if (associated(SrcOtherStateData%Fz_anchor)) then - LB(1:1) = lbound(SrcOtherStateData%Fz_anchor, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%Fz_anchor, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%Fz_anchor) + UB(1:1) = ubound(SrcOtherStateData%Fz_anchor) if (.not. associated(DstOtherStateData%Fz_anchor)) then allocate(DstOtherStateData%Fz_anchor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1095,7 +1118,7 @@ subroutine MAP_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(MAP_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackOtherState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1368,7 +1391,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%H_Len = SIZE(OtherStateData%H) IF (OtherStateData%C_obj%H_Len > 0) & - OtherStateData%C_obj%H = C_LOC(OtherStateData%H(LBOUND(OtherStateData%H,1, kind=B8Ki))) + OtherStateData%C_obj%H = C_LOC(OtherStateData%H(lbound(OtherStateData%H,1))) END IF END IF @@ -1380,7 +1403,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%V_Len = SIZE(OtherStateData%V) IF (OtherStateData%C_obj%V_Len > 0) & - OtherStateData%C_obj%V = C_LOC(OtherStateData%V(LBOUND(OtherStateData%V,1, kind=B8Ki))) + OtherStateData%C_obj%V = C_LOC(OtherStateData%V(lbound(OtherStateData%V,1))) END IF END IF @@ -1392,7 +1415,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Ha_Len = SIZE(OtherStateData%Ha) IF (OtherStateData%C_obj%Ha_Len > 0) & - OtherStateData%C_obj%Ha = C_LOC(OtherStateData%Ha(LBOUND(OtherStateData%Ha,1, kind=B8Ki))) + OtherStateData%C_obj%Ha = C_LOC(OtherStateData%Ha(lbound(OtherStateData%Ha,1))) END IF END IF @@ -1404,7 +1427,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Va_Len = SIZE(OtherStateData%Va) IF (OtherStateData%C_obj%Va_Len > 0) & - OtherStateData%C_obj%Va = C_LOC(OtherStateData%Va(LBOUND(OtherStateData%Va,1, kind=B8Ki))) + OtherStateData%C_obj%Va = C_LOC(OtherStateData%Va(lbound(OtherStateData%Va,1))) END IF END IF @@ -1416,7 +1439,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%x_Len = SIZE(OtherStateData%x) IF (OtherStateData%C_obj%x_Len > 0) & - OtherStateData%C_obj%x = C_LOC(OtherStateData%x(LBOUND(OtherStateData%x,1, kind=B8Ki))) + OtherStateData%C_obj%x = C_LOC(OtherStateData%x(lbound(OtherStateData%x,1))) END IF END IF @@ -1428,7 +1451,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%y_Len = SIZE(OtherStateData%y) IF (OtherStateData%C_obj%y_Len > 0) & - OtherStateData%C_obj%y = C_LOC(OtherStateData%y(LBOUND(OtherStateData%y,1, kind=B8Ki))) + OtherStateData%C_obj%y = C_LOC(OtherStateData%y(lbound(OtherStateData%y,1))) END IF END IF @@ -1440,7 +1463,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%z_Len = SIZE(OtherStateData%z) IF (OtherStateData%C_obj%z_Len > 0) & - OtherStateData%C_obj%z = C_LOC(OtherStateData%z(LBOUND(OtherStateData%z,1, kind=B8Ki))) + OtherStateData%C_obj%z = C_LOC(OtherStateData%z(lbound(OtherStateData%z,1))) END IF END IF @@ -1452,7 +1475,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%xa_Len = SIZE(OtherStateData%xa) IF (OtherStateData%C_obj%xa_Len > 0) & - OtherStateData%C_obj%xa = C_LOC(OtherStateData%xa(LBOUND(OtherStateData%xa,1, kind=B8Ki))) + OtherStateData%C_obj%xa = C_LOC(OtherStateData%xa(lbound(OtherStateData%xa,1))) END IF END IF @@ -1464,7 +1487,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%ya_Len = SIZE(OtherStateData%ya) IF (OtherStateData%C_obj%ya_Len > 0) & - OtherStateData%C_obj%ya = C_LOC(OtherStateData%ya(LBOUND(OtherStateData%ya,1, kind=B8Ki))) + OtherStateData%C_obj%ya = C_LOC(OtherStateData%ya(lbound(OtherStateData%ya,1))) END IF END IF @@ -1476,7 +1499,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%za_Len = SIZE(OtherStateData%za) IF (OtherStateData%C_obj%za_Len > 0) & - OtherStateData%C_obj%za = C_LOC(OtherStateData%za(LBOUND(OtherStateData%za,1, kind=B8Ki))) + OtherStateData%C_obj%za = C_LOC(OtherStateData%za(lbound(OtherStateData%za,1))) END IF END IF @@ -1488,7 +1511,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Fx_connect_Len = SIZE(OtherStateData%Fx_connect) IF (OtherStateData%C_obj%Fx_connect_Len > 0) & - OtherStateData%C_obj%Fx_connect = C_LOC(OtherStateData%Fx_connect(LBOUND(OtherStateData%Fx_connect,1, kind=B8Ki))) + OtherStateData%C_obj%Fx_connect = C_LOC(OtherStateData%Fx_connect(lbound(OtherStateData%Fx_connect,1))) END IF END IF @@ -1500,7 +1523,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Fy_connect_Len = SIZE(OtherStateData%Fy_connect) IF (OtherStateData%C_obj%Fy_connect_Len > 0) & - OtherStateData%C_obj%Fy_connect = C_LOC(OtherStateData%Fy_connect(LBOUND(OtherStateData%Fy_connect,1, kind=B8Ki))) + OtherStateData%C_obj%Fy_connect = C_LOC(OtherStateData%Fy_connect(lbound(OtherStateData%Fy_connect,1))) END IF END IF @@ -1512,7 +1535,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Fz_connect_Len = SIZE(OtherStateData%Fz_connect) IF (OtherStateData%C_obj%Fz_connect_Len > 0) & - OtherStateData%C_obj%Fz_connect = C_LOC(OtherStateData%Fz_connect(LBOUND(OtherStateData%Fz_connect,1, kind=B8Ki))) + OtherStateData%C_obj%Fz_connect = C_LOC(OtherStateData%Fz_connect(lbound(OtherStateData%Fz_connect,1))) END IF END IF @@ -1524,7 +1547,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Fx_anchor_Len = SIZE(OtherStateData%Fx_anchor) IF (OtherStateData%C_obj%Fx_anchor_Len > 0) & - OtherStateData%C_obj%Fx_anchor = C_LOC(OtherStateData%Fx_anchor(LBOUND(OtherStateData%Fx_anchor,1, kind=B8Ki))) + OtherStateData%C_obj%Fx_anchor = C_LOC(OtherStateData%Fx_anchor(lbound(OtherStateData%Fx_anchor,1))) END IF END IF @@ -1536,7 +1559,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Fy_anchor_Len = SIZE(OtherStateData%Fy_anchor) IF (OtherStateData%C_obj%Fy_anchor_Len > 0) & - OtherStateData%C_obj%Fy_anchor = C_LOC(OtherStateData%Fy_anchor(LBOUND(OtherStateData%Fy_anchor,1, kind=B8Ki))) + OtherStateData%C_obj%Fy_anchor = C_LOC(OtherStateData%Fy_anchor(lbound(OtherStateData%Fy_anchor,1))) END IF END IF @@ -1548,7 +1571,7 @@ SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ELSE OtherStateData%C_obj%Fz_anchor_Len = SIZE(OtherStateData%Fz_anchor) IF (OtherStateData%C_obj%Fz_anchor_Len > 0) & - OtherStateData%C_obj%Fz_anchor = C_LOC(OtherStateData%Fz_anchor(LBOUND(OtherStateData%Fz_anchor,1, kind=B8Ki))) + OtherStateData%C_obj%Fz_anchor = C_LOC(OtherStateData%Fz_anchor(lbound(OtherStateData%Fz_anchor,1))) END IF END IF END SUBROUTINE @@ -1559,14 +1582,14 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MAP_CopyConstrState' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcConstrStateData%H)) then - LB(1:1) = lbound(SrcConstrStateData%H, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%H, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%H) + UB(1:1) = ubound(SrcConstrStateData%H) if (.not. associated(DstConstrStateData%H)) then allocate(DstConstrStateData%H(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1580,8 +1603,8 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%H = SrcConstrStateData%H end if if (associated(SrcConstrStateData%V)) then - LB(1:1) = lbound(SrcConstrStateData%V, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%V, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%V) + UB(1:1) = ubound(SrcConstrStateData%V) if (.not. associated(DstConstrStateData%V)) then allocate(DstConstrStateData%V(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1595,8 +1618,8 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%V = SrcConstrStateData%V end if if (associated(SrcConstrStateData%x)) then - LB(1:1) = lbound(SrcConstrStateData%x, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%x, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%x) + UB(1:1) = ubound(SrcConstrStateData%x) if (.not. associated(DstConstrStateData%x)) then allocate(DstConstrStateData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1610,8 +1633,8 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%x = SrcConstrStateData%x end if if (associated(SrcConstrStateData%y)) then - LB(1:1) = lbound(SrcConstrStateData%y, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%y, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%y) + UB(1:1) = ubound(SrcConstrStateData%y) if (.not. associated(DstConstrStateData%y)) then allocate(DstConstrStateData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1625,8 +1648,8 @@ subroutine MAP_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, DstConstrStateData%y = SrcConstrStateData%y end if if (associated(SrcConstrStateData%z)) then - LB(1:1) = lbound(SrcConstrStateData%z, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%z, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%z) + UB(1:1) = ubound(SrcConstrStateData%z) if (.not. associated(DstConstrStateData%z)) then allocate(DstConstrStateData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1702,7 +1725,7 @@ subroutine MAP_UnPackConstrState(RF, OutData) type(RegFile), intent(inout) :: RF type(MAP_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackConstrState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1821,7 +1844,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe ELSE ConstrStateData%C_obj%H_Len = SIZE(ConstrStateData%H) IF (ConstrStateData%C_obj%H_Len > 0) & - ConstrStateData%C_obj%H = C_LOC(ConstrStateData%H(LBOUND(ConstrStateData%H,1, kind=B8Ki))) + ConstrStateData%C_obj%H = C_LOC(ConstrStateData%H(lbound(ConstrStateData%H,1))) END IF END IF @@ -1833,7 +1856,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe ELSE ConstrStateData%C_obj%V_Len = SIZE(ConstrStateData%V) IF (ConstrStateData%C_obj%V_Len > 0) & - ConstrStateData%C_obj%V = C_LOC(ConstrStateData%V(LBOUND(ConstrStateData%V,1, kind=B8Ki))) + ConstrStateData%C_obj%V = C_LOC(ConstrStateData%V(lbound(ConstrStateData%V,1))) END IF END IF @@ -1845,7 +1868,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe ELSE ConstrStateData%C_obj%x_Len = SIZE(ConstrStateData%x) IF (ConstrStateData%C_obj%x_Len > 0) & - ConstrStateData%C_obj%x = C_LOC(ConstrStateData%x(LBOUND(ConstrStateData%x,1, kind=B8Ki))) + ConstrStateData%C_obj%x = C_LOC(ConstrStateData%x(lbound(ConstrStateData%x,1))) END IF END IF @@ -1857,7 +1880,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe ELSE ConstrStateData%C_obj%y_Len = SIZE(ConstrStateData%y) IF (ConstrStateData%C_obj%y_Len > 0) & - ConstrStateData%C_obj%y = C_LOC(ConstrStateData%y(LBOUND(ConstrStateData%y,1, kind=B8Ki))) + ConstrStateData%C_obj%y = C_LOC(ConstrStateData%y(lbound(ConstrStateData%y,1))) END IF END IF @@ -1869,7 +1892,7 @@ SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointe ELSE ConstrStateData%C_obj%z_Len = SIZE(ConstrStateData%z) IF (ConstrStateData%C_obj%z_Len > 0) & - ConstrStateData%C_obj%z = C_LOC(ConstrStateData%z(LBOUND(ConstrStateData%z,1, kind=B8Ki))) + ConstrStateData%C_obj%z = C_LOC(ConstrStateData%z(lbound(ConstrStateData%z,1))) END IF END IF END SUBROUTINE @@ -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) @@ -2005,15 +2017,15 @@ subroutine MAP_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MAP_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcInputData%x)) then - LB(1:1) = lbound(SrcInputData%x, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%x, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%x) + UB(1:1) = ubound(SrcInputData%x) if (.not. associated(DstInputData%x)) then allocate(DstInputData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2027,8 +2039,8 @@ subroutine MAP_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%x = SrcInputData%x end if if (associated(SrcInputData%y)) then - LB(1:1) = lbound(SrcInputData%y, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%y, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%y) + UB(1:1) = ubound(SrcInputData%y) if (.not. associated(DstInputData%y)) then allocate(DstInputData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2042,8 +2054,8 @@ subroutine MAP_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%y = SrcInputData%y end if if (associated(SrcInputData%z)) then - LB(1:1) = lbound(SrcInputData%z, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%z, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%z) + UB(1:1) = ubound(SrcInputData%z) if (.not. associated(DstInputData%z)) then allocate(DstInputData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2113,7 +2125,7 @@ subroutine MAP_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(MAP_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -2205,7 +2217,7 @@ SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%x_Len = SIZE(InputData%x) IF (InputData%C_obj%x_Len > 0) & - InputData%C_obj%x = C_LOC(InputData%x(LBOUND(InputData%x,1, kind=B8Ki))) + InputData%C_obj%x = C_LOC(InputData%x(lbound(InputData%x,1))) END IF END IF @@ -2217,7 +2229,7 @@ SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%y_Len = SIZE(InputData%y) IF (InputData%C_obj%y_Len > 0) & - InputData%C_obj%y = C_LOC(InputData%y(LBOUND(InputData%y,1, kind=B8Ki))) + InputData%C_obj%y = C_LOC(InputData%y(lbound(InputData%y,1))) END IF END IF @@ -2229,7 +2241,7 @@ SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%z_Len = SIZE(InputData%z) IF (InputData%C_obj%z_Len > 0) & - InputData%C_obj%z = C_LOC(InputData%z(LBOUND(InputData%z,1, kind=B8Ki))) + InputData%C_obj%z = C_LOC(InputData%z(lbound(InputData%z,1))) END IF END IF END SUBROUTINE @@ -2240,15 +2252,15 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MAP_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcOutputData%Fx)) then - LB(1:1) = lbound(SrcOutputData%Fx, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%Fx, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%Fx) + UB(1:1) = ubound(SrcOutputData%Fx) if (.not. associated(DstOutputData%Fx)) then allocate(DstOutputData%Fx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2262,8 +2274,8 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%Fx = SrcOutputData%Fx end if if (associated(SrcOutputData%Fy)) then - LB(1:1) = lbound(SrcOutputData%Fy, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%Fy, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%Fy) + UB(1:1) = ubound(SrcOutputData%Fy) if (.not. associated(DstOutputData%Fy)) then allocate(DstOutputData%Fy(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2277,8 +2289,8 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%Fy = SrcOutputData%Fy end if if (associated(SrcOutputData%Fz)) then - LB(1:1) = lbound(SrcOutputData%Fz, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%Fz, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%Fz) + UB(1:1) = ubound(SrcOutputData%Fz) if (.not. associated(DstOutputData%Fz)) then allocate(DstOutputData%Fz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2292,8 +2304,8 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%Fz = SrcOutputData%Fz end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -2304,8 +2316,8 @@ subroutine MAP_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%WriteOutput = SrcOutputData%WriteOutput end if if (associated(SrcOutputData%wrtOutput)) then - LB(1:1) = lbound(SrcOutputData%wrtOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%wrtOutput, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%wrtOutput) + UB(1:1) = ubound(SrcOutputData%wrtOutput) if (.not. associated(DstOutputData%wrtOutput)) then allocate(DstOutputData%wrtOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2386,7 +2398,7 @@ subroutine MAP_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(MAP_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MAP_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -2493,7 +2505,7 @@ SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%Fx_Len = SIZE(OutputData%Fx) IF (OutputData%C_obj%Fx_Len > 0) & - OutputData%C_obj%Fx = C_LOC(OutputData%Fx(LBOUND(OutputData%Fx,1, kind=B8Ki))) + OutputData%C_obj%Fx = C_LOC(OutputData%Fx(lbound(OutputData%Fx,1))) END IF END IF @@ -2505,7 +2517,7 @@ SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%Fy_Len = SIZE(OutputData%Fy) IF (OutputData%C_obj%Fy_Len > 0) & - OutputData%C_obj%Fy = C_LOC(OutputData%Fy(LBOUND(OutputData%Fy,1, kind=B8Ki))) + OutputData%C_obj%Fy = C_LOC(OutputData%Fy(lbound(OutputData%Fy,1))) END IF END IF @@ -2517,7 +2529,7 @@ SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%Fz_Len = SIZE(OutputData%Fz) IF (OutputData%C_obj%Fz_Len > 0) & - OutputData%C_obj%Fz = C_LOC(OutputData%Fz(LBOUND(OutputData%Fz,1, kind=B8Ki))) + OutputData%C_obj%Fz = C_LOC(OutputData%Fz(lbound(OutputData%Fz,1))) END IF END IF @@ -2529,11 +2541,109 @@ SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%wrtOutput_Len = SIZE(OutputData%wrtOutput) IF (OutputData%C_obj%wrtOutput_Len > 0) & - OutputData%C_obj%wrtOutput = C_LOC(OutputData%wrtOutput(LBOUND(OutputData%wrtOutput,1, kind=B8Ki))) + OutputData%C_obj%wrtOutput = C_LOC(OutputData%wrtOutput(lbound(OutputData%wrtOutput,1))) END IF 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 ff21a2db4b..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 @@ -167,7 +166,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er InitOut%Ver = MD_ProgDesc CALL WrScr(' This is MoorDyn v2, with significant input file changes from v1.') - CALL DispCopyrightLicense( MD_ProgDesc%Name, 'Copyright (C) 2019 Matt Hall' ) + CALL DispCopyrightLicense( MD_ProgDesc%Name) !--------------------------------------------------------------------------------------------- @@ -638,10 +637,14 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! process stiffness coefficients CALL SplitByBars(tempString1, N, tempStrings) - if (N > 2) then - CALL SetErrStat( ErrID_Fatal, 'A line type EA entry can have at most 2 (comma-separated) values.', ErrStat, ErrMsg, RoutineName ) + if (N > 3) then + CALL SetErrStat( ErrID_Fatal, 'A line type EA entry can have at most 3 (bar-separated) values.', ErrStat, ErrMsg, RoutineName ) CALL CleanUp() - else if (N==2) then ! visco-elastic case! + else if (N==3) then ! visco-elastic case, load dependent dynamic stiffness! + m%LineTypeList(l)%ElasticMod = 3 + read(tempStrings(2), *) m%LineTypeList(l)%alphaMBL + read(tempStrings(3), *) m%LineTypeList(l)%vbeta + else if (N==2) then ! visco-elastic case, constant dynamic stiffness! m%LineTypeList(l)%ElasticMod = 2 read(tempStrings(2), *) m%LineTypeList(l)%EA_D else @@ -657,11 +660,11 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! process damping coefficients CALL SplitByBars(tempString2, N, tempStrings) if (N > m%LineTypeList(l)%ElasticMod) then - CALL SetErrStat( ErrID_Fatal, 'A line type BA entry cannot have more (comma-separated) values its EA entry.', ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrID_Fatal, 'A line type BA entry cannot have more (bar-separated) values than its EA entry.', ErrStat, ErrMsg, RoutineName ) CALL CleanUp() else if (N==2) then ! visco-elastic case when two BA values provided read(tempStrings(2), *) m%LineTypeList(l)%BA_D - else if (m%LineTypeList(l)%ElasticMod == 2) then ! case where there is no dynamic damping for viscoelastic model (will it work)? + else if (m%LineTypeList(l)%ElasticMod > 1) then ! case where there is no dynamic damping for viscoelastic model (will it work)? CALL WrScr("Warning, viscoelastic model being used with zero damping on the dynamic stiffness.") if (p%writeLog > 0) then write(p%UnLog,'(A)') "Warning, viscoelastic model being used with zero damping on the dynamic stiffness." @@ -1438,7 +1441,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er ! account for states of line m%LineStateIs1(l) = Nx + 1 - if (m%LineTypeList(m%LineList(l)%PropsIdNum)%ElasticMod == 2) then + if (m%LineTypeList(m%LineList(l)%PropsIdNum)%ElasticMod > 1) then ! todo add an error check here? or change to 2 or 3? Nx = Nx + 7*m%LineList(l)%N - 6 ! if using viscoelastic model, need one more state per segment m%LineStateIsN(l) = Nx else @@ -2622,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 @@ -2735,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) @@ -3287,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 @@ -3498,7 +3826,10 @@ SUBROUTINE MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, Er ! calculate line dynamics (and calculate line forces and masses attributed to points) DO l = 1,p%nLines - CALL Line_GetStateDeriv(m%LineList(l), dxdt%states(m%LineStateIs1(l):m%LineStateIsN(l)), m, p) !dt might also be passed for fancy friction models + CALL Line_GetStateDeriv(m%LineList(l), dxdt%states(m%LineStateIs1(l):m%LineStateIsN(l)), m, p, ErrStat, ErrMsg) !dt might also be passed for fancy friction models + if (ErrStat == ErrID_Fatal) then + return + endif END DO ! calculate point dynamics (including contributions from attached lines @@ -3852,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 @@ -3870,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 @@ -3978,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 !---------------------------------------------------------------------------------------------------------------------------------- @@ -4138,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 !< 3) then + ErrStat = ErrID_Fatal + ErrMsg = "Line ElasticMod > 3. This is not possible." + RETURN + endif Line%nEApoints = LineProp%nEApoints DO I = 1,Line%nEApoints @@ -141,7 +149,7 @@ SUBROUTINE SetupLine (Line, LineProp, p, ErrStat, ErrMsg) END IF ! if using viscoelastic model, allocate additional state quantities - if (Line%ElasticMod == 2) then + if (Line%ElasticMod > 1) then ALLOCATE ( Line%dl_1(N), STAT = ErrStat ) IF ( ErrStat /= ErrID_None ) THEN ErrMsg = ' Error allocating dl_1 array.' @@ -991,7 +999,7 @@ SUBROUTINE Line_SetState(Line, X, t) END DO ! if using viscoelastic model, also set the static stiffness stretch - if (Line%ElasticMod == 2) then + if (Line%ElasticMod > 1) then do I=1,Line%N Line%dl_1(I) = X( 6*Line%N-6 + I) ! these will be the last N entries in the state vector end do @@ -1001,12 +1009,15 @@ END SUBROUTINE Line_SetState !-------------------------------------------------------------- !-------------------------------------------------------------- - SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p) !, FairFtot, FairMtot, AnchFtot, AnchMtot) + SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p, ErrStat, ErrMsg) !, FairFtot, FairMtot, AnchFtot, AnchMtot) TYPE(MD_Line), INTENT(INOUT) :: Line ! the current Line object Real(DbKi), INTENT(INOUT) :: Xd(:) ! state derivative vector section for this line TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects TYPE(MD_ParameterType), INTENT(IN ) :: p ! Parameters + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! Real(DbKi), INTENT( IN ) :: X(:) ! state vector, provided ! Real(DbKi), INTENT( INOUT ) :: Xd(:) ! derivative of state vector, returned ! cahnged to INOUT @@ -1044,7 +1055,8 @@ SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p) !, FairFtot, FairMtot, AnchFtot, Real(DbKi) :: Yi ! used in interpolating from lookup table Real(DbKi) :: dl ! stretch of a segment [m] Real(DbKi) :: ld_1 ! rate of change of static stiffness portion of segment [m/s] - Real(DbKi) :: EA_1 ! stiffness of 'static stiffness' portion of segment, combines with dynamic stiffness to give static stiffnes [m/s] + Real(DbKi) :: EA_1 ! stiffness of 'slow' portion of segment, combines with dynamic stiffness to give static stiffnes [m/s] + Real(DbKi) :: EA_D ! stiffness of 'fast' portion of segment, combines with EA_1 stiffness to give static stiffnes [m/s] REAL(DbKi) :: surface_height ! Average the surface heights at the two nodes REAL(DbKi) :: firstNodeZ ! Difference of first node depth from surface height @@ -1268,21 +1280,49 @@ SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p) !, FairFtot, FairMtot, AnchFtot, else MagT = 0.0_DbKi ! cable can't "push" end if + ! line internal damping force based on line-specific BA value, including possibility of dynamic length changes in l and ld terms MagTd = Line%BA* ( Line%lstrd(I) - Line%lstr(I)*Line%ld(I)/Line%l(I) )/Line%l(I) - ! viscoelastic model - else if (Line%ElasticMod == 2) then + ! viscoelastic model from https://asmedigitalcollection.asme.org/OMAE/proceedings/IOWTC2023/87578/V001T01A029/1195018 + else if (Line%ElasticMod > 1) then + + if (Line%ElasticMod == 3) then + if (Line%dl_1(I) >= 0.0) then + ! Mean load dependent dynamic stiffness: from combining eqn. 2 and eqn. 10 from original MD viscoelastic paper, taking mean load = k1 delta_L1 / MBL, and solving for k_D using WolframAlpha with following conditions: k_D > k_s, (MBL,alpha,beta,unstrLen,delta_L1) > 0 + EA_D = 0.5 * ((Line%alphaMBL) + (Line%vbeta*Line%dl_1(I)*(Line%EA / Line%l(I))) + Line%EA + sqrt((Line%alphaMBL * Line%alphaMBL) + (2*Line%alphaMBL*(Line%EA / Line%l(I)) * (Line%vbeta*Line%dl_1(I) - Line%l(I))) + ((Line%EA / Line%l(I))*(Line%EA / Line%l(I)) * (Line%vbeta*Line%dl_1(I) + Line%l(I))*(Line%vbeta*Line%dl_1(I) + Line%l(I))))) + else + EA_D = Line%alphaMBL ! mean load is considered to be 0 in this case. The second term in the above equation is not valid for delta_L1 < 0. + endif + + else if (Line%ElasticMod == 2) then + ! constant dynamic stiffness + EA_D = Line%EA_D + endif + + if (EA_D == 0.0) then ! Make sure EA != EA_D or else nans, also make sure EA_D != 0 or else nans. + ErrStat = ErrID_Fatal + ErrMsg = "Viscoelastic model: Dynamic stiffness cannot equal zero" + return + else if (EA_D == Line%EA) then + ErrStat = ErrID_Fatal + ErrMsg = "Viscoelastic model: Dynamic stiffness cannot equal static stiffness" + return + endif - EA_1 = Line%EA_D*Line%EA/(Line%EA_D - Line%EA)! calculated EA_1 which is the stiffness in series with EA_D that will result in the desired static stiffness of EA_S + EA_1 = EA_D*Line%EA/(EA_D - Line%EA)! calculated EA_1 which is the stiffness in series with EA_D that will result in the desired static stiffness of EA_S. dl = Line%lstr(I) - Line%l(I) ! delta l of this segment - ld_1 = (Line%EA_D*dl - (Line%EA_D + EA_1)*Line%dl_1(I) + Line%BA_D*Line%lstrd(I)) /( Line%BA_D + Line%BA) ! rate of change of static stiffness portion [m/s] - - !MagT = (Line%EA*Line%dl_S(I) + Line%BA*ld_S)/ Line%l(I) ! compute tension based on static portion (dynamic portion would give same) - MagT = EA_1*Line%dl_1(I)/ Line%l(I) - MagTd = Line%BA*ld_1 / Line%l(I) + ld_1 = (EA_D*dl - (EA_D + EA_1)*Line%dl_1(I) + Line%BA_D*Line%lstrd(I)) /( Line%BA_D + Line%BA) ! rate of change of static stiffness portion [m/s] + + if (dl >= 0.0) then ! if both spring 1 (the spring dashpot in parallel) and the whole segment are not in compression + MagT = EA_1*Line%dl_1(I) / Line%l(I) ! compute tension based on static portion (dynamic portion would give same). See eqn. 14 in paper + else + MagT = 0.0_DbKi ! cable can't "push" + endif + + MagTd = Line%BA*ld_1 / Line%l(I) ! compute tension based on static portion (dynamic portion would give same). See eqn. 14 in paper ! update state derivative for static stiffness stretch (last N entries in the state vector) Xd( 6*N-6 + I) = ld_1 diff --git a/modules/moordyn/src/MoorDyn_Misc.f90 b/modules/moordyn/src/MoorDyn_Misc.f90 index cfc82ed6f4..bf26a7ab1b 100644 --- a/modules/moordyn/src/MoorDyn_Misc.f90 +++ b/modules/moordyn/src/MoorDyn_Misc.f90 @@ -1283,7 +1283,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - INTEGER(IntKi) :: I, iIn, ix, iy, iz + INTEGER(IntKi) :: I, iIn, ix, iy, iz, numHdrLn INTEGER(IntKi) :: ntIn ! number of time series inputs from file INTEGER(IntKi) :: UnIn ! unit number for coefficient input file INTEGER(IntKi) :: UnEcho @@ -1302,6 +1302,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) CHARACTER(120) :: Line CHARACTER(4096) :: entries2 INTEGER(IntKi) :: coordtype + LOGICAL :: dataBegin INTEGER(IntKi) :: NStepWave ! INTEGER(IntKi) :: NStepWave2 ! @@ -1313,7 +1314,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) REAL(SiKi), ALLOCATABLE :: TmpFFTWaveElev(:) ! Data for the FFT calculation TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using - + REAL(SiKi) :: tmpReal ! A temporary real number COMPLEX(SiKi),ALLOCATABLE :: tmpComplex(:) ! A temporary array (0:NStepWave2-1) for FFT use. REAL(SiKi) :: Omega ! Wave frequency (rad/s) @@ -1469,17 +1470,28 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) call WrScr( 'Reading wave elevation data from '//trim(WaveKinFile) ) ! Read through length of file to find its length - i = 1 ! start counter + i = 0 ! start line counter + numHdrLn = 0 ! start header-line counter + dataBegin = .FALSE. ! started reading the data section DO READ(UnElev,'(A)',IOSTAT=ErrStat2) Line !read into a line IF (ErrStat2 /= 0) EXIT ! break out of the loop if it couldn't read the line (i.e. if at end of file) i = i+1 + READ(Line,*,IOSTAT=ErrStatTmp) tmpReal + IF (ErrStatTmp/=0) THEN ! Not a number + IF (dataBegin) THEN + CALL SetErrStat( ErrID_Fatal,' Non-data line detected in WaveKinFile past the header lines.',ErrStat, ErrMsg, RoutineName); return + END IF + numHdrLn = numHdrLn + 1 + ELSE + dataBegin = .TRUE. + END IF END DO ! rewind to start of input file to re-read things now that we know how long it is REWIND(UnElev) - ntIn = i-3 ! save number of lines of file + ntIn = i-numHdrLn ! save number of lines of file ! allocate space for input wave elevation array (including time column) @@ -1487,8 +1499,9 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) CALL AllocAry(WaveElevIn, ntIn, 'WaveElevIn', ErrStat2, ErrMsg2 ); if(Failed()) return ! read the data in from the file - READ(UnElev,'(A)',IOSTAT=ErrStat2) Line ! skip the first two lines as headers - READ(UnElev,'(A)',IOSTAT=ErrStat2) Line ! + DO i = 1, numHdrLn + READ(UnElev,'(A)',IOSTAT=ErrStat2) Line ! skip header lines + END DO DO i = 1, ntIn READ (UnElev, *, IOSTAT=ErrStat2) WaveTimeIn(i), WaveElevIn(i) @@ -1502,7 +1515,7 @@ SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) CLOSE ( UnElev ) IF (WaveTimeIn(1) .NE. 0.0) THEN - CALL SetErrStat( ErrID_Warn, ' MoorDyn WaveElev time series should start at t = 0 seconds. First two lines are read as headers.',ErrStat, ErrMsg, RoutineName); return + CALL SetErrStat( ErrID_Fatal, ' MoorDyn WaveElev time series should start at t = 0 seconds.',ErrStat, ErrMsg, RoutineName); return ENDIF call WrScr( "Read "//trim(num2lstr(ntIn))//" time steps from input file." ) diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index a12ef6b85b..a5824b9764 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -55,6 +55,8 @@ typedef ^ ^ DbKi d - typedef ^ ^ DbKi w - - - "per-length weight in air" "[kg/m]" typedef ^ ^ DbKi EA - - - "axial stiffness" "[N]" typedef ^ ^ DbKi EA_D - - - "axial stiffness" "[N]" +typedef ^ ^ DbKi alphaMBL - - - "dynamic stiffness constant: Krd alpha term x MBL" "[N]" +typedef ^ ^ DbKi vbeta - - - "dynamic stiffness Lm slope: Krd beta term (to be multiplied by mean load)" "[N]" typedef ^ ^ DbKi BA - - - "internal damping coefficient times area" "[N-s]" typedef ^ ^ DbKi BA_D - - - "internal damping coefficient times area" "[N-s]" typedef ^ ^ DbKi EI - - - "bending stiffness" "[N-m]" @@ -62,14 +64,14 @@ typedef ^ ^ DbKi Can - typedef ^ ^ DbKi Cat - - - "tangential added mass coefficient" typedef ^ ^ DbKi Cdn - - - "transverse drag coefficient" typedef ^ ^ DbKi Cdt - - - "tangential drag coefficient" -typedef ^ ^ IntKi ElasticMod - - - "Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} " - -typedef ^ ^ IntKi nEApoints - 0 - "number of values in stress-strain lookup table (0 means using constant E)" +typedef ^ ^ IntKi ElasticMod - - - "Which elasticity model to use: {1 basic, 2 viscoelastic, 3 viscoelastic+meanload} " - +typedef ^ ^ IntKi nEApoints - - - "number of values in stress-strain lookup table (0 means using constant E)" typedef ^ ^ DbKi stiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" typedef ^ ^ DbKi stiffYs {30} - - "y array for stress-strain lookup table" -typedef ^ ^ IntKi nBApoints - 0 - "number of values in stress-strainrate lookup table (0 means using constant c)" +typedef ^ ^ IntKi nBApoints - - - "number of values in stress-strainrate lookup table (0 means using constant c)" typedef ^ ^ DbKi dampXs {30} - - "x array for stress-strainrate lookup table (up to nCoef)" typedef ^ ^ DbKi dampYs {30} - - "y array for stress-strainrate lookup table" -typedef ^ ^ IntKi nEIpoints - 0 - "number of values in bending stress-strain lookup table (0 means using constant E)" +typedef ^ ^ IntKi nEIpoints - - - "number of values in bending stress-strain lookup table (0 means using constant E)" typedef ^ ^ DbKi bstiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" typedef ^ ^ DbKi bstiffYs {30} - - "y array for stress-strain lookup table" @@ -92,8 +94,8 @@ typedef ^ MD_Body IntKi IdNum - typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 0=free, 1=fixed, -1=coupled, 2=coupledpinned" typedef ^ ^ IntKi AttachedC {30} - - "list of IdNums of points attached to this body" typedef ^ ^ IntKi AttachedR {30} - - "list of IdNums of rods attached to this body" -typedef ^ ^ IntKi nAttachedC - 0 - "number of attached points" -typedef ^ ^ IntKi nAttachedR - 0 - "number of attached rods" +typedef ^ ^ IntKi nAttachedC - - - "number of attached points" +typedef ^ ^ IntKi nAttachedR - - - "number of attached rods" typedef ^ ^ DbKi rPointRel {3}{30} - - "relative position of point on body" typedef ^ ^ DbKi r6RodRel {6}{30} - - "relative position and orientation of rod on body" typedef ^ ^ DbKi bodyM - - - "body mass (seperate from attached objects)" "[kg]" @@ -121,7 +123,7 @@ typedef ^ ^ CHARACTER(10) type - typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 1=fixed, -1=coupled, 0=free" typedef ^ ^ IntKi Attached {10} - - "list of IdNums of lines attached to this point node" typedef ^ ^ IntKi Top {10} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" -typedef ^ ^ IntKi nAttached - 0 - "number of attached lines" +typedef ^ ^ IntKi nAttached - - - "number of attached lines" typedef ^ ^ DbKi pointM - - - "point mass" "[kg]" typedef ^ ^ DbKi pointV - - - "point volume" "[m^3]" typedef ^ ^ DbKi pointFX - - - "" @@ -149,8 +151,8 @@ typedef ^ ^ IntKi AttachedA {10} typedef ^ ^ IntKi AttachedB {10} - - "list of IdNums of lines attached to end B" typedef ^ ^ IntKi TopA {10} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" typedef ^ ^ IntKi TopB {10} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" -typedef ^ ^ IntKi nAttachedA - 0 - "number of attached lines to Rod end A" -typedef ^ ^ IntKi nAttachedB - 0 - "number of attached lines to Rod end B" +typedef ^ ^ IntKi nAttachedA - - - "number of attached lines to Rod end A" +typedef ^ ^ IntKi nAttachedB - - - "number of attached lines to Rod end B" typedef ^ ^ IntKi OutFlagList {20} - - "array specifying what line quantities should be output (1 vs 0)" - typedef ^ ^ IntKi N - - - "The number of elements in the line" - typedef ^ ^ IntKi endTypeA - - - "type of point at end A: 0=pinned to Point, 1=cantilevered to Rod." - @@ -210,7 +212,7 @@ typedef ^ MD_Line IntKi IdNum - typedef ^ ^ IntKi PropsIdNum - - - "the IdNum of the associated line properties" - typedef ^ ^ IntKi ElasticMod - - - "Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} " - typedef ^ ^ IntKi OutFlagList {20} - - "array specifying what line quantities should be output (1 vs 0)" - -typedef ^ ^ IntKi CtrlChan - 0 - "index of control channel that will drive line active tensioning (0 for none)" - +typedef ^ ^ IntKi CtrlChan - - - "index of control channel that will drive line active tensioning (0 for none)" - typedef ^ ^ IntKi FairPoint - - - "IdNum of Point at fairlead" typedef ^ ^ IntKi AnchPoint - - - "IdNum of Point at anchor" typedef ^ ^ IntKi N - - - "The number of elements in the line" - @@ -219,22 +221,24 @@ typedef ^ ^ IntKi endTypeB - typedef ^ ^ DbKi UnstrLen - - - "unstretched length of the line" - typedef ^ ^ DbKi rho - - - "density" "[kg/m3]" typedef ^ ^ DbKi d - - - "volume-equivalent diameter" "[m]" -typedef ^ ^ DbKi EA - 0 - "stiffness" "[N]" -typedef ^ ^ DbKi EA_D - 0 - "dynamic stiffness when using viscoelastic model" "[N]" -typedef ^ ^ DbKi BA - 0 - "internal damping coefficient times area for this line only" "[N-s]" -typedef ^ ^ DbKi BA_D - 0 - "dynamic internal damping coefficient times area when using viscoelastic model" "[N-s]" -typedef ^ ^ DbKi EI - 0 - "bending stiffness" "[N-m]" +typedef ^ ^ DbKi EA - - - "stiffness" "[N]" +typedef ^ ^ DbKi EA_D - - - "constant dynamic stiffness when using viscoelastic model" "[N]" +typedef ^ ^ DbKi alphaMBL - - - "load dependent dynamic stiffness constant: Krd alpha term x MBL" "[N]" +typedef ^ ^ DbKi vbeta - - - "load dependent dynamic stiffness Lm slope: Krd beta term (to be multiplied by mean load)" "[N]" +typedef ^ ^ DbKi BA - - - "internal damping coefficient times area for this line only" "[N-s]" +typedef ^ ^ DbKi BA_D - - - "dynamic internal damping coefficient times area when using viscoelastic model" "[N-s]" +typedef ^ ^ DbKi EI - - - "bending stiffness" "[N-m]" typedef ^ ^ DbKi Can - - - "" "[-]" typedef ^ ^ DbKi Cat - - - "" "[-]" typedef ^ ^ DbKi Cdn - - - "" "[-]" typedef ^ ^ DbKi Cdt - - - "" "[-]" -typedef ^ ^ IntKi nEApoints - 0 - "number of values in stress-strain lookup table (0 means using constant E)" +typedef ^ ^ IntKi nEApoints - - - "number of values in stress-strain lookup table (0 means using constant E)" typedef ^ ^ DbKi stiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" typedef ^ ^ DbKi stiffYs {30} - - "y array for stress-strain lookup table" -typedef ^ ^ IntKi nBApoints - 0 - "number of values in stress-strainrate lookup table (0 means using constant c)" +typedef ^ ^ IntKi nBApoints - - - "number of values in stress-strainrate lookup table (0 means using constant c)" typedef ^ ^ DbKi dampXs {30} - - "x array for stress-strainrate lookup table (up to nCoef)" typedef ^ ^ DbKi dampYs {30} - - "y array for stress-strainrate lookup table" -typedef ^ ^ IntKi nEIpoints - 0 - "number of values in bending stress-strain lookup table (0 means using constant E)" +typedef ^ ^ IntKi nEIpoints - - - "number of values in bending stress-strain lookup table (0 means using constant E)" typedef ^ ^ DbKi bstiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" typedef ^ ^ DbKi bstiffYs {30} - - "y array for stress-strain lookup table" typedef ^ ^ DbKi time - - - "current time" "[s]" @@ -307,6 +311,7 @@ typedef ^ ^ LOGICAL RotFrame_x {:} 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 ^ ^ ModVarsType Vars - - - "Module Variables" - ## ============================== Define Continuous states here: ===================================================================================================================================== @@ -321,45 +326,6 @@ typedef ^ ConstraintStateType SiKi dummy - ## ============================== Define Other states here: ===================================================================================================================================== typedef ^ OtherStateType SiKi dummy - - - "Remove this variable if you have other states" - - -## ============================== Define Misc variables here: ===================================================================================================================================== -typedef ^ MiscVarType MD_LineProp LineTypeList {:} - - "array of properties for each line type" - -typedef ^ ^ MD_RodProp RodTypeList {:} - - "array of properties for each rod type" - -typedef ^ ^ MD_Body GroundBody - - - "the single ground body which is the parent of all stationary points" - -typedef ^ ^ MD_Body BodyList {:} - - "array of body objects" - -typedef ^ ^ MD_Rod RodList {:} - - "array of rod objects" - -typedef ^ ^ MD_Point PointList {:} - - "array of point objects" - -typedef ^ ^ MD_Line LineList {:} - - "array of line objects" - -typedef ^ ^ MD_Fail FailList {:} - - "array of line objects" - -typedef ^ ^ IntKi FreePointIs {:} - - "array of free point indices in PointList vector" "" -typedef ^ ^ IntKi CpldPointIs {:}{:} - - "array of coupled/fairlead point indices in PointList vector" "" -typedef ^ ^ IntKi FreeRodIs {:} - - "array of free rod indices in RodList vector" "" -typedef ^ ^ IntKi CpldRodIs {:}{:} - - "array of coupled/fairlead rod indices in RodList vector" "" -typedef ^ ^ IntKi FreeBodyIs {:} - - "array of free body indices in BodyList vector" "" -typedef ^ ^ IntKi CpldBodyIs {:}{:} - - "array of coupled body indices in BodyList vector" "" -typedef ^ ^ IntKi LineStateIs1 {:} - - "starting index of each line's states in state vector" "" -typedef ^ ^ IntKi LineStateIsN {:} - - "ending index of each line's states in state vector" "" -typedef ^ ^ IntKi PointStateIs1 {:} - - "starting index of each point's states in state vector" "" -typedef ^ ^ IntKi PointStateIsN {:} - - "ending index of each point's states in state vector" "" -typedef ^ ^ IntKi RodStateIs1 {:} - - "starting index of each rod's states in state vector" "" -typedef ^ ^ IntKi RodStateIsN {:} - - "ending index of each rod's states in state vector" "" -typedef ^ ^ IntKi BodyStateIs1 {:} - - "starting index of each body's states in state vector" "" -typedef ^ ^ IntKi BodyStateIsN {:} - - "ending index of each body's states in state vector" "" -typedef ^ ^ IntKi Nx - - - "number of states and size of state vector" "" -typedef ^ ^ IntKi Nxtra - - - "number of states and size of state vector including points for potential line failures" "" -typedef ^ ^ IntKi WaveTi - - - "current interpolation index for wave time series data" "" -typedef ^ ^ MD_ContinuousStateType xTemp - - - "contains temporary state vector used in integration (put here so it's only allocated once)" -typedef ^ ^ MD_ContinuousStateType xdTemp - - - "contains temporary state derivative vector used in integration (put here so it's only allocated once)" -typedef ^ ^ DbKi zeros6 {6} - - "array of zeros for convenience" -typedef ^ ^ DbKi MDWrOutput {:} - - "Data from time step to be written to a MoorDyn output file" -typedef ^ ^ DbKi LastOutTime - - - "Time of last writing to MD output files" -typedef ^ ^ ReKi PtfmInit {6} - - "initial position of platform for an individual (non-farm) MD instance" - -typedef ^ ^ DbKi BathymetryGrid {:}{:} - - "matrix describing the bathymetry in a grid of x's and y's" -typedef ^ ^ DbKi BathGrid_Xs {:} - - "array of x-coordinates in the bathymetry grid" -typedef ^ ^ DbKi BathGrid_Ys {:} - - "array of y-coordinates in the bathymetry grid" -typedef ^ ^ IntKi BathGrid_npoints {:} - - "number of grid points to describe the bathymetry grid" - - ## ============================== Parameters ============================================================================================================================================ typedef ^ ParameterType IntKi nLineTypes - 0 - "number of line types" "" typedef ^ ^ IntKi nRodTypes - 0 - "number of rod types" "" @@ -458,3 +424,46 @@ typedef ^ ^ MeshType VisLinesMesh {:} typedef ^ ^ MeshType VisRodsMesh {:} - - "Line2 mesh for visualizing mooring rods" - typedef ^ ^ MeshType VisBodiesMesh {:} - - "Point mesh for visualizing mooring bodies" - typedef ^ ^ MeshType VisAnchsMesh {:} - - "Point mesh for visualizing mooring anchors" - + + +## ============================== Define Misc variables here: ===================================================================================================================================== +typedef ^ MiscVarType ModJacType Jac - - - "Jacobian values corresponding to module variables" - +typedef ^ ^ MD_ContinuousStateType x_perturb - - - "States for calculating Jacobians" - +typedef ^ ^ MD_ContinuousStateType dxdt_lin - - - "States for calculating Jacobians" - +typedef ^ ^ MD_InputType u_perturb - - - "Inputs for calculating Jacobians" - +typedef ^ ^ MD_OutputType y_lin - - - "Outputs for calculating Jacobians" - +typedef ^ ^ MD_LineProp LineTypeList {:} - - "array of properties for each line type" - +typedef ^ ^ MD_RodProp RodTypeList {:} - - "array of properties for each rod type" - +typedef ^ ^ MD_Body GroundBody - - - "the single ground body which is the parent of all stationary points" - +typedef ^ ^ MD_Body BodyList {:} - - "array of body objects" - +typedef ^ ^ MD_Rod RodList {:} - - "array of rod objects" - +typedef ^ ^ MD_Point PointList {:} - - "array of point objects" - +typedef ^ ^ MD_Line LineList {:} - - "array of line objects" - +typedef ^ ^ MD_Fail FailList {:} - - "array of line objects" - +typedef ^ ^ IntKi FreePointIs {:} - - "array of free point indices in PointList vector" "" +typedef ^ ^ IntKi CpldPointIs {:}{:} - - "array of coupled/fairlead point indices in PointList vector" "" +typedef ^ ^ IntKi FreeRodIs {:} - - "array of free rod indices in RodList vector" "" +typedef ^ ^ IntKi CpldRodIs {:}{:} - - "array of coupled/fairlead rod indices in RodList vector" "" +typedef ^ ^ IntKi FreeBodyIs {:} - - "array of free body indices in BodyList vector" "" +typedef ^ ^ IntKi CpldBodyIs {:}{:} - - "array of coupled body indices in BodyList vector" "" +typedef ^ ^ IntKi LineStateIs1 {:} - - "starting index of each line's states in state vector" "" +typedef ^ ^ IntKi LineStateIsN {:} - - "ending index of each line's states in state vector" "" +typedef ^ ^ IntKi PointStateIs1 {:} - - "starting index of each point's states in state vector" "" +typedef ^ ^ IntKi PointStateIsN {:} - - "ending index of each point's states in state vector" "" +typedef ^ ^ IntKi RodStateIs1 {:} - - "starting index of each rod's states in state vector" "" +typedef ^ ^ IntKi RodStateIsN {:} - - "ending index of each rod's states in state vector" "" +typedef ^ ^ IntKi BodyStateIs1 {:} - - "starting index of each body's states in state vector" "" +typedef ^ ^ IntKi BodyStateIsN {:} - - "ending index of each body's states in state vector" "" +typedef ^ ^ IntKi Nx - - - "number of states and size of state vector" "" +typedef ^ ^ IntKi Nxtra - - - "number of states and size of state vector including points for potential line failures" "" +typedef ^ ^ IntKi WaveTi - - - "current interpolation index for wave time series data" "" +typedef ^ ^ MD_ContinuousStateType xTemp - - - "contains temporary state vector used in integration (put here so it's only allocated once)" +typedef ^ ^ MD_ContinuousStateType xdTemp - - - "contains temporary state derivative vector used in integration (put here so it's only allocated once)" +typedef ^ ^ DbKi zeros6 {6} - - "array of zeros for convenience" +typedef ^ ^ DbKi MDWrOutput {:} - - "Data from time step to be written to a MoorDyn output file" +typedef ^ ^ DbKi LastOutTime - - - "Time of last writing to MD output files" +typedef ^ ^ ReKi PtfmInit {6} - - "initial position of platform for an individual (non-farm) MD instance" - +typedef ^ ^ DbKi BathymetryGrid {:}{:} - - "matrix describing the bathymetry in a grid of x's and y's" +typedef ^ ^ DbKi BathGrid_Xs {:} - - "array of x-coordinates in the bathymetry grid" +typedef ^ ^ DbKi BathGrid_Ys {:} - - "array of y-coordinates in the bathymetry grid" +typedef ^ ^ IntKi BathGrid_npoints {:} - - "number of grid points to describe the bathymetry grid" diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 7f171fdd4b..97b3873739 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -68,6 +68,8 @@ MODULE MoorDyn_Types REAL(DbKi) :: w = 0.0_R8Ki !< per-length weight in air [[kg/m]] REAL(DbKi) :: EA = 0.0_R8Ki !< axial stiffness [[N]] REAL(DbKi) :: EA_D = 0.0_R8Ki !< axial stiffness [[N]] + REAL(DbKi) :: alphaMBL = 0.0_R8Ki !< dynamic stiffness constant: Krd alpha term x MBL [[N]] + REAL(DbKi) :: vbeta = 0.0_R8Ki !< dynamic stiffness Lm slope: Krd beta term (to be multiplied by mean load) [[N]] REAL(DbKi) :: BA = 0.0_R8Ki !< internal damping coefficient times area [[N-s]] REAL(DbKi) :: BA_D = 0.0_R8Ki !< internal damping coefficient times area [[N-s]] REAL(DbKi) :: EI = 0.0_R8Ki !< bending stiffness [[N-m]] @@ -75,14 +77,14 @@ MODULE MoorDyn_Types REAL(DbKi) :: Cat = 0.0_R8Ki !< tangential added mass coefficient [-] REAL(DbKi) :: Cdn = 0.0_R8Ki !< transverse drag coefficient [-] REAL(DbKi) :: Cdt = 0.0_R8Ki !< tangential drag coefficient [-] - INTEGER(IntKi) :: ElasticMod = 0_IntKi !< Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} [-] - INTEGER(IntKi) :: nEApoints = 0 !< number of values in stress-strain lookup table (0 means using constant E) [-] + INTEGER(IntKi) :: ElasticMod = 0_IntKi !< Which elasticity model to use: {1 basic, 2 viscoelastic, 3 viscoelastic+meanload} [-] + INTEGER(IntKi) :: nEApoints = 0_IntKi !< number of values in stress-strain lookup table (0 means using constant E) [-] REAL(DbKi) , DIMENSION(1:30) :: stiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] REAL(DbKi) , DIMENSION(1:30) :: stiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] - INTEGER(IntKi) :: nBApoints = 0 !< number of values in stress-strainrate lookup table (0 means using constant c) [-] + INTEGER(IntKi) :: nBApoints = 0_IntKi !< number of values in stress-strainrate lookup table (0 means using constant c) [-] REAL(DbKi) , DIMENSION(1:30) :: dampXs = 0.0_R8Ki !< x array for stress-strainrate lookup table (up to nCoef) [-] REAL(DbKi) , DIMENSION(1:30) :: dampYs = 0.0_R8Ki !< y array for stress-strainrate lookup table [-] - INTEGER(IntKi) :: nEIpoints = 0 !< number of values in bending stress-strain lookup table (0 means using constant E) [-] + INTEGER(IntKi) :: nEIpoints = 0_IntKi !< number of values in bending stress-strain lookup table (0 means using constant E) [-] REAL(DbKi) , DIMENSION(1:30) :: bstiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] REAL(DbKi) , DIMENSION(1:30) :: bstiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] END TYPE MD_LineProp @@ -109,8 +111,8 @@ MODULE MoorDyn_Types INTEGER(IntKi) :: typeNum = 0_IntKi !< integer identifying the type. 0=free, 1=fixed, -1=coupled, 2=coupledpinned [-] INTEGER(IntKi) , DIMENSION(1:30) :: AttachedC = 0_IntKi !< list of IdNums of points attached to this body [-] INTEGER(IntKi) , DIMENSION(1:30) :: AttachedR = 0_IntKi !< list of IdNums of rods attached to this body [-] - INTEGER(IntKi) :: nAttachedC = 0 !< number of attached points [-] - INTEGER(IntKi) :: nAttachedR = 0 !< number of attached rods [-] + INTEGER(IntKi) :: nAttachedC = 0_IntKi !< number of attached points [-] + INTEGER(IntKi) :: nAttachedR = 0_IntKi !< number of attached rods [-] REAL(DbKi) , DIMENSION(1:3,1:30) :: rPointRel = 0.0_R8Ki !< relative position of point on body [-] REAL(DbKi) , DIMENSION(1:6,1:30) :: r6RodRel = 0.0_R8Ki !< relative position and orientation of rod on body [-] REAL(DbKi) :: bodyM = 0.0_R8Ki !< body mass (seperate from attached objects) [[kg]] @@ -140,7 +142,7 @@ MODULE MoorDyn_Types INTEGER(IntKi) :: typeNum = 0_IntKi !< integer identifying the type. 1=fixed, -1=coupled, 0=free [-] INTEGER(IntKi) , DIMENSION(1:10) :: Attached = 0_IntKi !< list of IdNums of lines attached to this point node [-] INTEGER(IntKi) , DIMENSION(1:10) :: Top = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] - INTEGER(IntKi) :: nAttached = 0 !< number of attached lines [-] + INTEGER(IntKi) :: nAttached = 0_IntKi !< number of attached lines [-] REAL(DbKi) :: pointM = 0.0_R8Ki !< point mass [[kg]] REAL(DbKi) :: pointV = 0.0_R8Ki !< point volume [[m^3]] REAL(DbKi) :: pointFX = 0.0_R8Ki !< [-] @@ -170,8 +172,8 @@ MODULE MoorDyn_Types INTEGER(IntKi) , DIMENSION(1:10) :: AttachedB = 0_IntKi !< list of IdNums of lines attached to end B [-] INTEGER(IntKi) , DIMENSION(1:10) :: TopA = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] INTEGER(IntKi) , DIMENSION(1:10) :: TopB = 0_IntKi !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] - INTEGER(IntKi) :: nAttachedA = 0 !< number of attached lines to Rod end A [-] - INTEGER(IntKi) :: nAttachedB = 0 !< number of attached lines to Rod end B [-] + INTEGER(IntKi) :: nAttachedA = 0_IntKi !< number of attached lines to Rod end A [-] + INTEGER(IntKi) :: nAttachedB = 0_IntKi !< number of attached lines to Rod end B [-] INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList = 0_IntKi !< array specifying what line quantities should be output (1 vs 0) [-] INTEGER(IntKi) :: N = 0_IntKi !< The number of elements in the line [-] INTEGER(IntKi) :: endTypeA = 0_IntKi !< type of point at end A: 0=pinned to Point, 1=cantilevered to Rod. [-] @@ -231,7 +233,7 @@ MODULE MoorDyn_Types INTEGER(IntKi) :: PropsIdNum = 0_IntKi !< the IdNum of the associated line properties [-] INTEGER(IntKi) :: ElasticMod = 0_IntKi !< Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} [-] INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList = 0_IntKi !< array specifying what line quantities should be output (1 vs 0) [-] - INTEGER(IntKi) :: CtrlChan = 0 !< index of control channel that will drive line active tensioning (0 for none) [-] + INTEGER(IntKi) :: CtrlChan = 0_IntKi !< index of control channel that will drive line active tensioning (0 for none) [-] INTEGER(IntKi) :: FairPoint = 0_IntKi !< IdNum of Point at fairlead [-] INTEGER(IntKi) :: AnchPoint = 0_IntKi !< IdNum of Point at anchor [-] INTEGER(IntKi) :: N = 0_IntKi !< The number of elements in the line [-] @@ -240,22 +242,24 @@ MODULE MoorDyn_Types REAL(DbKi) :: UnstrLen = 0.0_R8Ki !< unstretched length of the line [-] REAL(DbKi) :: rho = 0.0_R8Ki !< density [[kg/m3]] REAL(DbKi) :: d = 0.0_R8Ki !< volume-equivalent diameter [[m]] - REAL(DbKi) :: EA = 0 !< stiffness [[N]] - REAL(DbKi) :: EA_D = 0 !< dynamic stiffness when using viscoelastic model [[N]] - REAL(DbKi) :: BA = 0 !< internal damping coefficient times area for this line only [[N-s]] - REAL(DbKi) :: BA_D = 0 !< dynamic internal damping coefficient times area when using viscoelastic model [[N-s]] - REAL(DbKi) :: EI = 0 !< bending stiffness [[N-m]] + REAL(DbKi) :: EA = 0.0_R8Ki !< stiffness [[N]] + REAL(DbKi) :: EA_D = 0.0_R8Ki !< constant dynamic stiffness when using viscoelastic model [[N]] + REAL(DbKi) :: alphaMBL = 0.0_R8Ki !< load dependent dynamic stiffness constant: Krd alpha term x MBL [[N]] + REAL(DbKi) :: vbeta = 0.0_R8Ki !< load dependent dynamic stiffness Lm slope: Krd beta term (to be multiplied by mean load) [[N]] + REAL(DbKi) :: BA = 0.0_R8Ki !< internal damping coefficient times area for this line only [[N-s]] + REAL(DbKi) :: BA_D = 0.0_R8Ki !< dynamic internal damping coefficient times area when using viscoelastic model [[N-s]] + REAL(DbKi) :: EI = 0.0_R8Ki !< bending stiffness [[N-m]] REAL(DbKi) :: Can = 0.0_R8Ki !< [[-]] REAL(DbKi) :: Cat = 0.0_R8Ki !< [[-]] REAL(DbKi) :: Cdn = 0.0_R8Ki !< [[-]] REAL(DbKi) :: Cdt = 0.0_R8Ki !< [[-]] - INTEGER(IntKi) :: nEApoints = 0 !< number of values in stress-strain lookup table (0 means using constant E) [-] + INTEGER(IntKi) :: nEApoints = 0_IntKi !< number of values in stress-strain lookup table (0 means using constant E) [-] REAL(DbKi) , DIMENSION(1:30) :: stiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] REAL(DbKi) , DIMENSION(1:30) :: stiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] - INTEGER(IntKi) :: nBApoints = 0 !< number of values in stress-strainrate lookup table (0 means using constant c) [-] + INTEGER(IntKi) :: nBApoints = 0_IntKi !< number of values in stress-strainrate lookup table (0 means using constant c) [-] REAL(DbKi) , DIMENSION(1:30) :: dampXs = 0.0_R8Ki !< x array for stress-strainrate lookup table (up to nCoef) [-] REAL(DbKi) , DIMENSION(1:30) :: dampYs = 0.0_R8Ki !< y array for stress-strainrate lookup table [-] - INTEGER(IntKi) :: nEIpoints = 0 !< number of values in bending stress-strain lookup table (0 means using constant E) [-] + INTEGER(IntKi) :: nEIpoints = 0_IntKi !< number of values in bending stress-strain lookup table (0 means using constant E) [-] REAL(DbKi) , DIMENSION(1:30) :: bstiffXs = 0.0_R8Ki !< x array for stress-strain lookup table (up to nCoef) [-] REAL(DbKi) , DIMENSION(1:30) :: bstiffYs = 0.0_R8Ki !< y array for stress-strain lookup table [-] REAL(DbKi) :: time = 0.0_R8Ki !< current time [[s]] @@ -335,6 +339,7 @@ MODULE MoorDyn_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 MD_InitOutputType ! ======================= ! ========= MD_ContinuousStateType ======= @@ -357,45 +362,6 @@ MODULE MoorDyn_Types REAL(SiKi) :: dummy = 0.0_R4Ki !< Remove this variable if you have other states [-] END TYPE MD_OtherStateType ! ======================= -! ========= MD_MiscVarType ======= - TYPE, PUBLIC :: MD_MiscVarType - TYPE(MD_LineProp) , DIMENSION(:), ALLOCATABLE :: LineTypeList !< array of properties for each line type [-] - TYPE(MD_RodProp) , DIMENSION(:), ALLOCATABLE :: RodTypeList !< array of properties for each rod type [-] - TYPE(MD_Body) :: GroundBody !< the single ground body which is the parent of all stationary points [-] - TYPE(MD_Body) , DIMENSION(:), ALLOCATABLE :: BodyList !< array of body objects [-] - TYPE(MD_Rod) , DIMENSION(:), ALLOCATABLE :: RodList !< array of rod objects [-] - TYPE(MD_Point) , DIMENSION(:), ALLOCATABLE :: PointList !< array of point objects [-] - TYPE(MD_Line) , DIMENSION(:), ALLOCATABLE :: LineList !< array of line objects [-] - TYPE(MD_Fail) , DIMENSION(:), ALLOCATABLE :: FailList !< array of line objects [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FreePointIs !< array of free point indices in PointList vector [] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CpldPointIs !< array of coupled/fairlead point indices in PointList vector [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FreeRodIs !< array of free rod indices in RodList vector [] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CpldRodIs !< array of coupled/fairlead rod indices in RodList vector [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FreeBodyIs !< array of free body indices in BodyList vector [] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CpldBodyIs !< array of coupled body indices in BodyList vector [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LineStateIs1 !< starting index of each line's states in state vector [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LineStateIsN !< ending index of each line's states in state vector [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PointStateIs1 !< starting index of each point's states in state vector [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PointStateIsN !< ending index of each point's states in state vector [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: RodStateIs1 !< starting index of each rod's states in state vector [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: RodStateIsN !< ending index of each rod's states in state vector [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BodyStateIs1 !< starting index of each body's states in state vector [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BodyStateIsN !< ending index of each body's states in state vector [] - INTEGER(IntKi) :: Nx = 0_IntKi !< number of states and size of state vector [] - INTEGER(IntKi) :: Nxtra = 0_IntKi !< number of states and size of state vector including points for potential line failures [] - INTEGER(IntKi) :: WaveTi = 0_IntKi !< current interpolation index for wave time series data [] - TYPE(MD_ContinuousStateType) :: xTemp !< contains temporary state vector used in integration (put here so it's only allocated once) [-] - TYPE(MD_ContinuousStateType) :: xdTemp !< contains temporary state derivative vector used in integration (put here so it's only allocated once) [-] - REAL(DbKi) , DIMENSION(1:6) :: zeros6 = 0.0_R8Ki !< array of zeros for convenience [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: MDWrOutput !< Data from time step to be written to a MoorDyn output file [-] - REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Time of last writing to MD output files [-] - REAL(ReKi) , DIMENSION(1:6) :: PtfmInit = 0.0_ReKi !< initial position of platform for an individual (non-farm) MD instance [-] - REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: BathymetryGrid !< matrix describing the bathymetry in a grid of x's and y's [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_Xs !< array of x-coordinates in the bathymetry grid [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_Ys !< array of y-coordinates in the bathymetry grid [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_npoints !< number of grid points to describe the bathymetry grid [-] - END TYPE MD_MiscVarType -! ======================= ! ========= MD_ParameterType ======= TYPE, PUBLIC :: MD_ParameterType INTEGER(IntKi) :: nLineTypes = 0 !< number of line types [] @@ -490,7 +456,63 @@ MODULE MoorDyn_Types TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: VisAnchsMesh !< Point mesh for visualizing mooring anchors [-] END TYPE MD_OutputType ! ======================= -CONTAINS +! ========= MD_MiscVarType ======= + TYPE, PUBLIC :: MD_MiscVarType + TYPE(ModJacType) :: Jac !< Jacobian values corresponding to module variables [-] + TYPE(MD_ContinuousStateType) :: x_perturb !< States for calculating Jacobians [-] + TYPE(MD_ContinuousStateType) :: dxdt_lin !< States for calculating Jacobians [-] + TYPE(MD_InputType) :: u_perturb !< Inputs for calculating Jacobians [-] + TYPE(MD_OutputType) :: y_lin !< Outputs for calculating Jacobians [-] + TYPE(MD_LineProp) , DIMENSION(:), ALLOCATABLE :: LineTypeList !< array of properties for each line type [-] + TYPE(MD_RodProp) , DIMENSION(:), ALLOCATABLE :: RodTypeList !< array of properties for each rod type [-] + TYPE(MD_Body) :: GroundBody !< the single ground body which is the parent of all stationary points [-] + TYPE(MD_Body) , DIMENSION(:), ALLOCATABLE :: BodyList !< array of body objects [-] + TYPE(MD_Rod) , DIMENSION(:), ALLOCATABLE :: RodList !< array of rod objects [-] + TYPE(MD_Point) , DIMENSION(:), ALLOCATABLE :: PointList !< array of point objects [-] + TYPE(MD_Line) , DIMENSION(:), ALLOCATABLE :: LineList !< array of line objects [-] + TYPE(MD_Fail) , DIMENSION(:), ALLOCATABLE :: FailList !< array of line objects [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FreePointIs !< array of free point indices in PointList vector [] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CpldPointIs !< array of coupled/fairlead point indices in PointList vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FreeRodIs !< array of free rod indices in RodList vector [] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CpldRodIs !< array of coupled/fairlead rod indices in RodList vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FreeBodyIs !< array of free body indices in BodyList vector [] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CpldBodyIs !< array of coupled body indices in BodyList vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LineStateIs1 !< starting index of each line's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LineStateIsN !< ending index of each line's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PointStateIs1 !< starting index of each point's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: PointStateIsN !< ending index of each point's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: RodStateIs1 !< starting index of each rod's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: RodStateIsN !< ending index of each rod's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BodyStateIs1 !< starting index of each body's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BodyStateIsN !< ending index of each body's states in state vector [] + INTEGER(IntKi) :: Nx = 0_IntKi !< number of states and size of state vector [] + INTEGER(IntKi) :: Nxtra = 0_IntKi !< number of states and size of state vector including points for potential line failures [] + INTEGER(IntKi) :: WaveTi = 0_IntKi !< current interpolation index for wave time series data [] + TYPE(MD_ContinuousStateType) :: xTemp !< contains temporary state vector used in integration (put here so it's only allocated once) [-] + TYPE(MD_ContinuousStateType) :: xdTemp !< contains temporary state derivative vector used in integration (put here so it's only allocated once) [-] + REAL(DbKi) , DIMENSION(1:6) :: zeros6 = 0.0_R8Ki !< array of zeros for convenience [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: MDWrOutput !< Data from time step to be written to a MoorDyn output file [-] + REAL(DbKi) :: LastOutTime = 0.0_R8Ki !< Time of last writing to MD output files [-] + REAL(ReKi) , DIMENSION(1:6) :: PtfmInit = 0.0_ReKi !< initial position of platform for an individual (non-farm) MD instance [-] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: BathymetryGrid !< matrix describing the bathymetry in a grid of x's and y's [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_Xs !< array of x-coordinates in the bathymetry grid [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_Ys !< array of y-coordinates in the bathymetry grid [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_npoints !< number of grid points to describe the bathymetry grid [-] + END TYPE MD_MiscVarType +! ======================= + integer(IntKi), public, parameter :: MD_x_states = 1 ! MD%states + integer(IntKi), public, parameter :: MD_z_dummy = 2 ! MD%dummy + integer(IntKi), public, parameter :: MD_u_CoupledKinematics = 3 ! MD%CoupledKinematics(DL%i1) + integer(IntKi), public, parameter :: MD_u_DeltaL = 4 ! MD%DeltaL + integer(IntKi), public, parameter :: MD_u_DeltaLdot = 5 ! MD%DeltaLdot + integer(IntKi), public, parameter :: MD_y_CoupledLoads = 6 ! MD%CoupledLoads(DL%i1) + integer(IntKi), public, parameter :: MD_y_WriteOutput = 7 ! MD%WriteOutput + integer(IntKi), public, parameter :: MD_y_VisLinesMesh = 8 ! MD%VisLinesMesh(DL%i1) + integer(IntKi), public, parameter :: MD_y_VisRodsMesh = 9 ! MD%VisRodsMesh(DL%i1) + integer(IntKi), public, parameter :: MD_y_VisBodiesMesh = 10 ! MD%VisBodiesMesh(DL%i1) + integer(IntKi), public, parameter :: MD_y_VisAnchsMesh = 11 ! MD%VisAnchsMesh(DL%i1) + +contains subroutine MD_CopyInputFileType(SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg) type(MD_InputFileType), intent(in) :: SrcInputFileTypeData @@ -545,7 +567,7 @@ subroutine MD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_CopyInitInput' @@ -555,8 +577,8 @@ subroutine MD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%rhoW = SrcInitInputData%rhoW DstInitInputData%WtrDepth = SrcInitInputData%WtrDepth if (allocated(SrcInitInputData%PtfmInit)) then - LB(1:2) = lbound(SrcInitInputData%PtfmInit, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%PtfmInit, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%PtfmInit) + UB(1:2) = ubound(SrcInitInputData%PtfmInit) if (.not. allocated(DstInitInputData%PtfmInit)) then allocate(DstInitInputData%PtfmInit(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -568,8 +590,8 @@ subroutine MD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta end if DstInitInputData%FarmSize = SrcInitInputData%FarmSize if (allocated(SrcInitInputData%TurbineRefPos)) then - LB(1:2) = lbound(SrcInitInputData%TurbineRefPos, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%TurbineRefPos, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%TurbineRefPos) + UB(1:2) = ubound(SrcInitInputData%TurbineRefPos) if (.not. allocated(DstInitInputData%TurbineRefPos)) then allocate(DstInitInputData%TurbineRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -588,8 +610,8 @@ subroutine MD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta if (ErrStat >= AbortErrLev) return DstInitInputData%Echo = SrcInitInputData%Echo if (allocated(SrcInitInputData%OutList)) then - LB(1:1) = lbound(SrcInitInputData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%OutList) + UB(1:1) = ubound(SrcInitInputData%OutList) if (.not. allocated(DstInitInputData%OutList)) then allocate(DstInitInputData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -652,7 +674,7 @@ subroutine MD_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(MD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackInitInput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -688,6 +710,8 @@ subroutine MD_CopyLineProp(SrcLinePropData, DstLinePropData, CtrlCode, ErrStat, DstLinePropData%w = SrcLinePropData%w DstLinePropData%EA = SrcLinePropData%EA DstLinePropData%EA_D = SrcLinePropData%EA_D + DstLinePropData%alphaMBL = SrcLinePropData%alphaMBL + DstLinePropData%vbeta = SrcLinePropData%vbeta DstLinePropData%BA = SrcLinePropData%BA DstLinePropData%BA_D = SrcLinePropData%BA_D DstLinePropData%EI = SrcLinePropData%EI @@ -727,6 +751,8 @@ subroutine MD_PackLineProp(RF, Indata) call RegPack(RF, InData%w) call RegPack(RF, InData%EA) call RegPack(RF, InData%EA_D) + call RegPack(RF, InData%alphaMBL) + call RegPack(RF, InData%vbeta) call RegPack(RF, InData%BA) call RegPack(RF, InData%BA_D) call RegPack(RF, InData%EI) @@ -758,6 +784,8 @@ subroutine MD_UnPackLineProp(RF, OutData) call RegUnpack(RF, OutData%w); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%EA); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%EA_D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaMBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%vbeta); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%BA); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%BA_D); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%EI); if (RegCheckErr(RF, RoutineName)) return @@ -967,7 +995,7 @@ subroutine MD_CopyPoint(SrcPointData, DstPointData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MD_CopyPoint' ErrStat = ErrID_None @@ -993,8 +1021,8 @@ subroutine MD_CopyPoint(SrcPointData, DstPointData, CtrlCode, ErrStat, ErrMsg) DstPointData%Ud = SrcPointData%Ud DstPointData%zeta = SrcPointData%zeta if (allocated(SrcPointData%PDyn)) then - LB(1:1) = lbound(SrcPointData%PDyn, kind=B8Ki) - UB(1:1) = ubound(SrcPointData%PDyn, kind=B8Ki) + LB(1:1) = lbound(SrcPointData%PDyn) + UB(1:1) = ubound(SrcPointData%PDyn) if (.not. allocated(DstPointData%PDyn)) then allocate(DstPointData%PDyn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1055,7 +1083,7 @@ subroutine MD_UnPackPoint(RF, OutData) type(RegFile), intent(inout) :: RF type(MD_Point), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackPoint' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1090,7 +1118,7 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MD_CopyRod' ErrStat = ErrID_None @@ -1126,8 +1154,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%pitch = SrcRodData%pitch DstRodData%h0 = SrcRodData%h0 if (allocated(SrcRodData%r)) then - LB(1:2) = lbound(SrcRodData%r, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%r, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%r) + UB(1:2) = ubound(SrcRodData%r) if (.not. allocated(DstRodData%r)) then allocate(DstRodData%r(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1138,8 +1166,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%r = SrcRodData%r end if if (allocated(SrcRodData%rd)) then - LB(1:2) = lbound(SrcRodData%rd, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%rd, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%rd) + UB(1:2) = ubound(SrcRodData%rd) if (.not. allocated(DstRodData%rd)) then allocate(DstRodData%rd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1151,8 +1179,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) end if DstRodData%q = SrcRodData%q if (allocated(SrcRodData%l)) then - LB(1:1) = lbound(SrcRodData%l, kind=B8Ki) - UB(1:1) = ubound(SrcRodData%l, kind=B8Ki) + LB(1:1) = lbound(SrcRodData%l) + UB(1:1) = ubound(SrcRodData%l) if (.not. allocated(DstRodData%l)) then allocate(DstRodData%l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1163,8 +1191,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%l = SrcRodData%l end if if (allocated(SrcRodData%V)) then - LB(1:1) = lbound(SrcRodData%V, kind=B8Ki) - UB(1:1) = ubound(SrcRodData%V, kind=B8Ki) + LB(1:1) = lbound(SrcRodData%V) + UB(1:1) = ubound(SrcRodData%V) if (.not. allocated(DstRodData%V)) then allocate(DstRodData%V(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1175,8 +1203,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%V = SrcRodData%V end if if (allocated(SrcRodData%U)) then - LB(1:2) = lbound(SrcRodData%U, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%U, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%U) + UB(1:2) = ubound(SrcRodData%U) if (.not. allocated(DstRodData%U)) then allocate(DstRodData%U(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1187,8 +1215,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%U = SrcRodData%U end if if (allocated(SrcRodData%Ud)) then - LB(1:2) = lbound(SrcRodData%Ud, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%Ud, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%Ud) + UB(1:2) = ubound(SrcRodData%Ud) if (.not. allocated(DstRodData%Ud)) then allocate(DstRodData%Ud(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1199,8 +1227,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Ud = SrcRodData%Ud end if if (allocated(SrcRodData%zeta)) then - LB(1:1) = lbound(SrcRodData%zeta, kind=B8Ki) - UB(1:1) = ubound(SrcRodData%zeta, kind=B8Ki) + LB(1:1) = lbound(SrcRodData%zeta) + UB(1:1) = ubound(SrcRodData%zeta) if (.not. allocated(DstRodData%zeta)) then allocate(DstRodData%zeta(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1211,8 +1239,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%zeta = SrcRodData%zeta end if if (allocated(SrcRodData%PDyn)) then - LB(1:1) = lbound(SrcRodData%PDyn, kind=B8Ki) - UB(1:1) = ubound(SrcRodData%PDyn, kind=B8Ki) + LB(1:1) = lbound(SrcRodData%PDyn) + UB(1:1) = ubound(SrcRodData%PDyn) if (.not. allocated(DstRodData%PDyn)) then allocate(DstRodData%PDyn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1223,8 +1251,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%PDyn = SrcRodData%PDyn end if if (allocated(SrcRodData%W)) then - LB(1:2) = lbound(SrcRodData%W, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%W, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%W) + UB(1:2) = ubound(SrcRodData%W) if (.not. allocated(DstRodData%W)) then allocate(DstRodData%W(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1235,8 +1263,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%W = SrcRodData%W end if if (allocated(SrcRodData%Bo)) then - LB(1:2) = lbound(SrcRodData%Bo, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%Bo, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%Bo) + UB(1:2) = ubound(SrcRodData%Bo) if (.not. allocated(DstRodData%Bo)) then allocate(DstRodData%Bo(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1247,8 +1275,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Bo = SrcRodData%Bo end if if (allocated(SrcRodData%Pd)) then - LB(1:2) = lbound(SrcRodData%Pd, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%Pd, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%Pd) + UB(1:2) = ubound(SrcRodData%Pd) if (.not. allocated(DstRodData%Pd)) then allocate(DstRodData%Pd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1259,8 +1287,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Pd = SrcRodData%Pd end if if (allocated(SrcRodData%Dp)) then - LB(1:2) = lbound(SrcRodData%Dp, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%Dp, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%Dp) + UB(1:2) = ubound(SrcRodData%Dp) if (.not. allocated(DstRodData%Dp)) then allocate(DstRodData%Dp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1271,8 +1299,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Dp = SrcRodData%Dp end if if (allocated(SrcRodData%Dq)) then - LB(1:2) = lbound(SrcRodData%Dq, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%Dq, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%Dq) + UB(1:2) = ubound(SrcRodData%Dq) if (.not. allocated(DstRodData%Dq)) then allocate(DstRodData%Dq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1283,8 +1311,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Dq = SrcRodData%Dq end if if (allocated(SrcRodData%Ap)) then - LB(1:2) = lbound(SrcRodData%Ap, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%Ap, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%Ap) + UB(1:2) = ubound(SrcRodData%Ap) if (.not. allocated(DstRodData%Ap)) then allocate(DstRodData%Ap(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1295,8 +1323,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Ap = SrcRodData%Ap end if if (allocated(SrcRodData%Aq)) then - LB(1:2) = lbound(SrcRodData%Aq, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%Aq, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%Aq) + UB(1:2) = ubound(SrcRodData%Aq) if (.not. allocated(DstRodData%Aq)) then allocate(DstRodData%Aq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1307,8 +1335,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Aq = SrcRodData%Aq end if if (allocated(SrcRodData%B)) then - LB(1:2) = lbound(SrcRodData%B, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%B, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%B) + UB(1:2) = ubound(SrcRodData%B) if (.not. allocated(DstRodData%B)) then allocate(DstRodData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1319,8 +1347,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%B = SrcRodData%B end if if (allocated(SrcRodData%Fnet)) then - LB(1:2) = lbound(SrcRodData%Fnet, kind=B8Ki) - UB(1:2) = ubound(SrcRodData%Fnet, kind=B8Ki) + LB(1:2) = lbound(SrcRodData%Fnet) + UB(1:2) = ubound(SrcRodData%Fnet) if (.not. allocated(DstRodData%Fnet)) then allocate(DstRodData%Fnet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1331,8 +1359,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%Fnet = SrcRodData%Fnet end if if (allocated(SrcRodData%M)) then - LB(1:3) = lbound(SrcRodData%M, kind=B8Ki) - UB(1:3) = ubound(SrcRodData%M, kind=B8Ki) + LB(1:3) = lbound(SrcRodData%M) + UB(1:3) = ubound(SrcRodData%M) if (.not. allocated(DstRodData%M)) then allocate(DstRodData%M(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1354,8 +1382,8 @@ subroutine MD_CopyRod(SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg) DstRodData%OrMat = SrcRodData%OrMat DstRodData%RodUnOut = SrcRodData%RodUnOut if (allocated(SrcRodData%RodWrOutput)) then - LB(1:1) = lbound(SrcRodData%RodWrOutput, kind=B8Ki) - UB(1:1) = ubound(SrcRodData%RodWrOutput, kind=B8Ki) + LB(1:1) = lbound(SrcRodData%RodWrOutput) + UB(1:1) = ubound(SrcRodData%RodWrOutput) if (.not. allocated(DstRodData%RodWrOutput)) then allocate(DstRodData%RodWrOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1506,7 +1534,7 @@ subroutine MD_UnPackRod(RF, OutData) type(RegFile), intent(inout) :: RF type(MD_Rod), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackRod' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1579,7 +1607,7 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MD_CopyLine' ErrStat = ErrID_None @@ -1599,6 +1627,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%d = SrcLineData%d DstLineData%EA = SrcLineData%EA DstLineData%EA_D = SrcLineData%EA_D + DstLineData%alphaMBL = SrcLineData%alphaMBL + DstLineData%vbeta = SrcLineData%vbeta DstLineData%BA = SrcLineData%BA DstLineData%BA_D = SrcLineData%BA_D DstLineData%EI = SrcLineData%EI @@ -1617,8 +1647,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%bstiffYs = SrcLineData%bstiffYs DstLineData%time = SrcLineData%time if (allocated(SrcLineData%r)) then - LB(1:2) = lbound(SrcLineData%r, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%r, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%r) + UB(1:2) = ubound(SrcLineData%r) if (.not. allocated(DstLineData%r)) then allocate(DstLineData%r(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1629,8 +1659,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%r = SrcLineData%r end if if (allocated(SrcLineData%rd)) then - LB(1:2) = lbound(SrcLineData%rd, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%rd, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%rd) + UB(1:2) = ubound(SrcLineData%rd) if (.not. allocated(DstLineData%rd)) then allocate(DstLineData%rd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1641,8 +1671,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%rd = SrcLineData%rd end if if (allocated(SrcLineData%q)) then - LB(1:2) = lbound(SrcLineData%q, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%q, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%q) + UB(1:2) = ubound(SrcLineData%q) if (.not. allocated(DstLineData%q)) then allocate(DstLineData%q(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1653,8 +1683,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%q = SrcLineData%q end if if (allocated(SrcLineData%qs)) then - LB(1:2) = lbound(SrcLineData%qs, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%qs, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%qs) + UB(1:2) = ubound(SrcLineData%qs) if (.not. allocated(DstLineData%qs)) then allocate(DstLineData%qs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1665,8 +1695,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%qs = SrcLineData%qs end if if (allocated(SrcLineData%l)) then - LB(1:1) = lbound(SrcLineData%l, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%l, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%l) + UB(1:1) = ubound(SrcLineData%l) if (.not. allocated(DstLineData%l)) then allocate(DstLineData%l(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1677,8 +1707,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%l = SrcLineData%l end if if (allocated(SrcLineData%ld)) then - LB(1:1) = lbound(SrcLineData%ld, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%ld, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%ld) + UB(1:1) = ubound(SrcLineData%ld) if (.not. allocated(DstLineData%ld)) then allocate(DstLineData%ld(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1689,8 +1719,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%ld = SrcLineData%ld end if if (allocated(SrcLineData%lstr)) then - LB(1:1) = lbound(SrcLineData%lstr, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%lstr, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%lstr) + UB(1:1) = ubound(SrcLineData%lstr) if (.not. allocated(DstLineData%lstr)) then allocate(DstLineData%lstr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1701,8 +1731,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%lstr = SrcLineData%lstr end if if (allocated(SrcLineData%lstrd)) then - LB(1:1) = lbound(SrcLineData%lstrd, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%lstrd, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%lstrd) + UB(1:1) = ubound(SrcLineData%lstrd) if (.not. allocated(DstLineData%lstrd)) then allocate(DstLineData%lstrd(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1713,8 +1743,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%lstrd = SrcLineData%lstrd end if if (allocated(SrcLineData%Kurv)) then - LB(1:1) = lbound(SrcLineData%Kurv, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%Kurv, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%Kurv) + UB(1:1) = ubound(SrcLineData%Kurv) if (.not. allocated(DstLineData%Kurv)) then allocate(DstLineData%Kurv(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1725,8 +1755,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Kurv = SrcLineData%Kurv end if if (allocated(SrcLineData%dl_1)) then - LB(1:1) = lbound(SrcLineData%dl_1, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%dl_1, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%dl_1) + UB(1:1) = ubound(SrcLineData%dl_1) if (.not. allocated(DstLineData%dl_1)) then allocate(DstLineData%dl_1(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1737,8 +1767,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%dl_1 = SrcLineData%dl_1 end if if (allocated(SrcLineData%V)) then - LB(1:1) = lbound(SrcLineData%V, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%V, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%V) + UB(1:1) = ubound(SrcLineData%V) if (.not. allocated(DstLineData%V)) then allocate(DstLineData%V(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1749,8 +1779,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%V = SrcLineData%V end if if (allocated(SrcLineData%F)) then - LB(1:1) = lbound(SrcLineData%F, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%F, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%F) + UB(1:1) = ubound(SrcLineData%F) if (.not. allocated(DstLineData%F)) then allocate(DstLineData%F(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1761,8 +1791,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%F = SrcLineData%F end if if (allocated(SrcLineData%U)) then - LB(1:2) = lbound(SrcLineData%U, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%U, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%U) + UB(1:2) = ubound(SrcLineData%U) if (.not. allocated(DstLineData%U)) then allocate(DstLineData%U(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1773,8 +1803,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%U = SrcLineData%U end if if (allocated(SrcLineData%Ud)) then - LB(1:2) = lbound(SrcLineData%Ud, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%Ud, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%Ud) + UB(1:2) = ubound(SrcLineData%Ud) if (.not. allocated(DstLineData%Ud)) then allocate(DstLineData%Ud(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1785,8 +1815,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Ud = SrcLineData%Ud end if if (allocated(SrcLineData%zeta)) then - LB(1:1) = lbound(SrcLineData%zeta, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%zeta, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%zeta) + UB(1:1) = ubound(SrcLineData%zeta) if (.not. allocated(DstLineData%zeta)) then allocate(DstLineData%zeta(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1797,8 +1827,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%zeta = SrcLineData%zeta end if if (allocated(SrcLineData%PDyn)) then - LB(1:1) = lbound(SrcLineData%PDyn, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%PDyn, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%PDyn) + UB(1:1) = ubound(SrcLineData%PDyn) if (.not. allocated(DstLineData%PDyn)) then allocate(DstLineData%PDyn(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1809,8 +1839,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%PDyn = SrcLineData%PDyn end if if (allocated(SrcLineData%T)) then - LB(1:2) = lbound(SrcLineData%T, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%T, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%T) + UB(1:2) = ubound(SrcLineData%T) if (.not. allocated(DstLineData%T)) then allocate(DstLineData%T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1821,8 +1851,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%T = SrcLineData%T end if if (allocated(SrcLineData%Td)) then - LB(1:2) = lbound(SrcLineData%Td, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%Td, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%Td) + UB(1:2) = ubound(SrcLineData%Td) if (.not. allocated(DstLineData%Td)) then allocate(DstLineData%Td(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1833,8 +1863,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Td = SrcLineData%Td end if if (allocated(SrcLineData%W)) then - LB(1:2) = lbound(SrcLineData%W, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%W, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%W) + UB(1:2) = ubound(SrcLineData%W) if (.not. allocated(DstLineData%W)) then allocate(DstLineData%W(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1845,8 +1875,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%W = SrcLineData%W end if if (allocated(SrcLineData%Dp)) then - LB(1:2) = lbound(SrcLineData%Dp, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%Dp, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%Dp) + UB(1:2) = ubound(SrcLineData%Dp) if (.not. allocated(DstLineData%Dp)) then allocate(DstLineData%Dp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1857,8 +1887,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Dp = SrcLineData%Dp end if if (allocated(SrcLineData%Dq)) then - LB(1:2) = lbound(SrcLineData%Dq, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%Dq, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%Dq) + UB(1:2) = ubound(SrcLineData%Dq) if (.not. allocated(DstLineData%Dq)) then allocate(DstLineData%Dq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1869,8 +1899,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Dq = SrcLineData%Dq end if if (allocated(SrcLineData%Ap)) then - LB(1:2) = lbound(SrcLineData%Ap, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%Ap, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%Ap) + UB(1:2) = ubound(SrcLineData%Ap) if (.not. allocated(DstLineData%Ap)) then allocate(DstLineData%Ap(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1881,8 +1911,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Ap = SrcLineData%Ap end if if (allocated(SrcLineData%Aq)) then - LB(1:2) = lbound(SrcLineData%Aq, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%Aq, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%Aq) + UB(1:2) = ubound(SrcLineData%Aq) if (.not. allocated(DstLineData%Aq)) then allocate(DstLineData%Aq(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1893,8 +1923,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Aq = SrcLineData%Aq end if if (allocated(SrcLineData%B)) then - LB(1:2) = lbound(SrcLineData%B, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%B, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%B) + UB(1:2) = ubound(SrcLineData%B) if (.not. allocated(DstLineData%B)) then allocate(DstLineData%B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1905,8 +1935,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%B = SrcLineData%B end if if (allocated(SrcLineData%Bs)) then - LB(1:2) = lbound(SrcLineData%Bs, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%Bs, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%Bs) + UB(1:2) = ubound(SrcLineData%Bs) if (.not. allocated(DstLineData%Bs)) then allocate(DstLineData%Bs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1917,8 +1947,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Bs = SrcLineData%Bs end if if (allocated(SrcLineData%Fnet)) then - LB(1:2) = lbound(SrcLineData%Fnet, kind=B8Ki) - UB(1:2) = ubound(SrcLineData%Fnet, kind=B8Ki) + LB(1:2) = lbound(SrcLineData%Fnet) + UB(1:2) = ubound(SrcLineData%Fnet) if (.not. allocated(DstLineData%Fnet)) then allocate(DstLineData%Fnet(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1929,8 +1959,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%Fnet = SrcLineData%Fnet end if if (allocated(SrcLineData%S)) then - LB(1:3) = lbound(SrcLineData%S, kind=B8Ki) - UB(1:3) = ubound(SrcLineData%S, kind=B8Ki) + LB(1:3) = lbound(SrcLineData%S) + UB(1:3) = ubound(SrcLineData%S) if (.not. allocated(DstLineData%S)) then allocate(DstLineData%S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1941,8 +1971,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%S = SrcLineData%S end if if (allocated(SrcLineData%M)) then - LB(1:3) = lbound(SrcLineData%M, kind=B8Ki) - UB(1:3) = ubound(SrcLineData%M, kind=B8Ki) + LB(1:3) = lbound(SrcLineData%M) + UB(1:3) = ubound(SrcLineData%M) if (.not. allocated(DstLineData%M)) then allocate(DstLineData%M(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1956,8 +1986,8 @@ subroutine MD_CopyLine(SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg) DstLineData%EndMomentB = SrcLineData%EndMomentB DstLineData%LineUnOut = SrcLineData%LineUnOut if (allocated(SrcLineData%LineWrOutput)) then - LB(1:1) = lbound(SrcLineData%LineWrOutput, kind=B8Ki) - UB(1:1) = ubound(SrcLineData%LineWrOutput, kind=B8Ki) + LB(1:1) = lbound(SrcLineData%LineWrOutput) + UB(1:1) = ubound(SrcLineData%LineWrOutput) if (.not. allocated(DstLineData%LineWrOutput)) then allocate(DstLineData%LineWrOutput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2085,6 +2115,8 @@ subroutine MD_PackLine(RF, Indata) call RegPack(RF, InData%d) call RegPack(RF, InData%EA) call RegPack(RF, InData%EA_D) + call RegPack(RF, InData%alphaMBL) + call RegPack(RF, InData%vbeta) call RegPack(RF, InData%BA) call RegPack(RF, InData%BA_D) call RegPack(RF, InData%EI) @@ -2141,7 +2173,7 @@ subroutine MD_UnPackLine(RF, OutData) type(RegFile), intent(inout) :: RF type(MD_Line), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackLine' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2160,6 +2192,8 @@ subroutine MD_UnPackLine(RF, OutData) call RegUnpack(RF, OutData%d); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%EA); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%EA_D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%alphaMBL); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%vbeta); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%BA); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%BA_D); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%EI); if (RegCheckErr(RF, RoutineName)) return @@ -2332,14 +2366,14 @@ subroutine MD_CopyVisDiam(SrcVisDiamData, DstVisDiamData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MD_CopyVisDiam' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcVisDiamData%Diam)) then - LB(1:1) = lbound(SrcVisDiamData%Diam, kind=B8Ki) - UB(1:1) = ubound(SrcVisDiamData%Diam, kind=B8Ki) + LB(1:1) = lbound(SrcVisDiamData%Diam) + UB(1:1) = ubound(SrcVisDiamData%Diam) if (.not. allocated(DstVisDiamData%Diam)) then allocate(DstVisDiamData%Diam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2376,7 +2410,7 @@ subroutine MD_UnPackVisDiam(RF, OutData) type(RegFile), intent(inout) :: RF type(VisDiam), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackVisDiam' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2389,15 +2423,15 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'MD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%writeOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%writeOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%writeOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%writeOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%writeOutputHdr) if (.not. allocated(DstInitOutputData%writeOutputHdr)) then allocate(DstInitOutputData%writeOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2408,8 +2442,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%writeOutputHdr = SrcInitOutputData%writeOutputHdr end if if (allocated(SrcInitOutputData%writeOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%writeOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%writeOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%writeOutputUnt) if (.not. allocated(DstInitOutputData%writeOutputUnt)) then allocate(DstInitOutputData%writeOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2423,8 +2457,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%CableCChanRqst)) then - LB(1:1) = lbound(SrcInitOutputData%CableCChanRqst, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%CableCChanRqst, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%CableCChanRqst) + UB(1:1) = ubound(SrcInitOutputData%CableCChanRqst) if (.not. allocated(DstInitOutputData%CableCChanRqst)) then allocate(DstInitOutputData%CableCChanRqst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2435,8 +2469,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst end if if (allocated(SrcInitOutputData%LinNames_y)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) + 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 @@ -2447,8 +2481,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2459,8 +2493,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) + 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 @@ -2471,8 +2505,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + 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 @@ -2483,8 +2517,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2495,8 +2529,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + 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 @@ -2507,8 +2541,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + 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 @@ -2519,8 +2553,8 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2530,6 +2564,9 @@ subroutine MD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err 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 MD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -2576,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) @@ -2595,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 @@ -2602,7 +2642,7 @@ subroutine MD_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(MD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2618,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) @@ -2626,14 +2667,14 @@ subroutine MD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'MD_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%states)) then - LB(1:1) = lbound(SrcContStateData%states, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%states, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%states) + UB(1:1) = ubound(SrcContStateData%states) if (.not. allocated(DstContStateData%states)) then allocate(DstContStateData%states(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2670,7 +2711,7 @@ subroutine MD_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(MD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'MD_UnPackContState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2791,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(B8Ki) :: i1, i2 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LineTypeList, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%RodTypeList, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BodyList, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%RodList, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%PointList, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LineList, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FailList, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FreePointIs, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%CpldPointIs, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FreeRodIs, kind=B8Ki) - if (.not. allocated(DstMiscData%FreeRodIs)) then - allocate(DstMiscData%FreeRodIs(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeRodIs.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%FreeRodIs = SrcMiscData%FreeRodIs - end if - if (allocated(SrcMiscData%CpldRodIs)) then - LB(1:2) = lbound(SrcMiscData%CpldRodIs, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%CpldRodIs, kind=B8Ki) - if (.not. allocated(DstMiscData%CpldRodIs)) then - allocate(DstMiscData%CpldRodIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldRodIs.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%CpldRodIs = SrcMiscData%CpldRodIs - end if - if (allocated(SrcMiscData%FreeBodyIs)) then - LB(1:1) = lbound(SrcMiscData%FreeBodyIs, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FreeBodyIs, kind=B8Ki) - if (.not. allocated(DstMiscData%FreeBodyIs)) then - allocate(DstMiscData%FreeBodyIs(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%FreeBodyIs.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%FreeBodyIs = SrcMiscData%FreeBodyIs + DstParamData%uyWave = SrcParamData%uyWave end if - if (allocated(SrcMiscData%CpldBodyIs)) then - LB(1:2) = lbound(SrcMiscData%CpldBodyIs, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%CpldBodyIs, kind=B8Ki) - if (.not. allocated(DstMiscData%CpldBodyIs)) then - allocate(DstMiscData%CpldBodyIs(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%CpldBodyIs.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uzWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%CpldBodyIs = SrcMiscData%CpldBodyIs + DstParamData%uzWave = SrcParamData%uzWave end if - if (allocated(SrcMiscData%LineStateIs1)) then - LB(1:1) = lbound(SrcMiscData%LineStateIs1, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LineStateIs1, kind=B8Ki) - if (.not. allocated(DstMiscData%LineStateIs1)) then - allocate(DstMiscData%LineStateIs1(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%LineStateIs1.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%axWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%LineStateIs1 = SrcMiscData%LineStateIs1 + DstParamData%axWave = SrcParamData%axWave end if - if (allocated(SrcMiscData%LineStateIsN)) then - LB(1:1) = lbound(SrcMiscData%LineStateIsN, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%LineStateIsN, kind=B8Ki) - if (.not. allocated(DstMiscData%LineStateIsN)) then - allocate(DstMiscData%LineStateIsN(LB(1):UB(1)), 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%LineStateIsN.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ayWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%LineStateIsN = SrcMiscData%LineStateIsN + DstParamData%ayWave = SrcParamData%ayWave end if - if (allocated(SrcMiscData%PointStateIs1)) then - LB(1:1) = lbound(SrcMiscData%PointStateIs1, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%PointStateIs1, kind=B8Ki) - if (.not. allocated(DstMiscData%PointStateIs1)) then - allocate(DstMiscData%PointStateIs1(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%PointStateIs1.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%azWave.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%PointStateIs1 = SrcMiscData%PointStateIs1 + DstParamData%azWave = SrcParamData%azWave end if - if (allocated(SrcMiscData%PointStateIsN)) then - LB(1:1) = lbound(SrcMiscData%PointStateIsN, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%PointStateIsN, kind=B8Ki) - if (.not. allocated(DstMiscData%PointStateIsN)) then - allocate(DstMiscData%PointStateIsN(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%PointStateIsN.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PDyn.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%PointStateIsN = SrcMiscData%PointStateIsN + DstParamData%PDyn = SrcParamData%PDyn end if - if (allocated(SrcMiscData%RodStateIs1)) then - LB(1:1) = lbound(SrcMiscData%RodStateIs1, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%RodStateIs1, kind=B8Ki) - if (.not. allocated(DstMiscData%RodStateIs1)) then - allocate(DstMiscData%RodStateIs1(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%RodStateIs1.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%zeta.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%RodStateIs1 = SrcMiscData%RodStateIs1 + DstParamData%zeta = SrcParamData%zeta end if - if (allocated(SrcMiscData%RodStateIsN)) then - LB(1:1) = lbound(SrcMiscData%RodStateIsN, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%RodStateIsN, kind=B8Ki) - if (.not. allocated(DstMiscData%RodStateIsN)) then - allocate(DstMiscData%RodStateIsN(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%RodStateIsN.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzCurrent.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%RodStateIsN = SrcMiscData%RodStateIsN + DstParamData%pzCurrent = SrcParamData%pzCurrent end if - if (allocated(SrcMiscData%BodyStateIs1)) then - LB(1:1) = lbound(SrcMiscData%BodyStateIs1, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BodyStateIs1, kind=B8Ki) - if (.not. allocated(DstMiscData%BodyStateIs1)) then - allocate(DstMiscData%BodyStateIs1(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%BodyStateIs1.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxCurrent.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%BodyStateIs1 = SrcMiscData%BodyStateIs1 + DstParamData%uxCurrent = SrcParamData%uxCurrent end if - if (allocated(SrcMiscData%BodyStateIsN)) then - LB(1:1) = lbound(SrcMiscData%BodyStateIsN, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BodyStateIsN, kind=B8Ki) - if (.not. allocated(DstMiscData%BodyStateIsN)) then - allocate(DstMiscData%BodyStateIsN(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%BodyStateIsN.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyCurrent.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%BodyStateIsN = SrcMiscData%BodyStateIsN + DstParamData%uyCurrent = SrcParamData%uyCurrent 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%MDWrOutput, kind=B8Ki) - if (.not. allocated(DstMiscData%MDWrOutput)) then - allocate(DstMiscData%MDWrOutput(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%MDWrOutput.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%MDWrOutput = SrcMiscData%MDWrOutput + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx end if - DstMiscData%LastOutTime = SrcMiscData%LastOutTime - DstMiscData%PtfmInit = SrcMiscData%PtfmInit - if (allocated(SrcMiscData%BathymetryGrid)) then - LB(1:2) = lbound(SrcMiscData%BathymetryGrid, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%BathymetryGrid, kind=B8Ki) - if (.not. allocated(DstMiscData%BathymetryGrid)) then - allocate(DstMiscData%BathymetryGrid(LB(1):UB(1),LB(2):UB(2)), 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%BathymetryGrid.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%BathymetryGrid = SrcMiscData%BathymetryGrid + DstParamData%du = SrcParamData%du end if - if (allocated(SrcMiscData%BathGrid_Xs)) then - LB(1:1) = lbound(SrcMiscData%BathGrid_Xs, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BathGrid_Xs, kind=B8Ki) - if (.not. allocated(DstMiscData%BathGrid_Xs)) then - allocate(DstMiscData%BathGrid_Xs(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%BathGrid_Xs.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%BathGrid_Xs = SrcMiscData%BathGrid_Xs + DstParamData%dx = SrcParamData%dx end if - if (allocated(SrcMiscData%BathGrid_Ys)) then - LB(1:1) = lbound(SrcMiscData%BathGrid_Ys, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BathGrid_Ys, kind=B8Ki) - if (.not. allocated(DstMiscData%BathGrid_Ys)) then - allocate(DstMiscData%BathGrid_Ys(LB(1):UB(1)), 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%BathGrid_Ys.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dxIdx_map2_xStateIdx.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMiscData%BathGrid_Ys = SrcMiscData%BathGrid_Ys + DstParamData%dxIdx_map2_xStateIdx = SrcParamData%dxIdx_map2_xStateIdx end if - if (allocated(SrcMiscData%BathGrid_npoints)) then - LB(1:1) = lbound(SrcMiscData%BathGrid_npoints, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BathGrid_npoints, kind=B8Ki) - 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(B8Ki) :: i1, i2 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(MiscData%LineTypeList, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(MiscData%RodTypeList, kind=B8Ki) - 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) + if (allocated(ParamData%nCpldBodies)) then + deallocate(ParamData%nCpldBodies) 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, kind=B8Ki) - UB(1:1) = ubound(MiscData%BodyList, kind=B8Ki) - 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%nCpldRods)) then + deallocate(ParamData%nCpldRods) end if - if (allocated(MiscData%RodList)) then - LB(1:1) = lbound(MiscData%RodList, kind=B8Ki) - UB(1:1) = ubound(MiscData%RodList, kind=B8Ki) - 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%nCpldPoints)) then + deallocate(ParamData%nCpldPoints) end if - if (allocated(MiscData%PointList)) then - LB(1:1) = lbound(MiscData%PointList, kind=B8Ki) - UB(1:1) = ubound(MiscData%PointList, kind=B8Ki) + 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_DestroyPoint(MiscData%PointList(i1), ErrStat2, ErrMsg2) + call MD_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%PointList) + deallocate(ParamData%OutParam) end if - if (allocated(MiscData%LineList)) then - LB(1:1) = lbound(MiscData%LineList, kind=B8Ki) - UB(1:1) = ubound(MiscData%LineList, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_DestroyLine(MiscData%LineList(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(MiscData%LineList) + if (allocated(ParamData%TurbineRefPos)) then + deallocate(ParamData%TurbineRefPos) end if - if (allocated(MiscData%FailList)) then - LB(1:1) = lbound(MiscData%FailList, kind=B8Ki) - UB(1:1) = ubound(MiscData%FailList, kind=B8Ki) - 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%pxWave)) then + deallocate(ParamData%pxWave) end if - if (allocated(MiscData%FreePointIs)) then - deallocate(MiscData%FreePointIs) + if (allocated(ParamData%pyWave)) then + deallocate(ParamData%pyWave) end if - if (allocated(MiscData%CpldPointIs)) then - deallocate(MiscData%CpldPointIs) + if (allocated(ParamData%pzWave)) then + deallocate(ParamData%pzWave) end if - if (allocated(MiscData%FreeRodIs)) then - deallocate(MiscData%FreeRodIs) - 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(B8Ki) :: i1, i2 - integer(B8Ki) :: 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, kind=B8Ki), ubound(InData%LineTypeList, kind=B8Ki)) - LB(1:1) = lbound(InData%LineTypeList, kind=B8Ki) - UB(1:1) = ubound(InData%LineTypeList, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackLineProp(RF, InData%LineTypeList(i1)) - end do - end if - call RegPack(RF, allocated(InData%RodTypeList)) - if (allocated(InData%RodTypeList)) then - call RegPackBounds(RF, 1, lbound(InData%RodTypeList, kind=B8Ki), ubound(InData%RodTypeList, kind=B8Ki)) - LB(1:1) = lbound(InData%RodTypeList, kind=B8Ki) - UB(1:1) = ubound(InData%RodTypeList, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%BodyList, kind=B8Ki)) - LB(1:1) = lbound(InData%BodyList, kind=B8Ki) - UB(1:1) = ubound(InData%BodyList, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%RodList, kind=B8Ki)) - LB(1:1) = lbound(InData%RodList, kind=B8Ki) - UB(1:1) = ubound(InData%RodList, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%PointList, kind=B8Ki)) - LB(1:1) = lbound(InData%PointList, kind=B8Ki) - UB(1:1) = ubound(InData%PointList, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%LineList, kind=B8Ki)) - LB(1:1) = lbound(InData%LineList, kind=B8Ki) - UB(1:1) = ubound(InData%LineList, kind=B8Ki) + 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_PackLine(RF, InData%LineList(i1)) + call MD_PackOutParmType(RF, InData%OutParam(i1)) end do end if - call RegPack(RF, allocated(InData%FailList)) - if (allocated(InData%FailList)) then - call RegPackBounds(RF, 1, lbound(InData%FailList, kind=B8Ki), ubound(InData%FailList, kind=B8Ki)) - LB(1:1) = lbound(InData%FailList, kind=B8Ki) - UB(1:1) = ubound(InData%FailList, kind=B8Ki) + 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(B8Ki) :: i1, i2 - integer(B8Ki) :: 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, 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) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineTypeList.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MD_UnpackLineProp(RF, OutData%LineTypeList(i1)) ! LineTypeList - end do - end if - 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%RodTypeList(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodTypeList.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call MD_UnpackRodProp(RF, OutData%RodTypeList(i1)) ! RodTypeList - 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 if - do i1 = LB(1), UB(1) - call MD_UnpackBody(RF, OutData%BodyList(i1)) ! BodyList - 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 - end if - do i1 = LB(1), UB(1) - call MD_UnpackRod(RF, OutData%RodList(i1)) ! RodList - end do - 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 - end if - do i1 = LB(1), UB(1) - call MD_UnpackPoint(RF, OutData%PointList(i1)) ! PointList - end do - end if - if (allocated(OutData%LineList)) deallocate(OutData%LineList) + 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%LineList(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%LineList.', 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_UnpackLine(RF, OutData%LineList(i1)) ! LineList + call MD_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam end do end if - if (allocated(OutData%FailList)) deallocate(OutData%FailList) + 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%FailList(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%FailList.', 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_UnpackFail(RF, OutData%FailList(i1)) ! FailList + call MD_UnpackVisDiam(RF, OutData%VisRodsDiam(i1)) ! VisRodsDiam 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_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(MD_ParameterType), intent(in) :: SrcParamData - type(MD_ParameterType), intent(inout) :: DstParamData +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(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: 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_CopyInput' 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%nCpldBodies, kind=B8Ki) - if (.not. allocated(DstParamData%nCpldBodies)) then - allocate(DstParamData%nCpldBodies(LB(1):UB(1)), stat=ErrStat2) + 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 DstParamData%nCpldBodies.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CoupledKinematics.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%nCpldBodies = SrcParamData%nCpldBodies + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%CoupledKinematics(i1), DstInputData%CoupledKinematics(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcParamData%nCpldRods)) then - LB(1:1) = lbound(SrcParamData%nCpldRods, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%nCpldRods, kind=B8Ki) - if (.not. allocated(DstParamData%nCpldRods)) then - allocate(DstParamData%nCpldRods(LB(1):UB(1)), stat=ErrStat2) + 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 DstParamData%nCpldRods.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaL.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%nCpldRods = SrcParamData%nCpldRods + DstInputData%DeltaL = SrcInputData%DeltaL end if - if (allocated(SrcParamData%nCpldPoints)) then - LB(1:1) = lbound(SrcParamData%nCpldPoints, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%nCpldPoints, kind=B8Ki) - if (.not. allocated(DstParamData%nCpldPoints)) then - allocate(DstParamData%nCpldPoints(LB(1):UB(1)), stat=ErrStat2) + 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 DstParamData%nCpldPoints.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%DeltaLdot.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%nCpldPoints = SrcParamData%nCpldPoints + DstInputData%DeltaLdot = SrcInputData%DeltaLdot 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) - 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 +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_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call MeshDestroy( InputData%CoupledKinematics(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end do + deallocate(InputData%CoupledKinematics) 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, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%TurbineRefPos, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%pxWave, kind=B8Ki) - 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 + if (allocated(InputData%DeltaL)) then + deallocate(InputData%DeltaL) end if - if (allocated(SrcParamData%pyWave)) then - LB(1:1) = lbound(SrcParamData%pyWave, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%pyWave, kind=B8Ki) - if (.not. allocated(DstParamData%pyWave)) then - allocate(DstParamData%pyWave(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pyWave.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%pyWave = SrcParamData%pyWave + if (allocated(InputData%DeltaLdot)) then + deallocate(InputData%DeltaLdot) end if - if (allocated(SrcParamData%pzWave)) then - LB(1:1) = lbound(SrcParamData%pzWave, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%pzWave, kind=B8Ki) - if (.not. allocated(DstParamData%pzWave)) then - allocate(DstParamData%pzWave(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzWave.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%pzWave = SrcParamData%pzWave +end 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 end if - DstParamData%dtWave = SrcParamData%dtWave - if (allocated(SrcParamData%uxWave)) then - LB(1:4) = lbound(SrcParamData%uxWave, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%uxWave, kind=B8Ki) - 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 + 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 end if - DstParamData%uxWave = SrcParamData%uxWave + do i1 = LB(1), UB(1) + call MeshUnpack(RF, OutData%CoupledKinematics(i1)) ! CoupledKinematics + end do end if - if (allocated(SrcParamData%uyWave)) then - LB(1:4) = lbound(SrcParamData%uyWave, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%uyWave, kind=B8Ki) - 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) + 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 (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyWave.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CoupledLoads.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%uyWave = SrcParamData%uyWave + 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%uzWave)) then - LB(1:4) = lbound(SrcParamData%uzWave, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%uzWave, kind=B8Ki) - 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 (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%uzWave.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%uzWave = SrcParamData%uzWave + DstOutputData%WriteOutput = SrcOutputData%WriteOutput end if - if (allocated(SrcParamData%axWave)) then - LB(1:4) = lbound(SrcParamData%axWave, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%axWave, kind=B8Ki) - 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 (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%axWave.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisLinesMesh.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%axWave = SrcParamData%axWave + 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 - if (allocated(SrcParamData%ayWave)) then - LB(1:4) = lbound(SrcParamData%ayWave, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%ayWave, kind=B8Ki) - 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 (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%ayWave.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisRodsMesh.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%ayWave = SrcParamData%ayWave + 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 end if - if (allocated(SrcParamData%azWave)) then - LB(1:4) = lbound(SrcParamData%azWave, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%azWave, kind=B8Ki) - 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 (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%azWave.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisBodiesMesh.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%azWave = SrcParamData%azWave + 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%PDyn)) then - LB(1:4) = lbound(SrcParamData%PDyn, kind=B8Ki) - UB(1:4) = ubound(SrcParamData%PDyn, kind=B8Ki) - 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 (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%PDyn.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%VisAnchsMesh.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%PDyn = SrcParamData%PDyn + 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 - if (allocated(SrcParamData%zeta)) then - LB(1:3) = lbound(SrcParamData%zeta, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%zeta, kind=B8Ki) - if (.not. allocated(DstParamData%zeta)) then - allocate(DstParamData%zeta(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%zeta.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%zeta = SrcParamData%zeta +end 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 - DstParamData%nzCurrent = SrcParamData%nzCurrent - if (allocated(SrcParamData%pzCurrent)) then - LB(1:1) = lbound(SrcParamData%pzCurrent, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%pzCurrent, kind=B8Ki) - 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 + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) end if - if (allocated(SrcParamData%uxCurrent)) then - LB(1:1) = lbound(SrcParamData%uxCurrent, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%uxCurrent, kind=B8Ki) - if (.not. allocated(DstParamData%uxCurrent)) then - allocate(DstParamData%uxCurrent(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxCurrent.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%uxCurrent = SrcParamData%uxCurrent + 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%uyCurrent)) then - LB(1:1) = lbound(SrcParamData%uyCurrent, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%uyCurrent, kind=B8Ki) - if (.not. allocated(DstParamData%uyCurrent)) then - allocate(DstParamData%uyCurrent(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyCurrent.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%uyCurrent = SrcParamData%uyCurrent + 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 - DstParamData%Nx0 = SrcParamData%Nx0 - if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_u_indx)) then - allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + 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(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 +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 + 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 + 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 + 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%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineTypeList.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx + 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%du)) then - LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) - if (.not. allocated(DstParamData%du)) then - allocate(DstParamData%du(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%du.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodTypeList.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%du = SrcParamData%du + 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 - if (allocated(SrcParamData%dx)) then - LB(1:1) = lbound(SrcParamData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dx, kind=B8Ki) - if (.not. allocated(DstParamData%dx)) then - allocate(DstParamData%dx(LB(1):UB(1)), 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%dx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyList.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%dx = SrcParamData%dx + 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 - 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dxIdx_map2_xStateIdx, kind=B8Ki) - if (.not. allocated(DstParamData%dxIdx_map2_xStateIdx)) then - allocate(DstParamData%dxIdx_map2_xStateIdx(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%dxIdx_map2_xStateIdx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodList.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%dxIdx_map2_xStateIdx = SrcParamData%dxIdx_map2_xStateIdx + 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 - DstParamData%VisMeshes = SrcParamData%VisMeshes - if (allocated(SrcParamData%VisRodsDiam)) then - LB(1:1) = lbound(SrcParamData%VisRodsDiam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%VisRodsDiam, kind=B8Ki) - if (.not. allocated(DstParamData%VisRodsDiam)) then - allocate(DstParamData%VisRodsDiam(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%VisRodsDiam.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%PointList.', 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_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 -end subroutine - -subroutine MD_DestroyParam(ParamData, ErrStat, ErrMsg) - type(MD_ParameterType), intent(inout) :: ParamData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + if (allocated(SrcMiscData%LineList)) then + LB(1:1) = lbound(SrcMiscData%LineList) + UB(1:1) = ubound(SrcMiscData%LineList) + if (.not. allocated(DstMiscData%LineList)) then + allocate(DstMiscData%LineList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if do i1 = LB(1), UB(1) - call MD_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + 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 - 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) + if (allocated(SrcMiscData%FailList)) then + LB(1:1) = lbound(SrcMiscData%FailList) + UB(1:1) = ubound(SrcMiscData%FailList) + if (.not. allocated(DstMiscData%FailList)) then + allocate(DstMiscData%FailList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FailList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyFail(SrcMiscData%FailList(i1), DstMiscData%FailList(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(ParamData%ayWave)) then - deallocate(ParamData%ayWave) + 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 (allocated(ParamData%azWave)) then - deallocate(ParamData%azWave) + 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 + DstMiscData%CpldPointIs = SrcMiscData%CpldPointIs end if - if (allocated(ParamData%PDyn)) then - deallocate(ParamData%PDyn) + if (allocated(SrcMiscData%FreeRodIs)) then + LB(1:1) = lbound(SrcMiscData%FreeRodIs) + UB(1:1) = ubound(SrcMiscData%FreeRodIs) + if (.not. allocated(DstMiscData%FreeRodIs)) then + allocate(DstMiscData%FreeRodIs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeRodIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FreeRodIs = SrcMiscData%FreeRodIs end if - if (allocated(ParamData%zeta)) then - deallocate(ParamData%zeta) + if (allocated(SrcMiscData%CpldRodIs)) then + LB(1:2) = lbound(SrcMiscData%CpldRodIs) + UB(1:2) = ubound(SrcMiscData%CpldRodIs) + if (.not. allocated(DstMiscData%CpldRodIs)) then + allocate(DstMiscData%CpldRodIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldRodIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%CpldRodIs = SrcMiscData%CpldRodIs end if - if (allocated(ParamData%pzCurrent)) then - deallocate(ParamData%pzCurrent) + if (allocated(SrcMiscData%FreeBodyIs)) then + LB(1:1) = lbound(SrcMiscData%FreeBodyIs) + UB(1:1) = ubound(SrcMiscData%FreeBodyIs) + if (.not. allocated(DstMiscData%FreeBodyIs)) then + allocate(DstMiscData%FreeBodyIs(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeBodyIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%FreeBodyIs = SrcMiscData%FreeBodyIs end if - if (allocated(ParamData%uxCurrent)) then - deallocate(ParamData%uxCurrent) + if (allocated(SrcMiscData%CpldBodyIs)) then + LB(1:2) = lbound(SrcMiscData%CpldBodyIs) + UB(1:2) = ubound(SrcMiscData%CpldBodyIs) + if (.not. allocated(DstMiscData%CpldBodyIs)) then + allocate(DstMiscData%CpldBodyIs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldBodyIs.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%CpldBodyIs = SrcMiscData%CpldBodyIs end if - if (allocated(ParamData%uyCurrent)) then - deallocate(ParamData%uyCurrent) + 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(ParamData%Jac_u_indx)) then - deallocate(ParamData%Jac_u_indx) + 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(ParamData%du)) then - deallocate(ParamData%du) + 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 - if (allocated(ParamData%dx)) then - deallocate(ParamData%dx) + 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 - if (allocated(ParamData%dxIdx_map2_xStateIdx)) then - deallocate(ParamData%dxIdx_map2_xStateIdx) + if (allocated(SrcMiscData%RodStateIs1)) then + LB(1:1) = lbound(SrcMiscData%RodStateIs1) + UB(1:1) = ubound(SrcMiscData%RodStateIs1) + if (.not. allocated(DstMiscData%RodStateIs1)) then + allocate(DstMiscData%RodStateIs1(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIs1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%RodStateIs1 = SrcMiscData%RodStateIs1 end if - if (allocated(ParamData%VisRodsDiam)) then - LB(1:1) = lbound(ParamData%VisRodsDiam, kind=B8Ki) - UB(1:1) = ubound(ParamData%VisRodsDiam, kind=B8Ki) - 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) + if (allocated(SrcMiscData%RodStateIsN)) then + LB(1:1) = lbound(SrcMiscData%RodStateIsN) + UB(1:1) = ubound(SrcMiscData%RodStateIsN) + if (.not. allocated(DstMiscData%RodStateIsN)) then + allocate(DstMiscData%RodStateIsN(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIsN.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%RodStateIsN = SrcMiscData%RodStateIsN end if -end subroutine - -subroutine MD_PackParam(RF, Indata) - type(RegFile), intent(inout) :: RF - type(MD_ParameterType), intent(in) :: InData - character(*), parameter :: RoutineName = 'MD_PackParam' - integer(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: 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, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackOutParmType(RF, InData%OutParam(i1)) - end do + 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 - 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, kind=B8Ki), ubound(InData%VisRodsDiam, kind=B8Ki)) - LB(1:1) = lbound(InData%VisRodsDiam, kind=B8Ki) - UB(1:1) = ubound(InData%VisRodsDiam, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackVisDiam(RF, InData%VisRodsDiam(i1)) - end do + 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 - 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(B8Ki) :: i1, i2, i3, i4 - integer(B8Ki) :: 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 + 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 DstMiscData%MDWrOutput.', 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%MDWrOutput = SrcMiscData%MDWrOutput 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 + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%PtfmInit = SrcMiscData%PtfmInit + if (allocated(SrcMiscData%BathymetryGrid)) then + LB(1:2) = lbound(SrcMiscData%BathymetryGrid) + UB(1:2) = ubound(SrcMiscData%BathymetryGrid) + if (.not. allocated(DstMiscData%BathymetryGrid)) then + allocate(DstMiscData%BathymetryGrid(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathymetryGrid.', ErrStat, ErrMsg, RoutineName) + return + end if end if - do i1 = LB(1), UB(1) - call MD_UnpackVisDiam(RF, OutData%VisRodsDiam(i1)) ! VisRodsDiam - end do + DstMiscData%BathymetryGrid = SrcMiscData%BathymetryGrid 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(B8Ki) :: i1 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%CoupledKinematics, kind=B8Ki) - if (.not. allocated(DstInputData%CoupledKinematics)) then - allocate(DstInputData%CoupledKinematics(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 DstInputData%CoupledKinematics.', 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(SrcInputData%CoupledKinematics(i1), DstInputData%CoupledKinematics(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(SrcInputData%DeltaL)) then - LB(1:1) = lbound(SrcInputData%DeltaL, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%DeltaL, kind=B8Ki) - if (.not. allocated(DstInputData%DeltaL)) then - allocate(DstInputData%DeltaL(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 DstInputData%DeltaL.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Ys.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%DeltaL = SrcInputData%DeltaL + DstMiscData%BathGrid_Ys = SrcMiscData%BathGrid_Ys end if - if (allocated(SrcInputData%DeltaLdot)) then - LB(1:1) = lbound(SrcInputData%DeltaLdot, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%DeltaLdot, kind=B8Ki) - if (.not. allocated(DstInputData%DeltaLdot)) then - allocate(DstInputData%DeltaLdot(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 DstInputData%DeltaLdot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_npoints.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInputData%DeltaLdot = SrcInputData%DeltaLdot + DstMiscData%BathGrid_npoints = SrcMiscData%BathGrid_npoints end if end subroutine -subroutine MD_DestroyInput(InputData, ErrStat, ErrMsg) - type(MD_InputType), intent(inout) :: InputData +subroutine MD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(MD_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'MD_DestroyInput' + character(*), parameter :: RoutineName = 'MD_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(InputData%CoupledKinematics)) then - LB(1:1) = lbound(InputData%CoupledKinematics, kind=B8Ki) - UB(1:1) = ubound(InputData%CoupledKinematics, kind=B8Ki) + 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( InputData%CoupledKinematics(i1), ErrStat2, ErrMsg2) + call MD_DestroyLineProp(MiscData%LineTypeList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(InputData%CoupledKinematics) - end if - if (allocated(InputData%DeltaL)) then - deallocate(InputData%DeltaL) - end if - if (allocated(InputData%DeltaLdot)) then - deallocate(InputData%DeltaLdot) - end if -end subroutine - -subroutine MD_PackInput(RF, Indata) - type(RegFile), intent(inout) :: RF - type(MD_InputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'MD_PackInput' - integer(B8Ki) :: i1 - integer(B8Ki) :: 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, kind=B8Ki), ubound(InData%CoupledKinematics, kind=B8Ki)) - LB(1:1) = lbound(InData%CoupledKinematics, kind=B8Ki) - UB(1:1) = ubound(InData%CoupledKinematics, kind=B8Ki) - do i1 = LB(1), UB(1) - call MeshPack(RF, InData%CoupledKinematics(i1)) - end do - 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(B8Ki) :: i1 - integer(B8Ki) :: 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 - end if - do i1 = LB(1), UB(1) - call MeshUnpack(RF, OutData%CoupledKinematics(i1)) ! CoupledKinematics - end do + deallocate(MiscData%LineTypeList) 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(B8Ki) :: i1 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%CoupledLoads, kind=B8Ki) - if (.not. allocated(DstOutputData%CoupledLoads)) then - allocate(DstOutputData%CoupledLoads(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CoupledLoads.', ErrStat, ErrMsg, RoutineName) - return - end if - end if + if (allocated(MiscData%RodTypeList)) then + LB(1:1) = lbound(MiscData%RodTypeList) + UB(1:1) = ubound(MiscData%RodTypeList) do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%CoupledLoads(i1), DstOutputData%CoupledLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call MD_DestroyRodProp(MiscData%RodTypeList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end do + deallocate(MiscData%RodTypeList) end if - if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) - if (.not. allocated(DstOutputData%WriteOutput)) then - allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstOutputData%WriteOutput = SrcOutputData%WriteOutput - end if - if (allocated(SrcOutputData%VisLinesMesh)) then - LB(1:1) = lbound(SrcOutputData%VisLinesMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%VisLinesMesh, kind=B8Ki) - 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 DstOutputData%VisLinesMesh.', ErrStat, ErrMsg, RoutineName) - return - end if - 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 MeshCopy(SrcOutputData%VisLinesMesh(i1), DstOutputData%VisLinesMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call MD_DestroyBody(MiscData%BodyList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end do + deallocate(MiscData%BodyList) end if - if (allocated(SrcOutputData%VisRodsMesh)) then - LB(1:1) = lbound(SrcOutputData%VisRodsMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%VisRodsMesh, kind=B8Ki) - 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 DstOutputData%VisRodsMesh.', ErrStat, ErrMsg, RoutineName) - return - end if - 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 MeshCopy(SrcOutputData%VisRodsMesh(i1), DstOutputData%VisRodsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call MD_DestroyRod(MiscData%RodList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end do + deallocate(MiscData%RodList) end if - if (allocated(SrcOutputData%VisBodiesMesh)) then - LB(1:1) = lbound(SrcOutputData%VisBodiesMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%VisBodiesMesh, kind=B8Ki) - 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 DstOutputData%VisBodiesMesh.', ErrStat, ErrMsg, RoutineName) - return - end if - 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 MeshCopy(SrcOutputData%VisBodiesMesh(i1), DstOutputData%VisBodiesMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call MD_DestroyPoint(MiscData%PointList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end do + deallocate(MiscData%PointList) end if - if (allocated(SrcOutputData%VisAnchsMesh)) then - LB(1:1) = lbound(SrcOutputData%VisAnchsMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%VisAnchsMesh, kind=B8Ki) - 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 DstOutputData%VisAnchsMesh.', ErrStat, ErrMsg, RoutineName) - return - end if - end if + if (allocated(MiscData%LineList)) then + LB(1:1) = lbound(MiscData%LineList) + UB(1:1) = ubound(MiscData%LineList) do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%VisAnchsMesh(i1), DstOutputData%VisAnchsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call MD_DestroyLine(MiscData%LineList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end do + deallocate(MiscData%LineList) end if -end subroutine - -subroutine MD_DestroyOutput(OutputData, ErrStat, ErrMsg) - type(MD_OutputType), intent(inout) :: OutputData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(OutputData%CoupledLoads, kind=B8Ki) + if (allocated(MiscData%FailList)) then + LB(1:1) = lbound(MiscData%FailList) + UB(1:1) = ubound(MiscData%FailList) do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%CoupledLoads(i1), ErrStat2, ErrMsg2) + call MD_DestroyFail(MiscData%FailList(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(OutputData%CoupledLoads) + deallocate(MiscData%FailList) end if - if (allocated(OutputData%WriteOutput)) then - deallocate(OutputData%WriteOutput) + if (allocated(MiscData%FreePointIs)) then + deallocate(MiscData%FreePointIs) end if - if (allocated(OutputData%VisLinesMesh)) then - LB(1:1) = lbound(OutputData%VisLinesMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%VisLinesMesh, kind=B8Ki) - 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) + 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(OutputData%VisRodsMesh)) then - LB(1:1) = lbound(OutputData%VisRodsMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%VisRodsMesh, kind=B8Ki) - 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) + if (allocated(MiscData%BathGrid_Xs)) then + deallocate(MiscData%BathGrid_Xs) end if - if (allocated(OutputData%VisBodiesMesh)) then - LB(1:1) = lbound(OutputData%VisBodiesMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%VisBodiesMesh, kind=B8Ki) - 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) + if (allocated(MiscData%BathGrid_Ys)) then + deallocate(MiscData%BathGrid_Ys) end if - if (allocated(OutputData%VisAnchsMesh)) then - LB(1:1) = lbound(OutputData%VisAnchsMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%VisAnchsMesh, kind=B8Ki) - 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) + 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(B8Ki) :: i1 - integer(B8Ki) :: 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, kind=B8Ki), ubound(InData%CoupledLoads, kind=B8Ki)) - LB(1:1) = lbound(InData%CoupledLoads, kind=B8Ki) - UB(1:1) = ubound(InData%CoupledLoads, kind=B8Ki) + 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, kind=B8Ki), ubound(InData%VisLinesMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%VisLinesMesh, kind=B8Ki) - UB(1:1) = ubound(InData%VisLinesMesh, kind=B8Ki) + 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, kind=B8Ki), ubound(InData%VisRodsMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%VisRodsMesh, kind=B8Ki) - UB(1:1) = ubound(InData%VisRodsMesh, kind=B8Ki) + 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, kind=B8Ki), ubound(InData%VisBodiesMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%VisBodiesMesh, kind=B8Ki) - UB(1:1) = ubound(InData%VisBodiesMesh, kind=B8Ki) + 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, kind=B8Ki), ubound(InData%VisAnchsMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%VisAnchsMesh, kind=B8Ki) - UB(1:1) = ubound(InData%VisAnchsMesh, kind=B8Ki) + 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(B8Ki) :: i1 - integer(B8Ki) :: 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) @@ -4724,7 +4800,7 @@ SUBROUTINE MD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) a2 = t_out/t(2) IF (ALLOCATED(u_out%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN - DO i1 = LBOUND(u_out%CoupledKinematics,1, kind=B8Ki),UBOUND(u_out%CoupledKinematics,1, kind=B8Ki) + do i1 = lbound(u_out%CoupledKinematics,1),ubound(u_out%CoupledKinematics,1) CALL MeshExtrapInterp1(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -4793,7 +4869,7 @@ SUBROUTINE MD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(u_out%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN - DO i1 = LBOUND(u_out%CoupledKinematics,1, kind=B8Ki),UBOUND(u_out%CoupledKinematics,1, kind=B8Ki) + do i1 = lbound(u_out%CoupledKinematics,1),ubound(u_out%CoupledKinematics,1) CALL MeshExtrapInterp2(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), u3%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -4904,7 +4980,7 @@ SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(y_out%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN - DO i1 = LBOUND(y_out%CoupledLoads,1, kind=B8Ki),UBOUND(y_out%CoupledLoads,1, kind=B8Ki) + do i1 = lbound(y_out%CoupledLoads,1),ubound(y_out%CoupledLoads,1) CALL MeshExtrapInterp1(y1%CoupledLoads(i1), y2%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -4913,25 +4989,25 @@ SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput END IF ! check if allocated IF (ALLOCATED(y_out%VisLinesMesh) .AND. ALLOCATED(y1%VisLinesMesh)) THEN - DO i1 = LBOUND(y_out%VisLinesMesh,1, kind=B8Ki),UBOUND(y_out%VisLinesMesh,1, kind=B8Ki) + do i1 = lbound(y_out%VisLinesMesh,1),ubound(y_out%VisLinesMesh,1) CALL MeshExtrapInterp1(y1%VisLinesMesh(i1), y2%VisLinesMesh(i1), tin, y_out%VisLinesMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%VisRodsMesh) .AND. ALLOCATED(y1%VisRodsMesh)) THEN - DO i1 = LBOUND(y_out%VisRodsMesh,1, kind=B8Ki),UBOUND(y_out%VisRodsMesh,1, kind=B8Ki) + do i1 = lbound(y_out%VisRodsMesh,1),ubound(y_out%VisRodsMesh,1) CALL MeshExtrapInterp1(y1%VisRodsMesh(i1), y2%VisRodsMesh(i1), tin, y_out%VisRodsMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%VisBodiesMesh) .AND. ALLOCATED(y1%VisBodiesMesh)) THEN - DO i1 = LBOUND(y_out%VisBodiesMesh,1, kind=B8Ki),UBOUND(y_out%VisBodiesMesh,1, kind=B8Ki) + do i1 = lbound(y_out%VisBodiesMesh,1),ubound(y_out%VisBodiesMesh,1) CALL MeshExtrapInterp1(y1%VisBodiesMesh(i1), y2%VisBodiesMesh(i1), tin, y_out%VisBodiesMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%VisAnchsMesh) .AND. ALLOCATED(y1%VisAnchsMesh)) THEN - DO i1 = LBOUND(y_out%VisAnchsMesh,1, kind=B8Ki),UBOUND(y_out%VisAnchsMesh,1, kind=B8Ki) + do i1 = lbound(y_out%VisAnchsMesh,1),ubound(y_out%VisAnchsMesh,1) CALL MeshExtrapInterp1(y1%VisAnchsMesh(i1), y2%VisAnchsMesh(i1), tin, y_out%VisAnchsMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -4994,7 +5070,7 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN - DO i1 = LBOUND(y_out%CoupledLoads,1, kind=B8Ki),UBOUND(y_out%CoupledLoads,1, kind=B8Ki) + do i1 = lbound(y_out%CoupledLoads,1),ubound(y_out%CoupledLoads,1) CALL MeshExtrapInterp2(y1%CoupledLoads(i1), y2%CoupledLoads(i1), y3%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -5003,29 +5079,355 @@ SUBROUTINE MD_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 IF (ALLOCATED(y_out%VisLinesMesh) .AND. ALLOCATED(y1%VisLinesMesh)) THEN - DO i1 = LBOUND(y_out%VisLinesMesh,1, kind=B8Ki),UBOUND(y_out%VisLinesMesh,1, kind=B8Ki) + do i1 = lbound(y_out%VisLinesMesh,1),ubound(y_out%VisLinesMesh,1) CALL MeshExtrapInterp2(y1%VisLinesMesh(i1), y2%VisLinesMesh(i1), y3%VisLinesMesh(i1), tin, y_out%VisLinesMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%VisRodsMesh) .AND. ALLOCATED(y1%VisRodsMesh)) THEN - DO i1 = LBOUND(y_out%VisRodsMesh,1, kind=B8Ki),UBOUND(y_out%VisRodsMesh,1, kind=B8Ki) + do i1 = lbound(y_out%VisRodsMesh,1),ubound(y_out%VisRodsMesh,1) CALL MeshExtrapInterp2(y1%VisRodsMesh(i1), y2%VisRodsMesh(i1), y3%VisRodsMesh(i1), tin, y_out%VisRodsMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%VisBodiesMesh) .AND. ALLOCATED(y1%VisBodiesMesh)) THEN - DO i1 = LBOUND(y_out%VisBodiesMesh,1, kind=B8Ki),UBOUND(y_out%VisBodiesMesh,1, kind=B8Ki) + do i1 = lbound(y_out%VisBodiesMesh,1),ubound(y_out%VisBodiesMesh,1) CALL MeshExtrapInterp2(y1%VisBodiesMesh(i1), y2%VisBodiesMesh(i1), y3%VisBodiesMesh(i1), tin, y_out%VisBodiesMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%VisAnchsMesh) .AND. ALLOCATED(y1%VisAnchsMesh)) THEN - DO i1 = LBOUND(y_out%VisAnchsMesh,1, kind=B8Ki),UBOUND(y_out%VisAnchsMesh,1, kind=B8Ki) + do i1 = lbound(y_out%VisAnchsMesh,1),ubound(y_out%VisAnchsMesh,1) CALL MeshExtrapInterp2(y1%VisAnchsMesh(i1), y2%VisAnchsMesh(i1), y3%VisAnchsMesh(i1), tin, y_out%VisAnchsMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) 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/moordyn/src/MoorDyn_bathymetry.txt b/modules/moordyn/src/MoorDyn_bathymetry.txt deleted file mode 100644 index bfe4ffbbbd..0000000000 --- a/modules/moordyn/src/MoorDyn_bathymetry.txt +++ /dev/null @@ -1,8 +0,0 @@ ---- MoorDyn Bathymetry Input File --- -nGridX 4 -nGridY 4 - -800 -10 10 800 --800 400 400 500 500 - -10 400 400 500 500 - 10 600 600 600 600 - 800 600 600 600 600 \ No newline at end of file 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/ModRegGen.py b/modules/nwtc-library/ModRegGen.py index b7a9811cca..7ab8753a63 100644 --- a/modules/nwtc-library/ModRegGen.py +++ b/modules/nwtc-library/ModRegGen.py @@ -273,7 +273,7 @@ subroutine RegPackBounds(RF, R, LB, UB) type(RegFile), intent(inout) :: RF integer(B4Ki), intent(in) :: R - integer(B8Ki), intent(in) :: LB(:), UB(:) + integer(B4Ki), intent(in) :: LB(:), UB(:) ! If has an error, return if (RF%ErrStat /= ErrID_None) return @@ -287,7 +287,7 @@ subroutine RegUnpackBounds(RF, R, LB, UB) type(RegFile), intent(inout) :: RF integer(B4Ki), intent(in) :: R - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) ! If has an error, return if (RF%ErrStat /= ErrID_None) return @@ -377,7 +377,7 @@ def gen_pack_alloc(w, dt, decl, rank): w.write(f'\n') if rank > 0: w.write(f'\n ! Write array bounds') - w.write(f'\n call RegPackBounds(RF, {rank}, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki))') + w.write(f'\n call RegPackBounds(RF, {rank}, lbound(Data), ubound(Data))') w.write(f'\n') w.write(f'\n ! Write data to file') w.write(f'\n call RegPack(RF, Data)') @@ -395,7 +395,7 @@ def gen_unpack_alloc(w, dt, decl, rank): w.write(f'\n integer(IntKi) :: stat') w.write(f'\n logical :: IsAllocated') if rank > 0: - w.write(f'\n integer(B8Ki) :: LB({rank}), UB({rank})') + w.write(f'\n integer(B4Ki) :: LB({rank}), UB({rank})') w.write(f'\n') w.write(f'\n ! If error, return') w.write(f'\n if (RF%ErrStat /= ErrID_None) return') @@ -449,7 +449,7 @@ def gen_pack_ptr(w, dt, decl, rank): if rank > 0: w.write(f'\n') w.write(f'\n ! Write array bounds') - w.write(f'\n call RegPackBounds(RF, {rank}, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki))') + w.write(f'\n call RegPackBounds(RF, {rank}, lbound(Data), ubound(Data))') w.write(f'\n') w.write(f'\n ! Write pointer info') w.write(f'\n call RegPackPointer(RF, c_loc(Data), PtrInIndex)') @@ -473,7 +473,7 @@ def gen_unpack_ptr(w, dt, decl, rank): w.write(f'\n type(RegFile), intent(inout) :: RF') w.write(f'\n {decl+", pointer, intent(out)":<36s} :: Data{dims}') if rank > 0: - w.write(f'\n integer(B8Ki), intent(out) :: LB(:), UB(:)') + w.write(f'\n integer(B4Ki), intent(out) :: LB(:), UB(:)') w.write(f'\n integer(IntKi) :: stat') w.write(f'\n integer(B8Ki) :: PtrIdx') w.write(f'\n logical :: IsAssociated') diff --git a/modules/nwtc-library/src/ModMesh.f90 b/modules/nwtc-library/src/ModMesh.f90 index 16b9ffafe0..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 @@ -1791,33 +1793,73 @@ SUBROUTINE MeshCopy( SrcMesh, DestMesh, CtrlCode, ErrStat , ErrMess & IF (.NOT. SrcMesh%Initialized) RETURN !bjj: maybe we should first CALL MeshDestroy(DestMesh,ErrStat, ErrMess) - IF ( CtrlCode .EQ. MESH_NEWCOPY .OR. CtrlCode .EQ. MESH_SIBLING .OR. CtrlCode .EQ. MESH_COUSIN ) THEN - - IF (CtrlCode .EQ. MESH_NEWCOPY) THEN - IOS_l = SrcMesh%IOS - Force_l = SrcMesh%FieldMask(MASKID_FORCE) - Moment_l = SrcMesh%FieldMask(MASKID_MOMENT) - Orientation_l = SrcMesh%FieldMask(MASKID_ORIENTATION) - TranslationDisp_l = SrcMesh%FieldMask(MASKID_TRANSLATIONDISP) - TranslationVel_l = SrcMesh%FieldMask(MASKID_TRANSLATIONVEL) - RotationVel_l = SrcMesh%FieldMask(MASKID_ROTATIONVEL) - TranslationAcc_l = SrcMesh%FieldMask(MASKID_TRANSLATIONACC) - RotationAcc_l = SrcMesh%FieldMask(MASKID_ROTATIONACC) - nScalars_l = SrcMesh%nScalars - ELSE ! Sibling or cousin - IOS_l = SrcMesh%IOS ; IF ( PRESENT(IOS) ) IOS_l = IOS - Force_l = .FALSE. ; IF ( PRESENT(Force) ) Force_l = Force - Moment_l = .FALSE. ; IF ( PRESENT(Moment) ) Moment_l = Moment - Orientation_l = .FALSE. ; IF ( PRESENT(Orientation) ) Orientation_l = Orientation - TranslationDisp_l = .FALSE. ; IF ( PRESENT(TranslationDisp) ) TranslationDisp_l = TranslationDisp - TranslationVel_l = .FALSE. ; IF ( PRESENT(TranslationVel) ) TranslationVel_l = TranslationVel - RotationVel_l = .FALSE. ; IF ( PRESENT(RotationVel) ) RotationVel_l = RotationVel - TranslationAcc_l = .FALSE. ; IF ( PRESENT(TranslationAcc) ) TranslationAcc_l = TranslationAcc - RotationAcc_l = .FALSE. ; IF ( PRESENT(RotationAcc) ) RotationAcc_l = RotationAcc - nScalars_l = 0 ; IF ( PRESENT(nScalars) ) nScalars_l = nScalars - END IF - - IF ( CtrlCode .EQ. MESH_NEWCOPY .OR. CtrlCode .EQ. MESH_COUSIN ) THEN + select case (CtrlCode) + case (MESH_NEWCOPY) + IOS_l = SrcMesh%IOS + Force_l = SrcMesh%FieldMask(MASKID_FORCE) + Moment_l = SrcMesh%FieldMask(MASKID_MOMENT) + Orientation_l = SrcMesh%FieldMask(MASKID_ORIENTATION) + TranslationDisp_l = SrcMesh%FieldMask(MASKID_TRANSLATIONDISP) + TranslationVel_l = SrcMesh%FieldMask(MASKID_TRANSLATIONVEL) + RotationVel_l = SrcMesh%FieldMask(MASKID_ROTATIONVEL) + TranslationAcc_l = SrcMesh%FieldMask(MASKID_TRANSLATIONACC) + RotationAcc_l = SrcMesh%FieldMask(MASKID_ROTATIONACC) + nScalars_l = SrcMesh%nScalars + case (MESH_SIBLING, MESH_COUSIN) + IF ( PRESENT(IOS) ) then + IOS_l = IOS + else + IOS_l = SrcMesh%IOS + end if + IF ( PRESENT(Force) ) then + Force_l = Force + else + Force_l = .FALSE. + end if + IF ( PRESENT(Moment) ) then + Moment_l = Moment + else + Moment_l = .FALSE. + end if + IF ( PRESENT(Orientation) ) then + Orientation_l = Orientation + else + Orientation_l = .FALSE. + end if + IF ( PRESENT(TranslationDisp) ) then + TranslationDisp_l = TranslationDisp + else + TranslationDisp_l = .FALSE. + end if + IF ( PRESENT(TranslationVel) ) then + TranslationVel_l = TranslationVel + else + TranslationVel_l = .FALSE. + end if + IF ( PRESENT(RotationVel) ) then + RotationVel_l = RotationVel + else + RotationVel_l = .FALSE. + end if + IF ( PRESENT(TranslationAcc) ) then + TranslationAcc_l = TranslationAcc + else + TranslationAcc_l = .FALSE. + end if + IF ( PRESENT(RotationAcc) ) then + RotationAcc_l = RotationAcc + else + RotationAcc_l = .FALSE. + end if + IF ( PRESENT(nScalars) ) then + nScalars_l = nScalars + else + nScalars_l = 0 + end if + end select + + select case (CtrlCode) + case (MESH_NEWCOPY, MESH_COUSIN) CALL MeshCreate( DestMesh, IOS=IOS_l, Nnodes=SrcMesh%Nnodes, ErrStat=ErrStat, ErrMess=ErrMess & ,Force=Force_l & @@ -1894,7 +1936,7 @@ SUBROUTINE MeshCopy( SrcMesh, DestMesh, CtrlCode, ErrStat , ErrMess & DestMesh%RemapFlag = SrcMesh%RemapFlag - ELSE IF ( CtrlCode .EQ. MESH_SIBLING ) THEN + case (MESH_SIBLING) !bjj: we should make sure the mesh has been committed, otherwise the element lists haven't been created, yet (and thus not shared) IF ( ASSOCIATED(SrcMesh%SiblingMesh) ) THEN ErrStat = ErrID_Fatal @@ -1936,17 +1978,7 @@ SUBROUTINE MeshCopy( SrcMesh, DestMesh, CtrlCode, ErrStat , ErrMess & DestMesh%maxelemlist = SrcMesh%maxelemlist DestMesh%nextelem = SrcMesh%nextelem - - ENDIF - - DO i = 1, NELEMKINDS - IF ( ASSOCIATED(SrcMesh%ElemTable) ) THEN - ENDIF - IF ( ASSOCIATED(DestMesh%ElemTable) ) THEN - ENDIF - ENDDO - - ELSE IF ( CtrlCode .EQ. MESH_UPDATECOPY ) THEN + case (MESH_UPDATECOPY) IF ( SrcMesh%nNodes .NE. DestMesh%nNodes ) THEN ErrStat = ErrID_Fatal @@ -1954,7 +1986,7 @@ SUBROUTINE MeshCopy( SrcMesh, DestMesh, CtrlCode, ErrStat , ErrMess & RETURN ENDIF - ELSE IF ( CtrlCode .EQ. MESH_UPDATEREFERENCE ) THEN + case (MESH_UPDATEREFERENCE) IF ( SrcMesh%nNodes .NE. DestMesh%nNodes ) THEN ErrStat = ErrID_Fatal @@ -1966,11 +1998,11 @@ SUBROUTINE MeshCopy( SrcMesh, DestMesh, CtrlCode, ErrStat , ErrMess & DestMesh%RefOrientation = SrcMesh%RefOrientation DestMesh%RemapFlag = SrcMesh%RemapFlag - ELSE + case default ErrStat = ErrID_Fatal ErrMess = 'MeshCopy: Invalid CtrlCode.' RETURN - ENDIF + end select ! These aren't shared between siblings, so they get copied, no matter what the CtrlCode: @@ -2713,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: @@ -2857,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/ModMesh_Mapping.f90 b/modules/nwtc-library/src/ModMesh_Mapping.f90 index 69cec3db98..fd63f374f3 100644 --- a/modules/nwtc-library/src/ModMesh_Mapping.f90 +++ b/modules/nwtc-library/src/ModMesh_Mapping.f90 @@ -3263,38 +3263,28 @@ FUNCTION GetLoadsScaleFactor( Src ) ! LOCAL: INTEGER :: I, j - REAL(ReKi) :: MaxLoad + REAL(ReKi) :: MaxLoad, MaxForce, MaxMoment + IF ( Src%FIELDMASK( MASKID_FORCE ) ) then + MaxForce = maxval(abs(src%Force)) + else + MaxForce = 0.0_ReKi + end if - GetLoadsScaleFactor = 1.0 - MaxLoad = 0.0 - - IF ( Src%FIELDMASK( MASKID_FORCE ) ) THEN - - DO I=1,Src%Nnodes - DO J=1,3 - MaxLoad = MAX(MaxLoad, ABS(Src%Force(j,I) ) ) - END DO - END DO - - END IF - + IF ( Src%FIELDMASK( MASKID_MOMENT ) ) then + MaxMoment = maxval(abs(src%Moment)) + else + MaxMoment = 0.0_ReKi + end if + + MaxLoad = max(MaxForce, MaxMoment) - IF ( Src%FIELDMASK( MASKID_MOMENT ) ) THEN - - DO I=1,Src%Nnodes - DO J=1,3 - MaxLoad = MAX(MaxLoad, ABS(Src%Moment(j,I) ) ) - END DO - END DO - - END IF - IF ( MaxLoad > 10. ) THEN GetLoadsScaleFactor = 10**MIN( NINT(log10(MaxLoad)), 15 ) ! Let's not get carried away and cause overflow; 10E15 is as far as we'll go + else + GetLoadsScaleFactor = 1.0_ReKi END IF - END FUNCTION GetLoadsScaleFactor !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE CreateLoadMap_P_to_P( Src, Dest, MeshMap, ErrStat, ErrMsg ) diff --git a/modules/nwtc-library/src/ModReg.f90 b/modules/nwtc-library/src/ModReg.f90 index ea398d46c3..48c664fe7d 100644 --- a/modules/nwtc-library/src/ModReg.f90 +++ b/modules/nwtc-library/src/ModReg.f90 @@ -340,7 +340,7 @@ subroutine RegUnpackPointer(RF, Ptr, Idx) subroutine RegPackBounds(RF, R, LB, UB) type(RegFile), intent(inout) :: RF integer(B4Ki), intent(in) :: R - integer(B8Ki), intent(in) :: LB(:), UB(:) + integer(B4Ki), intent(in) :: LB(:), UB(:) ! If has an error, return if (RF%ErrStat /= ErrID_None) return @@ -354,7 +354,7 @@ subroutine RegPackBounds(RF, R, LB, UB) subroutine RegUnpackBounds(RF, R, LB, UB) type(RegFile), intent(inout) :: RF integer(B4Ki), intent(in) :: R - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) ! If has an error, return if (RF%ErrStat /= ErrID_None) return @@ -576,7 +576,7 @@ subroutine PackAlloc_C1_Rank1(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -588,7 +588,7 @@ subroutine UnpackAlloc_C1_Rank1(RF, Data) character(*), allocatable, intent(out) :: Data(:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -632,7 +632,7 @@ subroutine PackPtr_C1_Rank1(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -647,7 +647,7 @@ subroutine PackPtr_C1_Rank1(RF, Data) subroutine UnpackPtr_C1_Rank1(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF character(*), pointer, intent(out) :: Data(:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -737,7 +737,7 @@ subroutine PackAlloc_C1_Rank2(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -749,7 +749,7 @@ subroutine UnpackAlloc_C1_Rank2(RF, Data) character(*), allocatable, intent(out) :: Data(:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -793,7 +793,7 @@ subroutine PackPtr_C1_Rank2(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -808,7 +808,7 @@ subroutine PackPtr_C1_Rank2(RF, Data) subroutine UnpackPtr_C1_Rank2(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF character(*), pointer, intent(out) :: Data(:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -898,7 +898,7 @@ subroutine PackAlloc_C1_Rank3(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -910,7 +910,7 @@ subroutine UnpackAlloc_C1_Rank3(RF, Data) character(*), allocatable, intent(out) :: Data(:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -954,7 +954,7 @@ subroutine PackPtr_C1_Rank3(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -969,7 +969,7 @@ subroutine PackPtr_C1_Rank3(RF, Data) subroutine UnpackPtr_C1_Rank3(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF character(*), pointer, intent(out) :: Data(:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -1059,7 +1059,7 @@ subroutine PackAlloc_C1_Rank4(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -1071,7 +1071,7 @@ subroutine UnpackAlloc_C1_Rank4(RF, Data) character(*), allocatable, intent(out) :: Data(:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -1115,7 +1115,7 @@ subroutine PackPtr_C1_Rank4(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -1130,7 +1130,7 @@ subroutine PackPtr_C1_Rank4(RF, Data) subroutine UnpackPtr_C1_Rank4(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF character(*), pointer, intent(out) :: Data(:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -1220,7 +1220,7 @@ subroutine PackAlloc_C1_Rank5(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -1232,7 +1232,7 @@ subroutine UnpackAlloc_C1_Rank5(RF, Data) character(*), allocatable, intent(out) :: Data(:,:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -1276,7 +1276,7 @@ subroutine PackPtr_C1_Rank5(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -1291,7 +1291,7 @@ subroutine PackPtr_C1_Rank5(RF, Data) subroutine UnpackPtr_C1_Rank5(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF character(*), pointer, intent(out) :: Data(:,:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -1527,7 +1527,7 @@ subroutine PackAlloc_L1_Rank1(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -1539,7 +1539,7 @@ subroutine UnpackAlloc_L1_Rank1(RF, Data) logical, allocatable, intent(out) :: Data(:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -1583,7 +1583,7 @@ subroutine PackPtr_L1_Rank1(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -1598,7 +1598,7 @@ subroutine PackPtr_L1_Rank1(RF, Data) subroutine UnpackPtr_L1_Rank1(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF logical, pointer, intent(out) :: Data(:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -1688,7 +1688,7 @@ subroutine PackAlloc_L1_Rank2(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -1700,7 +1700,7 @@ subroutine UnpackAlloc_L1_Rank2(RF, Data) logical, allocatable, intent(out) :: Data(:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -1744,7 +1744,7 @@ subroutine PackPtr_L1_Rank2(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -1759,7 +1759,7 @@ subroutine PackPtr_L1_Rank2(RF, Data) subroutine UnpackPtr_L1_Rank2(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF logical, pointer, intent(out) :: Data(:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -1849,7 +1849,7 @@ subroutine PackAlloc_L1_Rank3(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -1861,7 +1861,7 @@ subroutine UnpackAlloc_L1_Rank3(RF, Data) logical, allocatable, intent(out) :: Data(:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -1905,7 +1905,7 @@ subroutine PackPtr_L1_Rank3(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -1920,7 +1920,7 @@ subroutine PackPtr_L1_Rank3(RF, Data) subroutine UnpackPtr_L1_Rank3(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF logical, pointer, intent(out) :: Data(:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -2010,7 +2010,7 @@ subroutine PackAlloc_L1_Rank4(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -2022,7 +2022,7 @@ subroutine UnpackAlloc_L1_Rank4(RF, Data) logical, allocatable, intent(out) :: Data(:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -2066,7 +2066,7 @@ subroutine PackPtr_L1_Rank4(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -2081,7 +2081,7 @@ subroutine PackPtr_L1_Rank4(RF, Data) subroutine UnpackPtr_L1_Rank4(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF logical, pointer, intent(out) :: Data(:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -2171,7 +2171,7 @@ subroutine PackAlloc_L1_Rank5(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -2183,7 +2183,7 @@ subroutine UnpackAlloc_L1_Rank5(RF, Data) logical, allocatable, intent(out) :: Data(:,:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -2227,7 +2227,7 @@ subroutine PackPtr_L1_Rank5(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -2242,7 +2242,7 @@ subroutine PackPtr_L1_Rank5(RF, Data) subroutine UnpackPtr_L1_Rank5(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF logical, pointer, intent(out) :: Data(:,:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -2478,7 +2478,7 @@ subroutine PackAlloc_I4_Rank1(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -2490,7 +2490,7 @@ subroutine UnpackAlloc_I4_Rank1(RF, Data) integer(B4Ki), allocatable, intent(out) :: Data(:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -2534,7 +2534,7 @@ subroutine PackPtr_I4_Rank1(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -2549,7 +2549,7 @@ subroutine PackPtr_I4_Rank1(RF, Data) subroutine UnpackPtr_I4_Rank1(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B4Ki), pointer, intent(out) :: Data(:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -2639,7 +2639,7 @@ subroutine PackAlloc_I4_Rank2(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -2651,7 +2651,7 @@ subroutine UnpackAlloc_I4_Rank2(RF, Data) integer(B4Ki), allocatable, intent(out) :: Data(:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -2695,7 +2695,7 @@ subroutine PackPtr_I4_Rank2(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -2710,7 +2710,7 @@ subroutine PackPtr_I4_Rank2(RF, Data) subroutine UnpackPtr_I4_Rank2(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B4Ki), pointer, intent(out) :: Data(:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -2800,7 +2800,7 @@ subroutine PackAlloc_I4_Rank3(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -2812,7 +2812,7 @@ subroutine UnpackAlloc_I4_Rank3(RF, Data) integer(B4Ki), allocatable, intent(out) :: Data(:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -2856,7 +2856,7 @@ subroutine PackPtr_I4_Rank3(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -2871,7 +2871,7 @@ subroutine PackPtr_I4_Rank3(RF, Data) subroutine UnpackPtr_I4_Rank3(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B4Ki), pointer, intent(out) :: Data(:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -2961,7 +2961,7 @@ subroutine PackAlloc_I4_Rank4(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -2973,7 +2973,7 @@ subroutine UnpackAlloc_I4_Rank4(RF, Data) integer(B4Ki), allocatable, intent(out) :: Data(:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -3017,7 +3017,7 @@ subroutine PackPtr_I4_Rank4(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -3032,7 +3032,7 @@ subroutine PackPtr_I4_Rank4(RF, Data) subroutine UnpackPtr_I4_Rank4(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B4Ki), pointer, intent(out) :: Data(:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -3122,7 +3122,7 @@ subroutine PackAlloc_I4_Rank5(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -3134,7 +3134,7 @@ subroutine UnpackAlloc_I4_Rank5(RF, Data) integer(B4Ki), allocatable, intent(out) :: Data(:,:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -3178,7 +3178,7 @@ subroutine PackPtr_I4_Rank5(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -3193,7 +3193,7 @@ subroutine PackPtr_I4_Rank5(RF, Data) subroutine UnpackPtr_I4_Rank5(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B4Ki), pointer, intent(out) :: Data(:,:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -3429,7 +3429,7 @@ subroutine PackAlloc_I8_Rank1(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -3441,7 +3441,7 @@ subroutine UnpackAlloc_I8_Rank1(RF, Data) integer(B8Ki), allocatable, intent(out) :: Data(:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -3485,7 +3485,7 @@ subroutine PackPtr_I8_Rank1(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -3500,7 +3500,7 @@ subroutine PackPtr_I8_Rank1(RF, Data) subroutine UnpackPtr_I8_Rank1(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B8Ki), pointer, intent(out) :: Data(:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -3590,7 +3590,7 @@ subroutine PackAlloc_I8_Rank2(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -3602,7 +3602,7 @@ subroutine UnpackAlloc_I8_Rank2(RF, Data) integer(B8Ki), allocatable, intent(out) :: Data(:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -3646,7 +3646,7 @@ subroutine PackPtr_I8_Rank2(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -3661,7 +3661,7 @@ subroutine PackPtr_I8_Rank2(RF, Data) subroutine UnpackPtr_I8_Rank2(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B8Ki), pointer, intent(out) :: Data(:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -3751,7 +3751,7 @@ subroutine PackAlloc_I8_Rank3(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -3763,7 +3763,7 @@ subroutine UnpackAlloc_I8_Rank3(RF, Data) integer(B8Ki), allocatable, intent(out) :: Data(:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -3807,7 +3807,7 @@ subroutine PackPtr_I8_Rank3(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -3822,7 +3822,7 @@ subroutine PackPtr_I8_Rank3(RF, Data) subroutine UnpackPtr_I8_Rank3(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B8Ki), pointer, intent(out) :: Data(:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -3912,7 +3912,7 @@ subroutine PackAlloc_I8_Rank4(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -3924,7 +3924,7 @@ subroutine UnpackAlloc_I8_Rank4(RF, Data) integer(B8Ki), allocatable, intent(out) :: Data(:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -3968,7 +3968,7 @@ subroutine PackPtr_I8_Rank4(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -3983,7 +3983,7 @@ subroutine PackPtr_I8_Rank4(RF, Data) subroutine UnpackPtr_I8_Rank4(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B8Ki), pointer, intent(out) :: Data(:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -4073,7 +4073,7 @@ subroutine PackAlloc_I8_Rank5(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -4085,7 +4085,7 @@ subroutine UnpackAlloc_I8_Rank5(RF, Data) integer(B8Ki), allocatable, intent(out) :: Data(:,:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -4129,7 +4129,7 @@ subroutine PackPtr_I8_Rank5(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -4144,7 +4144,7 @@ subroutine PackPtr_I8_Rank5(RF, Data) subroutine UnpackPtr_I8_Rank5(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF integer(B8Ki), pointer, intent(out) :: Data(:,:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -4380,7 +4380,7 @@ subroutine PackAlloc_R4_Rank1(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -4392,7 +4392,7 @@ subroutine UnpackAlloc_R4_Rank1(RF, Data) real(R4Ki), allocatable, intent(out) :: Data(:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -4436,7 +4436,7 @@ subroutine PackPtr_R4_Rank1(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -4451,7 +4451,7 @@ subroutine PackPtr_R4_Rank1(RF, Data) subroutine UnpackPtr_R4_Rank1(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R4Ki), pointer, intent(out) :: Data(:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -4541,7 +4541,7 @@ subroutine PackAlloc_R4_Rank2(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -4553,7 +4553,7 @@ subroutine UnpackAlloc_R4_Rank2(RF, Data) real(R4Ki), allocatable, intent(out) :: Data(:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -4597,7 +4597,7 @@ subroutine PackPtr_R4_Rank2(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -4612,7 +4612,7 @@ subroutine PackPtr_R4_Rank2(RF, Data) subroutine UnpackPtr_R4_Rank2(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R4Ki), pointer, intent(out) :: Data(:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -4702,7 +4702,7 @@ subroutine PackAlloc_R4_Rank3(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -4714,7 +4714,7 @@ subroutine UnpackAlloc_R4_Rank3(RF, Data) real(R4Ki), allocatable, intent(out) :: Data(:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -4758,7 +4758,7 @@ subroutine PackPtr_R4_Rank3(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -4773,7 +4773,7 @@ subroutine PackPtr_R4_Rank3(RF, Data) subroutine UnpackPtr_R4_Rank3(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R4Ki), pointer, intent(out) :: Data(:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -4863,7 +4863,7 @@ subroutine PackAlloc_R4_Rank4(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -4875,7 +4875,7 @@ subroutine UnpackAlloc_R4_Rank4(RF, Data) real(R4Ki), allocatable, intent(out) :: Data(:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -4919,7 +4919,7 @@ subroutine PackPtr_R4_Rank4(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -4934,7 +4934,7 @@ subroutine PackPtr_R4_Rank4(RF, Data) subroutine UnpackPtr_R4_Rank4(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R4Ki), pointer, intent(out) :: Data(:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -5024,7 +5024,7 @@ subroutine PackAlloc_R4_Rank5(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -5036,7 +5036,7 @@ subroutine UnpackAlloc_R4_Rank5(RF, Data) real(R4Ki), allocatable, intent(out) :: Data(:,:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -5080,7 +5080,7 @@ subroutine PackPtr_R4_Rank5(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -5095,7 +5095,7 @@ subroutine PackPtr_R4_Rank5(RF, Data) subroutine UnpackPtr_R4_Rank5(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R4Ki), pointer, intent(out) :: Data(:,:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -5331,7 +5331,7 @@ subroutine PackAlloc_R8_Rank1(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -5343,7 +5343,7 @@ subroutine UnpackAlloc_R8_Rank1(RF, Data) real(R8Ki), allocatable, intent(out) :: Data(:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -5387,7 +5387,7 @@ subroutine PackPtr_R8_Rank1(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 1, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 1, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -5402,7 +5402,7 @@ subroutine PackPtr_R8_Rank1(RF, Data) subroutine UnpackPtr_R8_Rank1(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R8Ki), pointer, intent(out) :: Data(:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -5492,7 +5492,7 @@ subroutine PackAlloc_R8_Rank2(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -5504,7 +5504,7 @@ subroutine UnpackAlloc_R8_Rank2(RF, Data) real(R8Ki), allocatable, intent(out) :: Data(:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -5548,7 +5548,7 @@ subroutine PackPtr_R8_Rank2(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 2, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 2, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -5563,7 +5563,7 @@ subroutine PackPtr_R8_Rank2(RF, Data) subroutine UnpackPtr_R8_Rank2(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R8Ki), pointer, intent(out) :: Data(:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -5653,7 +5653,7 @@ subroutine PackAlloc_R8_Rank3(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -5665,7 +5665,7 @@ subroutine UnpackAlloc_R8_Rank3(RF, Data) real(R8Ki), allocatable, intent(out) :: Data(:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -5709,7 +5709,7 @@ subroutine PackPtr_R8_Rank3(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 3, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 3, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -5724,7 +5724,7 @@ subroutine PackPtr_R8_Rank3(RF, Data) subroutine UnpackPtr_R8_Rank3(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R8Ki), pointer, intent(out) :: Data(:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -5814,7 +5814,7 @@ subroutine PackAlloc_R8_Rank4(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -5826,7 +5826,7 @@ subroutine UnpackAlloc_R8_Rank4(RF, Data) real(R8Ki), allocatable, intent(out) :: Data(:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -5870,7 +5870,7 @@ subroutine PackPtr_R8_Rank4(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 4, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 4, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -5885,7 +5885,7 @@ subroutine PackPtr_R8_Rank4(RF, Data) subroutine UnpackPtr_R8_Rank4(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R8Ki), pointer, intent(out) :: Data(:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated @@ -5975,7 +5975,7 @@ subroutine PackAlloc_R8_Rank5(RF, Data) if (.not. allocated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write data to file call RegPack(RF, Data) @@ -5987,7 +5987,7 @@ subroutine UnpackAlloc_R8_Rank5(RF, Data) real(R8Ki), allocatable, intent(out) :: Data(:,:,:,:,:) integer(IntKi) :: stat logical :: IsAllocated - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) ! If error, return if (RF%ErrStat /= ErrID_None) return @@ -6031,7 +6031,7 @@ subroutine PackPtr_R8_Rank5(RF, Data) if (.not. associated(Data)) return ! Write array bounds - call RegPackBounds(RF, 5, lbound(Data, kind=B8Ki), ubound(Data, kind=B8Ki)) + call RegPackBounds(RF, 5, lbound(Data), ubound(Data)) ! Write pointer info call RegPackPointer(RF, c_loc(Data), PtrInIndex) @@ -6046,7 +6046,7 @@ subroutine PackPtr_R8_Rank5(RF, Data) subroutine UnpackPtr_R8_Rank5(RF, Data, LB, UB) type(RegFile), intent(inout) :: RF real(R8Ki), pointer, intent(out) :: Data(:,:,:,:,:) - integer(B8Ki), intent(out) :: LB(:), UB(:) + integer(B4Ki), intent(out) :: LB(:), UB(:) integer(IntKi) :: stat integer(B8Ki) :: PtrIdx logical :: IsAssociated 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 4228fe4ee2..bedcf6183b 100644 --- a/modules/nwtc-library/src/NWTC_Base.f90 +++ b/modules/nwtc-library/src/NWTC_Base.f90 @@ -40,7 +40,7 @@ MODULE NWTC_Base INTEGER(IntKi), PARAMETER :: MinChanLen = 10 !< The min allowable length of channel names (i.e., width of output columns), used because some modules (like Bladed DLL outputs) have excessively long names INTEGER(IntKi), PARAMETER :: LinChanLen = 200 !< The allowable length of row/column names in linearization files - INTEGER(IntKi), PARAMETER :: MaxFileInfoLineLen = 1024 !< The allowable length of an input line stored in FileInfoType%Lines + INTEGER(IntKi), PARAMETER :: MaxFileInfoLineLen = 8192 !< The allowable length of an input line stored in FileInfoType%Lines INTEGER(IntKi), PARAMETER :: NWTC_Verbose = 10 !< The maximum level of verbosity INTEGER(IntKi), PARAMETER :: NWTC_VerboseLevel = 5 !< a number in [0, NWTC_Verbose]: 0 = no output; NWTC_Verbose=verbose; @@ -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 911e63e131..6bddd1120e 100644 --- a/modules/nwtc-library/src/NWTC_Library_IncSubs.f90 +++ b/modules/nwtc-library/src/NWTC_Library_IncSubs.f90 @@ -58,14 +58,14 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyMeshMapLinearizationType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMeshMapLinearizationTypeData%mi)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%mi, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%mi, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%mi) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%mi) if (.not. allocated(DstMeshMapLinearizationTypeData%mi)) then allocate(DstMeshMapLinearizationTypeData%mi(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -76,8 +76,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%mi = SrcMeshMapLinearizationTypeData%mi end if if (allocated(SrcMeshMapLinearizationTypeData%fx_p)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%fx_p, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%fx_p, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%fx_p) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%fx_p) if (.not. allocated(DstMeshMapLinearizationTypeData%fx_p)) then allocate(DstMeshMapLinearizationTypeData%fx_p(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -88,8 +88,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%fx_p = SrcMeshMapLinearizationTypeData%fx_p end if if (allocated(SrcMeshMapLinearizationTypeData%tv_uD)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%tv_uD, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%tv_uD, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%tv_uD) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%tv_uD) if (.not. allocated(DstMeshMapLinearizationTypeData%tv_uD)) then allocate(DstMeshMapLinearizationTypeData%tv_uD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -100,8 +100,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%tv_uD = SrcMeshMapLinearizationTypeData%tv_uD end if if (allocated(SrcMeshMapLinearizationTypeData%tv_uS)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%tv_uS, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%tv_uS, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%tv_uS) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%tv_uS) if (.not. allocated(DstMeshMapLinearizationTypeData%tv_uS)) then allocate(DstMeshMapLinearizationTypeData%tv_uS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -112,8 +112,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%tv_uS = SrcMeshMapLinearizationTypeData%tv_uS end if if (allocated(SrcMeshMapLinearizationTypeData%ta_uD)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_uD, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_uD, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_uD) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_uD) if (.not. allocated(DstMeshMapLinearizationTypeData%ta_uD)) then allocate(DstMeshMapLinearizationTypeData%ta_uD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -124,8 +124,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%ta_uD = SrcMeshMapLinearizationTypeData%ta_uD end if if (allocated(SrcMeshMapLinearizationTypeData%ta_uS)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_uS, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_uS, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_uS) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_uS) if (.not. allocated(DstMeshMapLinearizationTypeData%ta_uS)) then allocate(DstMeshMapLinearizationTypeData%ta_uS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -136,8 +136,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%ta_uS = SrcMeshMapLinearizationTypeData%ta_uS end if if (allocated(SrcMeshMapLinearizationTypeData%ta_rv)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_rv, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_rv, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%ta_rv) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%ta_rv) if (.not. allocated(DstMeshMapLinearizationTypeData%ta_rv)) then allocate(DstMeshMapLinearizationTypeData%ta_rv(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -148,8 +148,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%ta_rv = SrcMeshMapLinearizationTypeData%ta_rv end if if (allocated(SrcMeshMapLinearizationTypeData%li)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%li, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%li, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%li) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%li) if (.not. allocated(DstMeshMapLinearizationTypeData%li)) then allocate(DstMeshMapLinearizationTypeData%li(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -160,8 +160,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%li = SrcMeshMapLinearizationTypeData%li end if if (allocated(SrcMeshMapLinearizationTypeData%M_uS)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_uS, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_uS, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_uS) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_uS) if (.not. allocated(DstMeshMapLinearizationTypeData%M_uS)) then allocate(DstMeshMapLinearizationTypeData%M_uS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -172,8 +172,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%M_uS = SrcMeshMapLinearizationTypeData%M_uS end if if (allocated(SrcMeshMapLinearizationTypeData%M_uD)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_uD, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_uD, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_uD) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_uD) if (.not. allocated(DstMeshMapLinearizationTypeData%M_uD)) then allocate(DstMeshMapLinearizationTypeData%M_uD(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -184,8 +184,8 @@ subroutine NWTC_Library_CopyMeshMapLinearizationType(SrcMeshMapLinearizationType DstMeshMapLinearizationTypeData%M_uD = SrcMeshMapLinearizationTypeData%M_uD end if if (allocated(SrcMeshMapLinearizationTypeData%M_f)) then - LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_f, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_f, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapLinearizationTypeData%M_f) + UB(1:2) = ubound(SrcMeshMapLinearizationTypeData%M_f) if (.not. allocated(DstMeshMapLinearizationTypeData%M_f)) then allocate(DstMeshMapLinearizationTypeData%M_f(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -262,7 +262,7 @@ subroutine NWTC_Library_UnPackMeshMapLinearizationType(RF, OutData) type(RegFile), intent(inout) :: RF type(MeshMapLinearizationType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMeshMapLinearizationType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -285,16 +285,16 @@ subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyMeshMapType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMeshMapTypeData%MapLoads)) then - LB(1:1) = lbound(SrcMeshMapTypeData%MapLoads, kind=B8Ki) - UB(1:1) = ubound(SrcMeshMapTypeData%MapLoads, kind=B8Ki) + LB(1:1) = lbound(SrcMeshMapTypeData%MapLoads) + UB(1:1) = ubound(SrcMeshMapTypeData%MapLoads) if (.not. allocated(DstMeshMapTypeData%MapLoads)) then allocate(DstMeshMapTypeData%MapLoads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -309,8 +309,8 @@ subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, end do end if if (allocated(SrcMeshMapTypeData%MapMotions)) then - LB(1:1) = lbound(SrcMeshMapTypeData%MapMotions, kind=B8Ki) - UB(1:1) = ubound(SrcMeshMapTypeData%MapMotions, kind=B8Ki) + LB(1:1) = lbound(SrcMeshMapTypeData%MapMotions) + UB(1:1) = ubound(SrcMeshMapTypeData%MapMotions) if (.not. allocated(DstMeshMapTypeData%MapMotions)) then allocate(DstMeshMapTypeData%MapMotions(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -325,8 +325,8 @@ subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, end do end if if (allocated(SrcMeshMapTypeData%MapSrcToAugmt)) then - LB(1:1) = lbound(SrcMeshMapTypeData%MapSrcToAugmt, kind=B8Ki) - UB(1:1) = ubound(SrcMeshMapTypeData%MapSrcToAugmt, kind=B8Ki) + LB(1:1) = lbound(SrcMeshMapTypeData%MapSrcToAugmt) + UB(1:1) = ubound(SrcMeshMapTypeData%MapSrcToAugmt) if (.not. allocated(DstMeshMapTypeData%MapSrcToAugmt)) then allocate(DstMeshMapTypeData%MapSrcToAugmt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -347,8 +347,8 @@ subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv)) then - LB(1:1) = lbound(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv, kind=B8Ki) - UB(1:1) = ubound(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv, kind=B8Ki) + LB(1:1) = lbound(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv) + UB(1:1) = ubound(SrcMeshMapTypeData%LoadLn2_A_Mat_Piv) if (.not. allocated(DstMeshMapTypeData%LoadLn2_A_Mat_Piv)) then allocate(DstMeshMapTypeData%LoadLn2_A_Mat_Piv(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -359,8 +359,8 @@ subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, DstMeshMapTypeData%LoadLn2_A_Mat_Piv = SrcMeshMapTypeData%LoadLn2_A_Mat_Piv end if if (allocated(SrcMeshMapTypeData%DisplacedPosition)) then - LB(1:3) = lbound(SrcMeshMapTypeData%DisplacedPosition, kind=B8Ki) - UB(1:3) = ubound(SrcMeshMapTypeData%DisplacedPosition, kind=B8Ki) + LB(1:3) = lbound(SrcMeshMapTypeData%DisplacedPosition) + UB(1:3) = ubound(SrcMeshMapTypeData%DisplacedPosition) if (.not. allocated(DstMeshMapTypeData%DisplacedPosition)) then allocate(DstMeshMapTypeData%DisplacedPosition(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -371,8 +371,8 @@ subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, DstMeshMapTypeData%DisplacedPosition = SrcMeshMapTypeData%DisplacedPosition end if if (allocated(SrcMeshMapTypeData%LoadLn2_A_Mat)) then - LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_A_Mat, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_A_Mat, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_A_Mat) + UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_A_Mat) if (.not. allocated(DstMeshMapTypeData%LoadLn2_A_Mat)) then allocate(DstMeshMapTypeData%LoadLn2_A_Mat(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -383,8 +383,8 @@ subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, DstMeshMapTypeData%LoadLn2_A_Mat = SrcMeshMapTypeData%LoadLn2_A_Mat end if if (allocated(SrcMeshMapTypeData%LoadLn2_F)) then - LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_F, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_F, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_F) + UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_F) if (.not. allocated(DstMeshMapTypeData%LoadLn2_F)) then allocate(DstMeshMapTypeData%LoadLn2_F(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -395,8 +395,8 @@ subroutine NWTC_Library_CopyMeshMapType(SrcMeshMapTypeData, DstMeshMapTypeData, DstMeshMapTypeData%LoadLn2_F = SrcMeshMapTypeData%LoadLn2_F end if if (allocated(SrcMeshMapTypeData%LoadLn2_M)) then - LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_M, kind=B8Ki) - UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_M, kind=B8Ki) + LB(1:2) = lbound(SrcMeshMapTypeData%LoadLn2_M) + UB(1:2) = ubound(SrcMeshMapTypeData%LoadLn2_M) if (.not. allocated(DstMeshMapTypeData%LoadLn2_M)) then allocate(DstMeshMapTypeData%LoadLn2_M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -415,16 +415,16 @@ subroutine NWTC_Library_DestroyMeshMapType(MeshMapTypeData, ErrStat, ErrMsg) type(MeshMapType), intent(inout) :: MeshMapTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'NWTC_Library_DestroyMeshMapType' ErrStat = ErrID_None ErrMsg = '' if (allocated(MeshMapTypeData%MapLoads)) then - LB(1:1) = lbound(MeshMapTypeData%MapLoads, kind=B8Ki) - UB(1:1) = ubound(MeshMapTypeData%MapLoads, kind=B8Ki) + LB(1:1) = lbound(MeshMapTypeData%MapLoads) + UB(1:1) = ubound(MeshMapTypeData%MapLoads) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMapType(MeshMapTypeData%MapLoads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -432,8 +432,8 @@ subroutine NWTC_Library_DestroyMeshMapType(MeshMapTypeData, ErrStat, ErrMsg) deallocate(MeshMapTypeData%MapLoads) end if if (allocated(MeshMapTypeData%MapMotions)) then - LB(1:1) = lbound(MeshMapTypeData%MapMotions, kind=B8Ki) - UB(1:1) = ubound(MeshMapTypeData%MapMotions, kind=B8Ki) + LB(1:1) = lbound(MeshMapTypeData%MapMotions) + UB(1:1) = ubound(MeshMapTypeData%MapMotions) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMapType(MeshMapTypeData%MapMotions(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -441,8 +441,8 @@ subroutine NWTC_Library_DestroyMeshMapType(MeshMapTypeData, ErrStat, ErrMsg) deallocate(MeshMapTypeData%MapMotions) end if if (allocated(MeshMapTypeData%MapSrcToAugmt)) then - LB(1:1) = lbound(MeshMapTypeData%MapSrcToAugmt, kind=B8Ki) - UB(1:1) = ubound(MeshMapTypeData%MapSrcToAugmt, kind=B8Ki) + LB(1:1) = lbound(MeshMapTypeData%MapSrcToAugmt) + UB(1:1) = ubound(MeshMapTypeData%MapSrcToAugmt) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMapType(MeshMapTypeData%MapSrcToAugmt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -476,32 +476,32 @@ subroutine NWTC_Library_PackMeshMapType(RF, Indata) type(RegFile), intent(inout) :: RF type(MeshMapType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackMeshMapType' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%MapLoads)) if (allocated(InData%MapLoads)) then - call RegPackBounds(RF, 1, lbound(InData%MapLoads, kind=B8Ki), ubound(InData%MapLoads, kind=B8Ki)) - LB(1:1) = lbound(InData%MapLoads, kind=B8Ki) - UB(1:1) = ubound(InData%MapLoads, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MapLoads), ubound(InData%MapLoads)) + LB(1:1) = lbound(InData%MapLoads) + UB(1:1) = ubound(InData%MapLoads) do i1 = LB(1), UB(1) call NWTC_Library_PackMapType(RF, InData%MapLoads(i1)) end do end if call RegPack(RF, allocated(InData%MapMotions)) if (allocated(InData%MapMotions)) then - call RegPackBounds(RF, 1, lbound(InData%MapMotions, kind=B8Ki), ubound(InData%MapMotions, kind=B8Ki)) - LB(1:1) = lbound(InData%MapMotions, kind=B8Ki) - UB(1:1) = ubound(InData%MapMotions, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MapMotions), ubound(InData%MapMotions)) + LB(1:1) = lbound(InData%MapMotions) + UB(1:1) = ubound(InData%MapMotions) do i1 = LB(1), UB(1) call NWTC_Library_PackMapType(RF, InData%MapMotions(i1)) end do end if call RegPack(RF, allocated(InData%MapSrcToAugmt)) if (allocated(InData%MapSrcToAugmt)) then - call RegPackBounds(RF, 1, lbound(InData%MapSrcToAugmt, kind=B8Ki), ubound(InData%MapSrcToAugmt, kind=B8Ki)) - LB(1:1) = lbound(InData%MapSrcToAugmt, kind=B8Ki) - UB(1:1) = ubound(InData%MapSrcToAugmt, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MapSrcToAugmt), ubound(InData%MapSrcToAugmt)) + LB(1:1) = lbound(InData%MapSrcToAugmt) + UB(1:1) = ubound(InData%MapSrcToAugmt) do i1 = LB(1), UB(1) call NWTC_Library_PackMapType(RF, InData%MapSrcToAugmt(i1)) end do @@ -521,8 +521,8 @@ subroutine NWTC_Library_UnPackMeshMapType(RF, OutData) type(RegFile), intent(inout) :: RF type(MeshMapType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackMeshMapType' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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 14ecb2c8a4..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 @@ -225,7 +264,7 @@ subroutine NWTC_Library_CopyFASTdataType(SrcFASTdataTypeData, DstFASTdataTypeDat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyFASTdataType' ErrStat = ErrID_None @@ -236,8 +275,8 @@ subroutine NWTC_Library_CopyFASTdataType(SrcFASTdataTypeData, DstFASTdataTypeDat DstFASTdataTypeData%NumRecs = SrcFASTdataTypeData%NumRecs DstFASTdataTypeData%TimeStep = SrcFASTdataTypeData%TimeStep if (allocated(SrcFASTdataTypeData%ChanNames)) then - LB(1:1) = lbound(SrcFASTdataTypeData%ChanNames, kind=B8Ki) - UB(1:1) = ubound(SrcFASTdataTypeData%ChanNames, kind=B8Ki) + LB(1:1) = lbound(SrcFASTdataTypeData%ChanNames) + UB(1:1) = ubound(SrcFASTdataTypeData%ChanNames) if (.not. allocated(DstFASTdataTypeData%ChanNames)) then allocate(DstFASTdataTypeData%ChanNames(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -248,8 +287,8 @@ subroutine NWTC_Library_CopyFASTdataType(SrcFASTdataTypeData, DstFASTdataTypeDat DstFASTdataTypeData%ChanNames = SrcFASTdataTypeData%ChanNames end if if (allocated(SrcFASTdataTypeData%ChanUnits)) then - LB(1:1) = lbound(SrcFASTdataTypeData%ChanUnits, kind=B8Ki) - UB(1:1) = ubound(SrcFASTdataTypeData%ChanUnits, kind=B8Ki) + LB(1:1) = lbound(SrcFASTdataTypeData%ChanUnits) + UB(1:1) = ubound(SrcFASTdataTypeData%ChanUnits) if (.not. allocated(DstFASTdataTypeData%ChanUnits)) then allocate(DstFASTdataTypeData%ChanUnits(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -260,8 +299,8 @@ subroutine NWTC_Library_CopyFASTdataType(SrcFASTdataTypeData, DstFASTdataTypeDat DstFASTdataTypeData%ChanUnits = SrcFASTdataTypeData%ChanUnits end if if (allocated(SrcFASTdataTypeData%Data)) then - LB(1:2) = lbound(SrcFASTdataTypeData%Data, kind=B8Ki) - UB(1:2) = ubound(SrcFASTdataTypeData%Data, kind=B8Ki) + LB(1:2) = lbound(SrcFASTdataTypeData%Data) + UB(1:2) = ubound(SrcFASTdataTypeData%Data) if (.not. allocated(DstFASTdataTypeData%Data)) then allocate(DstFASTdataTypeData%Data(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -311,7 +350,7 @@ subroutine NWTC_Library_UnPackFASTdataType(RF, OutData) type(RegFile), intent(inout) :: RF type(FASTdataType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackFASTdataType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -378,7 +417,7 @@ subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeDat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyFileInfoType' ErrStat = ErrID_None @@ -386,8 +425,8 @@ subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeDat DstFileInfoTypeData%NumLines = SrcFileInfoTypeData%NumLines DstFileInfoTypeData%NumFiles = SrcFileInfoTypeData%NumFiles if (allocated(SrcFileInfoTypeData%FileLine)) then - LB(1:1) = lbound(SrcFileInfoTypeData%FileLine, kind=B8Ki) - UB(1:1) = ubound(SrcFileInfoTypeData%FileLine, kind=B8Ki) + LB(1:1) = lbound(SrcFileInfoTypeData%FileLine) + UB(1:1) = ubound(SrcFileInfoTypeData%FileLine) if (.not. allocated(DstFileInfoTypeData%FileLine)) then allocate(DstFileInfoTypeData%FileLine(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -398,8 +437,8 @@ subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeDat DstFileInfoTypeData%FileLine = SrcFileInfoTypeData%FileLine end if if (allocated(SrcFileInfoTypeData%FileIndx)) then - LB(1:1) = lbound(SrcFileInfoTypeData%FileIndx, kind=B8Ki) - UB(1:1) = ubound(SrcFileInfoTypeData%FileIndx, kind=B8Ki) + LB(1:1) = lbound(SrcFileInfoTypeData%FileIndx) + UB(1:1) = ubound(SrcFileInfoTypeData%FileIndx) if (.not. allocated(DstFileInfoTypeData%FileIndx)) then allocate(DstFileInfoTypeData%FileIndx(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -410,8 +449,8 @@ subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeDat DstFileInfoTypeData%FileIndx = SrcFileInfoTypeData%FileIndx end if if (allocated(SrcFileInfoTypeData%FileList)) then - LB(1:1) = lbound(SrcFileInfoTypeData%FileList, kind=B8Ki) - UB(1:1) = ubound(SrcFileInfoTypeData%FileList, kind=B8Ki) + LB(1:1) = lbound(SrcFileInfoTypeData%FileList) + UB(1:1) = ubound(SrcFileInfoTypeData%FileList) if (.not. allocated(DstFileInfoTypeData%FileList)) then allocate(DstFileInfoTypeData%FileList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -422,8 +461,8 @@ subroutine NWTC_Library_CopyFileInfoType(SrcFileInfoTypeData, DstFileInfoTypeDat DstFileInfoTypeData%FileList = SrcFileInfoTypeData%FileList end if if (allocated(SrcFileInfoTypeData%Lines)) then - LB(1:1) = lbound(SrcFileInfoTypeData%Lines, kind=B8Ki) - UB(1:1) = ubound(SrcFileInfoTypeData%Lines, kind=B8Ki) + LB(1:1) = lbound(SrcFileInfoTypeData%Lines) + UB(1:1) = ubound(SrcFileInfoTypeData%Lines) if (.not. allocated(DstFileInfoTypeData%Lines)) then allocate(DstFileInfoTypeData%Lines(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -474,7 +513,7 @@ subroutine NWTC_Library_UnPackFileInfoType(RF, OutData) type(RegFile), intent(inout) :: RF type(FileInfoType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackFileInfoType' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -533,7 +572,7 @@ subroutine NWTC_Library_CopyNWTC_RandomNumber_ParameterType(SrcNWTC_RandomNumber integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'NWTC_Library_CopyNWTC_RandomNumber_ParameterType' ErrStat = ErrID_None @@ -541,8 +580,8 @@ subroutine NWTC_Library_CopyNWTC_RandomNumber_ParameterType(SrcNWTC_RandomNumber DstNWTC_RandomNumber_ParameterTypeData%pRNG = SrcNWTC_RandomNumber_ParameterTypeData%pRNG DstNWTC_RandomNumber_ParameterTypeData%RandSeed = SrcNWTC_RandomNumber_ParameterTypeData%RandSeed if (allocated(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) then - LB(1:1) = lbound(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry, kind=B8Ki) - UB(1:1) = ubound(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry, kind=B8Ki) + LB(1:1) = lbound(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry) + UB(1:1) = ubound(SrcNWTC_RandomNumber_ParameterTypeData%RandSeedAry) if (.not. allocated(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry)) then allocate(DstNWTC_RandomNumber_ParameterTypeData%RandSeedAry(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -583,7 +622,7 @@ subroutine NWTC_Library_UnPackNWTC_RandomNumber_ParameterType(RF, OutData) type(RegFile), intent(inout) :: RF type(NWTC_RandomNumber_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackNWTC_RandomNumber_ParameterType' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -593,79 +632,93 @@ 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 integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki) - UB(1:1) = ubound(SrcModVarTypeData%iLoc, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcModVarTypeData%iSol, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcModVarTypeData%iLin, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcModVarTypeData%iq, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcModVarTypeData%LinNames, kind=B8Ki) + LB(1:1) = lbound(SrcModVarTypeData%LinNames) + UB(1:1) = ubound(SrcModVarTypeData%LinNames) if (.not. allocated(DstModVarTypeData%LinNames)) then allocate(DstModVarTypeData%LinNames(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -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 @@ -729,25 +776,27 @@ subroutine NWTC_Library_UnPackModVarType(RF, OutData) type(RegFile), intent(inout) :: RF type(ModVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModVarType' - integer(B8Ki) :: LB(1), UB(1) + 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 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 @@ -757,18 +806,20 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 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, kind=B8Ki) - UB(1:1) = ubound(SrcModVarsTypeData%x, kind=B8Ki) + LB(1:1) = lbound(SrcModVarsTypeData%x) + UB(1:1) = ubound(SrcModVarsTypeData%x) if (.not. allocated(DstModVarsTypeData%x)) then allocate(DstModVarsTypeData%x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -782,9 +833,25 @@ 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, kind=B8Ki) - UB(1:1) = ubound(SrcModVarsTypeData%u, kind=B8Ki) + LB(1:1) = lbound(SrcModVarsTypeData%u) + UB(1:1) = ubound(SrcModVarsTypeData%u) if (.not. allocated(DstModVarsTypeData%u)) then allocate(DstModVarsTypeData%u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -799,8 +866,8 @@ subroutine NWTC_Library_CopyModVarsType(SrcModVarsTypeData, DstModVarsTypeData, end do end if if (allocated(SrcModVarsTypeData%y)) then - LB(1:1) = lbound(SrcModVarsTypeData%y, kind=B8Ki) - UB(1:1) = ubound(SrcModVarsTypeData%y, kind=B8Ki) + LB(1:1) = lbound(SrcModVarsTypeData%y) + UB(1:1) = ubound(SrcModVarsTypeData%y) if (.not. allocated(DstModVarsTypeData%y)) then allocate(DstModVarsTypeData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -814,34 +881,40 @@ 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) type(ModVarsType), intent(inout) :: ModVarsTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'NWTC_Library_DestroyModVarsType' ErrStat = ErrID_None ErrMsg = '' if (allocated(ModVarsTypeData%x)) then - LB(1:1) = lbound(ModVarsTypeData%x, kind=B8Ki) - UB(1:1) = ubound(ModVarsTypeData%x, kind=B8Ki) + LB(1:1) = lbound(ModVarsTypeData%x) + UB(1:1) = ubound(ModVarsTypeData%x) do i1 = LB(1), UB(1) call NWTC_Library_DestroyModVarType(ModVarsTypeData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) 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, kind=B8Ki) - UB(1:1) = ubound(ModVarsTypeData%u, kind=B8Ki) + LB(1:1) = lbound(ModVarsTypeData%u) + UB(1:1) = ubound(ModVarsTypeData%u) do i1 = LB(1), UB(1) call NWTC_Library_DestroyModVarType(ModVarsTypeData%u(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -849,8 +922,8 @@ subroutine NWTC_Library_DestroyModVarsType(ModVarsTypeData, ErrStat, ErrMsg) deallocate(ModVarsTypeData%u) end if if (allocated(ModVarsTypeData%y)) then - LB(1:1) = lbound(ModVarsTypeData%y, kind=B8Ki) - UB(1:1) = ubound(ModVarsTypeData%y, kind=B8Ki) + LB(1:1) = lbound(ModVarsTypeData%y) + UB(1:1) = ubound(ModVarsTypeData%y) do i1 = LB(1), UB(1) call NWTC_Library_DestroyModVarType(ModVarsTypeData%y(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -863,41 +936,49 @@ subroutine NWTC_Library_PackModVarsType(RF, Indata) type(RegFile), intent(inout) :: RF type(ModVarsType), intent(in) :: InData character(*), parameter :: RoutineName = 'NWTC_Library_PackModVarsType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + 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 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, kind=B8Ki), ubound(InData%u, kind=B8Ki)) - LB(1:1) = lbound(InData%u, kind=B8Ki) - UB(1:1) = ubound(InData%u, kind=B8Ki) + 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 NWTC_Library_PackModVarType(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, kind=B8Ki), ubound(InData%y, kind=B8Ki)) - LB(1:1) = lbound(InData%y, kind=B8Ki) - UB(1:1) = ubound(InData%y, kind=B8Ki) + 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 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 @@ -905,13 +986,15 @@ subroutine NWTC_Library_UnPackModVarsType(RF, OutData) type(RegFile), intent(inout) :: RF type(ModVarsType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'NWTC_Library_UnPackModVarsType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) 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(B8Ki) :: LB(2), UB(2) + 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, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%dxdt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%u, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%y, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%u_perturb, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%x_perturb, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%xp, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%xn, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%yp, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcModValsTypeData%yn, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcModValsTypeData%dYdx, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcModValsTypeData%dXdx, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcModValsTypeData%dYdu, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcModValsTypeData%dXdu, kind=B8Ki) - 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' - integer(B8Ki) :: LB(2), UB(2) + 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(B8Ki) :: 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, kind=B8Ki) - UB(1:2) = ubound(SrcModDataTypeData%ixs, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcModDataTypeData%ius, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcModDataTypeData%iys, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcModDataTypeData%SrcMaps, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcModDataTypeData%DstMaps, kind=B8Ki) - 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(B8Ki) :: 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 ad59aff85c..e4a74c31d1 100644 --- a/modules/nwtc-library/src/NWTC_Num.f90 +++ b/modules/nwtc-library/src/NWTC_Num.f90 @@ -504,7 +504,7 @@ END SUBROUTINE ConvertUnitsToEngr !> This function computes the cross product of two 3-element arrays (resulting in a vector): \n !! cross_product = Vector1 \f$\times\f$ Vector2 \n !! Use cross_product (nwtc_num::cross_product) instead of directly calling a specific routine in the generic interface. - FUNCTION Cross_ProductR4(Vector1, Vector2) result(CProd) + PURE FUNCTION Cross_ProductR4(Vector1, Vector2) result(CProd) ! Argument declarations. @@ -524,7 +524,7 @@ FUNCTION Cross_ProductR4(Vector1, Vector2) result(CProd) END FUNCTION Cross_ProductR4 !======================================================================= !> \copydoc nwtc_num::cross_productr4 - FUNCTION Cross_ProductR4R8(Vector1, Vector2) result(CProd) + PURE FUNCTION Cross_ProductR4R8(Vector1, Vector2) result(CProd) ! Argument declarations. @@ -544,7 +544,7 @@ FUNCTION Cross_ProductR4R8(Vector1, Vector2) result(CProd) END FUNCTION Cross_ProductR4R8 !======================================================================= !> \copydoc nwtc_num::cross_productr4 - FUNCTION Cross_ProductR8(Vector1, Vector2) result(CProd) + PURE FUNCTION Cross_ProductR8(Vector1, Vector2) result(CProd) ! Argument declarations. @@ -564,7 +564,7 @@ FUNCTION Cross_ProductR8(Vector1, Vector2) result(CProd) END FUNCTION Cross_ProductR8 !======================================================================= !> \copydoc nwtc_num::cross_productr4 - FUNCTION Cross_ProductR8R4(Vector1, Vector2) result(CProd) + PURE FUNCTION Cross_ProductR8R4(Vector1, Vector2) result(CProd) ! Argument declarations. @@ -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 d7d4de29ee..78921cf0c8 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -6,38 +6,38 @@ #............................................................. -typedef NWTC_Library ProgDesc CHARACTER(99) Name - - - "Name of the program or module" -typedef ^ ^ CHARACTER(99) Ver - - - "Version number of the program or module" -typedef ^ ^ CHARACTER(24) Date - - - "String containing date module was last updated" - -typedef NWTC_Library FASTdataType CHARACTER(1024) File - - - "Name of the FAST-style binary file" -typedef ^ ^ CHARACTER(1024) Descr - - - "String describing file" -typedef ^ ^ IntKi NumChans - - - "Number of output channels in this binary file (not including the time channel)" -typedef ^ ^ IntKi NumRecs - - - "Number of records (rows) of data in the file" -typedef ^ ^ DbKi TimeStep - - - "Time step for evenly-spaced data in the output file (when NumRecs is not allo" -typedef ^ ^ CHARACTER(ChanLen) ChanNames {:} - - "Strings describing the names of the channels from the binary file (including the time channel)" -typedef ^ ^ CHARACTER(ChanLen) ChanUnits {:} - - "Strings describing the units of the channels from the binary file (including the time channel)" -typedef ^ ^ ReKi Data {:}{:} - - "numeric data (rows and columns) from the binary file, including the time channel" - -typedef NWTC_Library OutParmType IntKi Indx - - - "An index into AllOuts array where this channel is computed/stored" -typedef ^ ^ CHARACTER(ChanLen) Name - - - "Name of the output channel" -typedef ^ ^ CHARACTER(ChanLen) Units - - - "Units this channel is specified in" -typedef ^ ^ IntKi SignM - - - "Multiplier for output channel; usually -1 (minus) or 0 (invalid channel)" - -typedef NWTC_Library FileInfoType IntKi NumLines -typedef ^ ^ IntKi NumFiles -typedef ^ ^ IntKi FileLine {:} -typedef ^ ^ IntKi FileIndx {:} +typedef NWTC_Library ProgDesc CHARACTER(99) Name - - - "Name of the program or module" +typedef ^ ^ CHARACTER(99) Ver - - - "Version number of the program or module" +typedef ^ ^ CHARACTER(24) Date - - - "String containing date module was last updated" + +typedef NWTC_Library FASTdataType CHARACTER(1024) File - - - "Name of the FAST-style binary file" +typedef ^ ^ CHARACTER(1024) Descr - - - "String describing file" +typedef ^ ^ IntKi NumChans - - - "Number of output channels in this binary file (not including the time channel)" +typedef ^ ^ IntKi NumRecs - - - "Number of records (rows) of data in the file" +typedef ^ ^ DbKi TimeStep - - - "Time step for evenly-spaced data in the output file (when NumRecs is not allo" +typedef ^ ^ CHARACTER(ChanLen) ChanNames {:} - - "Strings describing the names of the channels from the binary file (including the time channel)" +typedef ^ ^ CHARACTER(ChanLen) ChanUnits {:} - - "Strings describing the units of the channels from the binary file (including the time channel)" +typedef ^ ^ ReKi Data {:}{:} - - "numeric data (rows and columns) from the binary file, including the time channel" + +typedef NWTC_Library OutParmType IntKi Indx - - - "An index into AllOuts array where this channel is computed/stored" +typedef ^ ^ CHARACTER(ChanLen) Name - - - "Name of the output channel" +typedef ^ ^ CHARACTER(ChanLen) Units - - - "Units this channel is specified in" +typedef ^ ^ IntKi SignM - - - "Multiplier for output channel; usually -1 (minus) or 0 (invalid channel)" + +typedef NWTC_Library FileInfoType IntKi NumLines +typedef ^ ^ IntKi NumFiles +typedef ^ ^ IntKi FileLine {:} +typedef ^ ^ IntKi FileIndx {:} typedef ^ ^ CHARACTER(MaxFileInfoLineLen) FileList {:} typedef ^ ^ CHARACTER(MaxFileInfoLineLen) Lines {:} -typedef NWTC_Library Quaternion ReKi q0 -typedef ^ ^ ReKi v {3} +typedef NWTC_Library Quaternion ReKi q0 +typedef ^ ^ ReKi v {3} -typedef NWTC_Library NWTC_RandomNumber_ParameterType IntKi pRNG -typedef ^ ^ IntKi RandSeed {3} -typedef ^ ^ IntKi RandSeedAry {:} -typedef ^ ^ CHARACTER(6) RNG_type +typedef NWTC_Library NWTC_RandomNumber_ParameterType IntKi pRNG +typedef ^ ^ IntKi RandSeed {3} +typedef ^ ^ IntKi RandSeedAry {:} +typedef ^ ^ CHARACTER(6) RNG_type #------------------------------------------------------------------------------- # Module Variables @@ -45,83 +45,114 @@ typedef ^ ^ CHARACTER(6) RNG_t 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 @@ -133,22 +164,22 @@ typedef ^ ^ IntKi DstMaps : - - #BJJ: the following three types will actually be placed in the ModMesh_Mapping.f90 file instead of NWTC_Library_Types.f90 -typedef NWTC_Library MapType IntKi OtherMesh_Element - - - "Node (for point meshes) or Element (for line2 meshes) number on other mesh; for loads, other mesh is Dest, for motions/scalars, other mesh is Src" +typedef NWTC_Library MapType IntKi OtherMesh_Element - - - "Node (for point meshes) or Element (for line2 meshes) number on other mesh; for loads, other mesh is Dest, for motions/scalars, other mesh is Src" - typedef ^ ^ R8Ki distance - - - "Magnitude of couple_arm" m typedef ^ ^ R8Ki couple_arm {3} - - "Vector between a point and node 1 of an element (p_ODR - p_OSR)" m typedef ^ ^ R8Ki shape_fn {2} - - "shape functions: 1-D element-level location [0,1] based on closest-line projection of point" - -typedef NWTC_Library MeshMapLinearizationType R8Ki mi {:}{:} - - "block matrix of motions that reflects identity (i.e., solely the mapping of one quantity to itself on another mesh)" -typedef ^ ^ R8Ki fx_p {:}{:} - - "block matrix of motions that reflects skew-symmetric (cross-product) matrix" -typedef ^ ^ R8Ki tv_uD {:}{:} - - "block matrix of translational velocity that is multiplied by destination translational displacement" -typedef ^ ^ R8Ki tv_uS {:}{:} - - "block matrix of translational velocity that is multiplied by source translational displacement" -typedef ^ ^ R8Ki ta_uD {:}{:} - - "block matrix of translational acceleration that is multiplied by destination translational displacement" -typedef ^ ^ R8Ki ta_uS {:}{:} - - "block matrix of translational acceleration that is multiplied by source translational displacement" -typedef ^ ^ R8Ki ta_rv {:}{:} - - "block matrix of translational acceleration that is multiplied by omega (RotationVel)" -typedef ^ ^ R8Ki li {:}{:} - - "block matrix of loads that reflects identity (i.e., solely the mapping on one quantity to itself on another mesh)" -typedef ^ ^ R8Ki M_uS {:}{:} - - "block matrix of moment that is multiplied by Source u (translationDisp)" -typedef ^ ^ R8Ki M_uD {:}{:} - - "block matrix of moment that is multiplied by Destination u (translationDisp)" -typedef ^ ^ R8Ki M_f {:}{:} - - "block matrix of moment that is multiplied by force" +typedef NWTC_Library MeshMapLinearizationType R8Ki mi {:}{:} - - "block matrix of motions that reflects identity (i.e., solely the mapping of one quantity to itself on another mesh)" +typedef ^ ^ R8Ki fx_p {:}{:} - - "block matrix of motions that reflects skew-symmetric (cross-product) matrix" +typedef ^ ^ R8Ki tv_uD {:}{:} - - "block matrix of translational velocity that is multiplied by destination translational displacement" +typedef ^ ^ R8Ki tv_uS {:}{:} - - "block matrix of translational velocity that is multiplied by source translational displacement" +typedef ^ ^ R8Ki ta_uD {:}{:} - - "block matrix of translational acceleration that is multiplied by destination translational displacement" +typedef ^ ^ R8Ki ta_uS {:}{:} - - "block matrix of translational acceleration that is multiplied by source translational displacement" +typedef ^ ^ R8Ki ta_rv {:}{:} - - "block matrix of translational acceleration that is multiplied by omega (RotationVel)" +typedef ^ ^ R8Ki li {:}{:} - - "block matrix of loads that reflects identity (i.e., solely the mapping on one quantity to itself on another mesh)" +typedef ^ ^ R8Ki M_uS {:}{:} - - "block matrix of moment that is multiplied by Source u (translationDisp)" +typedef ^ ^ R8Ki M_uD {:}{:} - - "block matrix of moment that is multiplied by Destination u (translationDisp)" +typedef ^ ^ R8Ki M_f {:}{:} - - "block matrix of moment that is multiplied by force" typedef NWTC_Library MeshMapType MapType MapLoads {:} - - "mapping data structure for load fields on the mesh" typedef ^ ^ MapType MapMotions {:} - - "mapping data structure for motion and/or scalar fields on the mesh" @@ -160,6 +191,5 @@ typedef ^ ^ R8Ki DisplacedPo typedef ^ ^ R8Ki LoadLn2_A_Mat {:}{:} - - "The 3-components of the forces for each node of an element in the point-to-line load mapping (for each element)" typedef ^ ^ R8Ki LoadLn2_F {:}{:} - - "The 6-by-6 matrix that makes up the diagonal of the [A 0; B A] matrix in the point-to-line load mapping" typedef ^ ^ R8Ki LoadLn2_M {:}{:} - - "The 3-components of the moments for each node of an element in the point-to-line load mapping (for each element)" -typedef ^ ^ MeshMapLinearizationType dM -#typedef ^ ^ MeshType Lumped_Points_Dest - - - "temporary mesh for debugging the lumped values in the line2-to-line2" - +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/nwtc-library/src/VTK.f90 b/modules/nwtc-library/src/VTK.f90 index e56ad540b5..19f3d967a9 100644 --- a/modules/nwtc-library/src/VTK.f90 +++ b/modules/nwtc-library/src/VTK.f90 @@ -157,8 +157,10 @@ SUBROUTINE ReadVTK_SP_info( FileName, descr, dims, origin, gridSpacing, vecLabel closeOnReturn = .FALSE. END IF + !$OMP critical CALL GetNewUnit( Un, ErrStat, ErrMsg ) CALL OpenFInpFile ( Un, TRIM(FileName), ErrStat, ErrMsg ) + !$OMP end critical if (ErrStat >= AbortErrLev) return CALL ReadCom( Un, FileName, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, 0 ) @@ -357,8 +359,10 @@ SUBROUTINE WrVTK_SP_header( FileName, descr, Un, ErrStat, ErrMsg ) INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< error level/status of OpenFOutFile operation CHARACTER(*) , INTENT( OUT) :: ErrMsg !< message when error occurs + !$OMP critical CALL GetNewUnit( Un, ErrStat, ErrMsg ) CALL OpenFOutFile ( Un, TRIM(FileName), ErrStat, ErrMsg ) + !$OMP end critical if (ErrStat >= AbortErrLev) return WRITE(Un,'(A)') '# vtk DataFile Version 3.0' 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..f25d246e1d --- /dev/null +++ b/modules/openfast-library/src/FAST_AeroMap.f90 @@ -0,0 +1,1251 @@ +!********************************************************************************************************************************** +! 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 + +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%WriteOutput, 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(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%NumBl + T%ED%x(STATE_CURR)%QT(DOF_BF(j, 1)) = T%ED%x(STATE_CURR)%QT(DOF_BF(1, 1)) + T%ED%x(STATE_CURR)%QT(DOF_BF(j, 2)) = T%ED%x(STATE_CURR)%QT(DOF_BF(1, 2)) + T%ED%x(STATE_CURR)%QT(DOF_BE(j, 1)) = T%ED%x(STATE_CURR)%QT(DOF_BE(1, 1)) + end do + + ! Set velocities to zero + do j = 1, T%ED%p%NumBl + T%ED%x(STATE_CURR)%QDT(DOF_BF(j, 1)) = 0.0_R8Ki + T%ED%x(STATE_CURR)%QDT(DOF_BF(j, 2)) = 0.0_R8Ki + T%ED%x(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)%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)%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 + +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..b369a0da47 --- /dev/null +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -0,0 +1,1796 @@ +!******************************************************************************* +! 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:), T%ED%InputTimes, T%ED%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call ED_CopyInput(T%ED%Input(j), T%ED%Input(j + 1), MESH_UPDATECOPY, Errstat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%ED%InputTimes) + + 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 = 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), T%ED%p, & + T%ED%x(iState), T%ED%xd(iState), T%ED%z(iState), T%ED%OtherSt(iState), & + T%ED%y, T%ED%m, 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), u_op) + call ED_PackExtInputAry(ModData%Vars, T%ED%Input(iInput), 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, 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(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%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), T%ED%p, T%ED%x(iState), & + T%ED%xd(iState), T%ED%z(iState), T%ED%OtherSt(iState), & + T%ED%m, T%ED%m%dxdt_lin, ErrStat2, ErrMsg2) + if (Failed()) return + call ED_VarsPackContStateDeriv(ModData%Vars, T%ED%m%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(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)) + 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(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(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), T%ED%p, T%ED%x(iState), T%ED%xd(iState), & + T%ED%z(iState), T%ED%OtherSt(iState), T%ED%y, T%ED%m, 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), T%ED%p, & + T%ED%x(iState), T%ED%xd(iState), & + T%ED%z(iState), T%ED%OtherSt(iState), & + T%ED%y, T%ED%m, 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(iSrc), T%ED%x(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyDiscState(T%ED%xd(iSrc), T%ED%xd(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyConstrState(T%ED%z(iSrc), T%ED%z(iDst), CtrlCode, Errstat2, ErrMsg2); if (Failed()) return + call ED_CopyOtherState(T%ED%OtherSt(iSrc), T%ED%OtherSt(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), T%ED%Input(iDst), 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 + +end module diff --git a/modules/openfast-library/src/FAST_Library.f90 b/modules/openfast-library/src/FAST_Library.f90 index 6a957dcf6f..445c61b899 100644 --- a/modules/openfast-library/src/FAST_Library.f90 +++ b/modules/openfast-library/src/FAST_Library.f90 @@ -311,7 +311,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 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..bc251e2f01 --- /dev/null +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -0,0 +1,3381 @@ +!********************************************************************************************************************************** +! 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), 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, 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%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)%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%TowerLn2Mesh, Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Determine mesh transfer type and save to mapping + Mapping%XfrType = MeshTransferType(Turbine%ED%y%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)%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%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%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%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%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%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%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%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, Turbine%ED%p%NumBl + 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%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%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%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)) + 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, 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%RotSpeed + T%ADsk%Input(iInput)%BlPitch = T%ED%y%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 + omega_c = T%ED%y%RotSpeed * T%ED%y%HubPtMotion%Orientation(1,:,1) + r_hub = T%ED%y%HubPtMotion%Position(:,1) + T%ED%y%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)%GenTrq = T%SrvD%y%GenTrq + T%ED%Input(iInput)%HSSBrTrqC = T%SrvD%y%HSSBrTrqC + T%ED%Input(iInput)%BlPitchCom = T%SrvD%y%BlPitchCom + T%ED%Input(iInput)%YawMom = T%SrvD%y%YawMom + + case (Custom_ED_Tower_Damping) + + ! Get tower velocities at load mesh locations + call TransferMesh(Mapping%XfrType, T%ED%y%TowerLn2Mesh, Mapping%TmpMotionMesh, Mapping%MeshMap, ErrStat=ErrStat2, ErrMsg=ErrMsg2) + if (Failed()) return + + ! Apply damping force as Twr_Kdmp*(node velocity) + T%ED%Input(iInput)%TowerPtLoads%Force = T%ED%Input(iInput)%TowerPtLoads%Force - T%p_FAST%Twr_Kdmp * Mapping%TmpMotionMesh%TranslationVel + + case (Custom_ED_Blade_Damping) + + ! Get rotational velocity and current hub position + omega_c = T%ED%y%RotSpeed * T%ED%y%HubPtMotion%Orientation(1,:,1) + r_hub = T%ED%y%HubPtMotion%Position(:,1) + T%ED%y%HubPtMotion%TranslationDisp(:,1) + + ! Get blade velocities at load mesh locations + call TransferMesh(Mapping%XfrType, T%ED%y%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)%BladePtLoads(Mapping%i)%Force = T%ED%Input(iInput)%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%LSSTipPxa + T%ExtLd%u%DX_u%bldPitch(:) = T%ED%y%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%HubPtMotion%Position(:, 1) + & + T%ED%y%HubPtMotion%TranslationDisp(:, 1) + T%IfW%Input(iInput)%HubOrientation = T%ED%y%HubPtMotion%Orientation(:, :, 1) + + ! Set Lidar position directly from hub motion mesh + T%IfW%Input(iInput)%lidar%HubDisplacementX = T%ED%y%HubPtMotion%TranslationDisp(1, 1) + T%IfW%Input(iInput)%lidar%HubDisplacementY = T%ED%y%HubPtMotion%TranslationDisp(2, 1) + T%IfW%Input(iInput)%lidar%HubDisplacementZ = T%ED%y%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) + + T%SrvD%Input(iInput)%RootMxc(Mapping%SrcIns) = T%BD%y(Mapping%SrcIns)%RootMxr*cos(T%ED%y%BlPitch(Mapping%SrcIns)) + & + T%BD%y(Mapping%SrcIns)%RootMyr*sin(T%ED%y%BlPitch(Mapping%SrcIns)) + T%SrvD%Input(iInput)%RootMyc(Mapping%SrcIns) = -T%BD%y(Mapping%SrcIns)%RootMxr*sin(T%ED%y%BlPitch(Mapping%SrcIns)) + & + T%BD%y(Mapping%SrcIns)%RootMyr*cos(T%ED%y%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%RootMxc ! fixed-size arrays: always size 3 + T%SrvD%Input(iInput)%RootMyc = T%ED%y%RootMyc ! fixed-size arrays: always size 3 + end if + + T%SrvD%Input(iInput)%YawAngle = T%ED%y%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%BlPitch + T%SrvD%Input(iInput)%LSS_Spd = T%ED%y%LSS_Spd + T%SrvD%Input(iInput)%RotSpeed = T%ED%y%RotSpeed + + T%SrvD%Input(iInput)%YawBrTAxp = T%ED%y%YawBrTAxp + T%SrvD%Input(iInput)%YawBrTAyp = T%ED%y%YawBrTAyp + T%SrvD%Input(iInput)%LSSTipPxa = T%ED%y%LSSTipPxa + + T%SrvD%Input(iInput)%LSSTipMxa = T%ED%y%LSSTipMxa + T%SrvD%Input(iInput)%LSSTipMya = T%ED%y%LSSTipMya + T%SrvD%Input(iInput)%LSSTipMza = T%ED%y%LSSTipMza + T%SrvD%Input(iInput)%LSSTipMys = T%ED%y%LSSTipMys + T%SrvD%Input(iInput)%LSSTipMzs = T%ED%y%LSSTipMzs + + T%SrvD%Input(iInput)%YawBrMyn = T%ED%y%YawBrMyn + T%SrvD%Input(iInput)%YawBrMzn = T%ED%y%YawBrMzn + T%SrvD%Input(iInput)%NcIMURAxs = T%ED%y%NcIMURAxs + T%SrvD%Input(iInput)%NcIMURAys = T%ED%y%NcIMURAys + T%SrvD%Input(iInput)%NcIMURAzs = T%ED%y%NcIMURAzs + + T%SrvD%Input(iInput)%RotPwr = T%ED%y%RotPwr + + T%SrvD%Input(iInput)%LSShftFxa = T%ED%y%LSShftFxa + T%SrvD%Input(iInput)%LSShftFys = T%ED%y%LSShftFys + T%SrvD%Input(iInput)%LSShftFzs = T%ED%y%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..b75a16582f --- /dev/null +++ b/modules/openfast-library/src/FAST_ModGlue.f90 @@ -0,0 +1,1618 @@ +!********************************************************************************************************************************** +! 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 + + ErrStat = ErrID_None + ErrMsg = "" + + ! Get current azimuth angle from ElastoDyn output + psi = real(T%ED%y%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%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%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%RotSpeed) .and. & + (t_global >= p_FAST%TMax - 2._DbKi*(TwoPi_D)/T%ED%p%RotSpeed)) then + if (abs(T%ED%y%RotSpeed - T%ED%p%RotSpeed)/T%ED%p%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 + 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%RotSpeed*RPS2RPM, Fmt))//' rpm, BldPitch1='//trim(Num2LStr(Turbine%ED%y%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%RotSpeed + y_FAST%Lin%Azimuth = Turbine%ED%y%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..4113cb4ef5 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,97 +327,71 @@ 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 ] # note that I'm making the allocatable-for-instance-used part INSIDE the data type (as opposed to an array of IceDyn_Data types) because I want to pass arrays of x, xd, z, x_pred, etc) typedef FAST BeamDyn_Data BD_ContinuousStateType x {:}{:} - - "Continuous states" +typedef ^ ^ BD_ContinuousStateType dxdt {:} - - "Continuous state derivatives" 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 FAST ElastoDyn_Data ED_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ ED_ContinuousStateType dxdt - - - "Continuous state derivatives" +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_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" # ..... 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 +405,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 +438,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 @@ -896,6 +741,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 index f4ea398e61..d5da13d704 100644 --- a/modules/openfast-library/src/FAST_SS_Solver.f90 +++ b/modules/openfast-library/src/FAST_SS_Solver.f90 @@ -1222,7 +1222,7 @@ SUBROUTINE FormSteadyStateJacobian( caseData, Jmat, p_FAST, y_FAST, m_FAST, ED, if (output_debugging) then - call WrLinFile_txt_Head(SS_t_global, p_FAST, y_FAST, y_FAST%Lin%Glue, LinRootName, Un, ErrStat2, ErrMsg2 ) + call WrLinFile_txt_Head(SS_t_global, p_FAST, y_FAST, y_FAST%Lin%Glue, LinRootName, Un, Module_Glue, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >=AbortErrLev) then call cleanup() @@ -1325,11 +1325,11 @@ SUBROUTINE GetModuleJacobians( caseData, dxdotdy, p_FAST, y_FAST, m_FAST, ED, BD 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 ) + 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, ModIdx=ED%p%IdxAeroMap ) 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 ) + 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, ModIdx=ED%p%IdxAeroMap ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! get the operating point @@ -1338,7 +1338,7 @@ SUBROUTINE GetModuleJacobians( caseData, dxdotdy, p_FAST, y_FAST, m_FAST, ED, BD 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 ) + dx_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_dx, ModIdx=ED%p%IdxAeroMap ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >=AbortErrLev) return @@ -1360,9 +1360,7 @@ SUBROUTINE GetModuleJacobians( caseData, dxdotdy, p_FAST, y_FAST, m_FAST, ED, BD ! 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 ) + dXdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%B) 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), & diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index 83c0e525f9..0eaa252afb 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -5776,7 +5776,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 @@ -5807,7 +5807,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 @@ -5833,7 +5833,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 @@ -5875,7 +5875,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 @@ -5898,7 +5898,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 @@ -5921,7 +5921,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 @@ -5940,7 +5940,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 @@ -5964,7 +5964,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 @@ -5982,7 +5982,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 @@ -6001,7 +6001,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 @@ -6020,7 +6020,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 @@ -6043,7 +6043,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 @@ -6064,7 +6064,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 @@ -6159,7 +6159,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 @@ -6181,7 +6181,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 @@ -6220,7 +6220,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 @@ -6241,7 +6241,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 @@ -6265,7 +6265,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 @@ -6287,7 +6287,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 @@ -6304,7 +6304,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 @@ -6325,7 +6325,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 @@ -6343,7 +6343,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 @@ -6361,7 +6361,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 @@ -6379,7 +6379,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 @@ -6402,7 +6402,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 @@ -6422,7 +6422,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..c87dbcbbd6 --- /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, Turbine%ED%x(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 f48f249981..f38ebecd32 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,10 +21,15 @@ !********************************************************************************************************************************** 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 @@ -34,7 +39,6 @@ MODULE FAST_Subs !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> 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 +50,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,6 +128,10 @@ 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 @@ -164,8 +173,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 +234,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,79 +278,53 @@ 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), stat=ErrStat2); if (FailedAlloc("ED%Input")) return + allocate(ED%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("ED%InputTimes")) return + allocate(ED%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%x")) return + allocate(ED%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%xd")) return + allocate(ED%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%z")) return + allocate(ED%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("ED%OtherSt")) 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), 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) + 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%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 - - + if (p_FAST%CalcSteady) then if ( EqualRealNos(Init%OutData_ED%RotSpeed, 0.0_ReKi) ) then p_FAST%TrimCase = TrimCase_none @@ -330,167 +334,119 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S 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 + + !---------------------------------------------------------------------------- + ! 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 + else p_FAST%nBeams = Init%OutData_ED%NumBl ! initialize number of BeamDyn instances = number of blades - END IF - ELSE + 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 - - 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 + 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%HubPtMotion%Position(:,1) + Init%InData_BD%HubRot = ED%y%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%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: + ! 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" + Init%InData_BD%RootVel(1:3) = ED%y%BladeRootMotion(k)%TranslationVel(:,1) ! {:} - - "Initial root velocities and angular velocities" + Init%InData_BD%RootVel(4:6) = ED%y%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 @@ -507,7 +463,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S 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 @@ -517,106 +473,72 @@ 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 - CALL InflowWind_Init( Init%InData_IfW, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), & - IfW%OtherSt(STATE_CURR), IfW%y, IfW%m, p_FAST%dt_module( MODULE_IfW ), Init%OutData_IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - p_FAST%ModuleInitialized(Module_IfW) = .TRUE. - 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 - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + ! 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 - ELSEIF ( p_FAST%CompInflow == Module_ExtInfw ) THEN - IF ( PRESENT(ExternInitData) ) THEN - Init%InData_ExtInfw%NumActForcePtsBlade = ExternInitData%NumActForcePtsBlade - Init%InData_ExtInfw%NumActForcePtsTower = ExternInitData%NumActForcePtsTower - ELSE - CALL SetErrStat( ErrID_Fatal, 'ExternalInflow integration can be used only with external input data (not the stand-alone executable).', ErrStat, ErrMsg, RoutineName ) - CALL Cleanup() - RETURN - END IF - ! get blade and tower info from AD. Assumption made that all blades have same spanwise characteristics - Init%InData_ExtInfw%BladeLength = Init%OutData_AD%rotors(1)%BladeProps(1)%BlSpn(Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds) - if (allocated(Init%OutData_AD%rotors(1)%TwrElev)) then - Init%InData_ExtInfw%TowerHeight = Init%OutData_AD%rotors(1)%TwrElev(SIZE(Init%OutData_AD%rotors(1)%TwrElev)) - Init%OutData_AD%rotors(1)%TwrElev(1) ! TwrElev is based on ground or MSL. Need flexible tower length and first node - Init%InData_ExtInfw%TowerBaseHeight = Init%OutData_AD%rotors(1)%TwrElev(1) - ALLOCATE(Init%InData_ExtInfw%StructTwrHNodes( SIZE(Init%OutData_AD%rotors(1)%TwrElev)), STAT=ErrStat2) - Init%InData_ExtInfw%StructTwrHNodes(:) = Init%OutData_AD%rotors(1)%TwrElev(:) - else - Init%InData_ExtInfw%TowerHeight = 0.0_ReKi - Init%InData_ExtInfw%TowerBaseHeight = 0.0_ReKi - endif - ALLOCATE(Init%InData_ExtInfw%StructBldRNodes(Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds), STAT=ErrStat2) - Init%InData_ExtInfw%StructBldRNodes(:) = Init%OutData_AD%rotors(1)%BladeProps(1)%BlSpn(:) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating ExtInfw%InitInput.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF + y_FAST%Lin%WindSpeed = Init%OutData_IfW%WindFileInfo%MWS - !Set node clustering type - Init%InData_ExtInfw%NodeClusterType = ExternInitData%NodeClusterType - ! set up the data structures for integration with ExternalInflow - CALL Init_ExtInfw( Init%InData_ExtInfw, p_FAST, AirDens, AD%Input(1), Init%OutData_AD, AD%y, ExtInfw, Init%OutData_ExtInfw, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! 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. - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN + IF ( p_FAST%CompServo == Module_SrvD ) 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) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Init%InData_SrvD%LidSpeed = IfW%y%lidar%LidSpeed + endif + if (allocated(IfW%y%lidar%MsrPositionsX)) then ! make sure we have the array allocated before setting it + CALL AllocAry(Init%InData_SrvD%MsrPositionsX, size(IfW%y%lidar%MsrPositionsX), 'Init%InData_SrvD%MsrPositionsX', ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Init%InData_SrvD%MsrPositionsX = IfW%y%lidar%MsrPositionsX + endif + if (allocated(IfW%y%lidar%MsrPositionsY)) then ! make sure we have the array allocated before setting it + CALL AllocAry(Init%InData_SrvD%MsrPositionsY, size(IfW%y%lidar%MsrPositionsY), 'Init%InData_SrvD%MsrPositionsY', ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Init%InData_SrvD%MsrPositionsY = IfW%y%lidar%MsrPositionsY + endif + if (allocated(IfW%y%lidar%MsrPositionsZ)) then ! make sure we have the array allocated before setting it + CALL AllocAry(Init%InData_SrvD%MsrPositionsZ, size(IfW%y%lidar%MsrPositionsZ), 'Init%InData_SrvD%MsrPositionsZ', ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Init%InData_SrvD%MsrPositionsZ = IfW%y%lidar%MsrPositionsZ + endif + Init%InData_SrvD%SensorType = IfW%p%lidar%SensorType + Init%InData_SrvD%NumBeam = IfW%p%lidar%NumBeam + Init%InData_SrvD%NumPulseGate = IfW%p%lidar%NumPulseGate + Init%InData_SrvD%PulseSpacing = IfW%p%lidar%PulseSpacing END IF - !bjj: fix me!!! to do - Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi - - ! Set pointer to flowfield - IF (p_FAST%CompAero == Module_AD) AD%p%FlowField => Init%OutData_ExtInfw%FlowField - - ELSE + case (Module_ExtInfw) + ! ExtInfw requires initialization of AD first, so nothing executed here + 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 @@ -627,23 +549,24 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S 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 - - ! wave field visualization + ! 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) @@ -653,69 +576,31 @@ 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 ) + end if - if (allocated(Init%OutData_SeaSt%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%NumOutputs = size(Init%OutData_SeaSt%WriteOutputHdr) - end if + !---------------------------------------------------------------------------- + ! Initialize AeroDyn / ADsk + !---------------------------------------------------------------------------- - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - end if + select case (p_FAST%CompAero) + case (Module_AD, Module_ExtLd) - ! ........................ - ! 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 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( 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 - - 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 - - IF ( (p_FAST%CompAero == Module_AD) .OR. (p_FAST%CompAero == Module_ExtLd) ) THEN - - 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 @@ -724,16 +609,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 @@ -781,41 +662,36 @@ 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) - - 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 - 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 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) @@ -825,6 +701,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S Init%InData_ADsk%HubPosition = ED%y%HubPtMotion%Position(:,1) Init%InData_ADsk%HubOrientation = ED%y%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. @@ -833,90 +710,133 @@ 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) - END IF ! CompAero + ! 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 - IF ( p_FAST%CompAero == Module_ExtLd ) THEN + ! AeroDisk may override the AirDens value. Store this to inform other modules + AirDens = Init%OutData_ADsk%AirDens - IF ( PRESENT(ExternInitData) ) THEN + end select ! CompAero - ! 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) + !---------------------------------------------------------------------------- + ! External Loads + !---------------------------------------------------------------------------- - p_FAST%ModuleInitialized(Module_ExtLd) = .TRUE. - CALL SetModuleSubstepTime(Module_ExtLd, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + IF ( (p_FAST%CompAero == Module_ExtLd) .and. PRESENT(ExternInitData) ) THEN - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + ! 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 ) + if (Failed()) return - AirDens = Init%OutData_ExtLd%AirDens + p_FAST%ModuleInitialized(Module_ExtLd) = .TRUE. - 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 - ! ........................ ! No aero of any sort ! ........................ - IF ( (p_FAST%CompAero /= Module_AD) .and. (p_FAST%CompAero /= Module_ExtLd) ) THEN - ELSE + IF ( (p_FAST%CompAero == Module_None) .or. (p_FAST%CompAero == Module_Unknown)) THEN AirDens = 0.0_ReKi ENDIF - ! ........................ - ! initialize SuperController + ! initialize ExtInfw + ! Ideally this would be initialized in the same logic as InflowWind above. However AD outputs are required ! ........................ - 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 ) + IF ( p_FAST%CompInflow == Module_ExtInfw ) THEN + + IF ( PRESENT(ExternInitData) ) THEN + Init%InData_ExtInfw%NumActForcePtsBlade = ExternInitData%NumActForcePtsBlade + Init%InData_ExtInfw%NumActForcePtsTower = ExternInitData%NumActForcePtsTower 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 + CALL SetErrStat( ErrID_Fatal, 'ExternalInflow integration can be used only with external input data (not the stand-alone executable).', ErrStat, ErrMsg, RoutineName ) + CALL Cleanup() + RETURN END IF - END IF - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - - ! ........................ - ! initialize HydroDyn - ! ........................ - ALLOCATE( HD%Input( p_FAST%InterpOrder+1 ), HD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + ! get blade and tower info from AD. Assumption made that all blades have same spanwise characteristics + Init%InData_ExtInfw%BladeLength = Init%OutData_AD%rotors(1)%BladeProps(1)%BlSpn(Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds) + if (allocated(Init%OutData_AD%rotors(1)%TwrElev)) then + Init%InData_ExtInfw%TowerHeight = Init%OutData_AD%rotors(1)%TwrElev(SIZE(Init%OutData_AD%rotors(1)%TwrElev)) - Init%OutData_AD%rotors(1)%TwrElev(1) ! TwrElev is based on ground or MSL. Need flexible tower length and first node + Init%InData_ExtInfw%TowerBaseHeight = Init%OutData_AD%rotors(1)%TwrElev(1) + ALLOCATE(Init%InData_ExtInfw%StructTwrHNodes( SIZE(Init%OutData_AD%rotors(1)%TwrElev)), STAT=ErrStat2) + Init%InData_ExtInfw%StructTwrHNodes(:) = Init%OutData_AD%rotors(1)%TwrElev(:) + else + Init%InData_ExtInfw%TowerHeight = 0.0_ReKi + Init%InData_ExtInfw%TowerBaseHeight = 0.0_ReKi + endif + ALLOCATE(Init%InData_ExtInfw%StructBldRNodes(Init%OutData_AD%rotors(1)%BladeProps(1)%NumBlNds), STAT=ErrStat2) + Init%InData_ExtInfw%StructBldRNodes(:) = Init%OutData_AD%rotors(1)%BladeProps(1)%BlSpn(:) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating HD%Input and HD%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating ExtInfw%InitInput.",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) + !Set node clustering type + Init%InData_ExtInfw%NodeClusterType = ExternInitData%NodeClusterType + ! set up the data structures for integration with ExternalInflow + CALL Init_ExtInfw( Init%InData_ExtInfw, p_FAST, AirDens, AD%Input(1), Init%OutData_AD, AD%y, ExtInfw, Init%OutData_ExtInfw, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF - IF ( p_FAST%CompHydro == Module_HD ) THEN + !bjj: fix me!!! to do + Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi + + ! Set pointer to flowfield -- I would prefer that we did this through the AD_Init, but AD_InitOut results are required for ExtInfw_Init + IF (p_FAST%CompAero == Module_AD) AD%p%FlowField => Init%OutData_ExtInfw%FlowField + endif + + + !---------------------------------------------------------------------------- + ! 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 + + !---------------------------------------------------------------------------- + ! 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 + + IF (p_FAST%CompHydro == Module_HD) THEN Init%InData_HD%Gravity = p_FAST%Gravity Init%InData_HD%UseInputFile = .TRUE. @@ -924,6 +844,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 if (p_FAST%WrVTK /= VTK_None) Init%InData_HD%VisMeshes=.true. ! if ( p_FAST%CompSeaSt == Module_SeaSt ) then ! this is always true @@ -931,258 +852,157 @@ 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%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 - 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 @@ -1196,65 +1016,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%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 @@ -1262,79 +1059,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 + 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 - ! ------------------------------ - ! 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 - - ! 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)) @@ -1344,20 +1095,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' @@ -1369,14 +1138,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 @@ -1384,58 +1156,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) @@ -1476,18 +1241,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 @@ -1506,16 +1264,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S 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) @@ -1525,11 +1278,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) @@ -1543,78 +1292,30 @@ 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) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - Init%InData_SrvD%LidSpeed = IfW%y%lidar%LidSpeed - endif - if (allocated(IfW%y%lidar%MsrPositionsX)) then ! make sure we have the array allocated before setting it - CALL AllocAry(Init%InData_SrvD%MsrPositionsX, size(IfW%y%lidar%MsrPositionsX), 'Init%InData_SrvD%MsrPositionsX', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - Init%InData_SrvD%MsrPositionsX = IfW%y%lidar%MsrPositionsX - endif - if (allocated(IfW%y%lidar%MsrPositionsY)) then ! make sure we have the array allocated before setting it - CALL AllocAry(Init%InData_SrvD%MsrPositionsY, size(IfW%y%lidar%MsrPositionsY), 'Init%InData_SrvD%MsrPositionsY', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - Init%InData_SrvD%MsrPositionsY = IfW%y%lidar%MsrPositionsY - endif - if (allocated(IfW%y%lidar%MsrPositionsZ)) then ! make sure we have the array allocated before setting it - CALL AllocAry(Init%InData_SrvD%MsrPositionsZ, size(IfW%y%lidar%MsrPositionsZ), 'Init%InData_SrvD%MsrPositionsZ', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - Init%InData_SrvD%MsrPositionsZ = IfW%y%lidar%MsrPositionsZ - endif - Init%InData_SrvD%SensorType = IfW%p%lidar%SensorType - Init%InData_SrvD%NumBeam = IfW%p%lidar%NumBeam - Init%InData_SrvD%NumPulseGate = IfW%p%lidar%NumPulseGate - 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 CALL SetErrStat(ErrID_Fatal,'ElastoDyn must use the AB4 or ABM4 integration method to implement high-speed shaft braking.',ErrStat,ErrMsg,RoutineName) @@ -1631,116 +1332,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 low-pass-filtered displacements of HydroDyn potential-flow bodies - ! ---------------------------------------------------------------------------- - IF ( (p_FAST%CompHydro == Module_HD) .AND. (HD%p%PotMod == 1_IntKi) ) THEN - IF ( HD%p%WAMIT(1)%ExctnDisp == 2_IntKi ) THEN - ! Set the initial displacement of ED%PlatformPtMesh here to use MeshMapping - ED%y%PlatformPtMesh%TranslationDisp(:,1) = Init%OutData_ED%PlatformPos(1:3) - CALL SmllRotTrans( 'initial platform rotation ', & - REAL(Init%OutData_ED%PlatformPos(4),R8Ki), & - REAL(Init%OutData_ED%PlatformPos(5),R8Ki), & - REAL(Init%OutData_ED%PlatformPos(6),R8Ki), & - ED%y%PlatformPtMesh%Orientation(:,:,1), '', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ED%y%PlatformPtMesh%TranslationDisp(1,1) = ED%y%PlatformPtMesh%TranslationDisp(1,1) + ED%y%PlatformPtMesh%Orientation(3,1,1) * ED%p%PtfmRefzt - ED%y%PlatformPtMesh%TranslationDisp(2,1) = ED%y%PlatformPtMesh%TranslationDisp(2,1) + ED%y%PlatformPtMesh%Orientation(3,2,1) * ED%p%PtfmRefzt - ED%y%PlatformPtMesh%TranslationDisp(3,1) = ED%y%PlatformPtMesh%TranslationDisp(3,1) + ED%y%PlatformPtMesh%Orientation(3,3,1) * ED%p%PtfmRefzt - ED%p%PtfmRefzt - CALL Transfer_PlatformMotion_to_HD( ED%y%PlatformPtMesh, HD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - IF (HD%p%NBodyMod .EQ. 1_IntKi) THEN ! One instance of WAMIT with NBody - DO i = 1,HD%p%NBody - HD%xd(STATE_CURR)%WAMIT(1)%BdyPosFilt(1,i,:) = HD%Input(1)%WAMITMesh%TranslationDisp(1,i) - HD%xd(STATE_CURR)%WAMIT(1)%BdyPosFilt(2,i,:) = HD%Input(1)%WAMITMesh%TranslationDisp(2,i) - END DO - ELSE IF (HD%p%NBodyMod > 1_IntKi) THEN ! NBody instances of WAMIT with one body each - DO i = 1,HD%p%NBody - HD%xd(STATE_CURR)%WAMIT(i)%BdyPosFilt(1,1,:) = HD%Input(1)%WAMITMesh%TranslationDisp(1,i) - HD%xd(STATE_CURR)%WAMIT(i)%BdyPosFilt(2,1,:) = HD%Input(1)%WAMITMesh%TranslationDisp(2,i) - END DO - END IF - END IF - 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 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 @@ -1777,26 +1397,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 @@ -1900,7 +1530,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 @@ -1908,7 +1537,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. ) @@ -2271,7 +1899,7 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) IF (p%MHK /= MHK_None .and. p%MHK /= MHK_FixedBottom .and. p%MHK /= MHK_Floating) CALL SetErrStat( ErrID_Fatal, 'MHK switch is invalid. Set MHK to 0, 1, or 2 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) - IF (p%MHK /= MHK_None .and. p%Linearize) CALL SetErrStat( ErrID_Fatal, 'Linearization has not yet been implemented for an MHK turbine. Change MHK or Linearize in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + 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%Gravity < 0.0_ReKi) CALL SetErrStat( ErrID_Fatal, 'Gravity must not be negative.', ErrStat, ErrMsg, RoutineName ) @@ -2527,7 +2155,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 @@ -2560,11 +2188,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 @@ -2997,6 +2632,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) @@ -3616,12 +3278,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) @@ -5086,2910 +4742,484 @@ 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 + 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) - 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 ) + 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 -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 ) + !---------------------------------------------------------------------------- + ! Solve input-output relations; this section of code corresponds to Eq. (35) in Gasmi et al. (2013) + !---------------------------------------------------------------------------- - 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 + ! 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 - 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 + ! 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 - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + 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 - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - INTEGER(IntKi), PARAMETER :: n_t_global = -1 ! loop counter - INTEGER(IntKi), PARAMETER :: n_t_global_next = 0 ! loop counter - REAL(DbKi) :: t_initial ! next simulation time (t_global_next) - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution0' - - - !NOTE: m_FAST%t_global is t_initial in this routine - - ErrStat = ErrID_None - ErrMsg = "" - - t_initial = m_FAST%t_global ! which is used in place of t_global_next - y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_initial, p_FAST) - - IF (p_FAST%WrSttsTime) then - CALL SimStatus_FirstTime( m_FAST%TiLstPrn, m_FAST%PrevClockTime, m_FAST%SimStrtTime, m_FAST%UsrTime2, 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 ) - 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 ) - - 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 - - !---------------------------------------------------------------------------------------- - ! 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 ) - - ! 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) - - end if - - - !............... - ! 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 ) - - -END SUBROUTINE FAST_Solution0 -!---------------------------------------------------------------------------------------------------------------------------------- -!> 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 ) - - 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 - - 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' - - - 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 - - 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_initial - (j - 1) * p_FAST%dt - END DO - - 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 ) - - - ! 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 ) - - 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(j) = t_initial - (j - 1) * p_FAST%dt - !SrvD_OutputTimes(j) = t_initial - (j - 1) * dt - END DO - - 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 ) - - ! 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 ) - - 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(j) = t_initial - (j - 1) * p_FAST%dt - END DO - - 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 ) - - - ! 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 ) - - ELSEIF ( p_FAST%CompAero == Module_ADsk ) THEN - ! Copy values for interpolation/extrapolation: - - DO j = 1, p_FAST%InterpOrder + 1 - ADsk%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt - END DO - - 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 ) - - - ! 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 ) - - 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_initial - (j - 1) * p_FAST%dt - !IfW%OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - 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 ) - - - ! 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 ) - - 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_initial - (j - 1) * p_FAST%dt - !HD_OutputTimes(i) = t_initial - (j - 1) * dt - END DO - - 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 ) - - - ! 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 ) - - 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_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 + !---------------------------------------------------------------------------- + ! 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) - 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 ) + ! turn off VTK output when + 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 - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + !---------------------------------------------------------------------------- + ! Populate inputs at for ExtrapInterp and copy current state to predicted state + !---------------------------------------------------------------------------- - 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 + ! 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 - 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 + ! 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 - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules +END SUBROUTINE FAST_Solution0_T +!---------------------------------------------------------------------------------------------------------------------------------- +!> 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 - ! local variables - INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 - INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitIOarrays_SubStep_T' + INTEGER(IntKi) :: i, j 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 ) + ! Loop through modules + do i = 1, size(Turbine%m_Glue%ModData) - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## Step 3: Save all final variables (advance to next time) and reset global time - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + ! 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 - 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 ) + ! 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 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 - !---------------------------------------------------------------------------------------- - !! 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 do -END SUBROUTINE FAST_Solution +END SUBROUTINE FAST_InitIOarrays_SubStep_T !---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that calls FAST_Prework for one instance of a Turbine data structure. This is a separate subroutine so that the FAST +!> 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_Prework_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_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 ) +SUBROUTINE FAST_Reset_SubStep_T(t_initial, n_t_global, n_timesteps, Turbine, 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 ) + 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(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(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 - ! 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) - + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Reset_SubStep_T' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Prework' - - + 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 = "" - 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 + ! 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)] - ! set flag for writing output at time t_global_next - y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, p_FAST) + ! Update the global time + Turbine%m_FAST%t_global = t_global - !! 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 + ! Loop through modules + do i = 1, size(Turbine%m_Glue%ModData) + associate (ModData => Turbine%m_Glue%ModData(i)) - 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 + ! 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 - ! 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) ) + ! 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 = 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 - 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 + case default + call SetErrStat(ErrID_Fatal, "Unknown module "//ModData%Abbr, ErrStat, ErrMsg, RoutineName) + return + end select - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## 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 associate + end do +END SUBROUTINE FAST_Reset_SubStep_T -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 +!> 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_UpdateStates_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) +SUBROUTINE FAST_Store_SubStep_T(t_initial, n_t_global, Turbine, 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_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 - 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 ) + ErrStat = ErrID_None + 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 ) + t_global = t_initial + n_t_global * Turbine%p_FAST%DT - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time - INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter + ! Loop through modules + do i = 1, size(Turbine%m_Glue%ModData) + associate (ModData => Turbine%m_Glue%ModData(i)) - 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 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 - 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 + ! 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 - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + end associate + end do - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None +END SUBROUTINE FAST_Store_SubStep_T - ! 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 +!---------------------------------------------------------------------------------------------------------------------------------- +!> 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(ReKi) :: ControlInputGuess ! value of controller inputs + 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_Solution' INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UpdateStates' - + INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 + REAL(R8Ki) :: t_global_next 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 + ErrMsg = '' - ! 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 + ! 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 - !! predictor-corrector loop: - j_pc = 0 - do while (j_pc <= NumCorrections) - WriteThisStep = y_FAST%WriteThisStep .AND. j_pc==NumCorrections + !---------------------------------------------------------------------------- + ! Step 1.a: set some variables and Extrapolate Inputs + !---------------------------------------------------------------------------- - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## 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_Prework_T(t_initial, n_t_global, Turbine, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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.b: Advance states (yield state and constraint values at t_global_next) + ! Step 1.c: Input-Output Solve + ! Step 2: Correct (continue in loop) + !---------------------------------------------------------------------------- - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## 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 FAST_UpdateStates_T(t_initial, n_t_global, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 3: Save all final variables (advance to next time) and reset global time + !---------------------------------------------------------------------------- - !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - !! ## 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 + call FAST_AdvanceToNextTimeStep_T(t_initial, n_t_global, Turbine, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - 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 + !---------------------------------------------------------------------------- + ! Write output data to file + !---------------------------------------------------------------------------- -END SUBROUTINE FAST_UpdateStates + 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) -!---------------------------------------------------------------------------------------------------------------------------------- -!> 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 ) + !---------------------------------------------------------------------------- + ! Display simulation status every SttsTime-seconds (i.e., n_SttsTime steps): + !---------------------------------------------------------------------------- - 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 + 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 - 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_Solution_T -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 ) +!> Routine that calls FAST_Prework 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_Prework_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_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(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_next ! next simulation time (m_FAST%t_global + p_FAST%dt) - INTEGER(IntKi) :: I, k ! generic loop counters - + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Prework' 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 @@ -7997,80 +5227,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 @@ -8303,8 +5539,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 @@ -9372,38 +6608,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 @@ -9412,65 +6657,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 !---------------------------------------------------------------------------------------------------------------------------------- @@ -10385,7 +7639,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 @@ -10395,7 +7649,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 @@ -10425,6 +7679,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 @@ -10503,20 +7758,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) @@ -10535,20 +7792,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 +8125,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 eb19ff4a6f..a2f5443b4e 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,103 +335,77 @@ 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 ======= TYPE, PUBLIC :: BeamDyn_Data TYPE(BD_ContinuousStateType) , DIMENSION(:,:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(BD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: dxdt !< Continuous state derivatives [-] TYPE(BD_DiscreteStateType) , DIMENSION(:,:), ALLOCATABLE :: xd !< Discrete states [-] 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_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(ED_ContinuousStateType) :: dxdt !< Continuous state derivatives [-] + 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) :: 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 [-] 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 +423,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 +464,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 ======= @@ -909,6 +769,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 +795,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 @@ -940,14 +804,14 @@ subroutine FAST_CopyVTK_BLSurfaceType(SrcVTK_BLSurfaceTypeData, DstVTK_BLSurface integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FAST_CopyVTK_BLSurfaceType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcVTK_BLSurfaceTypeData%AirfoilCoords)) then - LB(1:3) = lbound(SrcVTK_BLSurfaceTypeData%AirfoilCoords, kind=B8Ki) - UB(1:3) = ubound(SrcVTK_BLSurfaceTypeData%AirfoilCoords, kind=B8Ki) + LB(1:3) = lbound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) + UB(1:3) = ubound(SrcVTK_BLSurfaceTypeData%AirfoilCoords) if (.not. allocated(DstVTK_BLSurfaceTypeData%AirfoilCoords)) then allocate(DstVTK_BLSurfaceTypeData%AirfoilCoords(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -984,7 +848,7 @@ subroutine FAST_UnPackVTK_BLSurfaceType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_VTK_BLSurfaceType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackVTK_BLSurfaceType' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -997,8 +861,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyVTK_SurfaceType' @@ -1009,8 +873,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa DstVTK_SurfaceTypeData%GroundRad = SrcVTK_SurfaceTypeData%GroundRad DstVTK_SurfaceTypeData%NacelleBox = SrcVTK_SurfaceTypeData%NacelleBox if (allocated(SrcVTK_SurfaceTypeData%TowerRad)) then - LB(1:1) = lbound(SrcVTK_SurfaceTypeData%TowerRad, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_SurfaceTypeData%TowerRad, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%TowerRad) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%TowerRad) if (.not. allocated(DstVTK_SurfaceTypeData%TowerRad)) then allocate(DstVTK_SurfaceTypeData%TowerRad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1022,8 +886,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa end if DstVTK_SurfaceTypeData%NWaveElevPts = SrcVTK_SurfaceTypeData%NWaveElevPts if (allocated(SrcVTK_SurfaceTypeData%WaveElevVisX)) then - LB(1:1) = lbound(SrcVTK_SurfaceTypeData%WaveElevVisX, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_SurfaceTypeData%WaveElevVisX, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%WaveElevVisX) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%WaveElevVisX) if (.not. allocated(DstVTK_SurfaceTypeData%WaveElevVisX)) then allocate(DstVTK_SurfaceTypeData%WaveElevVisX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1034,8 +898,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa DstVTK_SurfaceTypeData%WaveElevVisX = SrcVTK_SurfaceTypeData%WaveElevVisX end if if (allocated(SrcVTK_SurfaceTypeData%WaveElevVisY)) then - LB(1:1) = lbound(SrcVTK_SurfaceTypeData%WaveElevVisY, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_SurfaceTypeData%WaveElevVisY, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%WaveElevVisY) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%WaveElevVisY) if (.not. allocated(DstVTK_SurfaceTypeData%WaveElevVisY)) then allocate(DstVTK_SurfaceTypeData%WaveElevVisY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1046,8 +910,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa DstVTK_SurfaceTypeData%WaveElevVisY = SrcVTK_SurfaceTypeData%WaveElevVisY end if if (allocated(SrcVTK_SurfaceTypeData%WaveElevVisGrid)) then - LB(1:3) = lbound(SrcVTK_SurfaceTypeData%WaveElevVisGrid, kind=B8Ki) - UB(1:3) = ubound(SrcVTK_SurfaceTypeData%WaveElevVisGrid, kind=B8Ki) + LB(1:3) = lbound(SrcVTK_SurfaceTypeData%WaveElevVisGrid) + UB(1:3) = ubound(SrcVTK_SurfaceTypeData%WaveElevVisGrid) if (.not. allocated(DstVTK_SurfaceTypeData%WaveElevVisGrid)) then allocate(DstVTK_SurfaceTypeData%WaveElevVisGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1058,8 +922,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa DstVTK_SurfaceTypeData%WaveElevVisGrid = SrcVTK_SurfaceTypeData%WaveElevVisGrid end if if (allocated(SrcVTK_SurfaceTypeData%BladeShape)) then - LB(1:1) = lbound(SrcVTK_SurfaceTypeData%BladeShape, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_SurfaceTypeData%BladeShape, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%BladeShape) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%BladeShape) if (.not. allocated(DstVTK_SurfaceTypeData%BladeShape)) then allocate(DstVTK_SurfaceTypeData%BladeShape(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1074,8 +938,8 @@ subroutine FAST_CopyVTK_SurfaceType(SrcVTK_SurfaceTypeData, DstVTK_SurfaceTypeDa end do end if if (allocated(SrcVTK_SurfaceTypeData%MorisonVisRad)) then - LB(1:1) = lbound(SrcVTK_SurfaceTypeData%MorisonVisRad, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_SurfaceTypeData%MorisonVisRad, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_SurfaceTypeData%MorisonVisRad) + UB(1:1) = ubound(SrcVTK_SurfaceTypeData%MorisonVisRad) if (.not. allocated(DstVTK_SurfaceTypeData%MorisonVisRad)) then allocate(DstVTK_SurfaceTypeData%MorisonVisRad(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1091,8 +955,8 @@ subroutine FAST_DestroyVTK_SurfaceType(VTK_SurfaceTypeData, ErrStat, ErrMsg) type(FAST_VTK_SurfaceType), intent(inout) :: VTK_SurfaceTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyVTK_SurfaceType' @@ -1111,8 +975,8 @@ subroutine FAST_DestroyVTK_SurfaceType(VTK_SurfaceTypeData, ErrStat, ErrMsg) deallocate(VTK_SurfaceTypeData%WaveElevVisGrid) end if if (allocated(VTK_SurfaceTypeData%BladeShape)) then - LB(1:1) = lbound(VTK_SurfaceTypeData%BladeShape, kind=B8Ki) - UB(1:1) = ubound(VTK_SurfaceTypeData%BladeShape, kind=B8Ki) + LB(1:1) = lbound(VTK_SurfaceTypeData%BladeShape) + UB(1:1) = ubound(VTK_SurfaceTypeData%BladeShape) do i1 = LB(1), UB(1) call FAST_DestroyVTK_BLSurfaceType(VTK_SurfaceTypeData%BladeShape(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1128,8 +992,8 @@ subroutine FAST_PackVTK_SurfaceType(RF, Indata) type(RegFile), intent(inout) :: RF type(FAST_VTK_SurfaceType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackVTK_SurfaceType' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%NumSectors) call RegPack(RF, InData%HubRad) @@ -1142,9 +1006,9 @@ subroutine FAST_PackVTK_SurfaceType(RF, Indata) call RegPackAlloc(RF, InData%WaveElevVisGrid) call RegPack(RF, allocated(InData%BladeShape)) if (allocated(InData%BladeShape)) then - call RegPackBounds(RF, 1, lbound(InData%BladeShape, kind=B8Ki), ubound(InData%BladeShape, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeShape, kind=B8Ki) - UB(1:1) = ubound(InData%BladeShape, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BladeShape), ubound(InData%BladeShape)) + LB(1:1) = lbound(InData%BladeShape) + UB(1:1) = ubound(InData%BladeShape) do i1 = LB(1), UB(1) call FAST_PackVTK_BLSurfaceType(RF, InData%BladeShape(i1)) end do @@ -1157,8 +1021,8 @@ subroutine FAST_UnPackVTK_SurfaceType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_VTK_SurfaceType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackVTK_SurfaceType' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1193,7 +1057,7 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FAST_CopyVTK_ModeShapeType' ErrStat = ErrID_None @@ -1202,8 +1066,8 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape DstVTK_ModeShapeTypeData%MatlabFileName = SrcVTK_ModeShapeTypeData%MatlabFileName DstVTK_ModeShapeTypeData%VTKLinModes = SrcVTK_ModeShapeTypeData%VTKLinModes if (allocated(SrcVTK_ModeShapeTypeData%VTKModes)) then - LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%VTKModes, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%VTKModes, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%VTKModes) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%VTKModes) if (.not. allocated(DstVTK_ModeShapeTypeData%VTKModes)) then allocate(DstVTK_ModeShapeTypeData%VTKModes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1218,8 +1082,8 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape DstVTK_ModeShapeTypeData%VTKLinScale = SrcVTK_ModeShapeTypeData%VTKLinScale DstVTK_ModeShapeTypeData%VTKLinPhase = SrcVTK_ModeShapeTypeData%VTKLinPhase if (allocated(SrcVTK_ModeShapeTypeData%DampingRatio)) then - LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampingRatio, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampingRatio, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampingRatio) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampingRatio) if (.not. allocated(DstVTK_ModeShapeTypeData%DampingRatio)) then allocate(DstVTK_ModeShapeTypeData%DampingRatio(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1230,8 +1094,8 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape DstVTK_ModeShapeTypeData%DampingRatio = SrcVTK_ModeShapeTypeData%DampingRatio end if if (allocated(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz)) then - LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz) if (.not. allocated(DstVTK_ModeShapeTypeData%NaturalFreq_Hz)) then allocate(DstVTK_ModeShapeTypeData%NaturalFreq_Hz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1242,8 +1106,8 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape DstVTK_ModeShapeTypeData%NaturalFreq_Hz = SrcVTK_ModeShapeTypeData%NaturalFreq_Hz end if if (allocated(SrcVTK_ModeShapeTypeData%DampedFreq_Hz)) then - LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz, kind=B8Ki) - UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz, kind=B8Ki) + LB(1:1) = lbound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz) + UB(1:1) = ubound(SrcVTK_ModeShapeTypeData%DampedFreq_Hz) if (.not. allocated(DstVTK_ModeShapeTypeData%DampedFreq_Hz)) then allocate(DstVTK_ModeShapeTypeData%DampedFreq_Hz(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1254,8 +1118,8 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape DstVTK_ModeShapeTypeData%DampedFreq_Hz = SrcVTK_ModeShapeTypeData%DampedFreq_Hz end if if (allocated(SrcVTK_ModeShapeTypeData%x_eig_magnitude)) then - LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_magnitude, kind=B8Ki) - UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_magnitude, kind=B8Ki) + LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_magnitude) + UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_magnitude) if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_magnitude)) then allocate(DstVTK_ModeShapeTypeData%x_eig_magnitude(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1266,8 +1130,8 @@ subroutine FAST_CopyVTK_ModeShapeType(SrcVTK_ModeShapeTypeData, DstVTK_ModeShape DstVTK_ModeShapeTypeData%x_eig_magnitude = SrcVTK_ModeShapeTypeData%x_eig_magnitude end if if (allocated(SrcVTK_ModeShapeTypeData%x_eig_phase)) then - LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_phase, kind=B8Ki) - UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_phase, kind=B8Ki) + LB(1:3) = lbound(SrcVTK_ModeShapeTypeData%x_eig_phase) + UB(1:3) = ubound(SrcVTK_ModeShapeTypeData%x_eig_phase) if (.not. allocated(DstVTK_ModeShapeTypeData%x_eig_phase)) then allocate(DstVTK_ModeShapeTypeData%x_eig_phase(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1331,7 +1195,7 @@ subroutine FAST_UnPackVTK_ModeShapeType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_VTK_ModeShapeType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackVTK_ModeShapeType' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1403,7 +1267,7 @@ subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyParam' @@ -1421,6 +1285,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 @@ -1514,8 +1381,8 @@ subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WindSpeedOrTSR = SrcParamData%WindSpeedOrTSR DstParamData%RotSpeedInit = SrcParamData%RotSpeedInit if (allocated(SrcParamData%RotSpeed)) then - LB(1:1) = lbound(SrcParamData%RotSpeed, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%RotSpeed, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%RotSpeed) + UB(1:1) = ubound(SrcParamData%RotSpeed) if (.not. allocated(DstParamData%RotSpeed)) then allocate(DstParamData%RotSpeed(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1526,8 +1393,8 @@ subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%RotSpeed = SrcParamData%RotSpeed end if if (allocated(SrcParamData%WS_TSR)) then - LB(1:1) = lbound(SrcParamData%WS_TSR, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WS_TSR, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WS_TSR) + UB(1:1) = ubound(SrcParamData%WS_TSR) if (.not. allocated(DstParamData%WS_TSR)) then allocate(DstParamData%WS_TSR(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1538,8 +1405,8 @@ subroutine FAST_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%WS_TSR = SrcParamData%WS_TSR end if if (allocated(SrcParamData%Pitch)) then - LB(1:1) = lbound(SrcParamData%Pitch, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%Pitch, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%Pitch) + UB(1:1) = ubound(SrcParamData%Pitch) if (.not. allocated(DstParamData%Pitch)) then allocate(DstParamData%Pitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1593,6 +1460,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) @@ -1692,7 +1562,7 @@ subroutine FAST_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackParam' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1708,6 +1578,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,3720 +1675,324 @@ 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(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + 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, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%x_IceD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%xd_IceD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%z_IceD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%OtherSt_IceD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%u_IceD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%x_BD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%xd_BD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%z_BD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%OtherSt_BD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcLinStateSaveData%u_BD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_ED, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_ED, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_ED, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_ED, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_ED, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_SrvD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_SrvD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_SrvD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SrvD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_SrvD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_AD, kind=B8Ki) - 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) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%IsLoad_u.', 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 + DstLinTypeData%IsLoad_u = SrcLinTypeData%IsLoad_u end if - if (allocated(SrcLinStateSaveData%xd_AD)) then - LB(1:1) = lbound(SrcLinStateSaveData%xd_AD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_AD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%xd_AD)) then - allocate(DstLinStateSaveData%xd_AD(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcLinTypeData%RotFrame_u)) then + LB(1:1) = lbound(SrcLinTypeData%RotFrame_u) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_u) + if (.not. allocated(DstLinTypeData%RotFrame_u)) then + allocate(DstLinTypeData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_AD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_u.', 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 + DstLinTypeData%RotFrame_u = SrcLinTypeData%RotFrame_u end if - if (allocated(SrcLinStateSaveData%z_AD)) then - LB(1:1) = lbound(SrcLinStateSaveData%z_AD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_AD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%z_AD)) then - allocate(DstLinStateSaveData%z_AD(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcLinTypeData%RotFrame_y)) then + LB(1:1) = lbound(SrcLinTypeData%RotFrame_y) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_y) + if (.not. allocated(DstLinTypeData%RotFrame_y)) then + allocate(DstLinTypeData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_AD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_y.', 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 + DstLinTypeData%RotFrame_y = SrcLinTypeData%RotFrame_y end if - if (allocated(SrcLinStateSaveData%OtherSt_AD)) then - LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_AD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_AD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%OtherSt_AD)) then - allocate(DstLinStateSaveData%OtherSt_AD(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcLinTypeData%RotFrame_x)) then + LB(1:1) = lbound(SrcLinTypeData%RotFrame_x) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_x) + if (.not. allocated(DstLinTypeData%RotFrame_x)) then + allocate(DstLinTypeData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_AD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_x.', 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 + DstLinTypeData%RotFrame_x = SrcLinTypeData%RotFrame_x end if - if (allocated(SrcLinStateSaveData%u_AD)) then - LB(1:1) = lbound(SrcLinStateSaveData%u_AD, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_AD, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%u_AD)) then - allocate(DstLinStateSaveData%u_AD(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcLinTypeData%RotFrame_z)) then + LB(1:1) = lbound(SrcLinTypeData%RotFrame_z) + UB(1:1) = ubound(SrcLinTypeData%RotFrame_z) + if (.not. allocated(DstLinTypeData%RotFrame_z)) then + allocate(DstLinTypeData%RotFrame_z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_AD.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_z.', 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 + DstLinTypeData%RotFrame_z = SrcLinTypeData%RotFrame_z end if - if (allocated(SrcLinStateSaveData%x_IfW)) then - LB(1:1) = lbound(SrcLinStateSaveData%x_IfW, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_IfW, kind=B8Ki) - if (.not. allocated(DstLinStateSaveData%x_IfW)) then - allocate(DstLinStateSaveData%x_IfW(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcLinTypeData%DerivOrder_x)) then + LB(1:1) = lbound(SrcLinTypeData%DerivOrder_x) + UB(1:1) = ubound(SrcLinTypeData%DerivOrder_x) + if (.not. allocated(DstLinTypeData%DerivOrder_x)) then + allocate(DstLinTypeData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_IfW, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_IfW, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_IfW, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_IfW, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_SD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_SD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_SD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_SD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_ExtPtfm, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_ExtPtfm, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_ExtPtfm, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_ExtPtfm, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_ExtPtfm, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_HD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_HD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_HD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_HD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_HD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_SeaSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_SeaSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_SeaSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SeaSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_SeaSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_IceF, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_IceF, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_IceF, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_IceF, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_IceF, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_MAP, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_MAP, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_MAP, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_MAP, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_FEAM, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_FEAM, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_FEAM, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_FEAM, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_FEAM, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%x_MD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%xd_MD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%z_MD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_MD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinStateSaveData%u_MD, kind=B8Ki) - 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(B8Ki) :: i1, i2 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%x_IceD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%xd_IceD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%z_IceD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%OtherSt_IceD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%u_IceD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%x_BD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%xd_BD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%z_BD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%OtherSt_BD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(LinStateSaveData%u_BD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_ED, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_ED, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_ED, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_ED, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_ED, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_SrvD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_SrvD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_SrvD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_SrvD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_SrvD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_AD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_AD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_AD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_AD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_AD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_IfW, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_IfW, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_IfW, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_IfW, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_IfW, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_SD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_SD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_SD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_SD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_SD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_ExtPtfm, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_ExtPtfm, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_ExtPtfm, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_ExtPtfm, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_ExtPtfm, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_HD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_HD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_HD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_HD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_HD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_SeaSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_SeaSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_SeaSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_SeaSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_SeaSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_IceF, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_IceF, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_IceF, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_IceF, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_IceF, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_MAP, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_MAP, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_MAP, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_MAP, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_FEAM, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_FEAM, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_FEAM, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_FEAM, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_FEAM, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%x_MD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%xd_MD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%z_MD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%OtherSt_MD, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(LinStateSaveData%u_MD, kind=B8Ki) - 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(B8Ki) :: i1, i2 - integer(B8Ki) :: 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, kind=B8Ki), ubound(InData%x_IceD, kind=B8Ki)) - LB(1:2) = lbound(InData%x_IceD, kind=B8Ki) - UB(1:2) = ubound(InData%x_IceD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%xd_IceD, kind=B8Ki)) - LB(1:2) = lbound(InData%xd_IceD, kind=B8Ki) - UB(1:2) = ubound(InData%xd_IceD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%z_IceD, kind=B8Ki)) - LB(1:2) = lbound(InData%z_IceD, kind=B8Ki) - UB(1:2) = ubound(InData%z_IceD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%OtherSt_IceD, kind=B8Ki)) - LB(1:2) = lbound(InData%OtherSt_IceD, kind=B8Ki) - UB(1:2) = ubound(InData%OtherSt_IceD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%u_IceD, kind=B8Ki)) - LB(1:2) = lbound(InData%u_IceD, kind=B8Ki) - UB(1:2) = ubound(InData%u_IceD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%x_BD, kind=B8Ki)) - LB(1:2) = lbound(InData%x_BD, kind=B8Ki) - UB(1:2) = ubound(InData%x_BD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%xd_BD, kind=B8Ki)) - LB(1:2) = lbound(InData%xd_BD, kind=B8Ki) - UB(1:2) = ubound(InData%xd_BD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%z_BD, kind=B8Ki)) - LB(1:2) = lbound(InData%z_BD, kind=B8Ki) - UB(1:2) = ubound(InData%z_BD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%OtherSt_BD, kind=B8Ki)) - LB(1:2) = lbound(InData%OtherSt_BD, kind=B8Ki) - UB(1:2) = ubound(InData%OtherSt_BD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%u_BD, kind=B8Ki)) - LB(1:2) = lbound(InData%u_BD, kind=B8Ki) - UB(1:2) = ubound(InData%u_BD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%x_ED, kind=B8Ki)) - LB(1:1) = lbound(InData%x_ED, kind=B8Ki) - UB(1:1) = ubound(InData%x_ED, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%xd_ED, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_ED, kind=B8Ki) - UB(1:1) = ubound(InData%xd_ED, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%z_ED, kind=B8Ki)) - LB(1:1) = lbound(InData%z_ED, kind=B8Ki) - UB(1:1) = ubound(InData%z_ED, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%OtherSt_ED, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_ED, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_ED, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%u_ED, kind=B8Ki)) - LB(1:1) = lbound(InData%u_ED, kind=B8Ki) - UB(1:1) = ubound(InData%u_ED, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%x_SrvD, kind=B8Ki)) - LB(1:1) = lbound(InData%x_SrvD, kind=B8Ki) - UB(1:1) = ubound(InData%x_SrvD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%xd_SrvD, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_SrvD, kind=B8Ki) - UB(1:1) = ubound(InData%xd_SrvD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%z_SrvD, kind=B8Ki)) - LB(1:1) = lbound(InData%z_SrvD, kind=B8Ki) - UB(1:1) = ubound(InData%z_SrvD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%OtherSt_SrvD, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_SrvD, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_SrvD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%u_SrvD, kind=B8Ki)) - LB(1:1) = lbound(InData%u_SrvD, kind=B8Ki) - UB(1:1) = ubound(InData%u_SrvD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%x_AD, kind=B8Ki)) - LB(1:1) = lbound(InData%x_AD, kind=B8Ki) - UB(1:1) = ubound(InData%x_AD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%xd_AD, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_AD, kind=B8Ki) - UB(1:1) = ubound(InData%xd_AD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%z_AD, kind=B8Ki)) - LB(1:1) = lbound(InData%z_AD, kind=B8Ki) - UB(1:1) = ubound(InData%z_AD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%OtherSt_AD, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_AD, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_AD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%u_AD, kind=B8Ki)) - LB(1:1) = lbound(InData%u_AD, kind=B8Ki) - UB(1:1) = ubound(InData%u_AD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%x_IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%x_IfW, kind=B8Ki) - UB(1:1) = ubound(InData%x_IfW, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%xd_IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_IfW, kind=B8Ki) - UB(1:1) = ubound(InData%xd_IfW, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%z_IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%z_IfW, kind=B8Ki) - UB(1:1) = ubound(InData%z_IfW, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%OtherSt_IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_IfW, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_IfW, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%u_IfW, kind=B8Ki)) - LB(1:1) = lbound(InData%u_IfW, kind=B8Ki) - UB(1:1) = ubound(InData%u_IfW, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%x_SD, kind=B8Ki)) - LB(1:1) = lbound(InData%x_SD, kind=B8Ki) - UB(1:1) = ubound(InData%x_SD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%xd_SD, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_SD, kind=B8Ki) - UB(1:1) = ubound(InData%xd_SD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%z_SD, kind=B8Ki)) - LB(1:1) = lbound(InData%z_SD, kind=B8Ki) - UB(1:1) = ubound(InData%z_SD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%OtherSt_SD, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_SD, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_SD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%u_SD, kind=B8Ki)) - LB(1:1) = lbound(InData%u_SD, kind=B8Ki) - UB(1:1) = ubound(InData%u_SD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%x_ExtPtfm, kind=B8Ki)) - LB(1:1) = lbound(InData%x_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(InData%x_ExtPtfm, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%xd_ExtPtfm, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(InData%xd_ExtPtfm, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%z_ExtPtfm, kind=B8Ki)) - LB(1:1) = lbound(InData%z_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(InData%z_ExtPtfm, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%OtherSt_ExtPtfm, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_ExtPtfm, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%u_ExtPtfm, kind=B8Ki)) - LB(1:1) = lbound(InData%u_ExtPtfm, kind=B8Ki) - UB(1:1) = ubound(InData%u_ExtPtfm, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%x_HD, kind=B8Ki)) - LB(1:1) = lbound(InData%x_HD, kind=B8Ki) - UB(1:1) = ubound(InData%x_HD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%xd_HD, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_HD, kind=B8Ki) - UB(1:1) = ubound(InData%xd_HD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%z_HD, kind=B8Ki)) - LB(1:1) = lbound(InData%z_HD, kind=B8Ki) - UB(1:1) = ubound(InData%z_HD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%OtherSt_HD, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_HD, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_HD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%u_HD, kind=B8Ki)) - LB(1:1) = lbound(InData%u_HD, kind=B8Ki) - UB(1:1) = ubound(InData%u_HD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%x_SeaSt, kind=B8Ki)) - LB(1:1) = lbound(InData%x_SeaSt, kind=B8Ki) - UB(1:1) = ubound(InData%x_SeaSt, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%xd_SeaSt, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_SeaSt, kind=B8Ki) - UB(1:1) = ubound(InData%xd_SeaSt, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%z_SeaSt, kind=B8Ki)) - LB(1:1) = lbound(InData%z_SeaSt, kind=B8Ki) - UB(1:1) = ubound(InData%z_SeaSt, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%OtherSt_SeaSt, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_SeaSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_SeaSt, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%u_SeaSt, kind=B8Ki)) - LB(1:1) = lbound(InData%u_SeaSt, kind=B8Ki) - UB(1:1) = ubound(InData%u_SeaSt, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%x_IceF, kind=B8Ki)) - LB(1:1) = lbound(InData%x_IceF, kind=B8Ki) - UB(1:1) = ubound(InData%x_IceF, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%xd_IceF, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_IceF, kind=B8Ki) - UB(1:1) = ubound(InData%xd_IceF, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%z_IceF, kind=B8Ki)) - LB(1:1) = lbound(InData%z_IceF, kind=B8Ki) - UB(1:1) = ubound(InData%z_IceF, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%OtherSt_IceF, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_IceF, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_IceF, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%u_IceF, kind=B8Ki)) - LB(1:1) = lbound(InData%u_IceF, kind=B8Ki) - UB(1:1) = ubound(InData%u_IceF, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%x_MAP, kind=B8Ki)) - LB(1:1) = lbound(InData%x_MAP, kind=B8Ki) - UB(1:1) = ubound(InData%x_MAP, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%xd_MAP, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_MAP, kind=B8Ki) - UB(1:1) = ubound(InData%xd_MAP, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%z_MAP, kind=B8Ki)) - LB(1:1) = lbound(InData%z_MAP, kind=B8Ki) - UB(1:1) = ubound(InData%z_MAP, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%u_MAP, kind=B8Ki)) - LB(1:1) = lbound(InData%u_MAP, kind=B8Ki) - UB(1:1) = ubound(InData%u_MAP, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%x_FEAM, kind=B8Ki)) - LB(1:1) = lbound(InData%x_FEAM, kind=B8Ki) - UB(1:1) = ubound(InData%x_FEAM, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%xd_FEAM, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_FEAM, kind=B8Ki) - UB(1:1) = ubound(InData%xd_FEAM, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%z_FEAM, kind=B8Ki)) - LB(1:1) = lbound(InData%z_FEAM, kind=B8Ki) - UB(1:1) = ubound(InData%z_FEAM, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%OtherSt_FEAM, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_FEAM, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_FEAM, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%u_FEAM, kind=B8Ki)) - LB(1:1) = lbound(InData%u_FEAM, kind=B8Ki) - UB(1:1) = ubound(InData%u_FEAM, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%x_MD, kind=B8Ki)) - LB(1:1) = lbound(InData%x_MD, kind=B8Ki) - UB(1:1) = ubound(InData%x_MD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%xd_MD, kind=B8Ki)) - LB(1:1) = lbound(InData%xd_MD, kind=B8Ki) - UB(1:1) = ubound(InData%xd_MD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%z_MD, kind=B8Ki)) - LB(1:1) = lbound(InData%z_MD, kind=B8Ki) - UB(1:1) = ubound(InData%z_MD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%OtherSt_MD, kind=B8Ki)) - LB(1:1) = lbound(InData%OtherSt_MD, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt_MD, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%u_MD, kind=B8Ki)) - LB(1:1) = lbound(InData%u_MD, kind=B8Ki) - UB(1:1) = ubound(InData%u_MD, kind=B8Ki) - 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(B8Ki) :: i1, i2 - integer(B8Ki) :: 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(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%Names_u, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%Names_y, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%Names_x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%Names_xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%Names_z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%op_u, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%op_y, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%op_x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%op_dx, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%op_xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%op_z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%op_x_eig_mag, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%op_x_eig_phase, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%Use_u, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%Use_y, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%A, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%B, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%C, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%D, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%StateRotation, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%StateRel_x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcLinTypeData%StateRel_xdot, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%IsLoad_u, kind=B8Ki) - if (.not. allocated(DstLinTypeData%IsLoad_u)) then - allocate(DstLinTypeData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%IsLoad_u = SrcLinTypeData%IsLoad_u - end if - if (allocated(SrcLinTypeData%RotFrame_u)) then - LB(1:1) = lbound(SrcLinTypeData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%RotFrame_u, kind=B8Ki) - if (.not. allocated(DstLinTypeData%RotFrame_u)) then - allocate(DstLinTypeData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%RotFrame_u = SrcLinTypeData%RotFrame_u - end if - if (allocated(SrcLinTypeData%RotFrame_y)) then - LB(1:1) = lbound(SrcLinTypeData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%RotFrame_y, kind=B8Ki) - if (.not. allocated(DstLinTypeData%RotFrame_y)) then - allocate(DstLinTypeData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%RotFrame_y = SrcLinTypeData%RotFrame_y - end if - if (allocated(SrcLinTypeData%RotFrame_x)) then - LB(1:1) = lbound(SrcLinTypeData%RotFrame_x, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%RotFrame_x, kind=B8Ki) - if (.not. allocated(DstLinTypeData%RotFrame_x)) then - allocate(DstLinTypeData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_x.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%RotFrame_x = SrcLinTypeData%RotFrame_x - end if - if (allocated(SrcLinTypeData%RotFrame_z)) then - LB(1:1) = lbound(SrcLinTypeData%RotFrame_z, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%RotFrame_z, kind=B8Ki) - if (.not. allocated(DstLinTypeData%RotFrame_z)) then - allocate(DstLinTypeData%RotFrame_z(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_z.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstLinTypeData%RotFrame_z = SrcLinTypeData%RotFrame_z - end if - if (allocated(SrcLinTypeData%DerivOrder_x)) then - LB(1:1) = lbound(SrcLinTypeData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcLinTypeData%DerivOrder_x, kind=B8Ki) - if (.not. allocated(DstLinTypeData%DerivOrder_x)) then - allocate(DstLinTypeData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%DerivOrder_x.', ErrStat, ErrMsg, RoutineName) return end if end if @@ -5593,12 +2070,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 +2115,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) @@ -5662,7 +2131,7 @@ subroutine FAST_UnPackLinType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_LinType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackLinType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -5686,8 +2155,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 @@ -5705,16 +2172,16 @@ subroutine FAST_CopyModLinType(SrcModLinTypeData, DstModLinTypeData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyModLinType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcModLinTypeData%Instance)) then - LB(1:1) = lbound(SrcModLinTypeData%Instance, kind=B8Ki) - UB(1:1) = ubound(SrcModLinTypeData%Instance, kind=B8Ki) + LB(1:1) = lbound(SrcModLinTypeData%Instance) + UB(1:1) = ubound(SrcModLinTypeData%Instance) if (.not. allocated(DstModLinTypeData%Instance)) then allocate(DstModLinTypeData%Instance(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5734,16 +2201,16 @@ subroutine FAST_DestroyModLinType(ModLinTypeData, ErrStat, ErrMsg) type(FAST_ModLinType), intent(inout) :: ModLinTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyModLinType' ErrStat = ErrID_None ErrMsg = '' if (allocated(ModLinTypeData%Instance)) then - LB(1:1) = lbound(ModLinTypeData%Instance, kind=B8Ki) - UB(1:1) = ubound(ModLinTypeData%Instance, kind=B8Ki) + LB(1:1) = lbound(ModLinTypeData%Instance) + UB(1:1) = ubound(ModLinTypeData%Instance) do i1 = LB(1), UB(1) call FAST_DestroyLinType(ModLinTypeData%Instance(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5756,14 +2223,14 @@ subroutine FAST_PackModLinType(RF, Indata) type(RegFile), intent(inout) :: RF type(FAST_ModLinType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackModLinType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%Instance)) if (allocated(InData%Instance)) then - call RegPackBounds(RF, 1, lbound(InData%Instance, kind=B8Ki), ubound(InData%Instance, kind=B8Ki)) - LB(1:1) = lbound(InData%Instance, kind=B8Ki) - UB(1:1) = ubound(InData%Instance, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Instance), ubound(InData%Instance)) + LB(1:1) = lbound(InData%Instance) + UB(1:1) = ubound(InData%Instance) do i1 = LB(1), UB(1) call FAST_PackLinType(RF, InData%Instance(i1)) end do @@ -5775,8 +2242,8 @@ subroutine FAST_UnPackModLinType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_ModLinType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackModLinType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -5801,15 +2268,15 @@ subroutine FAST_CopyLinFileType(SrcLinFileTypeData, DstLinFileTypeData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyLinFileType' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcLinFileTypeData%Modules, kind=B8Ki) - UB(1:1) = ubound(SrcLinFileTypeData%Modules, kind=B8Ki) + LB(1:1) = lbound(SrcLinFileTypeData%Modules) + UB(1:1) = ubound(SrcLinFileTypeData%Modules) do i1 = LB(1), UB(1) call FAST_CopyModLinType(SrcLinFileTypeData%Modules(i1), DstLinFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5827,15 +2294,15 @@ subroutine FAST_DestroyLinFileType(LinFileTypeData, ErrStat, ErrMsg) type(FAST_LinFileType), intent(inout) :: LinFileTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyLinFileType' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(LinFileTypeData%Modules, kind=B8Ki) - UB(1:1) = ubound(LinFileTypeData%Modules, kind=B8Ki) + LB(1:1) = lbound(LinFileTypeData%Modules) + UB(1:1) = ubound(LinFileTypeData%Modules) do i1 = LB(1), UB(1) call FAST_DestroyModLinType(LinFileTypeData%Modules(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -5848,11 +2315,11 @@ subroutine FAST_PackLinFileType(RF, Indata) type(RegFile), intent(inout) :: RF type(FAST_LinFileType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackLinFileType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%Modules, kind=B8Ki) - UB(1:1) = ubound(InData%Modules, kind=B8Ki) + LB(1:1) = lbound(InData%Modules) + UB(1:1) = ubound(InData%Modules) do i1 = LB(1), UB(1) call FAST_PackModLinType(RF, InData%Modules(i1)) end do @@ -5867,11 +2334,11 @@ subroutine FAST_UnPackLinFileType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_LinFileType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackLinFileType' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat /= ErrID_None) return - LB(1:1) = lbound(OutData%Modules, kind=B8Ki) - UB(1:1) = ubound(OutData%Modules, kind=B8Ki) + LB(1:1) = lbound(OutData%Modules) + UB(1:1) = ubound(OutData%Modules) do i1 = LB(1), UB(1) call FAST_UnpackModLinType(RF, OutData%Modules(i1)) ! Modules end do @@ -5887,14 +2354,14 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FAST_CopyMiscLinType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscLinTypeData%LinTimes)) then - LB(1:1) = lbound(SrcMiscLinTypeData%LinTimes, kind=B8Ki) - UB(1:1) = ubound(SrcMiscLinTypeData%LinTimes, kind=B8Ki) + LB(1:1) = lbound(SrcMiscLinTypeData%LinTimes) + UB(1:1) = ubound(SrcMiscLinTypeData%LinTimes) if (.not. allocated(DstMiscLinTypeData%LinTimes)) then allocate(DstMiscLinTypeData%LinTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5906,8 +2373,8 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode end if DstMiscLinTypeData%CopyOP_CtrlCode = SrcMiscLinTypeData%CopyOP_CtrlCode if (allocated(SrcMiscLinTypeData%AzimTarget)) then - LB(1:1) = lbound(SrcMiscLinTypeData%AzimTarget, kind=B8Ki) - UB(1:1) = ubound(SrcMiscLinTypeData%AzimTarget, kind=B8Ki) + LB(1:1) = lbound(SrcMiscLinTypeData%AzimTarget) + UB(1:1) = ubound(SrcMiscLinTypeData%AzimTarget) if (.not. allocated(DstMiscLinTypeData%AzimTarget)) then allocate(DstMiscLinTypeData%AzimTarget(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5924,8 +2391,8 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode DstMiscLinTypeData%AzimIndx = SrcMiscLinTypeData%AzimIndx DstMiscLinTypeData%NextLinTimeIndx = SrcMiscLinTypeData%NextLinTimeIndx if (allocated(SrcMiscLinTypeData%Psi)) then - LB(1:1) = lbound(SrcMiscLinTypeData%Psi, kind=B8Ki) - UB(1:1) = ubound(SrcMiscLinTypeData%Psi, kind=B8Ki) + LB(1:1) = lbound(SrcMiscLinTypeData%Psi) + UB(1:1) = ubound(SrcMiscLinTypeData%Psi) if (.not. allocated(DstMiscLinTypeData%Psi)) then allocate(DstMiscLinTypeData%Psi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5936,8 +2403,8 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode DstMiscLinTypeData%Psi = SrcMiscLinTypeData%Psi end if if (allocated(SrcMiscLinTypeData%y_interp)) then - LB(1:1) = lbound(SrcMiscLinTypeData%y_interp, kind=B8Ki) - UB(1:1) = ubound(SrcMiscLinTypeData%y_interp, kind=B8Ki) + LB(1:1) = lbound(SrcMiscLinTypeData%y_interp) + UB(1:1) = ubound(SrcMiscLinTypeData%y_interp) if (.not. allocated(DstMiscLinTypeData%y_interp)) then allocate(DstMiscLinTypeData%y_interp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5948,8 +2415,8 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode DstMiscLinTypeData%y_interp = SrcMiscLinTypeData%y_interp end if if (allocated(SrcMiscLinTypeData%y_ref)) then - LB(1:1) = lbound(SrcMiscLinTypeData%y_ref, kind=B8Ki) - UB(1:1) = ubound(SrcMiscLinTypeData%y_ref, kind=B8Ki) + LB(1:1) = lbound(SrcMiscLinTypeData%y_ref) + UB(1:1) = ubound(SrcMiscLinTypeData%y_ref) if (.not. allocated(DstMiscLinTypeData%y_ref)) then allocate(DstMiscLinTypeData%y_ref(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -5960,8 +2427,8 @@ subroutine FAST_CopyMiscLinType(SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode DstMiscLinTypeData%y_ref = SrcMiscLinTypeData%y_ref end if if (allocated(SrcMiscLinTypeData%Y_prevRot)) then - LB(1:2) = lbound(SrcMiscLinTypeData%Y_prevRot, kind=B8Ki) - UB(1:2) = ubound(SrcMiscLinTypeData%Y_prevRot, kind=B8Ki) + LB(1:2) = lbound(SrcMiscLinTypeData%Y_prevRot) + UB(1:2) = ubound(SrcMiscLinTypeData%Y_prevRot) if (.not. allocated(DstMiscLinTypeData%Y_prevRot)) then allocate(DstMiscLinTypeData%Y_prevRot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6025,7 +2492,7 @@ subroutine FAST_UnPackMiscLinType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_MiscLinType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackMiscLinType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -6045,21 +2512,21 @@ 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 character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyOutputFileType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputFileTypeData%TimeData)) then - LB(1:1) = lbound(SrcOutputFileTypeData%TimeData, kind=B8Ki) - UB(1:1) = ubound(SrcOutputFileTypeData%TimeData, kind=B8Ki) + LB(1:1) = lbound(SrcOutputFileTypeData%TimeData) + UB(1:1) = ubound(SrcOutputFileTypeData%TimeData) if (.not. allocated(DstOutputFileTypeData%TimeData)) then allocate(DstOutputFileTypeData%TimeData(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6070,8 +2537,8 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, DstOutputFileTypeData%TimeData = SrcOutputFileTypeData%TimeData end if if (allocated(SrcOutputFileTypeData%AllOutData)) then - LB(1:2) = lbound(SrcOutputFileTypeData%AllOutData, kind=B8Ki) - UB(1:2) = ubound(SrcOutputFileTypeData%AllOutData, kind=B8Ki) + LB(1:2) = lbound(SrcOutputFileTypeData%AllOutData) + UB(1:2) = ubound(SrcOutputFileTypeData%AllOutData) if (.not. allocated(DstOutputFileTypeData%AllOutData)) then allocate(DstOutputFileTypeData%AllOutData(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6089,8 +2556,8 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, DstOutputFileTypeData%UnGra = SrcOutputFileTypeData%UnGra DstOutputFileTypeData%FileDescLines = SrcOutputFileTypeData%FileDescLines if (allocated(SrcOutputFileTypeData%ChannelNames)) then - LB(1:1) = lbound(SrcOutputFileTypeData%ChannelNames, kind=B8Ki) - UB(1:1) = ubound(SrcOutputFileTypeData%ChannelNames, kind=B8Ki) + LB(1:1) = lbound(SrcOutputFileTypeData%ChannelNames) + UB(1:1) = ubound(SrcOutputFileTypeData%ChannelNames) if (.not. allocated(DstOutputFileTypeData%ChannelNames)) then allocate(DstOutputFileTypeData%ChannelNames(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6101,8 +2568,8 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, DstOutputFileTypeData%ChannelNames = SrcOutputFileTypeData%ChannelNames end if if (allocated(SrcOutputFileTypeData%ChannelUnits)) then - LB(1:1) = lbound(SrcOutputFileTypeData%ChannelUnits, kind=B8Ki) - UB(1:1) = ubound(SrcOutputFileTypeData%ChannelUnits, kind=B8Ki) + LB(1:1) = lbound(SrcOutputFileTypeData%ChannelUnits) + UB(1:1) = ubound(SrcOutputFileTypeData%ChannelUnits) if (.not. allocated(DstOutputFileTypeData%ChannelUnits)) then allocate(DstOutputFileTypeData%ChannelUnits(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6112,8 +2579,8 @@ subroutine FAST_CopyOutputFileType(SrcOutputFileTypeData, DstOutputFileTypeData, end if DstOutputFileTypeData%ChannelUnits = SrcOutputFileTypeData%ChannelUnits end if - LB(1:1) = lbound(SrcOutputFileTypeData%Module_Ver, kind=B8Ki) - UB(1:1) = ubound(SrcOutputFileTypeData%Module_Ver, kind=B8Ki) + LB(1:1) = lbound(SrcOutputFileTypeData%Module_Ver) + UB(1:1) = ubound(SrcOutputFileTypeData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_CopyProgDesc(SrcOutputFileTypeData%Module_Ver(i1), DstOutputFileTypeData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6127,9 +2594,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 @@ -6137,8 +2601,8 @@ subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) type(FAST_OutputFileType), intent(inout) :: OutputFileTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyOutputFileType' @@ -6156,24 +2620,22 @@ subroutine FAST_DestroyOutputFileType(OutputFileTypeData, ErrStat, ErrMsg) if (allocated(OutputFileTypeData%ChannelUnits)) then deallocate(OutputFileTypeData%ChannelUnits) end if - LB(1:1) = lbound(OutputFileTypeData%Module_Ver, kind=B8Ki) - UB(1:1) = ubound(OutputFileTypeData%Module_Ver, kind=B8Ki) + LB(1:1) = lbound(OutputFileTypeData%Module_Ver) + UB(1:1) = ubound(OutputFileTypeData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_DestroyProgDesc(OutputFileTypeData%Module_Ver(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do call FAST_DestroyLinFileType(OutputFileTypeData%Lin, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call FAST_DestroyLinStateSave(OutputFileTypeData%op, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackOutputFileType(RF, Indata) type(RegFile), intent(inout) :: RF type(FAST_OutputFileType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackOutputFileType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%TimeData) call RegPackAlloc(RF, InData%AllOutData) @@ -6186,8 +2648,8 @@ subroutine FAST_PackOutputFileType(RF, Indata) call RegPack(RF, InData%FileDescLines) call RegPackAlloc(RF, InData%ChannelNames) call RegPackAlloc(RF, InData%ChannelUnits) - LB(1:1) = lbound(InData%Module_Ver, kind=B8Ki) - UB(1:1) = ubound(InData%Module_Ver, kind=B8Ki) + LB(1:1) = lbound(InData%Module_Ver) + UB(1:1) = ubound(InData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_PackProgDesc(RF, InData%Module_Ver(i1)) end do @@ -6197,7 +2659,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 @@ -6206,8 +2667,8 @@ subroutine FAST_UnPackOutputFileType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_OutputFileType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackOutputFileType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -6222,8 +2683,8 @@ subroutine FAST_UnPackOutputFileType(RF, OutData) call RegUnpack(RF, OutData%FileDescLines); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%ChannelNames); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%ChannelUnits); if (RegCheckErr(RF, RoutineName)) return - LB(1:1) = lbound(OutData%Module_Ver, kind=B8Ki) - UB(1:1) = ubound(OutData%Module_Ver, kind=B8Ki) + LB(1:1) = lbound(OutData%Module_Ver) + UB(1:1) = ubound(OutData%Module_Ver) do i1 = LB(1), UB(1) call NWTC_Library_UnpackProgDesc(RF, OutData%Module_Ver(i1)) ! Module_Ver end do @@ -6233,7 +2694,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 @@ -6243,16 +2703,16 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyIceDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcIceDyn_DataData%x)) then - LB(1:2) = lbound(SrcIceDyn_DataData%x, kind=B8Ki) - UB(1:2) = ubound(SrcIceDyn_DataData%x, kind=B8Ki) + LB(1:2) = lbound(SrcIceDyn_DataData%x) + UB(1:2) = ubound(SrcIceDyn_DataData%x) if (.not. allocated(DstIceDyn_DataData%x)) then allocate(DstIceDyn_DataData%x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6269,8 +2729,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%xd)) then - LB(1:2) = lbound(SrcIceDyn_DataData%xd, kind=B8Ki) - UB(1:2) = ubound(SrcIceDyn_DataData%xd, kind=B8Ki) + LB(1:2) = lbound(SrcIceDyn_DataData%xd) + UB(1:2) = ubound(SrcIceDyn_DataData%xd) if (.not. allocated(DstIceDyn_DataData%xd)) then allocate(DstIceDyn_DataData%xd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6287,8 +2747,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%z)) then - LB(1:2) = lbound(SrcIceDyn_DataData%z, kind=B8Ki) - UB(1:2) = ubound(SrcIceDyn_DataData%z, kind=B8Ki) + LB(1:2) = lbound(SrcIceDyn_DataData%z) + UB(1:2) = ubound(SrcIceDyn_DataData%z) if (.not. allocated(DstIceDyn_DataData%z)) then allocate(DstIceDyn_DataData%z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6305,8 +2765,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%OtherSt)) then - LB(1:2) = lbound(SrcIceDyn_DataData%OtherSt, kind=B8Ki) - UB(1:2) = ubound(SrcIceDyn_DataData%OtherSt, kind=B8Ki) + LB(1:2) = lbound(SrcIceDyn_DataData%OtherSt) + UB(1:2) = ubound(SrcIceDyn_DataData%OtherSt) if (.not. allocated(DstIceDyn_DataData%OtherSt)) then allocate(DstIceDyn_DataData%OtherSt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6323,8 +2783,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%p)) then - LB(1:1) = lbound(SrcIceDyn_DataData%p, kind=B8Ki) - UB(1:1) = ubound(SrcIceDyn_DataData%p, kind=B8Ki) + LB(1:1) = lbound(SrcIceDyn_DataData%p) + UB(1:1) = ubound(SrcIceDyn_DataData%p) if (.not. allocated(DstIceDyn_DataData%p)) then allocate(DstIceDyn_DataData%p(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6338,25 +2798,9 @@ 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, kind=B8Ki) - UB(1:1) = ubound(SrcIceDyn_DataData%u, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcIceDyn_DataData%y, kind=B8Ki) + LB(1:1) = lbound(SrcIceDyn_DataData%y) + UB(1:1) = ubound(SrcIceDyn_DataData%y) if (.not. allocated(DstIceDyn_DataData%y)) then allocate(DstIceDyn_DataData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6371,8 +2815,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%m)) then - LB(1:1) = lbound(SrcIceDyn_DataData%m, kind=B8Ki) - UB(1:1) = ubound(SrcIceDyn_DataData%m, kind=B8Ki) + LB(1:1) = lbound(SrcIceDyn_DataData%m) + UB(1:1) = ubound(SrcIceDyn_DataData%m) if (.not. allocated(DstIceDyn_DataData%m)) then allocate(DstIceDyn_DataData%m(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6387,8 +2831,8 @@ subroutine FAST_CopyIceDyn_Data(SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode end do end if if (allocated(SrcIceDyn_DataData%Input)) then - LB(1:2) = lbound(SrcIceDyn_DataData%Input, kind=B8Ki) - UB(1:2) = ubound(SrcIceDyn_DataData%Input, kind=B8Ki) + LB(1:2) = lbound(SrcIceDyn_DataData%Input) + UB(1:2) = ubound(SrcIceDyn_DataData%Input) if (.not. allocated(DstIceDyn_DataData%Input)) then allocate(DstIceDyn_DataData%Input(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6404,27 +2848,9 @@ 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, kind=B8Ki) - UB(1:2) = ubound(SrcIceDyn_DataData%Input_Saved, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcIceDyn_DataData%InputTimes, kind=B8Ki) + LB(1:2) = lbound(SrcIceDyn_DataData%InputTimes) + UB(1:2) = ubound(SrcIceDyn_DataData%InputTimes) if (.not. allocated(DstIceDyn_DataData%InputTimes)) then allocate(DstIceDyn_DataData%InputTimes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6434,34 +2860,22 @@ 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, kind=B8Ki) - UB(1:2) = ubound(SrcIceDyn_DataData%InputTimes_Saved, kind=B8Ki) - 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) type(IceDyn_Data), intent(inout) :: IceDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyIceDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(IceDyn_DataData%x)) then - LB(1:2) = lbound(IceDyn_DataData%x, kind=B8Ki) - UB(1:2) = ubound(IceDyn_DataData%x, kind=B8Ki) + LB(1:2) = lbound(IceDyn_DataData%x) + UB(1:2) = ubound(IceDyn_DataData%x) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyContState(IceDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2) @@ -6471,8 +2885,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%x) end if if (allocated(IceDyn_DataData%xd)) then - LB(1:2) = lbound(IceDyn_DataData%xd, kind=B8Ki) - UB(1:2) = ubound(IceDyn_DataData%xd, kind=B8Ki) + LB(1:2) = lbound(IceDyn_DataData%xd) + UB(1:2) = ubound(IceDyn_DataData%xd) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyDiscState(IceDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2) @@ -6482,8 +2896,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%xd) end if if (allocated(IceDyn_DataData%z)) then - LB(1:2) = lbound(IceDyn_DataData%z, kind=B8Ki) - UB(1:2) = ubound(IceDyn_DataData%z, kind=B8Ki) + LB(1:2) = lbound(IceDyn_DataData%z) + UB(1:2) = ubound(IceDyn_DataData%z) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyConstrState(IceDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2) @@ -6493,8 +2907,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%z) end if if (allocated(IceDyn_DataData%OtherSt)) then - LB(1:2) = lbound(IceDyn_DataData%OtherSt, kind=B8Ki) - UB(1:2) = ubound(IceDyn_DataData%OtherSt, kind=B8Ki) + LB(1:2) = lbound(IceDyn_DataData%OtherSt) + UB(1:2) = ubound(IceDyn_DataData%OtherSt) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyOtherState(IceDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2) @@ -6504,26 +2918,17 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%OtherSt) end if if (allocated(IceDyn_DataData%p)) then - LB(1:1) = lbound(IceDyn_DataData%p, kind=B8Ki) - UB(1:1) = ubound(IceDyn_DataData%p, kind=B8Ki) + LB(1:1) = lbound(IceDyn_DataData%p) + UB(1:1) = ubound(IceDyn_DataData%p) do i1 = LB(1), UB(1) call IceD_DestroyParam(IceDyn_DataData%p(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(IceDyn_DataData%p) end if - if (allocated(IceDyn_DataData%u)) then - LB(1:1) = lbound(IceDyn_DataData%u, kind=B8Ki) - UB(1:1) = ubound(IceDyn_DataData%u, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(IceDyn_DataData%y, kind=B8Ki) + LB(1:1) = lbound(IceDyn_DataData%y) + UB(1:1) = ubound(IceDyn_DataData%y) do i1 = LB(1), UB(1) call IceD_DestroyOutput(IceDyn_DataData%y(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6531,8 +2936,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%y) end if if (allocated(IceDyn_DataData%m)) then - LB(1:1) = lbound(IceDyn_DataData%m, kind=B8Ki) - UB(1:1) = ubound(IceDyn_DataData%m, kind=B8Ki) + LB(1:1) = lbound(IceDyn_DataData%m) + UB(1:1) = ubound(IceDyn_DataData%m) do i1 = LB(1), UB(1) call IceD_DestroyMisc(IceDyn_DataData%m(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6540,8 +2945,8 @@ subroutine FAST_DestroyIceDyn_Data(IceDyn_DataData, ErrStat, ErrMsg) deallocate(IceDyn_DataData%m) end if if (allocated(IceDyn_DataData%Input)) then - LB(1:2) = lbound(IceDyn_DataData%Input, kind=B8Ki) - UB(1:2) = ubound(IceDyn_DataData%Input, kind=B8Ki) + LB(1:2) = lbound(IceDyn_DataData%Input) + UB(1:2) = ubound(IceDyn_DataData%Input) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call IceD_DestroyInput(IceDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2) @@ -6550,37 +2955,23 @@ 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, kind=B8Ki) - UB(1:2) = ubound(IceDyn_DataData%Input_Saved, kind=B8Ki) - 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) type(RegFile), intent(inout) :: RF type(IceDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackIceDyn_Data' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 2, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:2) = lbound(InData%x, kind=B8Ki) - UB(1:2) = ubound(InData%x, kind=B8Ki) + 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 IceD_PackContState(RF, InData%x(i1,i2)) @@ -6589,9 +2980,9 @@ subroutine FAST_PackIceDyn_Data(RF, Indata) end if call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 2, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:2) = lbound(InData%xd, kind=B8Ki) - UB(1:2) = ubound(InData%xd, kind=B8Ki) + 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 IceD_PackDiscState(RF, InData%xd(i1,i2)) @@ -6600,9 +2991,9 @@ subroutine FAST_PackIceDyn_Data(RF, Indata) end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 2, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:2) = lbound(InData%z, kind=B8Ki) - UB(1:2) = ubound(InData%z, kind=B8Ki) + 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 IceD_PackConstrState(RF, InData%z(i1,i2)) @@ -6611,9 +3002,9 @@ subroutine FAST_PackIceDyn_Data(RF, Indata) end if call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(RF, 2, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) - LB(1:2) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:2) = ubound(InData%OtherSt, kind=B8Ki) + 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 IceD_PackOtherState(RF, InData%OtherSt(i1,i2)) @@ -6622,64 +3013,43 @@ subroutine FAST_PackIceDyn_Data(RF, Indata) end if call RegPack(RF, allocated(InData%p)) if (allocated(InData%p)) then - call RegPackBounds(RF, 1, lbound(InData%p, kind=B8Ki), ubound(InData%p, kind=B8Ki)) - LB(1:1) = lbound(InData%p, kind=B8Ki) - UB(1:1) = ubound(InData%p, kind=B8Ki) + 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 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, kind=B8Ki), ubound(InData%u, kind=B8Ki)) - LB(1:1) = lbound(InData%u, kind=B8Ki) - UB(1:1) = ubound(InData%u, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%y, kind=B8Ki)) - LB(1:1) = lbound(InData%y, kind=B8Ki) - UB(1:1) = ubound(InData%y, kind=B8Ki) + 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 IceD_PackOutput(RF, InData%y(i1)) end do end if call RegPack(RF, allocated(InData%m)) if (allocated(InData%m)) then - call RegPackBounds(RF, 1, lbound(InData%m, kind=B8Ki), ubound(InData%m, kind=B8Ki)) - LB(1:1) = lbound(InData%m, kind=B8Ki) - UB(1:1) = ubound(InData%m, kind=B8Ki) + 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 IceD_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, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:2) = lbound(InData%Input, kind=B8Ki) - UB(1:2) = ubound(InData%Input, kind=B8Ki) + 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 IceD_PackInput(RF, InData%Input(i1,i2)) 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, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:2) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:2) = ubound(InData%Input_Saved, kind=B8Ki) - 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 @@ -6687,8 +3057,8 @@ subroutine FAST_UnPackIceDyn_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(IceDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackIceDyn_Data' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -6765,19 +3135,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 +3176,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) @@ -6844,16 +3185,16 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyBeamDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcBeamDyn_DataData%x)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%x, kind=B8Ki) - UB(1:2) = ubound(SrcBeamDyn_DataData%x, kind=B8Ki) + LB(1:2) = lbound(SrcBeamDyn_DataData%x) + UB(1:2) = ubound(SrcBeamDyn_DataData%x) if (.not. allocated(DstBeamDyn_DataData%x)) then allocate(DstBeamDyn_DataData%x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6869,9 +3210,25 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end do end if + if (allocated(SrcBeamDyn_DataData%dxdt)) then + LB(1:1) = lbound(SrcBeamDyn_DataData%dxdt) + UB(1:1) = ubound(SrcBeamDyn_DataData%dxdt) + if (.not. allocated(DstBeamDyn_DataData%dxdt)) then + allocate(DstBeamDyn_DataData%dxdt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%dxdt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call BD_CopyContState(SrcBeamDyn_DataData%dxdt(i1), DstBeamDyn_DataData%dxdt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if if (allocated(SrcBeamDyn_DataData%xd)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%xd, kind=B8Ki) - UB(1:2) = ubound(SrcBeamDyn_DataData%xd, kind=B8Ki) + LB(1:2) = lbound(SrcBeamDyn_DataData%xd) + UB(1:2) = ubound(SrcBeamDyn_DataData%xd) if (.not. allocated(DstBeamDyn_DataData%xd)) then allocate(DstBeamDyn_DataData%xd(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6888,8 +3245,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%z)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%z, kind=B8Ki) - UB(1:2) = ubound(SrcBeamDyn_DataData%z, kind=B8Ki) + LB(1:2) = lbound(SrcBeamDyn_DataData%z) + UB(1:2) = ubound(SrcBeamDyn_DataData%z) if (.not. allocated(DstBeamDyn_DataData%z)) then allocate(DstBeamDyn_DataData%z(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6906,8 +3263,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%OtherSt)) then - LB(1:2) = lbound(SrcBeamDyn_DataData%OtherSt, kind=B8Ki) - UB(1:2) = ubound(SrcBeamDyn_DataData%OtherSt, kind=B8Ki) + LB(1:2) = lbound(SrcBeamDyn_DataData%OtherSt) + UB(1:2) = ubound(SrcBeamDyn_DataData%OtherSt) if (.not. allocated(DstBeamDyn_DataData%OtherSt)) then allocate(DstBeamDyn_DataData%OtherSt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6924,8 +3281,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%p)) then - LB(1:1) = lbound(SrcBeamDyn_DataData%p, kind=B8Ki) - UB(1:1) = ubound(SrcBeamDyn_DataData%p, kind=B8Ki) + LB(1:1) = lbound(SrcBeamDyn_DataData%p) + UB(1:1) = ubound(SrcBeamDyn_DataData%p) if (.not. allocated(DstBeamDyn_DataData%p)) then allocate(DstBeamDyn_DataData%p(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6939,25 +3296,9 @@ 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, kind=B8Ki) - UB(1:1) = ubound(SrcBeamDyn_DataData%u, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcBeamDyn_DataData%y, kind=B8Ki) + LB(1:1) = lbound(SrcBeamDyn_DataData%y) + UB(1:1) = ubound(SrcBeamDyn_DataData%y) if (.not. allocated(DstBeamDyn_DataData%y)) then allocate(DstBeamDyn_DataData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6972,8 +3313,8 @@ subroutine FAST_CopyBeamDyn_Data(SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlC end do end if if (allocated(SrcBeamDyn_DataData%m)) then - LB(1:1) = lbound(SrcBeamDyn_DataData%m, kind=B8Ki) - UB(1:1) = ubound(SrcBeamDyn_DataData%m, kind=B8Ki) + LB(1:1) = lbound(SrcBeamDyn_DataData%m) + UB(1:1) = ubound(SrcBeamDyn_DataData%m) if (.not. allocated(DstBeamDyn_DataData%m)) then allocate(DstBeamDyn_DataData%m(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -6987,43 +3328,9 @@ 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, kind=B8Ki) - UB(1:2) = ubound(SrcBeamDyn_DataData%Output, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcBeamDyn_DataData%y_interp, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcBeamDyn_DataData%Input, kind=B8Ki) + LB(1:2) = lbound(SrcBeamDyn_DataData%Input) + UB(1:2) = ubound(SrcBeamDyn_DataData%Input) if (.not. allocated(DstBeamDyn_DataData%Input)) then allocate(DstBeamDyn_DataData%Input(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7039,27 +3346,9 @@ 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, kind=B8Ki) - UB(1:2) = ubound(SrcBeamDyn_DataData%Input_Saved, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcBeamDyn_DataData%InputTimes, kind=B8Ki) + LB(1:2) = lbound(SrcBeamDyn_DataData%InputTimes) + UB(1:2) = ubound(SrcBeamDyn_DataData%InputTimes) if (.not. allocated(DstBeamDyn_DataData%InputTimes)) then allocate(DstBeamDyn_DataData%InputTimes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7069,34 +3358,22 @@ 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, kind=B8Ki) - UB(1:2) = ubound(SrcBeamDyn_DataData%InputTimes_Saved, kind=B8Ki) - 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) type(BeamDyn_Data), intent(inout) :: BeamDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyBeamDyn_Data' ErrStat = ErrID_None ErrMsg = '' if (allocated(BeamDyn_DataData%x)) then - LB(1:2) = lbound(BeamDyn_DataData%x, kind=B8Ki) - UB(1:2) = ubound(BeamDyn_DataData%x, kind=B8Ki) + LB(1:2) = lbound(BeamDyn_DataData%x) + UB(1:2) = ubound(BeamDyn_DataData%x) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyContState(BeamDyn_DataData%x(i1,i2), ErrStat2, ErrMsg2) @@ -7105,9 +3382,18 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) end do deallocate(BeamDyn_DataData%x) end if + if (allocated(BeamDyn_DataData%dxdt)) then + LB(1:1) = lbound(BeamDyn_DataData%dxdt) + UB(1:1) = ubound(BeamDyn_DataData%dxdt) + do i1 = LB(1), UB(1) + call BD_DestroyContState(BeamDyn_DataData%dxdt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(BeamDyn_DataData%dxdt) + end if if (allocated(BeamDyn_DataData%xd)) then - LB(1:2) = lbound(BeamDyn_DataData%xd, kind=B8Ki) - UB(1:2) = ubound(BeamDyn_DataData%xd, kind=B8Ki) + LB(1:2) = lbound(BeamDyn_DataData%xd) + UB(1:2) = ubound(BeamDyn_DataData%xd) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyDiscState(BeamDyn_DataData%xd(i1,i2), ErrStat2, ErrMsg2) @@ -7117,8 +3403,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%xd) end if if (allocated(BeamDyn_DataData%z)) then - LB(1:2) = lbound(BeamDyn_DataData%z, kind=B8Ki) - UB(1:2) = ubound(BeamDyn_DataData%z, kind=B8Ki) + LB(1:2) = lbound(BeamDyn_DataData%z) + UB(1:2) = ubound(BeamDyn_DataData%z) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyConstrState(BeamDyn_DataData%z(i1,i2), ErrStat2, ErrMsg2) @@ -7128,8 +3414,8 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%z) end if if (allocated(BeamDyn_DataData%OtherSt)) then - LB(1:2) = lbound(BeamDyn_DataData%OtherSt, kind=B8Ki) - UB(1:2) = ubound(BeamDyn_DataData%OtherSt, kind=B8Ki) + LB(1:2) = lbound(BeamDyn_DataData%OtherSt) + UB(1:2) = ubound(BeamDyn_DataData%OtherSt) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyOtherState(BeamDyn_DataData%OtherSt(i1,i2), ErrStat2, ErrMsg2) @@ -7139,26 +3425,17 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%OtherSt) end if if (allocated(BeamDyn_DataData%p)) then - LB(1:1) = lbound(BeamDyn_DataData%p, kind=B8Ki) - UB(1:1) = ubound(BeamDyn_DataData%p, kind=B8Ki) + LB(1:1) = lbound(BeamDyn_DataData%p) + UB(1:1) = ubound(BeamDyn_DataData%p) do i1 = LB(1), UB(1) call BD_DestroyParam(BeamDyn_DataData%p(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(BeamDyn_DataData%p) end if - if (allocated(BeamDyn_DataData%u)) then - LB(1:1) = lbound(BeamDyn_DataData%u, kind=B8Ki) - UB(1:1) = ubound(BeamDyn_DataData%u, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(BeamDyn_DataData%y, kind=B8Ki) + LB(1:1) = lbound(BeamDyn_DataData%y) + UB(1:1) = ubound(BeamDyn_DataData%y) do i1 = LB(1), UB(1) call BD_DestroyOutput(BeamDyn_DataData%y(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7166,37 +3443,17 @@ subroutine FAST_DestroyBeamDyn_Data(BeamDyn_DataData, ErrStat, ErrMsg) deallocate(BeamDyn_DataData%y) end if if (allocated(BeamDyn_DataData%m)) then - LB(1:1) = lbound(BeamDyn_DataData%m, kind=B8Ki) - UB(1:1) = ubound(BeamDyn_DataData%m, kind=B8Ki) + LB(1:1) = lbound(BeamDyn_DataData%m) + UB(1:1) = ubound(BeamDyn_DataData%m) do i1 = LB(1), UB(1) call BD_DestroyMisc(BeamDyn_DataData%m(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(BeamDyn_DataData%m) end if - if (allocated(BeamDyn_DataData%Output)) then - LB(1:2) = lbound(BeamDyn_DataData%Output, kind=B8Ki) - UB(1:2) = ubound(BeamDyn_DataData%Output, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(BeamDyn_DataData%y_interp, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(BeamDyn_DataData%Input, kind=B8Ki) + LB(1:2) = lbound(BeamDyn_DataData%Input) + UB(1:2) = ubound(BeamDyn_DataData%Input) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call BD_DestroyInput(BeamDyn_DataData%Input(i1,i2), ErrStat2, ErrMsg2) @@ -7205,48 +3462,43 @@ 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, kind=B8Ki) - UB(1:2) = ubound(BeamDyn_DataData%Input_Saved, kind=B8Ki) - 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) type(RegFile), intent(inout) :: RF type(BeamDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackBeamDyn_Data' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%x)) if (allocated(InData%x)) then - call RegPackBounds(RF, 2, lbound(InData%x, kind=B8Ki), ubound(InData%x, kind=B8Ki)) - LB(1:2) = lbound(InData%x, kind=B8Ki) - UB(1:2) = ubound(InData%x, kind=B8Ki) + 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 BD_PackContState(RF, InData%x(i1,i2)) end do end do end if + call RegPack(RF, allocated(InData%dxdt)) + if (allocated(InData%dxdt)) then + call RegPackBounds(RF, 1, lbound(InData%dxdt), ubound(InData%dxdt)) + LB(1:1) = lbound(InData%dxdt) + UB(1:1) = ubound(InData%dxdt) + do i1 = LB(1), UB(1) + call BD_PackContState(RF, InData%dxdt(i1)) + end do + end if call RegPack(RF, allocated(InData%xd)) if (allocated(InData%xd)) then - call RegPackBounds(RF, 2, lbound(InData%xd, kind=B8Ki), ubound(InData%xd, kind=B8Ki)) - LB(1:2) = lbound(InData%xd, kind=B8Ki) - UB(1:2) = ubound(InData%xd, kind=B8Ki) + 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 BD_PackDiscState(RF, InData%xd(i1,i2)) @@ -7255,9 +3507,9 @@ subroutine FAST_PackBeamDyn_Data(RF, Indata) end if call RegPack(RF, allocated(InData%z)) if (allocated(InData%z)) then - call RegPackBounds(RF, 2, lbound(InData%z, kind=B8Ki), ubound(InData%z, kind=B8Ki)) - LB(1:2) = lbound(InData%z, kind=B8Ki) - UB(1:2) = ubound(InData%z, kind=B8Ki) + 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 BD_PackConstrState(RF, InData%z(i1,i2)) @@ -7266,9 +3518,9 @@ subroutine FAST_PackBeamDyn_Data(RF, Indata) end if call RegPack(RF, allocated(InData%OtherSt)) if (allocated(InData%OtherSt)) then - call RegPackBounds(RF, 2, lbound(InData%OtherSt, kind=B8Ki), ubound(InData%OtherSt, kind=B8Ki)) - LB(1:2) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:2) = ubound(InData%OtherSt, kind=B8Ki) + 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 BD_PackOtherState(RF, InData%OtherSt(i1,i2)) @@ -7277,84 +3529,43 @@ subroutine FAST_PackBeamDyn_Data(RF, Indata) end if call RegPack(RF, allocated(InData%p)) if (allocated(InData%p)) then - call RegPackBounds(RF, 1, lbound(InData%p, kind=B8Ki), ubound(InData%p, kind=B8Ki)) - LB(1:1) = lbound(InData%p, kind=B8Ki) - UB(1:1) = ubound(InData%p, kind=B8Ki) + 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 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, kind=B8Ki), ubound(InData%u, kind=B8Ki)) - LB(1:1) = lbound(InData%u, kind=B8Ki) - UB(1:1) = ubound(InData%u, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%y, kind=B8Ki)) - LB(1:1) = lbound(InData%y, kind=B8Ki) - UB(1:1) = ubound(InData%y, kind=B8Ki) + 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 BD_PackOutput(RF, InData%y(i1)) end do end if call RegPack(RF, allocated(InData%m)) if (allocated(InData%m)) then - call RegPackBounds(RF, 1, lbound(InData%m, kind=B8Ki), ubound(InData%m, kind=B8Ki)) - LB(1:1) = lbound(InData%m, kind=B8Ki) - UB(1:1) = ubound(InData%m, kind=B8Ki) + 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 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, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:2) = lbound(InData%Output, kind=B8Ki) - UB(1:2) = ubound(InData%Output, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%y_interp, kind=B8Ki)) - LB(1:1) = lbound(InData%y_interp, kind=B8Ki) - UB(1:1) = ubound(InData%y_interp, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:2) = lbound(InData%Input, kind=B8Ki) - UB(1:2) = ubound(InData%Input, kind=B8Ki) + 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 BD_PackInput(RF, InData%Input(i1,i2)) 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, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:2) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:2) = ubound(InData%Input_Saved, kind=B8Ki) - 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 @@ -7362,8 +3573,8 @@ subroutine FAST_UnPackBeamDyn_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(BeamDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackBeamDyn_Data' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -7382,6 +3593,19 @@ subroutine FAST_UnPackBeamDyn_Data(RF, OutData) end do end do end if + if (allocated(OutData%dxdt)) deallocate(OutData%dxdt) + 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%dxdt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dxdt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call BD_UnpackContState(RF, OutData%dxdt(i1)) ! dxdt + end do + end if if (allocated(OutData%xd)) deallocate(OutData%xd) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -7440,19 +3664,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,34 +3690,6 @@ 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) - 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) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', 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 - 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 - end if - do i1 = LB(1), UB(1) - call BD_UnpackOutput(RF, OutData%y_interp(i1)) ! y_interp - end do - end if if (allocated(OutData%Input)) deallocate(OutData%Input) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then @@ -7522,23 +3705,7 @@ subroutine FAST_UnPackBeamDyn_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 BD_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_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, CtrlCode, ErrStat, ErrMsg) @@ -7547,123 +3714,108 @@ subroutine FAST_CopyElastoDyn_Data(SrcElastoDyn_DataData, DstElastoDyn_DataData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%OtherSt, kind=B8Ki) - 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) + if (allocated(SrcElastoDyn_DataData%x)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%x) + UB(1:1) = ubound(SrcElastoDyn_DataData%x) + if (.not. allocated(DstElastoDyn_DataData%x)) then + allocate(DstElastoDyn_DataData%x(LB(1):UB(1)), 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 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 + end if + call ED_CopyContState(SrcElastoDyn_DataData%dxdt, DstElastoDyn_DataData%dxdt, 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, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%Output, kind=B8Ki) - if (.not. allocated(DstElastoDyn_DataData%Output)) then - allocate(DstElastoDyn_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcElastoDyn_DataData%xd)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%xd) + UB(1:1) = ubound(SrcElastoDyn_DataData%xd) + if (.not. allocated(DstElastoDyn_DataData%xd)) then + allocate(DstElastoDyn_DataData%xd(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%xd.', 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_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 end if - if (allocated(SrcElastoDyn_DataData%Output_bak)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%Output_bak, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%Output_bak, kind=B8Ki) - if (.not. allocated(DstElastoDyn_DataData%Output_bak)) then - allocate(DstElastoDyn_DataData%Output_bak(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcElastoDyn_DataData%z)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%z) + UB(1:1) = ubound(SrcElastoDyn_DataData%z) + if (.not. allocated(DstElastoDyn_DataData%z)) then + allocate(DstElastoDyn_DataData%z(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%z.', 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_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 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, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%Input, kind=B8Ki) - if (.not. allocated(DstElastoDyn_DataData%Input)) then - allocate(DstElastoDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcElastoDyn_DataData%OtherSt)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcElastoDyn_DataData%OtherSt) + if (.not. allocated(DstElastoDyn_DataData%OtherSt)) then + allocate(DstElastoDyn_DataData%OtherSt(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%OtherSt.', 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_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 end if - if (allocated(SrcElastoDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstElastoDyn_DataData%Input_Saved)) then - allocate(DstElastoDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + 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_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%Input)) then + LB(1:1) = lbound(SrcElastoDyn_DataData%Input) + UB(1:1) = ubound(SrcElastoDyn_DataData%Input) + if (.not. allocated(DstElastoDyn_DataData%Input)) then + allocate(DstElastoDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input_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 ED_CopyInput(SrcElastoDyn_DataData%Input(i1), DstElastoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end if if (allocated(SrcElastoDyn_DataData%InputTimes)) then - LB(1:1) = lbound(SrcElastoDyn_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcElastoDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcElastoDyn_DataData%InputTimes) if (.not. allocated(DstElastoDyn_DataData%InputTimes)) then allocate(DstElastoDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -7673,179 +3825,134 @@ 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, kind=B8Ki) - UB(1:1) = ubound(SrcElastoDyn_DataData%InputTimes_Saved, kind=B8Ki) - 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(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyElastoDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(ElastoDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%OtherSt, kind=B8Ki) - 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) + if (allocated(ElastoDyn_DataData%x)) then + 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 + deallocate(ElastoDyn_DataData%x) + end if + call ED_DestroyContState(ElastoDyn_DataData%dxdt, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(ElastoDyn_DataData%Output)) then - LB(1:1) = lbound(ElastoDyn_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%Output, kind=B8Ki) + if (allocated(ElastoDyn_DataData%xd)) then + LB(1:1) = lbound(ElastoDyn_DataData%xd) + UB(1:1) = ubound(ElastoDyn_DataData%xd) do i1 = LB(1), UB(1) - call ED_DestroyOutput(ElastoDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call ED_DestroyDiscState(ElastoDyn_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(ElastoDyn_DataData%Output) + deallocate(ElastoDyn_DataData%xd) end if - if (allocated(ElastoDyn_DataData%Output_bak)) then - LB(1:1) = lbound(ElastoDyn_DataData%Output_bak, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%Output_bak, kind=B8Ki) + if (allocated(ElastoDyn_DataData%z)) then + LB(1:1) = lbound(ElastoDyn_DataData%z) + UB(1:1) = ubound(ElastoDyn_DataData%z) do i1 = LB(1), UB(1) - call ED_DestroyOutput(ElastoDyn_DataData%Output_bak(i1), ErrStat2, ErrMsg2) + call ED_DestroyConstrState(ElastoDyn_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(ElastoDyn_DataData%Output_bak) + deallocate(ElastoDyn_DataData%z) 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, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%Input, kind=B8Ki) + if (allocated(ElastoDyn_DataData%OtherSt)) then + LB(1:1) = lbound(ElastoDyn_DataData%OtherSt) + UB(1:1) = ubound(ElastoDyn_DataData%OtherSt) do i1 = LB(1), UB(1) - call ED_DestroyInput(ElastoDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call ED_DestroyOtherState(ElastoDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(ElastoDyn_DataData%Input) + deallocate(ElastoDyn_DataData%OtherSt) end if - if (allocated(ElastoDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(ElastoDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(ElastoDyn_DataData%Input_Saved, kind=B8Ki) + call ED_DestroyParam(ElastoDyn_DataData%p, 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%Input)) then + LB(1:1) = lbound(ElastoDyn_DataData%Input) + UB(1:1) = ubound(ElastoDyn_DataData%Input) do i1 = LB(1), UB(1) - call ED_DestroyInput(ElastoDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call ED_DestroyInput(ElastoDyn_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(ElastoDyn_DataData%Input_Saved) + 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(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) + 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 ED_PackOutput(RF, InData%Output(i1)) + call ED_PackContState(RF, InData%x(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, kind=B8Ki), ubound(InData%Output_bak, kind=B8Ki)) - LB(1:1) = lbound(InData%Output_bak, kind=B8Ki) - UB(1:1) = ubound(InData%Output_bak, kind=B8Ki) + call ED_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 ED_PackOutput(RF, InData%Output_bak(i1)) + call ED_PackDiscState(RF, InData%xd(i1)) 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, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + 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 ED_PackInput(RF, InData%Input(i1)) + call ED_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 ED_PackOtherState(RF, InData%OtherSt(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, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) + call ED_PackParam(RF, InData%p) + call ED_PackOutput(RF, InData%y) + call ED_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)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) - call ED_PackInput(RF, InData%Input_Saved(i1)) + call ED_PackInput(RF, InData%Input(i1)) end do end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -7853,90 +3960,81 @@ subroutine FAST_UnPackElastoDyn_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(ElastoDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackElastoDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call ED_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - 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%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 ED_UnpackOutput(RF, OutData%Output(i1)) ! Output + call ED_UnpackContState(RF, OutData%x(i1)) ! x end do end if - if (allocated(OutData%Output_bak)) deallocate(OutData%Output_bak) + call ED_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%Output_bak(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_bak.', 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 ED_UnpackOutput(RF, OutData%Output_bak(i1)) ! Output_bak + call ED_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do end if - call ED_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 ED_UnpackInput(RF, OutData%Input(i1)) ! Input + call ED_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 ED_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call ED_UnpackParam(RF, OutData%p) ! p + call ED_UnpackOutput(RF, OutData%y) ! y + call ED_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 ED_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + call ED_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_CopySED_Data(SrcSED_DataData, DstSED_DataData, CtrlCode, ErrStat, ErrMsg) @@ -7945,75 +4043,89 @@ subroutine FAST_CopySED_Data(SrcSED_DataData, DstSED_DataData, CtrlCode, ErrStat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopySED_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcSED_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcSED_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcSED_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcSED_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcSED_DataData%OtherSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcSED_DataData%Output, kind=B8Ki) - 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 - LB(1:1) = lbound(SrcSED_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcSED_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcSED_DataData%Input) + UB(1:1) = ubound(SrcSED_DataData%Input) if (.not. allocated(DstSED_DataData%Input)) then allocate(DstSED_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8028,8 +4140,8 @@ subroutine FAST_CopySED_Data(SrcSED_DataData, DstSED_DataData, CtrlCode, ErrStat end do end if if (allocated(SrcSED_DataData%InputTimes)) then - LB(1:1) = lbound(SrcSED_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcSED_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcSED_DataData%InputTimes) + UB(1:1) = ubound(SrcSED_DataData%InputTimes) if (.not. allocated(DstSED_DataData%InputTimes)) then allocate(DstSED_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -8045,116 +4157,120 @@ subroutine FAST_DestroySED_Data(SED_DataData, ErrStat, ErrMsg) type(SED_Data), intent(inout) :: SED_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroySED_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SED_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SED_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SED_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SED_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SED_DataData%OtherSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SED_DataData%Output, kind=B8Ki) + if (allocated(SED_DataData%Input)) then + LB(1:1) = lbound(SED_DataData%Input) + UB(1:1) = ubound(SED_DataData%Input) + do i1 = LB(1), UB(1) + call SED_DestroyInput(SED_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SED_DataData%Input) + end if + if (allocated(SED_DataData%InputTimes)) then + deallocate(SED_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackSED_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SED_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackSED_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + 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_DestroyOutput(SED_DataData%Output(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SED_PackConstrState(RF, InData%z(i1)) 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, kind=B8Ki) - UB(1:1) = ubound(SED_DataData%Input, kind=B8Ki) + 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_DestroyInput(SED_DataData%Input(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SED_PackOtherState(RF, InData%OtherSt(i1)) end do - deallocate(SED_DataData%Input) end if - if (allocated(SED_DataData%InputTimes)) then - deallocate(SED_DataData%InputTimes) - end if -end subroutine - -subroutine FAST_PackSED_Data(RF, Indata) - type(RegFile), intent(inout) :: RF - type(SED_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackSED_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SED_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SED_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SED_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SED_PackOtherState(RF, InData%OtherSt(i1)) - end do 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, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call SED_PackOutput(RF, InData%Output(i1)) - 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, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + 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 @@ -8167,49 +4283,66 @@ subroutine FAST_UnPackSED_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(SED_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackSED_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SED_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SED_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SED_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - 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%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_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 SED_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 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 @@ -8232,130 +4365,113 @@ subroutine FAST_CopyServoDyn_Data(SrcServoDyn_DataData, DstServoDyn_DataData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyServoDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcServoDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%OtherSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%Output, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%Input, kind=B8Ki) - 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%Input_Saved)) then - LB(1:1) = lbound(SrcServoDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstServoDyn_DataData%Input_Saved)) then - allocate(DstServoDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + 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%Input_Saved.', ErrStat, ErrMsg, RoutineName) + 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_CopyInput(SrcServoDyn_DataData%Input_Saved(i1), DstServoDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + 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%InputTimes)) then - LB(1:1) = lbound(SrcServoDyn_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%InputTimes, kind=B8Ki) - if (.not. allocated(DstServoDyn_DataData%InputTimes)) then - allocate(DstServoDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + 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%InputTimes.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) return end if end if - DstServoDyn_DataData%InputTimes = SrcServoDyn_DataData%InputTimes + 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 + 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.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SrvD_CopyInput(SrcServoDyn_DataData%Input(i1), DstServoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcServoDyn_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcServoDyn_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcServoDyn_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstServoDyn_DataData%InputTimes_Saved)) then - allocate(DstServoDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcServoDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcServoDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcServoDyn_DataData%InputTimes) + if (.not. allocated(DstServoDyn_DataData%InputTimes)) then + allocate(DstServoDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) return end if end if - DstServoDyn_DataData%InputTimes_Saved = SrcServoDyn_DataData%InputTimes_Saved + DstServoDyn_DataData%InputTimes = SrcServoDyn_DataData%InputTimes end if end subroutine @@ -8363,146 +4479,125 @@ subroutine FAST_DestroyServoDyn_Data(ServoDyn_DataData, ErrStat, ErrMsg) type(ServoDyn_Data), intent(inout) :: ServoDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyServoDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(ServoDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(ServoDyn_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(ServoDyn_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(ServoDyn_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(ServoDyn_DataData%OtherSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(ServoDyn_DataData%Output, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(ServoDyn_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(ServoDyn_DataData%Input) + UB(1:1) = ubound(ServoDyn_DataData%Input) do i1 = LB(1), UB(1) call SrvD_DestroyInput(ServoDyn_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(ServoDyn_DataData%Input) end if - if (allocated(ServoDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(ServoDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(ServoDyn_DataData%Input_Saved, kind=B8Ki) - 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) type(RegFile), intent(inout) :: RF type(ServoDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackServoDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) + 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_PackOutput(RF, InData%Output(i1)) + call SrvD_PackContState(RF, InData%x(i1)) end do end if - call SrvD_PackOutput(RF, InData%y_interp) - call RegPack(RF, allocated(InData%Input)) - if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + 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_PackInput(RF, InData%Input(i1)) + 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_PackOtherState(RF, InData%OtherSt(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, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) + 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)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) - call SrvD_PackInput(RF, InData%Input_Saved(i1)) + call SrvD_PackInput(RF, InData%Input(i1)) end do end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -8510,78 +4605,80 @@ subroutine FAST_UnPackServoDyn_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(ServoDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackServoDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SrvD_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - 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) @@ -8590,127 +4687,113 @@ subroutine FAST_CopyAeroDyn_Data(SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyAeroDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcAeroDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%OtherSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%Output, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%Input, kind=B8Ki) - 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%Input_Saved)) then - LB(1:1) = lbound(SrcAeroDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstAeroDyn_DataData%Input_Saved)) then - allocate(DstAeroDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + 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%Input_Saved.', ErrStat, ErrMsg, RoutineName) + 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_CopyInput(SrcAeroDyn_DataData%Input_Saved(i1), DstAeroDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + 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%InputTimes)) then - LB(1:1) = lbound(SrcAeroDyn_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%InputTimes, kind=B8Ki) - if (.not. allocated(DstAeroDyn_DataData%InputTimes)) then - allocate(DstAeroDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + 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%InputTimes.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) return end if end if - DstAeroDyn_DataData%InputTimes = SrcAeroDyn_DataData%InputTimes + 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 + 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.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call AD_CopyInput(SrcAeroDyn_DataData%Input(i1), DstAeroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcAeroDyn_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcAeroDyn_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDyn_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstAeroDyn_DataData%InputTimes_Saved)) then - allocate(DstAeroDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcAeroDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcAeroDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcAeroDyn_DataData%InputTimes) + if (.not. allocated(DstAeroDyn_DataData%InputTimes)) then + allocate(DstAeroDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) return end if end if - DstAeroDyn_DataData%InputTimes_Saved = SrcAeroDyn_DataData%InputTimes_Saved + DstAeroDyn_DataData%InputTimes = SrcAeroDyn_DataData%InputTimes end if end subroutine @@ -8718,143 +4801,125 @@ subroutine FAST_DestroyAeroDyn_Data(AeroDyn_DataData, ErrStat, ErrMsg) type(AeroDyn_Data), intent(inout) :: AeroDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyAeroDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(AeroDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(AeroDyn_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(AeroDyn_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(AeroDyn_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(AeroDyn_DataData%OtherSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(AeroDyn_DataData%Output, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(AeroDyn_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(AeroDyn_DataData%Input) + UB(1:1) = ubound(AeroDyn_DataData%Input) do i1 = LB(1), UB(1) call AD_DestroyInput(AeroDyn_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(AeroDyn_DataData%Input) end if - if (allocated(AeroDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(AeroDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(AeroDyn_DataData%Input_Saved, kind=B8Ki) - 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) type(RegFile), intent(inout) :: RF type(AeroDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackAeroDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) + 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_PackOutput(RF, InData%Output(i1)) + call AD_PackContState(RF, InData%x(i1)) end do end if - call AD_PackOutput(RF, InData%y_interp) - call RegPack(RF, allocated(InData%Input)) - if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + 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_PackInput(RF, InData%Input(i1)) + 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_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 AD_PackOtherState(RF, InData%OtherSt(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, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) + 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)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) - call AD_PackInput(RF, InData%Input_Saved(i1)) + call AD_PackInput(RF, InData%Input(i1)) end do end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -8862,77 +4927,80 @@ subroutine FAST_UnPackAeroDyn_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(AeroDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackAeroDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call AD_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - 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%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 AD_UnpackOutput(RF, OutData%Output(i1)) ! Output + call AD_UnpackContState(RF, OutData%x(i1)) ! x end do end if - call AD_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 AD_UnpackInput(RF, OutData%Input(i1)) ! Input + call AD_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 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) @@ -8941,36 +5009,36 @@ subroutine FAST_CopyExtLoads_Data(SrcExtLoads_DataData, DstExtLoads_DataData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyExtLoads_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcExtLoads_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcExtLoads_DataData%x, kind=B8Ki) + LB(1:1) = lbound(SrcExtLoads_DataData%x) + UB(1:1) = ubound(SrcExtLoads_DataData%x) do i1 = LB(1), UB(1) call ExtLd_CopyContState(SrcExtLoads_DataData%x(i1), DstExtLoads_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcExtLoads_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(SrcExtLoads_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(SrcExtLoads_DataData%xd) + UB(1:1) = ubound(SrcExtLoads_DataData%xd) do i1 = LB(1), UB(1) call ExtLd_CopyDiscState(SrcExtLoads_DataData%xd(i1), DstExtLoads_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcExtLoads_DataData%z, kind=B8Ki) - UB(1:1) = ubound(SrcExtLoads_DataData%z, kind=B8Ki) + LB(1:1) = lbound(SrcExtLoads_DataData%z) + UB(1:1) = ubound(SrcExtLoads_DataData%z) do i1 = LB(1), UB(1) call ExtLd_CopyConstrState(SrcExtLoads_DataData%z(i1), DstExtLoads_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do - LB(1:1) = lbound(SrcExtLoads_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(SrcExtLoads_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(SrcExtLoads_DataData%OtherSt) + UB(1:1) = ubound(SrcExtLoads_DataData%OtherSt) do i1 = LB(1), UB(1) call ExtLd_CopyOtherState(SrcExtLoads_DataData%OtherSt(i1), DstExtLoads_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -8989,8 +5057,8 @@ subroutine FAST_CopyExtLoads_Data(SrcExtLoads_DataData, DstExtLoads_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcExtLoads_DataData%InputTimes)) then - LB(1:1) = lbound(SrcExtLoads_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcExtLoads_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcExtLoads_DataData%InputTimes) + UB(1:1) = ubound(SrcExtLoads_DataData%InputTimes) if (.not. allocated(DstExtLoads_DataData%InputTimes)) then allocate(DstExtLoads_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9006,33 +5074,33 @@ subroutine FAST_DestroyExtLoads_Data(ExtLoads_DataData, ErrStat, ErrMsg) type(ExtLoads_Data), intent(inout) :: ExtLoads_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyExtLoads_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(ExtLoads_DataData%x, kind=B8Ki) - UB(1:1) = ubound(ExtLoads_DataData%x, kind=B8Ki) + LB(1:1) = lbound(ExtLoads_DataData%x) + UB(1:1) = ubound(ExtLoads_DataData%x) do i1 = LB(1), UB(1) call ExtLd_DestroyContState(ExtLoads_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(ExtLoads_DataData%xd, kind=B8Ki) - UB(1:1) = ubound(ExtLoads_DataData%xd, kind=B8Ki) + LB(1:1) = lbound(ExtLoads_DataData%xd) + UB(1:1) = ubound(ExtLoads_DataData%xd) do i1 = LB(1), UB(1) call ExtLd_DestroyDiscState(ExtLoads_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(ExtLoads_DataData%z, kind=B8Ki) - UB(1:1) = ubound(ExtLoads_DataData%z, kind=B8Ki) + LB(1:1) = lbound(ExtLoads_DataData%z) + UB(1:1) = ubound(ExtLoads_DataData%z) do i1 = LB(1), UB(1) call ExtLd_DestroyConstrState(ExtLoads_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - LB(1:1) = lbound(ExtLoads_DataData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(ExtLoads_DataData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(ExtLoads_DataData%OtherSt) + UB(1:1) = ubound(ExtLoads_DataData%OtherSt) do i1 = LB(1), UB(1) call ExtLd_DestroyOtherState(ExtLoads_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9054,26 +5122,26 @@ subroutine FAST_PackExtLoads_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(ExtLoads_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackExtLoads_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) do i1 = LB(1), UB(1) call ExtLd_PackContState(RF, InData%x(i1)) end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) do i1 = LB(1), UB(1) call ExtLd_PackDiscState(RF, InData%xd(i1)) end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) do i1 = LB(1), UB(1) call ExtLd_PackConstrState(RF, InData%z(i1)) end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) do i1 = LB(1), UB(1) call ExtLd_PackOtherState(RF, InData%OtherSt(i1)) end do @@ -9089,28 +5157,28 @@ subroutine FAST_UnPackExtLoads_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtLoads_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackExtLoads_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) + LB(1:1) = lbound(OutData%x) + UB(1:1) = ubound(OutData%x) do i1 = LB(1), UB(1) call ExtLd_UnpackContState(RF, OutData%x(i1)) ! x end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) + LB(1:1) = lbound(OutData%xd) + UB(1:1) = ubound(OutData%xd) do i1 = LB(1), UB(1) call ExtLd_UnpackDiscState(RF, OutData%xd(i1)) ! xd end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) + LB(1:1) = lbound(OutData%z) + UB(1:1) = ubound(OutData%z) do i1 = LB(1), UB(1) call ExtLd_UnpackConstrState(RF, OutData%z(i1)) ! z end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) + LB(1:1) = lbound(OutData%OtherSt) + UB(1:1) = ubound(OutData%OtherSt) do i1 = LB(1), UB(1) call ExtLd_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do @@ -9127,75 +5195,89 @@ subroutine FAST_CopyAeroDisk_Data(SrcAeroDisk_DataData, DstAeroDisk_DataData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyAeroDisk_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcAeroDisk_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDisk_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDisk_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDisk_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDisk_DataData%OtherSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDisk_DataData%Output, kind=B8Ki) - if (.not. allocated(DstAeroDisk_DataData%Output)) then - allocate(DstAeroDisk_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + 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 - LB(1:1) = lbound(SrcAeroDisk_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDisk_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcAeroDisk_DataData%Input) + UB(1:1) = ubound(SrcAeroDisk_DataData%Input) if (.not. allocated(DstAeroDisk_DataData%Input)) then allocate(DstAeroDisk_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9210,8 +5292,8 @@ subroutine FAST_CopyAeroDisk_Data(SrcAeroDisk_DataData, DstAeroDisk_DataData, Ct end do end if if (allocated(SrcAeroDisk_DataData%InputTimes)) then - LB(1:1) = lbound(SrcAeroDisk_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcAeroDisk_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcAeroDisk_DataData%InputTimes) + UB(1:1) = ubound(SrcAeroDisk_DataData%InputTimes) if (.not. allocated(DstAeroDisk_DataData%InputTimes)) then allocate(DstAeroDisk_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -9227,59 +5309,58 @@ subroutine FAST_DestroyAeroDisk_Data(AeroDisk_DataData, ErrStat, ErrMsg) type(AeroDisk_Data), intent(inout) :: AeroDisk_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyAeroDisk_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(AeroDisk_DataData%x, kind=B8Ki) - UB(1:1) = ubound(AeroDisk_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(AeroDisk_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(AeroDisk_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(AeroDisk_DataData%OtherSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(AeroDisk_DataData%Output, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(AeroDisk_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(AeroDisk_DataData%Input) + UB(1:1) = ubound(AeroDisk_DataData%Input) do i1 = LB(1), UB(1) call ADsk_DestroyInput(AeroDisk_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -9295,48 +5376,53 @@ subroutine FAST_PackAeroDisk_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(AeroDisk_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackAeroDisk_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) + 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_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 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_PackOutput(RF, InData%Output(i1)) + call ADsk_PackOtherState(RF, InData%OtherSt(i1)) end do end if - call ADsk_PackOutput(RF, InData%y_interp) + 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, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + 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 ADsk_PackInput(RF, InData%Input(i1)) end do @@ -9349,49 +5435,66 @@ subroutine FAST_UnPackAeroDisk_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(AeroDisk_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackAeroDisk_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call ADsk_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - 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 @@ -9414,127 +5517,113 @@ subroutine FAST_CopyInflowWind_Data(SrcInflowWind_DataData, DstInflowWind_DataDa integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyInflowWind_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcInflowWind_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%OtherSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%Output, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%Input, kind=B8Ki) - 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%Input_Saved)) then - LB(1:1) = lbound(SrcInflowWind_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstInflowWind_DataData%Input_Saved)) then - allocate(DstInflowWind_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + 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%Input_Saved.', ErrStat, ErrMsg, RoutineName) + 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_CopyInput(SrcInflowWind_DataData%Input_Saved(i1), DstInflowWind_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + 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%InputTimes)) then - LB(1:1) = lbound(SrcInflowWind_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%InputTimes, kind=B8Ki) - if (.not. allocated(DstInflowWind_DataData%InputTimes)) then - allocate(DstInflowWind_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + 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%InputTimes.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes + 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 + 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.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call InflowWind_CopyInput(SrcInflowWind_DataData%Input(i1), DstInflowWind_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcInflowWind_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcInflowWind_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcInflowWind_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstInflowWind_DataData%InputTimes_Saved)) then - allocate(DstInflowWind_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcInflowWind_DataData%InputTimes)) then + LB(1:1) = lbound(SrcInflowWind_DataData%InputTimes) + UB(1:1) = ubound(SrcInflowWind_DataData%InputTimes) + if (.not. allocated(DstInflowWind_DataData%InputTimes)) then + allocate(DstInflowWind_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) return end if end if - DstInflowWind_DataData%InputTimes_Saved = SrcInflowWind_DataData%InputTimes_Saved + DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes end if end subroutine @@ -9542,143 +5631,125 @@ subroutine FAST_DestroyInflowWind_Data(InflowWind_DataData, ErrStat, ErrMsg) type(InflowWind_Data), intent(inout) :: InflowWind_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyInflowWind_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(InflowWind_DataData%x, kind=B8Ki) - UB(1:1) = ubound(InflowWind_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(InflowWind_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(InflowWind_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(InflowWind_DataData%OtherSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(InflowWind_DataData%Output, kind=B8Ki) + if (allocated(InflowWind_DataData%Input)) then + LB(1:1) = lbound(InflowWind_DataData%Input) + UB(1:1) = ubound(InflowWind_DataData%Input) do i1 = LB(1), UB(1) - call InflowWind_DestroyOutput(InflowWind_DataData%Output(i1), ErrStat2, ErrMsg2) + call InflowWind_DestroyInput(InflowWind_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(InflowWind_DataData%Output) + deallocate(InflowWind_DataData%Input) 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, kind=B8Ki) - UB(1:1) = ubound(InflowWind_DataData%Input, kind=B8Ki) + if (allocated(InflowWind_DataData%InputTimes)) then + deallocate(InflowWind_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackInflowWind_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(InflowWind_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackInflowWind_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + 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_DestroyInput(InflowWind_DataData%Input(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + 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 - deallocate(InflowWind_DataData%Input) end if - if (allocated(InflowWind_DataData%Input_Saved)) then - LB(1:1) = lbound(InflowWind_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InflowWind_DataData%Input_Saved, kind=B8Ki) + 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_DestroyInput(InflowWind_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call InflowWind_PackOtherState(RF, InData%OtherSt(i1)) 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) - type(RegFile), intent(inout) :: RF - type(InflowWind_Data), intent(in) :: InData - character(*), parameter :: RoutineName = 'FAST_PackInflowWind_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_PackOutput(RF, InData%Output(i1)) - end do - end if - call InflowWind_PackOutput(RF, InData%y_interp) call RegPack(RF, allocated(InData%Input)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + 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 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, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - 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 @@ -9686,77 +5757,80 @@ subroutine FAST_UnPackInflowWind_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(InflowWind_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackInflowWind_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call InflowWind_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - 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) @@ -9892,127 +5966,116 @@ subroutine FAST_CopySubDyn_Data(SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopySubDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcSubDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%OtherSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%Input, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%Input_Saved, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%Output, kind=B8Ki) - 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 - if (allocated(SrcSubDyn_DataData%InputTimes)) then - LB(1:1) = lbound(SrcSubDyn_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%InputTimes, kind=B8Ki) - if (.not. allocated(DstSubDyn_DataData%InputTimes)) then - allocate(DstSubDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + 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%InputTimes.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) return end if end if - DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes + 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_Saved)) then - LB(1:1) = lbound(SrcSubDyn_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcSubDyn_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstSubDyn_DataData%InputTimes_Saved)) then - allocate(DstSubDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcSubDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcSubDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcSubDyn_DataData%InputTimes) + if (.not. allocated(DstSubDyn_DataData%InputTimes)) then + allocate(DstSubDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) return end if end if - DstSubDyn_DataData%InputTimes_Saved = SrcSubDyn_DataData%InputTimes_Saved + DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes end if end subroutine @@ -10020,143 +6083,128 @@ subroutine FAST_DestroySubDyn_Data(SubDyn_DataData, ErrStat, ErrMsg) type(SubDyn_Data), intent(inout) :: SubDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroySubDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SubDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SubDyn_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SubDyn_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SubDyn_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SubDyn_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_DestroyOtherState(SubDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - call SD_DestroyParam(SubDyn_DataData%p, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SD_DestroyInput(SubDyn_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SD_DestroyOutput(SubDyn_DataData%y, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SD_DestroyMisc(SubDyn_DataData%m, ErrStat2, ErrMsg2) + 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) - if (allocated(SubDyn_DataData%Input)) then - LB(1:1) = lbound(SubDyn_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SubDyn_DataData%Input, kind=B8Ki) + 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_DestroyInput(SubDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SD_DestroyDiscState(SubDyn_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(SubDyn_DataData%Input) + deallocate(SubDyn_DataData%xd) end if - if (allocated(SubDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(SubDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SubDyn_DataData%Input_Saved, kind=B8Ki) + 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_DestroyInput(SubDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call SD_DestroyConstrState(SubDyn_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(SubDyn_DataData%Input_Saved) + deallocate(SubDyn_DataData%z) end if - if (allocated(SubDyn_DataData%Output)) then - LB(1:1) = lbound(SubDyn_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(SubDyn_DataData%Output, kind=B8Ki) + 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_DestroyOutput(SubDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call SD_DestroyOtherState(SubDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(SubDyn_DataData%Output) + deallocate(SubDyn_DataData%OtherSt) end if - call SD_DestroyOutput(SubDyn_DataData%y_interp, ErrStat2, ErrMsg2) + 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) + call SD_DestroyMisc(SubDyn_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(SubDyn_DataData%Input)) then + LB(1:1) = lbound(SubDyn_DataData%Input) + UB(1:1) = ubound(SubDyn_DataData%Input) + do i1 = LB(1), UB(1) + call SD_DestroyInput(SubDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SubDyn_DataData%Input) + end if if (allocated(SubDyn_DataData%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) type(RegFile), intent(inout) :: RF type(SubDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackSubDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_PackOtherState(RF, InData%OtherSt(i1)) - end do - 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)) - if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + 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_PackInput(RF, InData%Input(i1)) + 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%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) + 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_PackInput(RF, InData%Input_Saved(i1)) + call SD_PackOtherState(RF, InData%OtherSt(i1)) end do end if - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) + call SD_PackParam(RF, InData%p) + call SD_PackOutput(RF, InData%y) + call SD_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)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) - call SD_PackOutput(RF, InData%Output(i1)) + call SD_PackInput(RF, InData%Input(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 @@ -10164,77 +6212,81 @@ subroutine FAST_UnPackSubDyn_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(SubDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackSubDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SD_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - 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) @@ -10243,47 +6295,80 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyExtPtfm_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcExtPtfm_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%OtherSt, kind=B8Ki) - 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 @@ -10291,8 +6376,8 @@ subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcExtPtfm_DataData%Input)) then - LB(1:1) = lbound(SrcExtPtfm_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcExtPtfm_DataData%Input) + UB(1:1) = ubound(SrcExtPtfm_DataData%Input) if (.not. allocated(DstExtPtfm_DataData%Input)) then allocate(DstExtPtfm_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -10306,25 +6391,9 @@ 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, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%Input_Saved, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcExtPtfm_DataData%InputTimes) + UB(1:1) = ubound(SrcExtPtfm_DataData%InputTimes) if (.not. allocated(DstExtPtfm_DataData%InputTimes)) then allocate(DstExtPtfm_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -10334,140 +6403,131 @@ 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, kind=B8Ki) - UB(1:1) = ubound(SrcExtPtfm_DataData%InputTimes_Saved, kind=B8Ki) - 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) type(ExtPtfm_Data), intent(inout) :: ExtPtfm_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyExtPtfm_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(ExtPtfm_DataData%x, kind=B8Ki) - UB(1:1) = ubound(ExtPtfm_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(ExtPtfm_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(ExtPtfm_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(ExtPtfm_DataData%OtherSt, kind=B8Ki) - 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) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ExtPtfm_DataData%Input)) then - LB(1:1) = lbound(ExtPtfm_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(ExtPtfm_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(ExtPtfm_DataData%Input) + UB(1:1) = ubound(ExtPtfm_DataData%Input) do i1 = LB(1), UB(1) call ExtPtfm_DestroyInput(ExtPtfm_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(ExtPtfm_DataData%Input) end if - if (allocated(ExtPtfm_DataData%Input_Saved)) then - LB(1:1) = lbound(ExtPtfm_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(ExtPtfm_DataData%Input_Saved, kind=B8Ki) - 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) type(RegFile), intent(inout) :: RF type(ExtPtfm_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackExtPtfm_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - 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)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + 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 ExtPtfm_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, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_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 @@ -10475,63 +6535,80 @@ subroutine FAST_UnPackExtPtfm_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(ExtPtfm_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackExtPtfm_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call ExtPtfm_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - 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) + 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 ExtPtfm_UnpackInput(RF, OutData%Input(i1)) ! Input + 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 + 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_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt end do end if - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + call ExtPtfm_UnpackParam(RF, OutData%p) ! p + call ExtPtfm_UnpackOutput(RF, OutData%y) ! y + call ExtPtfm_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 ExtPtfm_UnpackInput(RF, OutData%Input_Saved(i1)) ! Input_Saved + call ExtPtfm_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_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, CtrlCode, ErrStat, ErrMsg) @@ -10540,107 +6617,105 @@ subroutine FAST_CopySeaState_Data(SrcSeaState_DataData, DstSeaState_DataData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopySeaState_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcSeaState_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%OtherSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%Input, kind=B8Ki) - 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%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%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + 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 end if - if (allocated(SrcSeaState_DataData%Input_Saved)) then - LB(1:1) = lbound(SrcSeaState_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstSeaState_DataData%Input_Saved)) then - allocate(DstSeaState_DataData%Input_Saved(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%Input_Saved.', 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_CopyInput(SrcSeaState_DataData%Input_Saved(i1), DstSeaState_DataData%Input_Saved(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 - if (allocated(SrcSeaState_DataData%Output)) then - LB(1:1) = lbound(SrcSeaState_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%Output, kind=B8Ki) - if (.not. allocated(DstSeaState_DataData%Output)) then - allocate(DstSeaState_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + 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%Output.', ErrStat, ErrMsg, RoutineName) + 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_CopyOutput(SrcSeaState_DataData%Output(i1), DstSeaState_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + 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 - call SeaSt_CopyOutput(SrcSeaState_DataData%y_interp, DstSeaState_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return if (allocated(SrcSeaState_DataData%InputTimes)) then - LB(1:1) = lbound(SrcSeaState_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcSeaState_DataData%InputTimes) + UB(1:1) = ubound(SrcSeaState_DataData%InputTimes) if (.not. allocated(DstSeaState_DataData%InputTimes)) then allocate(DstSeaState_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -10650,161 +6725,131 @@ 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, kind=B8Ki) - UB(1:1) = ubound(SrcSeaState_DataData%InputTimes_Saved, kind=B8Ki) - 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) type(SeaState_Data), intent(inout) :: SeaState_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroySeaState_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SeaState_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SeaState_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SeaState_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SeaState_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SeaState_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_DestroyOtherState(SeaState_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - call SeaSt_DestroyParam(SeaState_DataData%p, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_DestroyInput(SeaState_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_DestroyOutput(SeaState_DataData%y, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SeaSt_DestroyMisc(SeaState_DataData%m, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(SeaState_DataData%Input)) then - LB(1:1) = lbound(SeaState_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SeaState_DataData%Input, kind=B8Ki) + 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_DestroyInput(SeaState_DataData%Input(i1), ErrStat2, ErrMsg2) + call SeaSt_DestroyContState(SeaState_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(SeaState_DataData%Input) + 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%Input_Saved)) then - LB(1:1) = lbound(SeaState_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SeaState_DataData%Input_Saved, kind=B8Ki) + 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_DestroyInput(SeaState_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call SeaSt_DestroyConstrState(SeaState_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(SeaState_DataData%Input_Saved) + deallocate(SeaState_DataData%z) end if - if (allocated(SeaState_DataData%Output)) then - LB(1:1) = lbound(SeaState_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(SeaState_DataData%Output, kind=B8Ki) + 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_DestroyOutput(SeaState_DataData%Output(i1), ErrStat2, ErrMsg2) + call SeaSt_DestroyOtherState(SeaState_DataData%OtherSt(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(SeaState_DataData%Output) + deallocate(SeaState_DataData%OtherSt) end if - call SeaSt_DestroyOutput(SeaState_DataData%y_interp, ErrStat2, ErrMsg2) + call SeaSt_DestroyParam(SeaState_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyOutput(SeaState_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyMisc(SeaState_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(SeaState_DataData%Input)) then + LB(1:1) = lbound(SeaState_DataData%Input) + UB(1:1) = ubound(SeaState_DataData%Input) + do i1 = LB(1), UB(1) + call SeaSt_DestroyInput(SeaState_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SeaState_DataData%Input) + end if if (allocated(SeaState_DataData%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) type(RegFile), intent(inout) :: RF type(SeaState_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackSeaState_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_PackOtherState(RF, InData%OtherSt(i1)) - end do - 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)) - if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + 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_PackInput(RF, InData%Input(i1)) + 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%Input_Saved)) - if (allocated(InData%Input_Saved)) then - call RegPackBounds(RF, 1, lbound(InData%Input_Saved, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) + 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_PackInput(RF, InData%Input_Saved(i1)) + call SeaSt_PackOtherState(RF, InData%OtherSt(i1)) end do end if - call RegPack(RF, allocated(InData%Output)) - if (allocated(InData%Output)) then - call RegPackBounds(RF, 1, lbound(InData%Output, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) + call SeaSt_PackParam(RF, InData%p) + call SeaSt_PackOutput(RF, InData%y) + call SeaSt_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)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) - call SeaSt_PackOutput(RF, InData%Output(i1)) + call SeaSt_PackInput(RF, InData%Input(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 @@ -10812,77 +6857,80 @@ subroutine FAST_UnPackSeaState_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(SeaState_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackSeaState_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call SeaSt_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - 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) @@ -10891,127 +6939,116 @@ subroutine FAST_CopyHydroDyn_Data(SrcHydroDyn_DataData, DstHydroDyn_DataData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyHydroDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcHydroDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%OtherSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%Output, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%Input, kind=B8Ki) - 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%Input_Saved)) then - LB(1:1) = lbound(SrcHydroDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstHydroDyn_DataData%Input_Saved)) then - allocate(DstHydroDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + 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%Input_Saved.', ErrStat, ErrMsg, RoutineName) + 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_CopyInput(SrcHydroDyn_DataData%Input_Saved(i1), DstHydroDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + 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%InputTimes)) then - LB(1:1) = lbound(SrcHydroDyn_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%InputTimes, kind=B8Ki) - if (.not. allocated(DstHydroDyn_DataData%InputTimes)) then - allocate(DstHydroDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + 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%InputTimes.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) return end if end if - DstHydroDyn_DataData%InputTimes = SrcHydroDyn_DataData%InputTimes + 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 + 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.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call HydroDyn_CopyInput(SrcHydroDyn_DataData%Input(i1), DstHydroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcHydroDyn_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcHydroDyn_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcHydroDyn_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstHydroDyn_DataData%InputTimes_Saved)) then - allocate(DstHydroDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcHydroDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcHydroDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcHydroDyn_DataData%InputTimes) + if (.not. allocated(DstHydroDyn_DataData%InputTimes)) then + allocate(DstHydroDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) return end if end if - DstHydroDyn_DataData%InputTimes_Saved = SrcHydroDyn_DataData%InputTimes_Saved + DstHydroDyn_DataData%InputTimes = SrcHydroDyn_DataData%InputTimes end if end subroutine @@ -11019,143 +7056,128 @@ subroutine FAST_DestroyHydroDyn_Data(HydroDyn_DataData, ErrStat, ErrMsg) type(HydroDyn_Data), intent(inout) :: HydroDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyHydroDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(HydroDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(HydroDyn_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(HydroDyn_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(HydroDyn_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(HydroDyn_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_DestroyOtherState(HydroDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - call HydroDyn_DestroyParam(HydroDyn_DataData%p, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call HydroDyn_DestroyInput(HydroDyn_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call HydroDyn_DestroyOutput(HydroDyn_DataData%y, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call HydroDyn_DestroyMisc(HydroDyn_DataData%m, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(HydroDyn_DataData%Output)) then - LB(1:1) = lbound(HydroDyn_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(HydroDyn_DataData%Output, kind=B8Ki) + 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_DestroyOutput(HydroDyn_DataData%Output(i1), ErrStat2, ErrMsg2) + call HydroDyn_DestroyContState(HydroDyn_DataData%x(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(HydroDyn_DataData%Output) + deallocate(HydroDyn_DataData%x) end if - call HydroDyn_DestroyOutput(HydroDyn_DataData%y_interp, ErrStat2, ErrMsg2) + call HydroDyn_DestroyContState(HydroDyn_DataData%dxdt, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(HydroDyn_DataData%Input)) then - LB(1:1) = lbound(HydroDyn_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(HydroDyn_DataData%Input, kind=B8Ki) + 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_DestroyInput(HydroDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call HydroDyn_DestroyDiscState(HydroDyn_DataData%xd(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(HydroDyn_DataData%Input) + deallocate(HydroDyn_DataData%xd) end if - if (allocated(HydroDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(HydroDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(HydroDyn_DataData%Input_Saved, kind=B8Ki) + 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_DestroyInput(HydroDyn_DataData%Input_Saved(i1), ErrStat2, ErrMsg2) + call HydroDyn_DestroyConstrState(HydroDyn_DataData%z(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(HydroDyn_DataData%Input_Saved) + 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) + UB(1:1) = ubound(HydroDyn_DataData%Input) + do i1 = LB(1), UB(1) + call HydroDyn_DestroyInput(HydroDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(HydroDyn_DataData%Input) end if if (allocated(HydroDyn_DataData%InputTimes)) then deallocate(HydroDyn_DataData%InputTimes) end if - if (allocated(HydroDyn_DataData%InputTimes_Saved)) then - deallocate(HydroDyn_DataData%InputTimes_Saved) - end if end subroutine subroutine FAST_PackHydroDyn_Data(RF, Indata) type(RegFile), intent(inout) :: RF type(HydroDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackHydroDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) + 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_PackOutput(RF, InData%Output(i1)) + call HydroDyn_PackDiscState(RF, InData%xd(i1)) end do end if - call HydroDyn_PackOutput(RF, InData%y_interp) - call RegPack(RF, allocated(InData%Input)) - if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + 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_PackInput(RF, InData%Input(i1)) + 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_PackOtherState(RF, InData%OtherSt(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, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) + 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)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) do i1 = LB(1), UB(1) - call HydroDyn_PackInput(RF, InData%Input_Saved(i1)) + call HydroDyn_PackInput(RF, InData%Input(i1)) end do end if call RegPackAlloc(RF, InData%InputTimes) - call RegPackAlloc(RF, InData%InputTimes_Saved) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -11163,77 +7185,81 @@ subroutine FAST_UnPackHydroDyn_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(HydroDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackHydroDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call HydroDyn_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - 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) @@ -11242,47 +7268,80 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyIceFloe_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcIceFloe_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%OtherSt, kind=B8Ki) - 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 @@ -11290,8 +7349,8 @@ subroutine FAST_CopyIceFloe_Data(SrcIceFloe_DataData, DstIceFloe_DataData, CtrlC call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcIceFloe_DataData%Input)) then - LB(1:1) = lbound(SrcIceFloe_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcIceFloe_DataData%Input) + UB(1:1) = ubound(SrcIceFloe_DataData%Input) if (.not. allocated(DstIceFloe_DataData%Input)) then allocate(DstIceFloe_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -11305,25 +7364,9 @@ 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, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%Input_Saved, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcIceFloe_DataData%InputTimes) + UB(1:1) = ubound(SrcIceFloe_DataData%InputTimes) if (.not. allocated(DstIceFloe_DataData%InputTimes)) then allocate(DstIceFloe_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -11333,140 +7376,131 @@ 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, kind=B8Ki) - UB(1:1) = ubound(SrcIceFloe_DataData%InputTimes_Saved, kind=B8Ki) - 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) type(IceFloe_Data), intent(inout) :: IceFloe_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyIceFloe_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(IceFloe_DataData%x, kind=B8Ki) - UB(1:1) = ubound(IceFloe_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(IceFloe_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(IceFloe_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(IceFloe_DataData%OtherSt, kind=B8Ki) - 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) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(IceFloe_DataData%Input)) then - LB(1:1) = lbound(IceFloe_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(IceFloe_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(IceFloe_DataData%Input) + UB(1:1) = ubound(IceFloe_DataData%Input) do i1 = LB(1), UB(1) call IceFloe_DestroyInput(IceFloe_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(IceFloe_DataData%Input) end if - if (allocated(IceFloe_DataData%Input_Saved)) then - LB(1:1) = lbound(IceFloe_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(IceFloe_DataData%Input_Saved, kind=B8Ki) - 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) type(RegFile), intent(inout) :: RF type(IceFloe_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackIceFloe_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - 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)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + 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 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, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - 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 @@ -11474,63 +7508,80 @@ subroutine FAST_UnPackIceFloe_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(IceFloe_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackIceFloe_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call IceFloe_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - 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) @@ -11539,123 +7590,103 @@ subroutine FAST_CopyMAP_Data(SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyMAP_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcMAP_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcMAP_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMAP_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMAP_DataData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_CopyConstrState(SrcMAP_DataData%z(i1), DstMAP_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - call MAP_CopyOtherState(SrcMAP_DataData%OtherSt, DstMAP_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MAP_CopyParam(SrcMAP_DataData%p, DstMAP_DataData%p, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MAP_CopyInput(SrcMAP_DataData%u, DstMAP_DataData%u, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MAP_CopyOutput(SrcMAP_DataData%y, DstMAP_DataData%y, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - call MAP_CopyOtherState(SrcMAP_DataData%OtherSt_old, DstMAP_DataData%OtherSt_old, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcMAP_DataData%Output)) then - LB(1:1) = lbound(SrcMAP_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(SrcMAP_DataData%Output, kind=B8Ki) - if (.not. allocated(DstMAP_DataData%Output)) then - allocate(DstMAP_DataData%Output(LB(1):UB(1)), stat=ErrStat2) + 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%Output.', ErrStat, ErrMsg, RoutineName) + 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_CopyOutput(SrcMAP_DataData%Output(i1), DstMAP_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2) + 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 - call MAP_CopyOutput(SrcMAP_DataData%y_interp, DstMAP_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - if (allocated(SrcMAP_DataData%Input)) then - LB(1:1) = lbound(SrcMAP_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcMAP_DataData%Input, kind=B8Ki) - if (.not. allocated(DstMAP_DataData%Input)) then - allocate(DstMAP_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + 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%Input.', ErrStat, ErrMsg, RoutineName) + 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_CopyInput(SrcMAP_DataData%Input(i1), DstMAP_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + 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%Input_Saved)) then - LB(1:1) = lbound(SrcMAP_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcMAP_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstMAP_DataData%Input_Saved)) then - allocate(DstMAP_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + 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%Input_Saved.', ErrStat, ErrMsg, RoutineName) + 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_CopyInput(SrcMAP_DataData%Input_Saved(i1), DstMAP_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + 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 - if (allocated(SrcMAP_DataData%InputTimes)) then - LB(1:1) = lbound(SrcMAP_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcMAP_DataData%InputTimes, kind=B8Ki) - if (.not. allocated(DstMAP_DataData%InputTimes)) then - allocate(DstMAP_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + 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_CopyOutput(SrcMAP_DataData%y, DstMAP_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyMisc(SrcMAP_DataData%m, DstMAP_DataData%m, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MAP_CopyOtherState(SrcMAP_DataData%OtherSt_old, DstMAP_DataData%OtherSt_old, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcMAP_DataData%Input)) then + LB(1:1) = lbound(SrcMAP_DataData%Input) + UB(1:1) = ubound(SrcMAP_DataData%Input) + if (.not. allocated(DstMAP_DataData%Input)) then + allocate(DstMAP_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Input.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMAP_DataData%InputTimes = SrcMAP_DataData%InputTimes + do i1 = LB(1), UB(1) + call MAP_CopyInput(SrcMAP_DataData%Input(i1), DstMAP_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcMAP_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcMAP_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcMAP_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstMAP_DataData%InputTimes_Saved)) then - allocate(DstMAP_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMAP_DataData%InputTimes)) then + LB(1:1) = lbound(SrcMAP_DataData%InputTimes) + UB(1:1) = ubound(SrcMAP_DataData%InputTimes) + if (.not. allocated(DstMAP_DataData%InputTimes)) then + allocate(DstMAP_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMAP_DataData%InputTimes_Saved = SrcMAP_DataData%InputTimes_Saved + DstMAP_DataData%InputTimes = SrcMAP_DataData%InputTimes end if end subroutine @@ -11663,135 +7694,113 @@ subroutine FAST_DestroyMAP_Data(MAP_DataData, ErrStat, ErrMsg) type(MAP_Data), intent(inout) :: MAP_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyMAP_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(MAP_DataData%x, kind=B8Ki) - UB(1:1) = ubound(MAP_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(MAP_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(MAP_DataData%z, kind=B8Ki) - 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 MAP_DestroyMisc(MAP_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(MAP_DataData%Output)) then - LB(1:1) = lbound(MAP_DataData%Output, kind=B8Ki) - UB(1:1) = ubound(MAP_DataData%Output, kind=B8Ki) - 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_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, kind=B8Ki) - UB(1:1) = ubound(MAP_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(MAP_DataData%Input) + UB(1:1) = ubound(MAP_DataData%Input) do i1 = LB(1), UB(1) call MAP_DestroyInput(MAP_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(MAP_DataData%Input) end if - if (allocated(MAP_DataData%Input_Saved)) then - LB(1:1) = lbound(MAP_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(MAP_DataData%Input_Saved, kind=B8Ki) - 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) type(RegFile), intent(inout) :: RF type(MAP_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackMAP_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + 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 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, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - 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 @@ -11799,73 +7808,69 @@ subroutine FAST_UnPackMAP_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(MAP_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackMAP_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call MAP_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - 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%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 - if (allocated(OutData%Input_Saved)) deallocate(OutData%Input_Saved) + 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) @@ -11874,47 +7879,80 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyFEAMooring_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcFEAMooring_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%OtherSt, kind=B8Ki) - 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 @@ -11922,8 +7960,8 @@ subroutine FAST_CopyFEAMooring_Data(SrcFEAMooring_DataData, DstFEAMooring_DataDa call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcFEAMooring_DataData%Input)) then - LB(1:1) = lbound(SrcFEAMooring_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcFEAMooring_DataData%Input) + UB(1:1) = ubound(SrcFEAMooring_DataData%Input) if (.not. allocated(DstFEAMooring_DataData%Input)) then allocate(DstFEAMooring_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -11937,25 +7975,9 @@ 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, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%Input_Saved, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcFEAMooring_DataData%InputTimes) + UB(1:1) = ubound(SrcFEAMooring_DataData%InputTimes) if (.not. allocated(DstFEAMooring_DataData%InputTimes)) then allocate(DstFEAMooring_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -11965,140 +7987,131 @@ 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, kind=B8Ki) - UB(1:1) = ubound(SrcFEAMooring_DataData%InputTimes_Saved, kind=B8Ki) - 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 subroutine + +subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) + type(FEAMooring_Data), intent(inout) :: FEAMooring_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroyFEAMooring_Data' + ErrStat = ErrID_None + ErrMsg = '' + 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 -end subroutine - -subroutine FAST_DestroyFEAMooring_Data(FEAMooring_DataData, ErrStat, ErrMsg) - type(FEAMooring_Data), intent(inout) :: FEAMooring_DataData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'FAST_DestroyFEAMooring_Data' - ErrStat = ErrID_None - ErrMsg = '' - LB(1:1) = lbound(FEAMooring_DataData%x, kind=B8Ki) - UB(1:1) = ubound(FEAMooring_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(FEAMooring_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(FEAMooring_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(FEAMooring_DataData%OtherSt, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_DestroyOtherState(FEAMooring_DataData%OtherSt(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do call FEAM_DestroyParam(FEAMooring_DataData%p, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call FEAM_DestroyInput(FEAMooring_DataData%u, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FEAM_DestroyOutput(FEAMooring_DataData%y, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FEAM_DestroyMisc(FEAMooring_DataData%m, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(FEAMooring_DataData%Input)) then - LB(1:1) = lbound(FEAMooring_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(FEAMooring_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(FEAMooring_DataData%Input) + UB(1:1) = ubound(FEAMooring_DataData%Input) do i1 = LB(1), UB(1) call FEAM_DestroyInput(FEAMooring_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(FEAMooring_DataData%Input) end if - if (allocated(FEAMooring_DataData%Input_Saved)) then - LB(1:1) = lbound(FEAMooring_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(FEAMooring_DataData%Input_Saved, kind=B8Ki) - 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) type(RegFile), intent(inout) :: RF type(FEAMooring_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackFEAMooring_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - 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)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + 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 FEAM_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, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_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 @@ -12106,63 +8119,80 @@ subroutine FAST_UnPackFEAMooring_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(FEAMooring_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackFEAMooring_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call FEAM_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - 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%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 FEAM_UnpackInput(RF, OutData%Input(i1)) ! Input + 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 + 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_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 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) @@ -12171,127 +8201,113 @@ subroutine FAST_CopyMoorDyn_Data(SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlC integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyMoorDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcMoorDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%OtherSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%Output, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%Input, kind=B8Ki) - 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%Input_Saved)) then - LB(1:1) = lbound(SrcMoorDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%Input_Saved, kind=B8Ki) - if (.not. allocated(DstMoorDyn_DataData%Input_Saved)) then - allocate(DstMoorDyn_DataData%Input_Saved(LB(1):UB(1)), stat=ErrStat2) + 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%Input_Saved.', ErrStat, ErrMsg, RoutineName) + 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_CopyInput(SrcMoorDyn_DataData%Input_Saved(i1), DstMoorDyn_DataData%Input_Saved(i1), CtrlCode, ErrStat2, ErrMsg2) + 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%InputTimes)) then - LB(1:1) = lbound(SrcMoorDyn_DataData%InputTimes, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%InputTimes, kind=B8Ki) - if (.not. allocated(DstMoorDyn_DataData%InputTimes)) then - allocate(DstMoorDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + 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%InputTimes.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMoorDyn_DataData%InputTimes = SrcMoorDyn_DataData%InputTimes + 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 + 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.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call MD_CopyInput(SrcMoorDyn_DataData%Input(i1), DstMoorDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcMoorDyn_DataData%InputTimes_Saved)) then - LB(1:1) = lbound(SrcMoorDyn_DataData%InputTimes_Saved, kind=B8Ki) - UB(1:1) = ubound(SrcMoorDyn_DataData%InputTimes_Saved, kind=B8Ki) - if (.not. allocated(DstMoorDyn_DataData%InputTimes_Saved)) then - allocate(DstMoorDyn_DataData%InputTimes_Saved(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcMoorDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcMoorDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcMoorDyn_DataData%InputTimes) + if (.not. allocated(DstMoorDyn_DataData%InputTimes)) then + allocate(DstMoorDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes_Saved.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) return end if end if - DstMoorDyn_DataData%InputTimes_Saved = SrcMoorDyn_DataData%InputTimes_Saved + DstMoorDyn_DataData%InputTimes = SrcMoorDyn_DataData%InputTimes end if end subroutine @@ -12299,143 +8315,125 @@ subroutine FAST_DestroyMoorDyn_Data(MoorDyn_DataData, ErrStat, ErrMsg) type(MoorDyn_Data), intent(inout) :: MoorDyn_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyMoorDyn_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(MoorDyn_DataData%x, kind=B8Ki) - UB(1:1) = ubound(MoorDyn_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(MoorDyn_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(MoorDyn_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(MoorDyn_DataData%OtherSt, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(MoorDyn_DataData%Output, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(MoorDyn_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(MoorDyn_DataData%Input) + UB(1:1) = ubound(MoorDyn_DataData%Input) do i1 = LB(1), UB(1) call MD_DestroyInput(MoorDyn_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(MoorDyn_DataData%Input) end if - if (allocated(MoorDyn_DataData%Input_Saved)) then - LB(1:1) = lbound(MoorDyn_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(MoorDyn_DataData%Input_Saved, kind=B8Ki) - 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) type(RegFile), intent(inout) :: RF type(MoorDyn_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackMoorDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%Output, kind=B8Ki)) - LB(1:1) = lbound(InData%Output, kind=B8Ki) - UB(1:1) = ubound(InData%Output, kind=B8Ki) + 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_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 MD_PackOutput(RF, InData%Output(i1)) + call MD_PackOtherState(RF, InData%OtherSt(i1)) end do end if - call MD_PackOutput(RF, InData%y_interp) + 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, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + 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 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, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - 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 @@ -12443,77 +8441,80 @@ subroutine FAST_UnPackMoorDyn_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(MoorDyn_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackMoorDyn_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call MD_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - 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%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 MD_UnpackInput(RF, OutData%Input(i1)) ! Input + 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%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 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) @@ -12522,47 +8523,80 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyOrcaFlex_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(SrcOrcaFlex_DataData%x, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%OtherSt, kind=B8Ki) - 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 @@ -12570,8 +8604,8 @@ subroutine FAST_CopyOrcaFlex_Data(SrcOrcaFlex_DataData, DstOrcaFlex_DataData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOrcaFlex_DataData%Input)) then - LB(1:1) = lbound(SrcOrcaFlex_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(SrcOrcaFlex_DataData%Input) + UB(1:1) = ubound(SrcOrcaFlex_DataData%Input) if (.not. allocated(DstOrcaFlex_DataData%Input)) then allocate(DstOrcaFlex_DataData%Input(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12585,25 +8619,9 @@ 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, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%Input_Saved, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%InputTimes, kind=B8Ki) + LB(1:1) = lbound(SrcOrcaFlex_DataData%InputTimes) + UB(1:1) = ubound(SrcOrcaFlex_DataData%InputTimes) if (.not. allocated(DstOrcaFlex_DataData%InputTimes)) then allocate(DstOrcaFlex_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12613,140 +8631,131 @@ 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, kind=B8Ki) - UB(1:1) = ubound(SrcOrcaFlex_DataData%InputTimes_Saved, kind=B8Ki) - 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) type(OrcaFlex_Data), intent(inout) :: OrcaFlex_DataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyOrcaFlex_Data' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(OrcaFlex_DataData%x, kind=B8Ki) - UB(1:1) = ubound(OrcaFlex_DataData%x, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(OrcaFlex_DataData%xd, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(OrcaFlex_DataData%z, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(OrcaFlex_DataData%OtherSt, kind=B8Ki) - 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) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(OrcaFlex_DataData%Input)) then - LB(1:1) = lbound(OrcaFlex_DataData%Input, kind=B8Ki) - UB(1:1) = ubound(OrcaFlex_DataData%Input, kind=B8Ki) + LB(1:1) = lbound(OrcaFlex_DataData%Input) + UB(1:1) = ubound(OrcaFlex_DataData%Input) do i1 = LB(1), UB(1) call Orca_DestroyInput(OrcaFlex_DataData%Input(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(OrcaFlex_DataData%Input) end if - if (allocated(OrcaFlex_DataData%Input_Saved)) then - LB(1:1) = lbound(OrcaFlex_DataData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(OrcaFlex_DataData%Input_Saved, kind=B8Ki) - 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) type(RegFile), intent(inout) :: RF type(OrcaFlex_Data), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackOrcaFlex_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return - LB(1:1) = lbound(InData%x, kind=B8Ki) - UB(1:1) = ubound(InData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_PackContState(RF, InData%x(i1)) - end do - LB(1:1) = lbound(InData%xd, kind=B8Ki) - UB(1:1) = ubound(InData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_PackDiscState(RF, InData%xd(i1)) - end do - LB(1:1) = lbound(InData%z, kind=B8Ki) - UB(1:1) = ubound(InData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_PackConstrState(RF, InData%z(i1)) - end do - LB(1:1) = lbound(InData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(InData%OtherSt, kind=B8Ki) - 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)) if (allocated(InData%Input)) then - call RegPackBounds(RF, 1, lbound(InData%Input, kind=B8Ki), ubound(InData%Input, kind=B8Ki)) - LB(1:1) = lbound(InData%Input, kind=B8Ki) - UB(1:1) = ubound(InData%Input, kind=B8Ki) + 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 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, kind=B8Ki), ubound(InData%Input_Saved, kind=B8Ki)) - LB(1:1) = lbound(InData%Input_Saved, kind=B8Ki) - UB(1:1) = ubound(InData%Input_Saved, kind=B8Ki) - 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 @@ -12754,63 +8763,80 @@ subroutine FAST_UnPackOrcaFlex_Data(RF, OutData) type(RegFile), intent(inout) :: RF type(OrcaFlex_Data), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackOrcaFlex_Data' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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, kind=B8Ki) - UB(1:1) = ubound(OutData%x, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_UnpackContState(RF, OutData%x(i1)) ! x - end do - LB(1:1) = lbound(OutData%xd, kind=B8Ki) - UB(1:1) = ubound(OutData%xd, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_UnpackDiscState(RF, OutData%xd(i1)) ! xd - end do - LB(1:1) = lbound(OutData%z, kind=B8Ki) - UB(1:1) = ubound(OutData%z, kind=B8Ki) - do i1 = LB(1), UB(1) - call Orca_UnpackConstrState(RF, OutData%z(i1)) ! z - end do - LB(1:1) = lbound(OutData%OtherSt, kind=B8Ki) - UB(1:1) = ubound(OutData%OtherSt, kind=B8Ki) - 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) @@ -12819,16 +8845,16 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyModuleMapType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcModuleMapTypeData%ED_P_2_BD_P)) then - LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_BD_P, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_BD_P, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_BD_P) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_BD_P) if (.not. allocated(DstModuleMapTypeData%ED_P_2_BD_P)) then allocate(DstModuleMapTypeData%ED_P_2_BD_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12843,8 +8869,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%BD_P_2_ED_P)) then - LB(1:1) = lbound(SrcModuleMapTypeData%BD_P_2_ED_P, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%BD_P_2_ED_P, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%BD_P_2_ED_P) + UB(1:1) = ubound(SrcModuleMapTypeData%BD_P_2_ED_P) if (.not. allocated(DstModuleMapTypeData%BD_P_2_ED_P)) then allocate(DstModuleMapTypeData%BD_P_2_ED_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12859,8 +8885,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%ED_P_2_BD_P_Hub)) then - LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_BD_P_Hub, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_BD_P_Hub, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_BD_P_Hub) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_BD_P_Hub) if (.not. allocated(DstModuleMapTypeData%ED_P_2_BD_P_Hub)) then allocate(DstModuleMapTypeData%ED_P_2_BD_P_Hub(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12902,8 +8928,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%ED_P_2_NStC_P_N)) then - LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_NStC_P_N, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_NStC_P_N, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_NStC_P_N) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_NStC_P_N) if (.not. allocated(DstModuleMapTypeData%ED_P_2_NStC_P_N)) then allocate(DstModuleMapTypeData%ED_P_2_NStC_P_N(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12918,8 +8944,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%NStC_P_2_ED_P_N)) then - LB(1:1) = lbound(SrcModuleMapTypeData%NStC_P_2_ED_P_N, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%NStC_P_2_ED_P_N, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%NStC_P_2_ED_P_N) + UB(1:1) = ubound(SrcModuleMapTypeData%NStC_P_2_ED_P_N) if (.not. allocated(DstModuleMapTypeData%NStC_P_2_ED_P_N)) then allocate(DstModuleMapTypeData%NStC_P_2_ED_P_N(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12934,8 +8960,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%ED_L_2_TStC_P_T)) then - LB(1:1) = lbound(SrcModuleMapTypeData%ED_L_2_TStC_P_T, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%ED_L_2_TStC_P_T, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%ED_L_2_TStC_P_T) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_L_2_TStC_P_T) if (.not. allocated(DstModuleMapTypeData%ED_L_2_TStC_P_T)) then allocate(DstModuleMapTypeData%ED_L_2_TStC_P_T(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12950,8 +8976,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%TStC_P_2_ED_P_T)) then - LB(1:1) = lbound(SrcModuleMapTypeData%TStC_P_2_ED_P_T, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%TStC_P_2_ED_P_T, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%TStC_P_2_ED_P_T) + UB(1:1) = ubound(SrcModuleMapTypeData%TStC_P_2_ED_P_T) if (.not. allocated(DstModuleMapTypeData%TStC_P_2_ED_P_T)) then allocate(DstModuleMapTypeData%TStC_P_2_ED_P_T(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12966,8 +8992,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%ED_L_2_BStC_P_B)) then - LB(1:2) = lbound(SrcModuleMapTypeData%ED_L_2_BStC_P_B, kind=B8Ki) - UB(1:2) = ubound(SrcModuleMapTypeData%ED_L_2_BStC_P_B, kind=B8Ki) + LB(1:2) = lbound(SrcModuleMapTypeData%ED_L_2_BStC_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%ED_L_2_BStC_P_B) if (.not. allocated(DstModuleMapTypeData%ED_L_2_BStC_P_B)) then allocate(DstModuleMapTypeData%ED_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -12984,8 +9010,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%BStC_P_2_ED_P_B)) then - LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_ED_P_B, kind=B8Ki) - UB(1:2) = ubound(SrcModuleMapTypeData%BStC_P_2_ED_P_B, kind=B8Ki) + LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_ED_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%BStC_P_2_ED_P_B) if (.not. allocated(DstModuleMapTypeData%BStC_P_2_ED_P_B)) then allocate(DstModuleMapTypeData%BStC_P_2_ED_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13002,8 +9028,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%BD_L_2_BStC_P_B)) then - LB(1:2) = lbound(SrcModuleMapTypeData%BD_L_2_BStC_P_B, kind=B8Ki) - UB(1:2) = ubound(SrcModuleMapTypeData%BD_L_2_BStC_P_B, kind=B8Ki) + LB(1:2) = lbound(SrcModuleMapTypeData%BD_L_2_BStC_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%BD_L_2_BStC_P_B) if (.not. allocated(DstModuleMapTypeData%BD_L_2_BStC_P_B)) then allocate(DstModuleMapTypeData%BD_L_2_BStC_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13020,8 +9046,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%BStC_P_2_BD_P_B)) then - LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_BD_P_B, kind=B8Ki) - UB(1:2) = ubound(SrcModuleMapTypeData%BStC_P_2_BD_P_B, kind=B8Ki) + LB(1:2) = lbound(SrcModuleMapTypeData%BStC_P_2_BD_P_B) + UB(1:2) = ubound(SrcModuleMapTypeData%BStC_P_2_BD_P_B) if (.not. allocated(DstModuleMapTypeData%BStC_P_2_BD_P_B)) then allocate(DstModuleMapTypeData%BStC_P_2_BD_P_B(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13038,8 +9064,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%SStC_P_P_2_SubStructure)) then - LB(1:1) = lbound(SrcModuleMapTypeData%SStC_P_P_2_SubStructure, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%SStC_P_P_2_SubStructure, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%SStC_P_P_2_SubStructure) + UB(1:1) = ubound(SrcModuleMapTypeData%SStC_P_P_2_SubStructure) if (.not. allocated(DstModuleMapTypeData%SStC_P_P_2_SubStructure)) then allocate(DstModuleMapTypeData%SStC_P_P_2_SubStructure(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13054,8 +9080,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%SubStructure_2_SStC_P_P)) then - LB(1:1) = lbound(SrcModuleMapTypeData%SubStructure_2_SStC_P_P, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%SubStructure_2_SStC_P_P, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%SubStructure_2_SStC_P_P) + UB(1:1) = ubound(SrcModuleMapTypeData%SubStructure_2_SStC_P_P) if (.not. allocated(DstModuleMapTypeData%SubStructure_2_SStC_P_P)) then allocate(DstModuleMapTypeData%SubStructure_2_SStC_P_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13073,8 +9099,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%BDED_L_2_AD_L_B)) then - LB(1:1) = lbound(SrcModuleMapTypeData%BDED_L_2_AD_L_B, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%BDED_L_2_AD_L_B, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%BDED_L_2_AD_L_B) + UB(1:1) = ubound(SrcModuleMapTypeData%BDED_L_2_AD_L_B) if (.not. allocated(DstModuleMapTypeData%BDED_L_2_AD_L_B)) then allocate(DstModuleMapTypeData%BDED_L_2_AD_L_B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13089,8 +9115,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%AD_L_2_BDED_B)) then - LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_BDED_B, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%AD_L_2_BDED_B, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_BDED_B) + UB(1:1) = ubound(SrcModuleMapTypeData%AD_L_2_BDED_B) if (.not. allocated(DstModuleMapTypeData%AD_L_2_BDED_B)) then allocate(DstModuleMapTypeData%AD_L_2_BDED_B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13105,8 +9131,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%BD_L_2_BD_L)) then - LB(1:1) = lbound(SrcModuleMapTypeData%BD_L_2_BD_L, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%BD_L_2_BD_L, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%BD_L_2_BD_L) + UB(1:1) = ubound(SrcModuleMapTypeData%BD_L_2_BD_L) if (.not. allocated(DstModuleMapTypeData%BD_L_2_BD_L)) then allocate(DstModuleMapTypeData%BD_L_2_BD_L(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13121,8 +9147,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%SED_P_2_AD_L_B)) then - LB(1:1) = lbound(SrcModuleMapTypeData%SED_P_2_AD_L_B, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%SED_P_2_AD_L_B, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%SED_P_2_AD_L_B) + UB(1:1) = ubound(SrcModuleMapTypeData%SED_P_2_AD_L_B) if (.not. allocated(DstModuleMapTypeData%SED_P_2_AD_L_B)) then allocate(DstModuleMapTypeData%SED_P_2_AD_L_B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13137,8 +9163,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%SED_P_2_AD_P_R)) then - LB(1:1) = lbound(SrcModuleMapTypeData%SED_P_2_AD_P_R, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%SED_P_2_AD_P_R, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%SED_P_2_AD_P_R) + UB(1:1) = ubound(SrcModuleMapTypeData%SED_P_2_AD_P_R) if (.not. allocated(DstModuleMapTypeData%SED_P_2_AD_P_R)) then allocate(DstModuleMapTypeData%SED_P_2_AD_P_R(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13153,8 +9179,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%AD_L_2_SED_P)) then - LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_SED_P, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%AD_L_2_SED_P, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_SED_P) + UB(1:1) = ubound(SrcModuleMapTypeData%AD_L_2_SED_P) if (.not. allocated(DstModuleMapTypeData%AD_L_2_SED_P)) then allocate(DstModuleMapTypeData%AD_L_2_SED_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13187,8 +9213,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%ED_P_2_AD_P_R)) then - LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_AD_P_R, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_AD_P_R, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_AD_P_R) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_AD_P_R) if (.not. allocated(DstModuleMapTypeData%ED_P_2_AD_P_R)) then allocate(DstModuleMapTypeData%ED_P_2_AD_P_R(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13230,8 +9256,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B)) then - LB(1:1) = lbound(SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B) + UB(1:1) = ubound(SrcModuleMapTypeData%BDED_L_2_ExtLd_P_B) if (.not. allocated(DstModuleMapTypeData%BDED_L_2_ExtLd_P_B)) then allocate(DstModuleMapTypeData%BDED_L_2_ExtLd_P_B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13246,8 +9272,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%ExtLd_P_2_BDED_B)) then - LB(1:1) = lbound(SrcModuleMapTypeData%ExtLd_P_2_BDED_B, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%ExtLd_P_2_BDED_B, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%ExtLd_P_2_BDED_B) + UB(1:1) = ubound(SrcModuleMapTypeData%ExtLd_P_2_BDED_B) if (.not. allocated(DstModuleMapTypeData%ExtLd_P_2_BDED_B)) then allocate(DstModuleMapTypeData%ExtLd_P_2_BDED_B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13268,8 +9294,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%ED_P_2_ExtLd_P_R)) then - LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_ExtLd_P_R, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_ExtLd_P_R, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%ED_P_2_ExtLd_P_R) + UB(1:1) = ubound(SrcModuleMapTypeData%ED_P_2_ExtLd_P_R) if (.not. allocated(DstModuleMapTypeData%ED_P_2_ExtLd_P_R)) then allocate(DstModuleMapTypeData%ED_P_2_ExtLd_P_R(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13287,8 +9313,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%AD_L_2_ExtLd_B)) then - LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_ExtLd_B, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%AD_L_2_ExtLd_B, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%AD_L_2_ExtLd_B) + UB(1:1) = ubound(SrcModuleMapTypeData%AD_L_2_ExtLd_B) if (.not. allocated(DstModuleMapTypeData%AD_L_2_ExtLd_B)) then allocate(DstModuleMapTypeData%AD_L_2_ExtLd_B(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13312,8 +9338,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%IceD_P_2_SD_P)) then - LB(1:1) = lbound(SrcModuleMapTypeData%IceD_P_2_SD_P, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%IceD_P_2_SD_P, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%IceD_P_2_SD_P) + UB(1:1) = ubound(SrcModuleMapTypeData%IceD_P_2_SD_P) if (.not. allocated(DstModuleMapTypeData%IceD_P_2_SD_P)) then allocate(DstModuleMapTypeData%IceD_P_2_SD_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13328,8 +9354,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%SDy3_P_2_IceD_P)) then - LB(1:1) = lbound(SrcModuleMapTypeData%SDy3_P_2_IceD_P, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%SDy3_P_2_IceD_P, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%SDy3_P_2_IceD_P) + UB(1:1) = ubound(SrcModuleMapTypeData%SDy3_P_2_IceD_P) if (.not. allocated(DstModuleMapTypeData%SDy3_P_2_IceD_P)) then allocate(DstModuleMapTypeData%SDy3_P_2_IceD_P(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13344,8 +9370,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%Jacobian_Opt1)) then - LB(1:2) = lbound(SrcModuleMapTypeData%Jacobian_Opt1, kind=B8Ki) - UB(1:2) = ubound(SrcModuleMapTypeData%Jacobian_Opt1, kind=B8Ki) + LB(1:2) = lbound(SrcModuleMapTypeData%Jacobian_Opt1) + UB(1:2) = ubound(SrcModuleMapTypeData%Jacobian_Opt1) if (.not. allocated(DstModuleMapTypeData%Jacobian_Opt1)) then allocate(DstModuleMapTypeData%Jacobian_Opt1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13356,8 +9382,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct DstModuleMapTypeData%Jacobian_Opt1 = SrcModuleMapTypeData%Jacobian_Opt1 end if if (allocated(SrcModuleMapTypeData%Jacobian_pivot)) then - LB(1:1) = lbound(SrcModuleMapTypeData%Jacobian_pivot, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%Jacobian_pivot, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%Jacobian_pivot) + UB(1:1) = ubound(SrcModuleMapTypeData%Jacobian_pivot) if (.not. allocated(DstModuleMapTypeData%Jacobian_pivot)) then allocate(DstModuleMapTypeData%Jacobian_pivot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13368,8 +9394,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct DstModuleMapTypeData%Jacobian_pivot = SrcModuleMapTypeData%Jacobian_pivot end if if (allocated(SrcModuleMapTypeData%Jac_u_indx)) then - LB(1:2) = lbound(SrcModuleMapTypeData%Jac_u_indx, kind=B8Ki) - UB(1:2) = ubound(SrcModuleMapTypeData%Jac_u_indx, kind=B8Ki) + LB(1:2) = lbound(SrcModuleMapTypeData%Jac_u_indx) + UB(1:2) = ubound(SrcModuleMapTypeData%Jac_u_indx) if (.not. allocated(DstModuleMapTypeData%Jac_u_indx)) then allocate(DstModuleMapTypeData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13401,8 +9427,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%u_ED_BladePtLoads)) then - LB(1:1) = lbound(SrcModuleMapTypeData%u_ED_BladePtLoads, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%u_ED_BladePtLoads, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%u_ED_BladePtLoads) + UB(1:1) = ubound(SrcModuleMapTypeData%u_ED_BladePtLoads) if (.not. allocated(DstModuleMapTypeData%u_ED_BladePtLoads)) then allocate(DstModuleMapTypeData%u_ED_BladePtLoads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13432,8 +9458,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%u_BD_RootMotion)) then - LB(1:1) = lbound(SrcModuleMapTypeData%u_BD_RootMotion, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%u_BD_RootMotion, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%u_BD_RootMotion) + UB(1:1) = ubound(SrcModuleMapTypeData%u_BD_RootMotion) if (.not. allocated(DstModuleMapTypeData%u_BD_RootMotion)) then allocate(DstModuleMapTypeData%u_BD_RootMotion(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13448,8 +9474,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%y_BD_BldMotion_4Loads)) then - LB(1:1) = lbound(SrcModuleMapTypeData%y_BD_BldMotion_4Loads, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%y_BD_BldMotion_4Loads, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%y_BD_BldMotion_4Loads) + UB(1:1) = ubound(SrcModuleMapTypeData%y_BD_BldMotion_4Loads) if (.not. allocated(DstModuleMapTypeData%y_BD_BldMotion_4Loads)) then allocate(DstModuleMapTypeData%y_BD_BldMotion_4Loads(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13464,8 +9490,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%u_BD_Distrload)) then - LB(1:1) = lbound(SrcModuleMapTypeData%u_BD_Distrload, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%u_BD_Distrload, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%u_BD_Distrload) + UB(1:1) = ubound(SrcModuleMapTypeData%u_BD_Distrload) if (.not. allocated(DstModuleMapTypeData%u_BD_Distrload)) then allocate(DstModuleMapTypeData%u_BD_Distrload(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13489,8 +9515,8 @@ subroutine FAST_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcModuleMapTypeData%HubOrient)) then - LB(1:3) = lbound(SrcModuleMapTypeData%HubOrient, kind=B8Ki) - UB(1:3) = ubound(SrcModuleMapTypeData%HubOrient, kind=B8Ki) + LB(1:3) = lbound(SrcModuleMapTypeData%HubOrient) + UB(1:3) = ubound(SrcModuleMapTypeData%HubOrient) if (.not. allocated(DstModuleMapTypeData%HubOrient)) then allocate(DstModuleMapTypeData%HubOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -13506,16 +9532,16 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) type(FAST_ModuleMapType), intent(inout) :: ModuleMapTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyModuleMapType' ErrStat = ErrID_None ErrMsg = '' if (allocated(ModuleMapTypeData%ED_P_2_BD_P)) then - LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_BD_P, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_BD_P, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_BD_P) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_BD_P) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13523,8 +9549,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%ED_P_2_BD_P) end if if (allocated(ModuleMapTypeData%BD_P_2_ED_P)) then - LB(1:1) = lbound(ModuleMapTypeData%BD_P_2_ED_P, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%BD_P_2_ED_P, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%BD_P_2_ED_P) + UB(1:1) = ubound(ModuleMapTypeData%BD_P_2_ED_P) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13532,8 +9558,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BD_P_2_ED_P) end if if (allocated(ModuleMapTypeData%ED_P_2_BD_P_Hub)) then - LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_BD_P_Hub, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_BD_P_Hub, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_BD_P_Hub) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_BD_P_Hub) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13559,8 +9585,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SD_TP_2_ED_P, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%ED_P_2_NStC_P_N)) then - LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_NStC_P_N, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_NStC_P_N, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_NStC_P_N) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_NStC_P_N) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_NStC_P_N(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13568,8 +9594,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%ED_P_2_NStC_P_N) end if if (allocated(ModuleMapTypeData%NStC_P_2_ED_P_N)) then - LB(1:1) = lbound(ModuleMapTypeData%NStC_P_2_ED_P_N, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%NStC_P_2_ED_P_N, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%NStC_P_2_ED_P_N) + UB(1:1) = ubound(ModuleMapTypeData%NStC_P_2_ED_P_N) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%NStC_P_2_ED_P_N(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13577,8 +9603,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%NStC_P_2_ED_P_N) end if if (allocated(ModuleMapTypeData%ED_L_2_TStC_P_T)) then - LB(1:1) = lbound(ModuleMapTypeData%ED_L_2_TStC_P_T, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%ED_L_2_TStC_P_T, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%ED_L_2_TStC_P_T) + UB(1:1) = ubound(ModuleMapTypeData%ED_L_2_TStC_P_T) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_L_2_TStC_P_T(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13586,8 +9612,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%ED_L_2_TStC_P_T) end if if (allocated(ModuleMapTypeData%TStC_P_2_ED_P_T)) then - LB(1:1) = lbound(ModuleMapTypeData%TStC_P_2_ED_P_T, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%TStC_P_2_ED_P_T, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%TStC_P_2_ED_P_T) + UB(1:1) = ubound(ModuleMapTypeData%TStC_P_2_ED_P_T) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%TStC_P_2_ED_P_T(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13595,8 +9621,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%TStC_P_2_ED_P_T) end if if (allocated(ModuleMapTypeData%ED_L_2_BStC_P_B)) then - LB(1:2) = lbound(ModuleMapTypeData%ED_L_2_BStC_P_B, kind=B8Ki) - UB(1:2) = ubound(ModuleMapTypeData%ED_L_2_BStC_P_B, kind=B8Ki) + LB(1:2) = lbound(ModuleMapTypeData%ED_L_2_BStC_P_B) + UB(1:2) = ubound(ModuleMapTypeData%ED_L_2_BStC_P_B) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2) @@ -13606,8 +9632,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%ED_L_2_BStC_P_B) end if if (allocated(ModuleMapTypeData%BStC_P_2_ED_P_B)) then - LB(1:2) = lbound(ModuleMapTypeData%BStC_P_2_ED_P_B, kind=B8Ki) - UB(1:2) = ubound(ModuleMapTypeData%BStC_P_2_ED_P_B, kind=B8Ki) + LB(1:2) = lbound(ModuleMapTypeData%BStC_P_2_ED_P_B) + UB(1:2) = ubound(ModuleMapTypeData%BStC_P_2_ED_P_B) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BStC_P_2_ED_P_B(i1,i2), ErrStat2, ErrMsg2) @@ -13617,8 +9643,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BStC_P_2_ED_P_B) end if if (allocated(ModuleMapTypeData%BD_L_2_BStC_P_B)) then - LB(1:2) = lbound(ModuleMapTypeData%BD_L_2_BStC_P_B, kind=B8Ki) - UB(1:2) = ubound(ModuleMapTypeData%BD_L_2_BStC_P_B, kind=B8Ki) + LB(1:2) = lbound(ModuleMapTypeData%BD_L_2_BStC_P_B) + UB(1:2) = ubound(ModuleMapTypeData%BD_L_2_BStC_P_B) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BD_L_2_BStC_P_B(i1,i2), ErrStat2, ErrMsg2) @@ -13628,8 +9654,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BD_L_2_BStC_P_B) end if if (allocated(ModuleMapTypeData%BStC_P_2_BD_P_B)) then - LB(1:2) = lbound(ModuleMapTypeData%BStC_P_2_BD_P_B, kind=B8Ki) - UB(1:2) = ubound(ModuleMapTypeData%BStC_P_2_BD_P_B, kind=B8Ki) + LB(1:2) = lbound(ModuleMapTypeData%BStC_P_2_BD_P_B) + UB(1:2) = ubound(ModuleMapTypeData%BStC_P_2_BD_P_B) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BStC_P_2_BD_P_B(i1,i2), ErrStat2, ErrMsg2) @@ -13639,8 +9665,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BStC_P_2_BD_P_B) end if if (allocated(ModuleMapTypeData%SStC_P_P_2_SubStructure)) then - LB(1:1) = lbound(ModuleMapTypeData%SStC_P_P_2_SubStructure, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%SStC_P_P_2_SubStructure, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%SStC_P_P_2_SubStructure) + UB(1:1) = ubound(ModuleMapTypeData%SStC_P_P_2_SubStructure) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SStC_P_P_2_SubStructure(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13648,8 +9674,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%SStC_P_P_2_SubStructure) end if if (allocated(ModuleMapTypeData%SubStructure_2_SStC_P_P)) then - LB(1:1) = lbound(ModuleMapTypeData%SubStructure_2_SStC_P_P, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%SubStructure_2_SStC_P_P, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%SubStructure_2_SStC_P_P) + UB(1:1) = ubound(ModuleMapTypeData%SubStructure_2_SStC_P_P) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SubStructure_2_SStC_P_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13659,8 +9685,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_SrvD_P_P, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%BDED_L_2_AD_L_B)) then - LB(1:1) = lbound(ModuleMapTypeData%BDED_L_2_AD_L_B, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%BDED_L_2_AD_L_B, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%BDED_L_2_AD_L_B) + UB(1:1) = ubound(ModuleMapTypeData%BDED_L_2_AD_L_B) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13668,8 +9694,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BDED_L_2_AD_L_B) end if if (allocated(ModuleMapTypeData%AD_L_2_BDED_B)) then - LB(1:1) = lbound(ModuleMapTypeData%AD_L_2_BDED_B, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%AD_L_2_BDED_B, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%AD_L_2_BDED_B) + UB(1:1) = ubound(ModuleMapTypeData%AD_L_2_BDED_B) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13677,8 +9703,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%AD_L_2_BDED_B) end if if (allocated(ModuleMapTypeData%BD_L_2_BD_L)) then - LB(1:1) = lbound(ModuleMapTypeData%BD_L_2_BD_L, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%BD_L_2_BD_L, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%BD_L_2_BD_L) + UB(1:1) = ubound(ModuleMapTypeData%BD_L_2_BD_L) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13686,8 +9712,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BD_L_2_BD_L) end if if (allocated(ModuleMapTypeData%SED_P_2_AD_L_B)) then - LB(1:1) = lbound(ModuleMapTypeData%SED_P_2_AD_L_B, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%SED_P_2_AD_L_B, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%SED_P_2_AD_L_B) + UB(1:1) = ubound(ModuleMapTypeData%SED_P_2_AD_L_B) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SED_P_2_AD_L_B(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13695,8 +9721,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%SED_P_2_AD_L_B) end if if (allocated(ModuleMapTypeData%SED_P_2_AD_P_R)) then - LB(1:1) = lbound(ModuleMapTypeData%SED_P_2_AD_P_R, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%SED_P_2_AD_P_R, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%SED_P_2_AD_P_R) + UB(1:1) = ubound(ModuleMapTypeData%SED_P_2_AD_P_R) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13704,8 +9730,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%SED_P_2_AD_P_R) end if if (allocated(ModuleMapTypeData%AD_L_2_SED_P)) then - LB(1:1) = lbound(ModuleMapTypeData%AD_L_2_SED_P, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%AD_L_2_SED_P, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%AD_L_2_SED_P) + UB(1:1) = ubound(ModuleMapTypeData%AD_L_2_SED_P) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_L_2_SED_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13725,8 +9751,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%ED_P_2_AD_P_R)) then - LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_AD_P_R, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_AD_P_R, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_AD_P_R) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_AD_P_R) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13752,8 +9778,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%BDED_L_2_ExtLd_P_B)) then - LB(1:1) = lbound(ModuleMapTypeData%BDED_L_2_ExtLd_P_B, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%BDED_L_2_ExtLd_P_B, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%BDED_L_2_ExtLd_P_B) + UB(1:1) = ubound(ModuleMapTypeData%BDED_L_2_ExtLd_P_B) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BDED_L_2_ExtLd_P_B(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13761,8 +9787,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BDED_L_2_ExtLd_P_B) end if if (allocated(ModuleMapTypeData%ExtLd_P_2_BDED_B)) then - LB(1:1) = lbound(ModuleMapTypeData%ExtLd_P_2_BDED_B, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%ExtLd_P_2_BDED_B, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%ExtLd_P_2_BDED_B) + UB(1:1) = ubound(ModuleMapTypeData%ExtLd_P_2_BDED_B) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ExtLd_P_2_BDED_B(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13774,8 +9800,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ExtLd_P_2_ED_P_T, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%ED_P_2_ExtLd_P_R)) then - LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_ExtLd_P_R, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_ExtLd_P_R, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%ED_P_2_ExtLd_P_R) + UB(1:1) = ubound(ModuleMapTypeData%ED_P_2_ExtLd_P_R) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_ExtLd_P_R(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13785,8 +9811,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%ED_P_2_ExtLd_P_H, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%AD_L_2_ExtLd_B)) then - LB(1:1) = lbound(ModuleMapTypeData%AD_L_2_ExtLd_B, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%AD_L_2_ExtLd_B, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%AD_L_2_ExtLd_B) + UB(1:1) = ubound(ModuleMapTypeData%AD_L_2_ExtLd_B) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%AD_L_2_ExtLd_B(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13800,8 +9826,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SDy3_P_2_IceF_P, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%IceD_P_2_SD_P)) then - LB(1:1) = lbound(ModuleMapTypeData%IceD_P_2_SD_P, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%IceD_P_2_SD_P, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%IceD_P_2_SD_P) + UB(1:1) = ubound(ModuleMapTypeData%IceD_P_2_SD_P) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13809,8 +9835,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%IceD_P_2_SD_P) end if if (allocated(ModuleMapTypeData%SDy3_P_2_IceD_P)) then - LB(1:1) = lbound(ModuleMapTypeData%SDy3_P_2_IceD_P, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%SDy3_P_2_IceD_P, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%SDy3_P_2_IceD_P) + UB(1:1) = ubound(ModuleMapTypeData%SDy3_P_2_IceD_P) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13841,8 +9867,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call MeshDestroy( ModuleMapTypeData%u_ED_TowerPtloads, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%u_ED_BladePtLoads)) then - LB(1:1) = lbound(ModuleMapTypeData%u_ED_BladePtLoads, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%u_ED_BladePtLoads, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%u_ED_BladePtLoads) + UB(1:1) = ubound(ModuleMapTypeData%u_ED_BladePtLoads) do i1 = LB(1), UB(1) call MeshDestroy( ModuleMapTypeData%u_ED_BladePtLoads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13860,8 +9886,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) call MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad_2, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ModuleMapTypeData%u_BD_RootMotion)) then - LB(1:1) = lbound(ModuleMapTypeData%u_BD_RootMotion, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%u_BD_RootMotion, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%u_BD_RootMotion) + UB(1:1) = ubound(ModuleMapTypeData%u_BD_RootMotion) do i1 = LB(1), UB(1) call MeshDestroy( ModuleMapTypeData%u_BD_RootMotion(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13869,8 +9895,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%u_BD_RootMotion) end if if (allocated(ModuleMapTypeData%y_BD_BldMotion_4Loads)) then - LB(1:1) = lbound(ModuleMapTypeData%y_BD_BldMotion_4Loads, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%y_BD_BldMotion_4Loads, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%y_BD_BldMotion_4Loads) + UB(1:1) = ubound(ModuleMapTypeData%y_BD_BldMotion_4Loads) do i1 = LB(1), UB(1) call MeshDestroy( ModuleMapTypeData%y_BD_BldMotion_4Loads(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13878,8 +9904,8 @@ subroutine FAST_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%y_BD_BldMotion_4Loads) end if if (allocated(ModuleMapTypeData%u_BD_Distrload)) then - LB(1:1) = lbound(ModuleMapTypeData%u_BD_Distrload, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%u_BD_Distrload, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%u_BD_Distrload) + UB(1:1) = ubound(ModuleMapTypeData%u_BD_Distrload) do i1 = LB(1), UB(1) call MeshDestroy( ModuleMapTypeData%u_BD_Distrload(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -13901,32 +9927,32 @@ subroutine FAST_PackModuleMapType(RF, Indata) type(RegFile), intent(inout) :: RF type(FAST_ModuleMapType), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackModuleMapType' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%ED_P_2_BD_P)) if (allocated(InData%ED_P_2_BD_P)) then - call RegPackBounds(RF, 1, lbound(InData%ED_P_2_BD_P, kind=B8Ki), ubound(InData%ED_P_2_BD_P, kind=B8Ki)) - LB(1:1) = lbound(InData%ED_P_2_BD_P, kind=B8Ki) - UB(1:1) = ubound(InData%ED_P_2_BD_P, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_BD_P), ubound(InData%ED_P_2_BD_P)) + LB(1:1) = lbound(InData%ED_P_2_BD_P) + UB(1:1) = ubound(InData%ED_P_2_BD_P) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_BD_P(i1)) end do end if call RegPack(RF, allocated(InData%BD_P_2_ED_P)) if (allocated(InData%BD_P_2_ED_P)) then - call RegPackBounds(RF, 1, lbound(InData%BD_P_2_ED_P, kind=B8Ki), ubound(InData%BD_P_2_ED_P, kind=B8Ki)) - LB(1:1) = lbound(InData%BD_P_2_ED_P, kind=B8Ki) - UB(1:1) = ubound(InData%BD_P_2_ED_P, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BD_P_2_ED_P), ubound(InData%BD_P_2_ED_P)) + LB(1:1) = lbound(InData%BD_P_2_ED_P) + UB(1:1) = ubound(InData%BD_P_2_ED_P) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%BD_P_2_ED_P(i1)) end do end if call RegPack(RF, allocated(InData%ED_P_2_BD_P_Hub)) if (allocated(InData%ED_P_2_BD_P_Hub)) then - call RegPackBounds(RF, 1, lbound(InData%ED_P_2_BD_P_Hub, kind=B8Ki), ubound(InData%ED_P_2_BD_P_Hub, kind=B8Ki)) - LB(1:1) = lbound(InData%ED_P_2_BD_P_Hub, kind=B8Ki) - UB(1:1) = ubound(InData%ED_P_2_BD_P_Hub, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_BD_P_Hub), ubound(InData%ED_P_2_BD_P_Hub)) + LB(1:1) = lbound(InData%ED_P_2_BD_P_Hub) + UB(1:1) = ubound(InData%ED_P_2_BD_P_Hub) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_BD_P_Hub(i1)) end do @@ -13942,45 +9968,45 @@ subroutine FAST_PackModuleMapType(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%SD_TP_2_ED_P) call RegPack(RF, allocated(InData%ED_P_2_NStC_P_N)) if (allocated(InData%ED_P_2_NStC_P_N)) then - call RegPackBounds(RF, 1, lbound(InData%ED_P_2_NStC_P_N, kind=B8Ki), ubound(InData%ED_P_2_NStC_P_N, kind=B8Ki)) - LB(1:1) = lbound(InData%ED_P_2_NStC_P_N, kind=B8Ki) - UB(1:1) = ubound(InData%ED_P_2_NStC_P_N, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_NStC_P_N), ubound(InData%ED_P_2_NStC_P_N)) + LB(1:1) = lbound(InData%ED_P_2_NStC_P_N) + UB(1:1) = ubound(InData%ED_P_2_NStC_P_N) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_NStC_P_N(i1)) end do end if call RegPack(RF, allocated(InData%NStC_P_2_ED_P_N)) if (allocated(InData%NStC_P_2_ED_P_N)) then - call RegPackBounds(RF, 1, lbound(InData%NStC_P_2_ED_P_N, kind=B8Ki), ubound(InData%NStC_P_2_ED_P_N, kind=B8Ki)) - LB(1:1) = lbound(InData%NStC_P_2_ED_P_N, kind=B8Ki) - UB(1:1) = ubound(InData%NStC_P_2_ED_P_N, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%NStC_P_2_ED_P_N), ubound(InData%NStC_P_2_ED_P_N)) + LB(1:1) = lbound(InData%NStC_P_2_ED_P_N) + UB(1:1) = ubound(InData%NStC_P_2_ED_P_N) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%NStC_P_2_ED_P_N(i1)) end do end if call RegPack(RF, allocated(InData%ED_L_2_TStC_P_T)) if (allocated(InData%ED_L_2_TStC_P_T)) then - call RegPackBounds(RF, 1, lbound(InData%ED_L_2_TStC_P_T, kind=B8Ki), ubound(InData%ED_L_2_TStC_P_T, kind=B8Ki)) - LB(1:1) = lbound(InData%ED_L_2_TStC_P_T, kind=B8Ki) - UB(1:1) = ubound(InData%ED_L_2_TStC_P_T, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ED_L_2_TStC_P_T), ubound(InData%ED_L_2_TStC_P_T)) + LB(1:1) = lbound(InData%ED_L_2_TStC_P_T) + UB(1:1) = ubound(InData%ED_L_2_TStC_P_T) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%ED_L_2_TStC_P_T(i1)) end do end if call RegPack(RF, allocated(InData%TStC_P_2_ED_P_T)) if (allocated(InData%TStC_P_2_ED_P_T)) then - call RegPackBounds(RF, 1, lbound(InData%TStC_P_2_ED_P_T, kind=B8Ki), ubound(InData%TStC_P_2_ED_P_T, kind=B8Ki)) - LB(1:1) = lbound(InData%TStC_P_2_ED_P_T, kind=B8Ki) - UB(1:1) = ubound(InData%TStC_P_2_ED_P_T, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%TStC_P_2_ED_P_T), ubound(InData%TStC_P_2_ED_P_T)) + LB(1:1) = lbound(InData%TStC_P_2_ED_P_T) + UB(1:1) = ubound(InData%TStC_P_2_ED_P_T) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%TStC_P_2_ED_P_T(i1)) end do end if call RegPack(RF, allocated(InData%ED_L_2_BStC_P_B)) if (allocated(InData%ED_L_2_BStC_P_B)) then - call RegPackBounds(RF, 2, lbound(InData%ED_L_2_BStC_P_B, kind=B8Ki), ubound(InData%ED_L_2_BStC_P_B, kind=B8Ki)) - LB(1:2) = lbound(InData%ED_L_2_BStC_P_B, kind=B8Ki) - UB(1:2) = ubound(InData%ED_L_2_BStC_P_B, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%ED_L_2_BStC_P_B), ubound(InData%ED_L_2_BStC_P_B)) + LB(1:2) = lbound(InData%ED_L_2_BStC_P_B) + UB(1:2) = ubound(InData%ED_L_2_BStC_P_B) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%ED_L_2_BStC_P_B(i1,i2)) @@ -13989,9 +10015,9 @@ subroutine FAST_PackModuleMapType(RF, Indata) end if call RegPack(RF, allocated(InData%BStC_P_2_ED_P_B)) if (allocated(InData%BStC_P_2_ED_P_B)) then - call RegPackBounds(RF, 2, lbound(InData%BStC_P_2_ED_P_B, kind=B8Ki), ubound(InData%BStC_P_2_ED_P_B, kind=B8Ki)) - LB(1:2) = lbound(InData%BStC_P_2_ED_P_B, kind=B8Ki) - UB(1:2) = ubound(InData%BStC_P_2_ED_P_B, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%BStC_P_2_ED_P_B), ubound(InData%BStC_P_2_ED_P_B)) + LB(1:2) = lbound(InData%BStC_P_2_ED_P_B) + UB(1:2) = ubound(InData%BStC_P_2_ED_P_B) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%BStC_P_2_ED_P_B(i1,i2)) @@ -14000,9 +10026,9 @@ subroutine FAST_PackModuleMapType(RF, Indata) end if call RegPack(RF, allocated(InData%BD_L_2_BStC_P_B)) if (allocated(InData%BD_L_2_BStC_P_B)) then - call RegPackBounds(RF, 2, lbound(InData%BD_L_2_BStC_P_B, kind=B8Ki), ubound(InData%BD_L_2_BStC_P_B, kind=B8Ki)) - LB(1:2) = lbound(InData%BD_L_2_BStC_P_B, kind=B8Ki) - UB(1:2) = ubound(InData%BD_L_2_BStC_P_B, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%BD_L_2_BStC_P_B), ubound(InData%BD_L_2_BStC_P_B)) + LB(1:2) = lbound(InData%BD_L_2_BStC_P_B) + UB(1:2) = ubound(InData%BD_L_2_BStC_P_B) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%BD_L_2_BStC_P_B(i1,i2)) @@ -14011,9 +10037,9 @@ subroutine FAST_PackModuleMapType(RF, Indata) end if call RegPack(RF, allocated(InData%BStC_P_2_BD_P_B)) if (allocated(InData%BStC_P_2_BD_P_B)) then - call RegPackBounds(RF, 2, lbound(InData%BStC_P_2_BD_P_B, kind=B8Ki), ubound(InData%BStC_P_2_BD_P_B, kind=B8Ki)) - LB(1:2) = lbound(InData%BStC_P_2_BD_P_B, kind=B8Ki) - UB(1:2) = ubound(InData%BStC_P_2_BD_P_B, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%BStC_P_2_BD_P_B), ubound(InData%BStC_P_2_BD_P_B)) + LB(1:2) = lbound(InData%BStC_P_2_BD_P_B) + UB(1:2) = ubound(InData%BStC_P_2_BD_P_B) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%BStC_P_2_BD_P_B(i1,i2)) @@ -14022,18 +10048,18 @@ subroutine FAST_PackModuleMapType(RF, Indata) end if call RegPack(RF, allocated(InData%SStC_P_P_2_SubStructure)) if (allocated(InData%SStC_P_P_2_SubStructure)) then - call RegPackBounds(RF, 1, lbound(InData%SStC_P_P_2_SubStructure, kind=B8Ki), ubound(InData%SStC_P_P_2_SubStructure, kind=B8Ki)) - LB(1:1) = lbound(InData%SStC_P_P_2_SubStructure, kind=B8Ki) - UB(1:1) = ubound(InData%SStC_P_P_2_SubStructure, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SStC_P_P_2_SubStructure), ubound(InData%SStC_P_P_2_SubStructure)) + LB(1:1) = lbound(InData%SStC_P_P_2_SubStructure) + UB(1:1) = ubound(InData%SStC_P_P_2_SubStructure) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%SStC_P_P_2_SubStructure(i1)) end do end if call RegPack(RF, allocated(InData%SubStructure_2_SStC_P_P)) if (allocated(InData%SubStructure_2_SStC_P_P)) then - call RegPackBounds(RF, 1, lbound(InData%SubStructure_2_SStC_P_P, kind=B8Ki), ubound(InData%SubStructure_2_SStC_P_P, kind=B8Ki)) - LB(1:1) = lbound(InData%SubStructure_2_SStC_P_P, kind=B8Ki) - UB(1:1) = ubound(InData%SubStructure_2_SStC_P_P, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SubStructure_2_SStC_P_P), ubound(InData%SubStructure_2_SStC_P_P)) + LB(1:1) = lbound(InData%SubStructure_2_SStC_P_P) + UB(1:1) = ubound(InData%SubStructure_2_SStC_P_P) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%SubStructure_2_SStC_P_P(i1)) end do @@ -14041,54 +10067,54 @@ subroutine FAST_PackModuleMapType(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_SrvD_P_P) call RegPack(RF, allocated(InData%BDED_L_2_AD_L_B)) if (allocated(InData%BDED_L_2_AD_L_B)) then - call RegPackBounds(RF, 1, lbound(InData%BDED_L_2_AD_L_B, kind=B8Ki), ubound(InData%BDED_L_2_AD_L_B, kind=B8Ki)) - LB(1:1) = lbound(InData%BDED_L_2_AD_L_B, kind=B8Ki) - UB(1:1) = ubound(InData%BDED_L_2_AD_L_B, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BDED_L_2_AD_L_B), ubound(InData%BDED_L_2_AD_L_B)) + LB(1:1) = lbound(InData%BDED_L_2_AD_L_B) + UB(1:1) = ubound(InData%BDED_L_2_AD_L_B) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%BDED_L_2_AD_L_B(i1)) end do end if call RegPack(RF, allocated(InData%AD_L_2_BDED_B)) if (allocated(InData%AD_L_2_BDED_B)) then - call RegPackBounds(RF, 1, lbound(InData%AD_L_2_BDED_B, kind=B8Ki), ubound(InData%AD_L_2_BDED_B, kind=B8Ki)) - LB(1:1) = lbound(InData%AD_L_2_BDED_B, kind=B8Ki) - UB(1:1) = ubound(InData%AD_L_2_BDED_B, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%AD_L_2_BDED_B), ubound(InData%AD_L_2_BDED_B)) + LB(1:1) = lbound(InData%AD_L_2_BDED_B) + UB(1:1) = ubound(InData%AD_L_2_BDED_B) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%AD_L_2_BDED_B(i1)) end do end if call RegPack(RF, allocated(InData%BD_L_2_BD_L)) if (allocated(InData%BD_L_2_BD_L)) then - call RegPackBounds(RF, 1, lbound(InData%BD_L_2_BD_L, kind=B8Ki), ubound(InData%BD_L_2_BD_L, kind=B8Ki)) - LB(1:1) = lbound(InData%BD_L_2_BD_L, kind=B8Ki) - UB(1:1) = ubound(InData%BD_L_2_BD_L, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BD_L_2_BD_L), ubound(InData%BD_L_2_BD_L)) + LB(1:1) = lbound(InData%BD_L_2_BD_L) + UB(1:1) = ubound(InData%BD_L_2_BD_L) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%BD_L_2_BD_L(i1)) end do end if call RegPack(RF, allocated(InData%SED_P_2_AD_L_B)) if (allocated(InData%SED_P_2_AD_L_B)) then - call RegPackBounds(RF, 1, lbound(InData%SED_P_2_AD_L_B, kind=B8Ki), ubound(InData%SED_P_2_AD_L_B, kind=B8Ki)) - LB(1:1) = lbound(InData%SED_P_2_AD_L_B, kind=B8Ki) - UB(1:1) = ubound(InData%SED_P_2_AD_L_B, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SED_P_2_AD_L_B), ubound(InData%SED_P_2_AD_L_B)) + LB(1:1) = lbound(InData%SED_P_2_AD_L_B) + UB(1:1) = ubound(InData%SED_P_2_AD_L_B) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%SED_P_2_AD_L_B(i1)) end do end if call RegPack(RF, allocated(InData%SED_P_2_AD_P_R)) if (allocated(InData%SED_P_2_AD_P_R)) then - call RegPackBounds(RF, 1, lbound(InData%SED_P_2_AD_P_R, kind=B8Ki), ubound(InData%SED_P_2_AD_P_R, kind=B8Ki)) - LB(1:1) = lbound(InData%SED_P_2_AD_P_R, kind=B8Ki) - UB(1:1) = ubound(InData%SED_P_2_AD_P_R, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SED_P_2_AD_P_R), ubound(InData%SED_P_2_AD_P_R)) + LB(1:1) = lbound(InData%SED_P_2_AD_P_R) + UB(1:1) = ubound(InData%SED_P_2_AD_P_R) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%SED_P_2_AD_P_R(i1)) end do end if call RegPack(RF, allocated(InData%AD_L_2_SED_P)) if (allocated(InData%AD_L_2_SED_P)) then - call RegPackBounds(RF, 1, lbound(InData%AD_L_2_SED_P, kind=B8Ki), ubound(InData%AD_L_2_SED_P, kind=B8Ki)) - LB(1:1) = lbound(InData%AD_L_2_SED_P, kind=B8Ki) - UB(1:1) = ubound(InData%AD_L_2_SED_P, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%AD_L_2_SED_P), ubound(InData%AD_L_2_SED_P)) + LB(1:1) = lbound(InData%AD_L_2_SED_P) + UB(1:1) = ubound(InData%AD_L_2_SED_P) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%AD_L_2_SED_P(i1)) end do @@ -14101,9 +10127,9 @@ subroutine FAST_PackModuleMapType(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%AD_L_2_ED_P_T) call RegPack(RF, allocated(InData%ED_P_2_AD_P_R)) if (allocated(InData%ED_P_2_AD_P_R)) then - call RegPackBounds(RF, 1, lbound(InData%ED_P_2_AD_P_R, kind=B8Ki), ubound(InData%ED_P_2_AD_P_R, kind=B8Ki)) - LB(1:1) = lbound(InData%ED_P_2_AD_P_R, kind=B8Ki) - UB(1:1) = ubound(InData%ED_P_2_AD_P_R, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_AD_P_R), ubound(InData%ED_P_2_AD_P_R)) + LB(1:1) = lbound(InData%ED_P_2_AD_P_R) + UB(1:1) = ubound(InData%ED_P_2_AD_P_R) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_AD_P_R(i1)) end do @@ -14119,18 +10145,18 @@ subroutine FAST_PackModuleMapType(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%AD_P_2_ED_P_H) call RegPack(RF, allocated(InData%BDED_L_2_ExtLd_P_B)) if (allocated(InData%BDED_L_2_ExtLd_P_B)) then - call RegPackBounds(RF, 1, lbound(InData%BDED_L_2_ExtLd_P_B, kind=B8Ki), ubound(InData%BDED_L_2_ExtLd_P_B, kind=B8Ki)) - LB(1:1) = lbound(InData%BDED_L_2_ExtLd_P_B, kind=B8Ki) - UB(1:1) = ubound(InData%BDED_L_2_ExtLd_P_B, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%BDED_L_2_ExtLd_P_B), ubound(InData%BDED_L_2_ExtLd_P_B)) + LB(1:1) = lbound(InData%BDED_L_2_ExtLd_P_B) + UB(1:1) = ubound(InData%BDED_L_2_ExtLd_P_B) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%BDED_L_2_ExtLd_P_B(i1)) end do end if call RegPack(RF, allocated(InData%ExtLd_P_2_BDED_B)) if (allocated(InData%ExtLd_P_2_BDED_B)) then - call RegPackBounds(RF, 1, lbound(InData%ExtLd_P_2_BDED_B, kind=B8Ki), ubound(InData%ExtLd_P_2_BDED_B, kind=B8Ki)) - LB(1:1) = lbound(InData%ExtLd_P_2_BDED_B, kind=B8Ki) - UB(1:1) = ubound(InData%ExtLd_P_2_BDED_B, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ExtLd_P_2_BDED_B), ubound(InData%ExtLd_P_2_BDED_B)) + LB(1:1) = lbound(InData%ExtLd_P_2_BDED_B) + UB(1:1) = ubound(InData%ExtLd_P_2_BDED_B) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%ExtLd_P_2_BDED_B(i1)) end do @@ -14139,9 +10165,9 @@ subroutine FAST_PackModuleMapType(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%ExtLd_P_2_ED_P_T) call RegPack(RF, allocated(InData%ED_P_2_ExtLd_P_R)) if (allocated(InData%ED_P_2_ExtLd_P_R)) then - call RegPackBounds(RF, 1, lbound(InData%ED_P_2_ExtLd_P_R, kind=B8Ki), ubound(InData%ED_P_2_ExtLd_P_R, kind=B8Ki)) - LB(1:1) = lbound(InData%ED_P_2_ExtLd_P_R, kind=B8Ki) - UB(1:1) = ubound(InData%ED_P_2_ExtLd_P_R, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ED_P_2_ExtLd_P_R), ubound(InData%ED_P_2_ExtLd_P_R)) + LB(1:1) = lbound(InData%ED_P_2_ExtLd_P_R) + UB(1:1) = ubound(InData%ED_P_2_ExtLd_P_R) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_ExtLd_P_R(i1)) end do @@ -14149,9 +10175,9 @@ subroutine FAST_PackModuleMapType(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%ED_P_2_ExtLd_P_H) call RegPack(RF, allocated(InData%AD_L_2_ExtLd_B)) if (allocated(InData%AD_L_2_ExtLd_B)) then - call RegPackBounds(RF, 1, lbound(InData%AD_L_2_ExtLd_B, kind=B8Ki), ubound(InData%AD_L_2_ExtLd_B, kind=B8Ki)) - LB(1:1) = lbound(InData%AD_L_2_ExtLd_B, kind=B8Ki) - UB(1:1) = ubound(InData%AD_L_2_ExtLd_B, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%AD_L_2_ExtLd_B), ubound(InData%AD_L_2_ExtLd_B)) + LB(1:1) = lbound(InData%AD_L_2_ExtLd_B) + UB(1:1) = ubound(InData%AD_L_2_ExtLd_B) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%AD_L_2_ExtLd_B(i1)) end do @@ -14161,18 +10187,18 @@ subroutine FAST_PackModuleMapType(RF, Indata) call NWTC_Library_PackMeshMapType(RF, InData%SDy3_P_2_IceF_P) call RegPack(RF, allocated(InData%IceD_P_2_SD_P)) if (allocated(InData%IceD_P_2_SD_P)) then - call RegPackBounds(RF, 1, lbound(InData%IceD_P_2_SD_P, kind=B8Ki), ubound(InData%IceD_P_2_SD_P, kind=B8Ki)) - LB(1:1) = lbound(InData%IceD_P_2_SD_P, kind=B8Ki) - UB(1:1) = ubound(InData%IceD_P_2_SD_P, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%IceD_P_2_SD_P), ubound(InData%IceD_P_2_SD_P)) + LB(1:1) = lbound(InData%IceD_P_2_SD_P) + UB(1:1) = ubound(InData%IceD_P_2_SD_P) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%IceD_P_2_SD_P(i1)) end do end if call RegPack(RF, allocated(InData%SDy3_P_2_IceD_P)) if (allocated(InData%SDy3_P_2_IceD_P)) then - call RegPackBounds(RF, 1, lbound(InData%SDy3_P_2_IceD_P, kind=B8Ki), ubound(InData%SDy3_P_2_IceD_P, kind=B8Ki)) - LB(1:1) = lbound(InData%SDy3_P_2_IceD_P, kind=B8Ki) - UB(1:1) = ubound(InData%SDy3_P_2_IceD_P, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SDy3_P_2_IceD_P), ubound(InData%SDy3_P_2_IceD_P)) + LB(1:1) = lbound(InData%SDy3_P_2_IceD_P) + UB(1:1) = ubound(InData%SDy3_P_2_IceD_P) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%SDy3_P_2_IceD_P(i1)) end do @@ -14189,9 +10215,9 @@ subroutine FAST_PackModuleMapType(RF, Indata) call MeshPack(RF, InData%u_ED_TowerPtloads) call RegPack(RF, allocated(InData%u_ED_BladePtLoads)) if (allocated(InData%u_ED_BladePtLoads)) then - call RegPackBounds(RF, 1, lbound(InData%u_ED_BladePtLoads, kind=B8Ki), ubound(InData%u_ED_BladePtLoads, kind=B8Ki)) - LB(1:1) = lbound(InData%u_ED_BladePtLoads, kind=B8Ki) - UB(1:1) = ubound(InData%u_ED_BladePtLoads, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%u_ED_BladePtLoads), ubound(InData%u_ED_BladePtLoads)) + LB(1:1) = lbound(InData%u_ED_BladePtLoads) + UB(1:1) = ubound(InData%u_ED_BladePtLoads) do i1 = LB(1), UB(1) call MeshPack(RF, InData%u_ED_BladePtLoads(i1)) end do @@ -14203,27 +10229,27 @@ subroutine FAST_PackModuleMapType(RF, Indata) call MeshPack(RF, InData%u_ED_HubPtLoad_2) call RegPack(RF, allocated(InData%u_BD_RootMotion)) if (allocated(InData%u_BD_RootMotion)) then - call RegPackBounds(RF, 1, lbound(InData%u_BD_RootMotion, kind=B8Ki), ubound(InData%u_BD_RootMotion, kind=B8Ki)) - LB(1:1) = lbound(InData%u_BD_RootMotion, kind=B8Ki) - UB(1:1) = ubound(InData%u_BD_RootMotion, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%u_BD_RootMotion), ubound(InData%u_BD_RootMotion)) + LB(1:1) = lbound(InData%u_BD_RootMotion) + UB(1:1) = ubound(InData%u_BD_RootMotion) do i1 = LB(1), UB(1) call MeshPack(RF, InData%u_BD_RootMotion(i1)) end do end if call RegPack(RF, allocated(InData%y_BD_BldMotion_4Loads)) if (allocated(InData%y_BD_BldMotion_4Loads)) then - call RegPackBounds(RF, 1, lbound(InData%y_BD_BldMotion_4Loads, kind=B8Ki), ubound(InData%y_BD_BldMotion_4Loads, kind=B8Ki)) - LB(1:1) = lbound(InData%y_BD_BldMotion_4Loads, kind=B8Ki) - UB(1:1) = ubound(InData%y_BD_BldMotion_4Loads, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%y_BD_BldMotion_4Loads), ubound(InData%y_BD_BldMotion_4Loads)) + LB(1:1) = lbound(InData%y_BD_BldMotion_4Loads) + UB(1:1) = ubound(InData%y_BD_BldMotion_4Loads) do i1 = LB(1), UB(1) call MeshPack(RF, InData%y_BD_BldMotion_4Loads(i1)) end do end if call RegPack(RF, allocated(InData%u_BD_Distrload)) if (allocated(InData%u_BD_Distrload)) then - call RegPackBounds(RF, 1, lbound(InData%u_BD_Distrload, kind=B8Ki), ubound(InData%u_BD_Distrload, kind=B8Ki)) - LB(1:1) = lbound(InData%u_BD_Distrload, kind=B8Ki) - UB(1:1) = ubound(InData%u_BD_Distrload, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%u_BD_Distrload), ubound(InData%u_BD_Distrload)) + LB(1:1) = lbound(InData%u_BD_Distrload) + UB(1:1) = ubound(InData%u_BD_Distrload) do i1 = LB(1), UB(1) call MeshPack(RF, InData%u_BD_Distrload(i1)) end do @@ -14239,8 +10265,8 @@ subroutine FAST_UnPackModuleMapType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_ModuleMapType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackModuleMapType' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -14845,8 +10871,8 @@ subroutine FAST_CopyInitData(SrcInitDataData, DstInitDataData, CtrlCode, ErrStat integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_CopyInitData' @@ -14868,8 +10894,8 @@ subroutine FAST_CopyInitData(SrcInitDataData, DstInitDataData, CtrlCode, ErrStat call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitDataData%OutData_BD)) then - LB(1:1) = lbound(SrcInitDataData%OutData_BD, kind=B8Ki) - UB(1:1) = ubound(SrcInitDataData%OutData_BD, kind=B8Ki) + LB(1:1) = lbound(SrcInitDataData%OutData_BD) + UB(1:1) = ubound(SrcInitDataData%OutData_BD) if (.not. allocated(DstInitDataData%OutData_BD)) then allocate(DstInitDataData%OutData_BD(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -14985,8 +11011,8 @@ subroutine FAST_DestroyInitData(InitDataData, ErrStat, ErrMsg) type(FAST_InitData), intent(inout) :: InitDataData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FAST_DestroyInitData' @@ -15003,8 +11029,8 @@ subroutine FAST_DestroyInitData(InitDataData, ErrStat, ErrMsg) call BD_DestroyInitInput(InitDataData%InData_BD, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(InitDataData%OutData_BD)) then - LB(1:1) = lbound(InitDataData%OutData_BD, kind=B8Ki) - UB(1:1) = ubound(InitDataData%OutData_BD, kind=B8Ki) + LB(1:1) = lbound(InitDataData%OutData_BD) + UB(1:1) = ubound(InitDataData%OutData_BD) do i1 = LB(1), UB(1) call BD_DestroyInitOutput(InitDataData%OutData_BD(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -15081,8 +11107,8 @@ subroutine FAST_PackInitData(RF, Indata) type(RegFile), intent(inout) :: RF type(FAST_InitData), intent(in) :: InData character(*), parameter :: RoutineName = 'FAST_PackInitData' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + 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) @@ -15091,9 +11117,9 @@ subroutine FAST_PackInitData(RF, Indata) call BD_PackInitInput(RF, InData%InData_BD) call RegPack(RF, allocated(InData%OutData_BD)) if (allocated(InData%OutData_BD)) then - call RegPackBounds(RF, 1, lbound(InData%OutData_BD, kind=B8Ki), ubound(InData%OutData_BD, kind=B8Ki)) - LB(1:1) = lbound(InData%OutData_BD, kind=B8Ki) - UB(1:1) = ubound(InData%OutData_BD, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%OutData_BD), ubound(InData%OutData_BD)) + LB(1:1) = lbound(InData%OutData_BD) + UB(1:1) = ubound(InData%OutData_BD) do i1 = LB(1), UB(1) call BD_PackInitOutput(RF, InData%OutData_BD(i1)) end do @@ -15137,8 +11163,8 @@ subroutine FAST_UnPackInitData(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_InitData), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackInitData' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -15200,7 +11226,7 @@ subroutine FAST_CopyExternInitType(SrcExternInitTypeData, DstExternInitTypeData, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'FAST_CopyExternInitType' ErrStat = ErrID_None @@ -15213,8 +11239,8 @@ subroutine FAST_CopyExternInitType(SrcExternInitTypeData, DstExternInitTypeData, DstExternInitTypeData%NumSC2Ctrl = SrcExternInitTypeData%NumSC2Ctrl DstExternInitTypeData%NumCtrl2SC = SrcExternInitTypeData%NumCtrl2SC if (allocated(SrcExternInitTypeData%fromSCGlob)) then - LB(1:1) = lbound(SrcExternInitTypeData%fromSCGlob, kind=B8Ki) - UB(1:1) = ubound(SrcExternInitTypeData%fromSCGlob, kind=B8Ki) + LB(1:1) = lbound(SrcExternInitTypeData%fromSCGlob) + UB(1:1) = ubound(SrcExternInitTypeData%fromSCGlob) if (.not. allocated(DstExternInitTypeData%fromSCGlob)) then allocate(DstExternInitTypeData%fromSCGlob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -15225,8 +11251,8 @@ subroutine FAST_CopyExternInitType(SrcExternInitTypeData, DstExternInitTypeData, DstExternInitTypeData%fromSCGlob = SrcExternInitTypeData%fromSCGlob end if if (allocated(SrcExternInitTypeData%fromSC)) then - LB(1:1) = lbound(SrcExternInitTypeData%fromSC, kind=B8Ki) - UB(1:1) = ubound(SrcExternInitTypeData%fromSC, kind=B8Ki) + LB(1:1) = lbound(SrcExternInitTypeData%fromSC) + UB(1:1) = ubound(SrcExternInitTypeData%fromSC) if (.not. allocated(DstExternInitTypeData%fromSC)) then allocate(DstExternInitTypeData%fromSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -15302,7 +11328,7 @@ subroutine FAST_UnPackExternInitType(RF, OutData) type(RegFile), intent(inout) :: RF type(FAST_ExternInitType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'FAST_UnPackExternInitType' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -15353,6 +11379,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 +11468,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 +11527,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 +11563,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 +11588,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 0edad6ac87..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, @@ -370,13 +410,13 @@ void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, w << indent << "character(*), intent( out) :: ErrMsg"; if (has_ddt_arr) { - w << indent << "integer(B8Ki) :: "; + w << indent << "integer(B4Ki) :: "; for (int i = 1; i <= ddt.max_rank; i++) w << (i > 1 ? ", " : "") << "i" << i; w << ""; } if (has_ddt_arr || has_alloc) - w << indent << "integer(B8Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + w << indent << "integer(B4Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; if (has_ddt || has_alloc) w << indent << "integer(IntKi) :: ErrStat2"; if (has_ddt) @@ -411,8 +451,8 @@ void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, std::string dims(""); if (field.rank > 0) { - w << indent << "LB(1:" << field.rank << ") = lbound(" << src << ", kind=B8Ki)"; - w << indent << "UB(1:" << field.rank << ") = ubound(" << src << ", kind=B8Ki)"; + w << indent << "LB(1:" << field.rank << ") = lbound(" << src << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << src << ")"; for (int d = 1; d <= field.rank; d++) dims += ",LB(" + std::to_string(d) + "):UB(" + std::to_string(d) + ")"; dims = "(" + dims.substr(1) + ")"; @@ -453,8 +493,8 @@ void gen_copy(std::ostream &w, const Module &mod, const DataType::Derived &ddt, // Get bounds for non-allocated field if (field.rank > 0 && !field.is_allocatable) { - w << indent << "LB(1:" << field.rank << ") = lbound(" << src << ", kind=B8Ki)"; - w << indent << "UB(1:" << field.rank << ") = ubound(" << src << ", kind=B8Ki)"; + w << indent << "LB(1:" << field.rank << ") = lbound(" << src << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << src << ")"; } for (int d = field.rank; d >= 1; d--) @@ -538,10 +578,10 @@ void gen_destroy(std::ostream &w, const Module &mod, const DataType::Derived &dd w << indent << "character(*), intent( out) :: ErrMsg"; if (has_ddt_arr) { - w << indent << "integer(B8Ki) :: "; + w << indent << "integer(B4Ki) :: "; for (int i = 1; i <= ddt.max_rank; i++) w << (i > 1 ? ", " : "") << "i" << i; - w << indent << "integer(B8Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + w << indent << "integer(B4Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; } if (has_ddt) { @@ -581,8 +621,8 @@ void gen_destroy(std::ostream &w, const Module &mod, const DataType::Derived &dd if (field.rank > 0) { - w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ", kind=B8Ki)"; - w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ", kind=B8Ki)"; + w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ")"; } for (int d = field.rank; d >= 1; d--) { @@ -661,10 +701,10 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; if (has_ddt_arr) { - w << indent << "integer(B8Ki) :: "; + w << indent << "integer(B4Ki) :: "; for (int i = 1; i <= ddt.max_rank; i++) w << (i > 1 ? ", " : "") << "i" << i; - w << indent << "integer(B8Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + w << indent << "integer(B4Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; } if (has_ptr) { @@ -711,7 +751,7 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, indent += " "; if (field.rank > 0) { - w << indent << "call RegPackBounds(RF, " << field.rank << ", lbound(" << var << ", kind=B8Ki), ubound(" << var << ", kind=B8Ki))"; + w << indent << "call RegPackBounds(RF, " << field.rank << ", lbound(" << var << "), ubound(" << var << "))"; } if (field.is_pointer) { @@ -728,8 +768,8 @@ void gen_pack(std::ostream &w, const Module &mod, const DataType::Derived &ddt, if (field.rank > 0) { - w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ", kind=B8Ki)"; - w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ", kind=B8Ki)"; + w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ")"; } for (int d = field.rank; d >= 1; d--) @@ -804,14 +844,14 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt w << indent << "character(*), parameter :: RoutineName = '" << routine_name << "'"; if (has_ddt_arr) { - w << indent << "integer(B8Ki) :: "; + w << indent << "integer(B4Ki) :: "; for (int i = 1; i <= ddt.max_rank; i++) w << (i > 1 ? ", " : "") << "i" << i; w << ""; } if (has_ddt_arr || has_alloc) { - w << indent << "integer(B8Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; + w << indent << "integer(B4Ki) :: LB(" << ddt.max_rank << "), UB(" << ddt.max_rank << ")"; } if (has_alloc) { @@ -927,8 +967,8 @@ void gen_unpack(std::ostream &w, const Module &mod, const DataType::Derived &ddt // Get bounds for non-allocated field if (field.rank > 0 && !field.is_allocatable) { - w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ", kind=B8Ki)"; - w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ", kind=B8Ki)"; + w << indent << "LB(1:" << field.rank << ") = lbound(" << var << ")"; + w << indent << "UB(1:" << field.rank << ") = ubound(" << var << ")"; } for (int d = field.rank; d >= 1; d--) @@ -1043,7 +1083,7 @@ void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const for (int j = field.rank; j > 0; j--) { - w << indent << "DO i" << recurse_level << j << " = LBOUND(" << uy << "_out" << field_var << "," << j << ", kind=B8Ki),UBOUND(" << uy << "_out" << field_var << "," << j << ", kind=B8Ki)"; + w << indent << "do i" << recurse_level << j << " = lbound(" << uy << "_out" << field_var << "," << j << "),ubound(" << uy << "_out" << field_var << "," << j << ")"; indent += " "; } @@ -1072,7 +1112,7 @@ void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const { for (int j = field.rank; j > 0; j--) { - w << indent << "DO i" << j << " = LBOUND(" << vout << "," << j << ", kind=B8Ki),UBOUND(" << vout << "," << j << ", kind=B8Ki)"; + w << indent << "do i" << j << " = lbound(" << vout << "," << j << "),ubound(" << vout << "," << j << ")"; indent += " "; } @@ -1139,7 +1179,7 @@ void gen_extint_order(std::ostream &w, const Module &mod, std::string uy, const { for (int j = field.rank; j > 0; j--) { - w << indent << "DO i" << j << " = LBOUND(" << vout << "," << j << ", kind=B8Ki),UBOUND(" << vout << "," << j << ", kind=B8Ki)"; + w << indent << "do i" << j << " = lbound(" << vout << "," << j << "),ubound(" << vout << "," << j << ")"; indent += " "; } } @@ -1604,7 +1644,7 @@ void gen_copy_f2c(std::ostream &w, const Module &mod, const DataType::Derived &d { std::string dims; for (int d = 1; d <= field.rank; d++) - dims += std::string(d > 1 ? "," : "") + "LBOUND(" + var_f + "," + std::to_string(d) + ", kind=B8Ki)"; + dims += std::string(d > 1 ? "," : "") + "lbound(" + var_f + "," + std::to_string(d) + ")"; w << indent; w << indent << "! -- " << field.name << " " << ddt.name_short << " Data fields"; w << indent << "IF (.NOT. SkipPointers_local ) THEN"; @@ -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 6a6e5abce4..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 @@ -158,7 +169,7 @@ subroutine Orca_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Orca_CopyInitOutput' @@ -168,8 +179,8 @@ subroutine Orca_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -180,8 +191,8 @@ subroutine Orca_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -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 @@ -227,13 +248,33 @@ subroutine Orca_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(Orca_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + 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) @@ -330,17 +371,21 @@ subroutine Orca_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + 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 if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) + 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 @@ -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) @@ -382,10 +432,11 @@ subroutine Orca_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(Orca_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackMisc' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) 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 @@ -399,21 +450,35 @@ subroutine Orca_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 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 DstParamData%SimNamePathLen = SrcParamData%SimNamePathLen DstParamData%NumOuts = SrcParamData%NumOuts if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + 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 @@ -433,18 +498,24 @@ subroutine Orca_DestroyParam(ParamData, ErrStat, ErrMsg) type(Orca_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 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 - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + 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) @@ -457,9 +528,19 @@ subroutine Orca_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(Orca_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'Orca_PackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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) @@ -467,9 +548,9 @@ subroutine Orca_PackParam(RF, Indata) call RegPack(RF, InData%NumOuts) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + 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 @@ -481,11 +562,33 @@ subroutine Orca_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(Orca_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + 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 (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 @@ -558,7 +661,7 @@ subroutine Orca_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Orca_CopyOutput' @@ -568,8 +671,8 @@ subroutine Orca_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -611,7 +714,7 @@ subroutine Orca_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(Orca_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Orca_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) 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/src/Current_Types.f90 b/modules/seastate/src/Current_Types.f90 index 4a2917f3a2..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 @@ -66,7 +67,7 @@ subroutine Current_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Current_CopyInitInput' ErrStat = ErrID_None @@ -82,8 +83,8 @@ subroutine Current_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, E DstInitInputData%CurrMod = SrcInitInputData%CurrMod DstInitInputData%EffWtrDpth = SrcInitInputData%EffWtrDpth if (allocated(SrcInitInputData%WaveKinGridzi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi) if (.not. allocated(DstInitInputData%WaveKinGridzi)) then allocate(DstInitInputData%WaveKinGridzi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -134,7 +135,7 @@ subroutine Current_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(Current_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Current_UnPackInitInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -159,14 +160,14 @@ subroutine Current_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Current_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%CurrVxi)) then - LB(1:1) = lbound(SrcInitOutputData%CurrVxi, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%CurrVxi, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%CurrVxi) + UB(1:1) = ubound(SrcInitOutputData%CurrVxi) if (.not. allocated(DstInitOutputData%CurrVxi)) then allocate(DstInitOutputData%CurrVxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -177,8 +178,8 @@ subroutine Current_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode DstInitOutputData%CurrVxi = SrcInitOutputData%CurrVxi end if if (allocated(SrcInitOutputData%CurrVyi)) then - LB(1:1) = lbound(SrcInitOutputData%CurrVyi, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%CurrVyi, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%CurrVyi) + UB(1:1) = ubound(SrcInitOutputData%CurrVyi) if (.not. allocated(DstInitOutputData%CurrVyi)) then allocate(DstInitOutputData%CurrVyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -223,7 +224,7 @@ subroutine Current_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(Current_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Current_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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..a76d9affed 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -7,8 +7,6 @@ MODULE SeaSt_WaveField PRIVATE ! Public functions and subroutines -PUBLIC WaveField_GetNodeWaveElev1 -PUBLIC WaveField_GetNodeWaveElev2 PUBLIC WaveField_GetNodeTotalWaveElev PUBLIC WaveField_GetNodeWaveNormal PUBLIC WaveField_GetNodeWaveKin @@ -21,92 +19,48 @@ MODULE SeaSt_WaveField 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 + if (present(Elev1)) Elev1 = Zeta1 + if (present(Elev2)) Elev2 = Zeta2 -end function WaveField_GetNodeWaveElev2 - - -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 +68,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 @@ -180,10 +134,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 @@ -237,7 +190,6 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod ! Extrapoled 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) @@ -309,7 +261,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 @@ -346,7 +298,6 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNod ! Extrapoled 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 @@ -462,9 +413,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 +433,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 +447,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 +476,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 +506,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 @@ -588,13 +544,13 @@ subroutine SetTimeIndex(Time, deltaT, nMax, Indx_Lo, Indx_Hi, isopc, ErrStat, Er Tmp = MOD(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 +572,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 +600,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 +640,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 +659,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 +689,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 +719,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 +752,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 +787,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 +806,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,22 +828,20 @@ 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 diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index a7d3397fc8..96a847db25 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -33,20 +33,20 @@ MODULE SeaSt_WaveField_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 [-] @@ -105,7 +105,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 @@ -210,15 +211,15 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_WaveField_CopySeaSt_WaveFieldType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcSeaSt_WaveFieldTypeData%WaveTime)) then - LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveTime, kind=B8Ki) - UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveTime, kind=B8Ki) + LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveTime) + UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveTime) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveTime)) then allocate(DstSeaSt_WaveFieldTypeData%WaveTime(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -229,8 +230,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveTime = SrcSeaSt_WaveFieldTypeData%WaveTime end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveDynP)) then - LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDynP, kind=B8Ki) - UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%WaveDynP, kind=B8Ki) + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDynP) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%WaveDynP) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveDynP)) then allocate(DstSeaSt_WaveFieldTypeData%WaveDynP(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -241,8 +242,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveDynP = SrcSeaSt_WaveFieldTypeData%WaveDynP end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveAcc)) then - LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAcc, kind=B8Ki) - UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveAcc, kind=B8Ki) + LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAcc) + UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveAcc) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveAcc)) then allocate(DstSeaSt_WaveFieldTypeData%WaveAcc(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -253,8 +254,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveAcc = SrcSeaSt_WaveFieldTypeData%WaveAcc end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveAccMCF)) then - LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAccMCF, kind=B8Ki) - UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveAccMCF, kind=B8Ki) + LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveAccMCF) + UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveAccMCF) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveAccMCF)) then allocate(DstSeaSt_WaveFieldTypeData%WaveAccMCF(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -265,8 +266,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveAccMCF = SrcSeaSt_WaveFieldTypeData%WaveAccMCF end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveVel)) then - LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveVel, kind=B8Ki) - UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveVel, kind=B8Ki) + LB(1:5) = lbound(SrcSeaSt_WaveFieldTypeData%WaveVel) + UB(1:5) = ubound(SrcSeaSt_WaveFieldTypeData%WaveVel) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveVel)) then allocate(DstSeaSt_WaveFieldTypeData%WaveVel(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -277,8 +278,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveVel = SrcSeaSt_WaveFieldTypeData%WaveVel end if if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveDynP0)) then - LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveDynP0, kind=B8Ki) - UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveDynP0, kind=B8Ki) + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveDynP0) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveDynP0) if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveDynP0)) then allocate(DstSeaSt_WaveFieldTypeData%PWaveDynP0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -289,8 +290,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%PWaveDynP0 = SrcSeaSt_WaveFieldTypeData%PWaveDynP0 end if if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveAcc0)) then - LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAcc0, kind=B8Ki) - UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveAcc0, kind=B8Ki) + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAcc0) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveAcc0) if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveAcc0)) then allocate(DstSeaSt_WaveFieldTypeData%PWaveAcc0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -301,8 +302,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%PWaveAcc0 = SrcSeaSt_WaveFieldTypeData%PWaveAcc0 end if if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0)) then - LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0, kind=B8Ki) - UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0, kind=B8Ki) + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0) if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0)) then allocate(DstSeaSt_WaveFieldTypeData%PWaveAccMCF0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -313,8 +314,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%PWaveAccMCF0 = SrcSeaSt_WaveFieldTypeData%PWaveAccMCF0 end if if (allocated(SrcSeaSt_WaveFieldTypeData%PWaveVel0)) then - LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveVel0, kind=B8Ki) - UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveVel0, kind=B8Ki) + LB(1:4) = lbound(SrcSeaSt_WaveFieldTypeData%PWaveVel0) + UB(1:4) = ubound(SrcSeaSt_WaveFieldTypeData%PWaveVel0) if (.not. allocated(DstSeaSt_WaveFieldTypeData%PWaveVel0)) then allocate(DstSeaSt_WaveFieldTypeData%PWaveVel0(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -325,8 +326,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%PWaveVel0 = SrcSeaSt_WaveFieldTypeData%PWaveVel0 end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev0)) then - LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev0, kind=B8Ki) - UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev0, kind=B8Ki) + LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev0) + UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev0) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElev0)) then allocate(DstSeaSt_WaveFieldTypeData%WaveElev0(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -337,8 +338,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveElev0 = SrcSeaSt_WaveFieldTypeData%WaveElev0 end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev1)) then - LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev1, kind=B8Ki) - UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev1, kind=B8Ki) + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev1) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev1) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElev1)) then allocate(DstSeaSt_WaveFieldTypeData%WaveElev1(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -349,8 +350,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveElev1 = SrcSeaSt_WaveFieldTypeData%WaveElev1 end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElev2)) then - LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev2, kind=B8Ki) - UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev2, kind=B8Ki) + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElev2) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElev2) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElev2)) then allocate(DstSeaSt_WaveFieldTypeData%WaveElev2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -367,8 +368,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%EffWtrDpth = SrcSeaSt_WaveFieldTypeData%EffWtrDpth DstSeaSt_WaveFieldTypeData%MSL2SWL = SrcSeaSt_WaveFieldTypeData%MSL2SWL if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElevC)) then - LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElevC, kind=B8Ki) - UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElevC, kind=B8Ki) + LB(1:3) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElevC) + UB(1:3) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElevC) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElevC)) then allocate(DstSeaSt_WaveFieldTypeData%WaveElevC(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -379,8 +380,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveElevC = SrcSeaSt_WaveFieldTypeData%WaveElevC end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveElevC0)) then - LB(1:2) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElevC0, kind=B8Ki) - UB(1:2) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElevC0, kind=B8Ki) + LB(1:2) = lbound(SrcSeaSt_WaveFieldTypeData%WaveElevC0) + UB(1:2) = ubound(SrcSeaSt_WaveFieldTypeData%WaveElevC0) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveElevC0)) then allocate(DstSeaSt_WaveFieldTypeData%WaveElevC0(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -391,8 +392,8 @@ subroutine SeaSt_WaveField_CopySeaSt_WaveFieldType(SrcSeaSt_WaveFieldTypeData, D DstSeaSt_WaveFieldTypeData%WaveElevC0 = SrcSeaSt_WaveFieldTypeData%WaveElevC0 end if if (allocated(SrcSeaSt_WaveFieldTypeData%WaveDirArr)) then - LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDirArr, kind=B8Ki) - UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveDirArr, kind=B8Ki) + LB(1:1) = lbound(SrcSeaSt_WaveFieldTypeData%WaveDirArr) + UB(1:1) = ubound(SrcSeaSt_WaveFieldTypeData%WaveDirArr) if (.not. allocated(DstSeaSt_WaveFieldTypeData%WaveDirArr)) then allocate(DstSeaSt_WaveFieldTypeData%WaveDirArr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -529,7 +530,7 @@ subroutine SeaSt_WaveField_UnPackSeaSt_WaveFieldType(RF, OutData) type(RegFile), intent(inout) :: RF type(SeaSt_WaveFieldType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_WaveField_UnPackSeaSt_WaveFieldType' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -571,5 +572,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..d5c05ea1d4 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(:,:,:,:) @@ -668,12 +745,10 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er ! 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..ee6d77770f 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" @@ -94,11 +97,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 +119,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 +144,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 +156,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_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index fa16c449bb..ca3707b3a4 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 [-] @@ -114,11 +116,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 +139,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 +161,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 +173,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 @@ -214,7 +197,7 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_CopyInputFile' @@ -240,8 +223,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%Echo = SrcInputFileData%Echo DstInputFileData%NWaveElev = SrcInputFileData%NWaveElev if (allocated(SrcInputFileData%WaveElevxi)) then - LB(1:1) = lbound(SrcInputFileData%WaveElevxi, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%WaveElevxi, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%WaveElevxi) + UB(1:1) = ubound(SrcInputFileData%WaveElevxi) if (.not. allocated(DstInputFileData%WaveElevxi)) then allocate(DstInputFileData%WaveElevxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -252,8 +235,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%WaveElevxi = SrcInputFileData%WaveElevxi end if if (allocated(SrcInputFileData%WaveElevyi)) then - LB(1:1) = lbound(SrcInputFileData%WaveElevyi, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%WaveElevyi, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%WaveElevyi) + UB(1:1) = ubound(SrcInputFileData%WaveElevyi) if (.not. allocated(DstInputFileData%WaveElevyi)) then allocate(DstInputFileData%WaveElevyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -265,8 +248,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err end if DstInputFileData%NWaveKin = SrcInputFileData%NWaveKin if (allocated(SrcInputFileData%WaveKinxi)) then - LB(1:1) = lbound(SrcInputFileData%WaveKinxi, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%WaveKinxi, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%WaveKinxi) + UB(1:1) = ubound(SrcInputFileData%WaveKinxi) if (.not. allocated(DstInputFileData%WaveKinxi)) then allocate(DstInputFileData%WaveKinxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -277,8 +260,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%WaveKinxi = SrcInputFileData%WaveKinxi end if if (allocated(SrcInputFileData%WaveKinyi)) then - LB(1:1) = lbound(SrcInputFileData%WaveKinyi, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%WaveKinyi, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%WaveKinyi) + UB(1:1) = ubound(SrcInputFileData%WaveKinyi) if (.not. allocated(DstInputFileData%WaveKinyi)) then allocate(DstInputFileData%WaveKinyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -289,8 +272,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%WaveKinyi = SrcInputFileData%WaveKinyi end if if (allocated(SrcInputFileData%WaveKinzi)) then - LB(1:1) = lbound(SrcInputFileData%WaveKinzi, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%WaveKinzi, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%WaveKinzi) + UB(1:1) = ubound(SrcInputFileData%WaveKinzi) if (.not. allocated(DstInputFileData%WaveKinzi)) then allocate(DstInputFileData%WaveKinzi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -304,8 +287,8 @@ subroutine SeaSt_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, Err DstInputFileData%OutAll = SrcInputFileData%OutAll DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -423,7 +406,7 @@ subroutine SeaSt_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(SeaSt_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackInputFile' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -573,15 +556,15 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -592,8 +575,8 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -608,8 +591,8 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, if (ErrStat >= AbortErrLev) return DstInitOutputData%InvalidWithSSExctn = SrcInitOutputData%InvalidWithSSExctn if (allocated(SrcInitOutputData%WaveElevVisX)) then - LB(1:1) = lbound(SrcInitOutputData%WaveElevVisX, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WaveElevVisX, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WaveElevVisX) + UB(1:1) = ubound(SrcInitOutputData%WaveElevVisX) if (.not. allocated(DstInitOutputData%WaveElevVisX)) then allocate(DstInitOutputData%WaveElevVisX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -620,8 +603,8 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveElevVisX = SrcInitOutputData%WaveElevVisX end if if (allocated(SrcInitOutputData%WaveElevVisY)) then - LB(1:1) = lbound(SrcInitOutputData%WaveElevVisY, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WaveElevVisY, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WaveElevVisY) + UB(1:1) = ubound(SrcInitOutputData%WaveElevVisY) if (.not. allocated(DstInitOutputData%WaveElevVisY)) then allocate(DstInitOutputData%WaveElevVisY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -632,8 +615,8 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveElevVisY = SrcInitOutputData%WaveElevVisY end if if (allocated(SrcInitOutputData%WaveElevVisGrid)) then - LB(1:3) = lbound(SrcInitOutputData%WaveElevVisGrid, kind=B8Ki) - UB(1:3) = ubound(SrcInitOutputData%WaveElevVisGrid, kind=B8Ki) + LB(1:3) = lbound(SrcInitOutputData%WaveElevVisGrid) + UB(1:3) = ubound(SrcInitOutputData%WaveElevVisGrid) if (.not. allocated(DstInitOutputData%WaveElevVisGrid)) then allocate(DstInitOutputData%WaveElevVisGrid(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -644,66 +627,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, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - 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 +659,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 +683,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 @@ -782,7 +691,7 @@ subroutine SeaSt_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SeaSt_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackInitOutput' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -813,11 +722,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,234 +877,14 @@ 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(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(SrcLinParamsData%du, kind=B8Ki) - 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(B8Ki) :: 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 integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_CopyParam' @@ -1211,8 +896,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%deltaGrid = SrcParamData%deltaGrid DstParamData%NWaveElev = SrcParamData%NWaveElev if (allocated(SrcParamData%WaveElevxi)) then - LB(1:1) = lbound(SrcParamData%WaveElevxi, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WaveElevxi, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WaveElevxi) + UB(1:1) = ubound(SrcParamData%WaveElevxi) if (.not. allocated(DstParamData%WaveElevxi)) then allocate(DstParamData%WaveElevxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1223,8 +908,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveElevxi = SrcParamData%WaveElevxi end if if (allocated(SrcParamData%WaveElevyi)) then - LB(1:1) = lbound(SrcParamData%WaveElevyi, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WaveElevyi, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WaveElevyi) + UB(1:1) = ubound(SrcParamData%WaveElevyi) if (.not. allocated(DstParamData%WaveElevyi)) then allocate(DstParamData%WaveElevyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1236,8 +921,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg end if DstParamData%NWaveKin = SrcParamData%NWaveKin if (allocated(SrcParamData%WaveKinxi)) then - LB(1:1) = lbound(SrcParamData%WaveKinxi, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WaveKinxi, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WaveKinxi) + UB(1:1) = ubound(SrcParamData%WaveKinxi) if (.not. allocated(DstParamData%WaveKinxi)) then allocate(DstParamData%WaveKinxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1248,8 +933,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveKinxi = SrcParamData%WaveKinxi end if if (allocated(SrcParamData%WaveKinyi)) then - LB(1:1) = lbound(SrcParamData%WaveKinyi, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WaveKinyi, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WaveKinyi) + UB(1:1) = ubound(SrcParamData%WaveKinyi) if (.not. allocated(DstParamData%WaveKinyi)) then allocate(DstParamData%WaveKinyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1260,8 +945,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveKinyi = SrcParamData%WaveKinyi end if if (allocated(SrcParamData%WaveKinzi)) then - LB(1:1) = lbound(SrcParamData%WaveKinzi, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%WaveKinzi, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%WaveKinzi) + UB(1:1) = ubound(SrcParamData%WaveKinzi) if (.not. allocated(DstParamData%WaveKinzi)) then allocate(DstParamData%WaveKinzi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1272,8 +957,8 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WaveKinzi = SrcParamData%WaveKinzi end if if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + 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 @@ -1306,17 +991,14 @@ 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) type(SeaSt_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SeaSt_DestroyParam' @@ -1338,8 +1020,8 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%WaveKinzi) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + 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) @@ -1352,16 +1034,14 @@ 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) type(RegFile), intent(inout) :: RF type(SeaSt_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SeaSt_PackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%WaveDT) @@ -1377,9 +1057,9 @@ subroutine SeaSt_PackParam(RF, Indata) call RegPackAlloc(RF, InData%WaveKinzi) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + 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 @@ -1398,7 +1078,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 @@ -1406,8 +1085,8 @@ subroutine SeaSt_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(SeaSt_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1462,7 +1141,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) @@ -1509,14 +1187,14 @@ subroutine SeaSt_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SeaSt_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -1553,11 +1231,359 @@ subroutine SeaSt_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SeaSt_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SeaSt_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc 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 a8bd1b7ccf..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 @@ -64,7 +65,7 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Waves2_CopyInitInput' ErrStat = ErrID_None @@ -74,8 +75,8 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid if (allocated(SrcInitInputData%WaveKinGridxi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridxi, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridxi, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridxi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridxi) if (.not. allocated(DstInitInputData%WaveKinGridxi)) then allocate(DstInitInputData%WaveKinGridxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -86,8 +87,8 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%WaveKinGridxi = SrcInitInputData%WaveKinGridxi end if if (allocated(SrcInitInputData%WaveKinGridyi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridyi, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridyi) if (.not. allocated(DstInitInputData%WaveKinGridyi)) then allocate(DstInitInputData%WaveKinGridyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -98,8 +99,8 @@ subroutine Waves2_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%WaveKinGridyi = SrcInitInputData%WaveKinGridyi end if if (allocated(SrcInitInputData%WaveKinGridzi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi) if (.not. allocated(DstInitInputData%WaveKinGridzi)) then allocate(DstInitInputData%WaveKinGridzi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -152,7 +153,7 @@ subroutine Waves2_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(Waves2_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Waves2_UnPackInitInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -173,14 +174,14 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'Waves2_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WaveAcc2D)) then - LB(1:5) = lbound(SrcInitOutputData%WaveAcc2D, kind=B8Ki) - UB(1:5) = ubound(SrcInitOutputData%WaveAcc2D, kind=B8Ki) + LB(1:5) = lbound(SrcInitOutputData%WaveAcc2D) + UB(1:5) = ubound(SrcInitOutputData%WaveAcc2D) if (.not. allocated(DstInitOutputData%WaveAcc2D)) then allocate(DstInitOutputData%WaveAcc2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -191,8 +192,8 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveAcc2D = SrcInitOutputData%WaveAcc2D end if if (allocated(SrcInitOutputData%WaveDynP2D)) then - LB(1:4) = lbound(SrcInitOutputData%WaveDynP2D, kind=B8Ki) - UB(1:4) = ubound(SrcInitOutputData%WaveDynP2D, kind=B8Ki) + LB(1:4) = lbound(SrcInitOutputData%WaveDynP2D) + UB(1:4) = ubound(SrcInitOutputData%WaveDynP2D) if (.not. allocated(DstInitOutputData%WaveDynP2D)) then allocate(DstInitOutputData%WaveDynP2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -203,8 +204,8 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDynP2D = SrcInitOutputData%WaveDynP2D end if if (allocated(SrcInitOutputData%WaveAcc2S)) then - LB(1:5) = lbound(SrcInitOutputData%WaveAcc2S, kind=B8Ki) - UB(1:5) = ubound(SrcInitOutputData%WaveAcc2S, kind=B8Ki) + LB(1:5) = lbound(SrcInitOutputData%WaveAcc2S) + UB(1:5) = ubound(SrcInitOutputData%WaveAcc2S) if (.not. allocated(DstInitOutputData%WaveAcc2S)) then allocate(DstInitOutputData%WaveAcc2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -215,8 +216,8 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveAcc2S = SrcInitOutputData%WaveAcc2S end if if (allocated(SrcInitOutputData%WaveDynP2S)) then - LB(1:4) = lbound(SrcInitOutputData%WaveDynP2S, kind=B8Ki) - UB(1:4) = ubound(SrcInitOutputData%WaveDynP2S, kind=B8Ki) + LB(1:4) = lbound(SrcInitOutputData%WaveDynP2S) + UB(1:4) = ubound(SrcInitOutputData%WaveDynP2S) if (.not. allocated(DstInitOutputData%WaveDynP2S)) then allocate(DstInitOutputData%WaveDynP2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -227,8 +228,8 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveDynP2S = SrcInitOutputData%WaveDynP2S end if if (allocated(SrcInitOutputData%WaveVel2D)) then - LB(1:5) = lbound(SrcInitOutputData%WaveVel2D, kind=B8Ki) - UB(1:5) = ubound(SrcInitOutputData%WaveVel2D, kind=B8Ki) + LB(1:5) = lbound(SrcInitOutputData%WaveVel2D) + UB(1:5) = ubound(SrcInitOutputData%WaveVel2D) if (.not. allocated(DstInitOutputData%WaveVel2D)) then allocate(DstInitOutputData%WaveVel2D(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -239,8 +240,8 @@ subroutine Waves2_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveVel2D = SrcInitOutputData%WaveVel2D end if if (allocated(SrcInitOutputData%WaveVel2S)) then - LB(1:5) = lbound(SrcInitOutputData%WaveVel2S, kind=B8Ki) - UB(1:5) = ubound(SrcInitOutputData%WaveVel2S, kind=B8Ki) + LB(1:5) = lbound(SrcInitOutputData%WaveVel2S) + UB(1:5) = ubound(SrcInitOutputData%WaveVel2S) if (.not. allocated(DstInitOutputData%WaveVel2S)) then allocate(DstInitOutputData%WaveVel2S(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4),LB(5):UB(5)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -297,7 +298,7 @@ subroutine Waves2_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(Waves2_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Waves2_UnPackInitOutput' - integer(B8Ki) :: LB(5), UB(5) + integer(B4Ki) :: LB(5), UB(5) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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 4cbea1da35..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 @@ -84,7 +85,7 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'Waves_CopyInitInput' @@ -108,8 +109,8 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%NWaveElevGrid = SrcInitInputData%NWaveElevGrid DstInitInputData%NWaveKinGrid = SrcInitInputData%NWaveKinGrid if (allocated(SrcInitInputData%WaveKinGridxi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridxi, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridxi, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridxi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridxi) if (.not. allocated(DstInitInputData%WaveKinGridxi)) then allocate(DstInitInputData%WaveKinGridxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -120,8 +121,8 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WaveKinGridxi = SrcInitInputData%WaveKinGridxi end if if (allocated(SrcInitInputData%WaveKinGridyi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridyi, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridyi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridyi) if (.not. allocated(DstInitInputData%WaveKinGridyi)) then allocate(DstInitInputData%WaveKinGridyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -132,8 +133,8 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WaveKinGridyi = SrcInitInputData%WaveKinGridyi end if if (allocated(SrcInitInputData%WaveKinGridzi)) then - LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%WaveKinGridzi) + UB(1:1) = ubound(SrcInitInputData%WaveKinGridzi) if (.not. allocated(DstInitInputData%WaveKinGridzi)) then allocate(DstInitInputData%WaveKinGridzi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -144,8 +145,8 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%WaveKinGridzi = SrcInitInputData%WaveKinGridzi end if if (allocated(SrcInitInputData%CurrVxi)) then - LB(1:1) = lbound(SrcInitInputData%CurrVxi, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%CurrVxi, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%CurrVxi) + UB(1:1) = ubound(SrcInitInputData%CurrVxi) if (.not. allocated(DstInitInputData%CurrVxi)) then allocate(DstInitInputData%CurrVxi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -156,8 +157,8 @@ subroutine Waves_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%CurrVxi = SrcInitInputData%CurrVxi end if if (allocated(SrcInitInputData%CurrVyi)) then - LB(1:1) = lbound(SrcInitInputData%CurrVyi, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%CurrVyi, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%CurrVyi) + UB(1:1) = ubound(SrcInitInputData%CurrVyi) if (.not. allocated(DstInitInputData%CurrVyi)) then allocate(DstInitInputData%CurrVyi(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -255,7 +256,7 @@ subroutine Waves_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(Waves_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'Waves_UnPackInitInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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 0d8ed88c71..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 @@ -585,7 +670,7 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyInitInput' @@ -596,8 +681,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%NumBl = SrcInitInputData%NumBl DstInitInputData%RootName = SrcInitInputData%RootName if (allocated(SrcInitInputData%BlPitchInit)) then - LB(1:1) = lbound(SrcInitInputData%BlPitchInit, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%BlPitchInit, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%BlPitchInit) + UB(1:1) = ubound(SrcInitInputData%BlPitchInit) if (.not. allocated(DstInitInputData%BlPitchInit)) then allocate(DstInitInputData%BlPitchInit(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -630,8 +715,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%TrimGain = SrcInitInputData%TrimGain DstInitInputData%RotSpeedRef = SrcInitInputData%RotSpeedRef if (allocated(SrcInitInputData%BladeRootRefPos)) then - LB(1:2) = lbound(SrcInitInputData%BladeRootRefPos, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%BladeRootRefPos, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%BladeRootRefPos) + UB(1:2) = ubound(SrcInitInputData%BladeRootRefPos) if (.not. allocated(DstInitInputData%BladeRootRefPos)) then allocate(DstInitInputData%BladeRootRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -642,8 +727,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%BladeRootRefPos = SrcInitInputData%BladeRootRefPos end if if (allocated(SrcInitInputData%BladeRootTransDisp)) then - LB(1:2) = lbound(SrcInitInputData%BladeRootTransDisp, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%BladeRootTransDisp, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%BladeRootTransDisp) + UB(1:2) = ubound(SrcInitInputData%BladeRootTransDisp) if (.not. allocated(DstInitInputData%BladeRootTransDisp)) then allocate(DstInitInputData%BladeRootTransDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -654,8 +739,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%BladeRootTransDisp = SrcInitInputData%BladeRootTransDisp end if if (allocated(SrcInitInputData%BladeRootOrient)) then - LB(1:3) = lbound(SrcInitInputData%BladeRootOrient, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%BladeRootOrient, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%BladeRootOrient) + UB(1:3) = ubound(SrcInitInputData%BladeRootOrient) if (.not. allocated(DstInitInputData%BladeRootOrient)) then allocate(DstInitInputData%BladeRootOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -666,8 +751,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%BladeRootOrient = SrcInitInputData%BladeRootOrient end if if (allocated(SrcInitInputData%BladeRootRefOrient)) then - LB(1:3) = lbound(SrcInitInputData%BladeRootRefOrient, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%BladeRootRefOrient, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%BladeRootRefOrient) + UB(1:3) = ubound(SrcInitInputData%BladeRootRefOrient) if (.not. allocated(DstInitInputData%BladeRootRefOrient)) then allocate(DstInitInputData%BladeRootRefOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -683,8 +768,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS if (ErrStat >= AbortErrLev) return DstInitInputData%NumCableControl = SrcInitInputData%NumCableControl if (allocated(SrcInitInputData%CableControlRequestor)) then - LB(1:1) = lbound(SrcInitInputData%CableControlRequestor, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%CableControlRequestor, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%CableControlRequestor) + UB(1:1) = ubound(SrcInitInputData%CableControlRequestor) if (.not. allocated(DstInitInputData%CableControlRequestor)) then allocate(DstInitInputData%CableControlRequestor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -696,8 +781,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if DstInitInputData%InterpOrder = SrcInitInputData%InterpOrder if (allocated(SrcInitInputData%fromSCGlob)) then - LB(1:1) = lbound(SrcInitInputData%fromSCGlob, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%fromSCGlob, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%fromSCGlob) + UB(1:1) = ubound(SrcInitInputData%fromSCGlob) if (.not. allocated(DstInitInputData%fromSCGlob)) then allocate(DstInitInputData%fromSCGlob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -708,8 +793,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%fromSCGlob = SrcInitInputData%fromSCGlob end if if (allocated(SrcInitInputData%fromSC)) then - LB(1:1) = lbound(SrcInitInputData%fromSC, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%fromSC, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%fromSC) + UB(1:1) = ubound(SrcInitInputData%fromSC) if (.not. allocated(DstInitInputData%fromSC)) then allocate(DstInitInputData%fromSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -720,8 +805,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%fromSC = SrcInitInputData%fromSC end if if (allocated(SrcInitInputData%LidSpeed)) then - LB(1:1) = lbound(SrcInitInputData%LidSpeed, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%LidSpeed, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%LidSpeed) + UB(1:1) = ubound(SrcInitInputData%LidSpeed) if (.not. allocated(DstInitInputData%LidSpeed)) then allocate(DstInitInputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -732,8 +817,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%LidSpeed = SrcInitInputData%LidSpeed end if if (allocated(SrcInitInputData%MsrPositionsX)) then - LB(1:1) = lbound(SrcInitInputData%MsrPositionsX, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%MsrPositionsX, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%MsrPositionsX) + UB(1:1) = ubound(SrcInitInputData%MsrPositionsX) if (.not. allocated(DstInitInputData%MsrPositionsX)) then allocate(DstInitInputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -744,8 +829,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%MsrPositionsX = SrcInitInputData%MsrPositionsX end if if (allocated(SrcInitInputData%MsrPositionsY)) then - LB(1:1) = lbound(SrcInitInputData%MsrPositionsY, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%MsrPositionsY, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%MsrPositionsY) + UB(1:1) = ubound(SrcInitInputData%MsrPositionsY) if (.not. allocated(DstInitInputData%MsrPositionsY)) then allocate(DstInitInputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -756,8 +841,8 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS DstInitInputData%MsrPositionsY = SrcInitInputData%MsrPositionsY end if if (allocated(SrcInitInputData%MsrPositionsZ)) then - LB(1:1) = lbound(SrcInitInputData%MsrPositionsZ, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%MsrPositionsZ, kind=B8Ki) + LB(1:1) = lbound(SrcInitInputData%MsrPositionsZ) + UB(1:1) = ubound(SrcInitInputData%MsrPositionsZ) if (.not. allocated(DstInitInputData%MsrPositionsZ)) then allocate(DstInitInputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -882,7 +967,7 @@ subroutine SrvD_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackInitInput' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -941,15 +1026,15 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -960,8 +1045,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -974,11 +1059,12 @@ 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 - LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) + 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 @@ -989,8 +1075,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1001,8 +1087,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) + 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 @@ -1013,8 +1099,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + 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 @@ -1025,8 +1111,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1037,8 +1123,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + 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 @@ -1049,8 +1135,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + 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 @@ -1061,8 +1147,8 @@ subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, E DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -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) @@ -1142,13 +1237,33 @@ subroutine SrvD_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + 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 @@ -1167,7 +1282,7 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SrvD_CopyInputFile' ErrStat = ErrID_None @@ -1222,8 +1337,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%Tstart = SrcInputFileData%Tstart DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1254,8 +1369,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%GenPwr_Dem = SrcInputFileData%GenPwr_Dem DstInputFileData%DLL_NumTrq = SrcInputFileData%DLL_NumTrq if (allocated(SrcInputFileData%GenSpd_TLU)) then - LB(1:1) = lbound(SrcInputFileData%GenSpd_TLU, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%GenSpd_TLU, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%GenSpd_TLU) + UB(1:1) = ubound(SrcInputFileData%GenSpd_TLU) if (.not. allocated(DstInputFileData%GenSpd_TLU)) then allocate(DstInputFileData%GenSpd_TLU(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1266,8 +1381,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%GenSpd_TLU = SrcInputFileData%GenSpd_TLU end if if (allocated(SrcInputFileData%GenTrq_TLU)) then - LB(1:1) = lbound(SrcInputFileData%GenTrq_TLU, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%GenTrq_TLU, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%GenTrq_TLU) + UB(1:1) = ubound(SrcInputFileData%GenTrq_TLU) if (.not. allocated(DstInputFileData%GenTrq_TLU)) then allocate(DstInputFileData%GenTrq_TLU(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1280,8 +1395,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS DstInputFileData%UseLegacyInterface = SrcInputFileData%UseLegacyInterface DstInputFileData%NumBStC = SrcInputFileData%NumBStC if (allocated(SrcInputFileData%BStCfiles)) then - LB(1:1) = lbound(SrcInputFileData%BStCfiles, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%BStCfiles, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%BStCfiles) + UB(1:1) = ubound(SrcInputFileData%BStCfiles) if (.not. allocated(DstInputFileData%BStCfiles)) then allocate(DstInputFileData%BStCfiles(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1293,8 +1408,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if DstInputFileData%NumNStC = SrcInputFileData%NumNStC if (allocated(SrcInputFileData%NStCfiles)) then - LB(1:1) = lbound(SrcInputFileData%NStCfiles, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%NStCfiles, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%NStCfiles) + UB(1:1) = ubound(SrcInputFileData%NStCfiles) if (.not. allocated(DstInputFileData%NStCfiles)) then allocate(DstInputFileData%NStCfiles(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1306,8 +1421,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if DstInputFileData%NumTStC = SrcInputFileData%NumTStC if (allocated(SrcInputFileData%TStCfiles)) then - LB(1:1) = lbound(SrcInputFileData%TStCfiles, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%TStCfiles, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%TStCfiles) + UB(1:1) = ubound(SrcInputFileData%TStCfiles) if (.not. allocated(DstInputFileData%TStCfiles)) then allocate(DstInputFileData%TStCfiles(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1319,8 +1434,8 @@ subroutine SrvD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrS end if DstInputFileData%NumSStC = SrcInputFileData%NumSStC if (allocated(SrcInputFileData%SStCfiles)) then - LB(1:1) = lbound(SrcInputFileData%SStCfiles, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%SStCfiles, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%SStCfiles) + UB(1:1) = ubound(SrcInputFileData%SStCfiles) if (.not. allocated(DstInputFileData%SStCfiles)) then allocate(DstInputFileData%SStCfiles(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1467,7 +1582,7 @@ subroutine SrvD_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackInputFile' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1566,16 +1681,16 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyBladedDLLType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcBladedDLLTypeData%avrSWAP)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%avrSWAP, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%avrSWAP, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%avrSWAP) + UB(1:1) = ubound(SrcBladedDLLTypeData%avrSWAP) if (.not. allocated(DstBladedDLLTypeData%avrSWAP)) then allocate(DstBladedDLLTypeData%avrSWAP(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1596,8 +1711,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%ElecPwr_prev = SrcBladedDLLTypeData%ElecPwr_prev DstBladedDLLTypeData%GenTrq_prev = SrcBladedDLLTypeData%GenTrq_prev if (allocated(SrcBladedDLLTypeData%toSC)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%toSC, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%toSC, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%toSC) + UB(1:1) = ubound(SrcBladedDLLTypeData%toSC) if (.not. allocated(DstBladedDLLTypeData%toSC)) then allocate(DstBladedDLLTypeData%toSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1610,8 +1725,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%initialized = SrcBladedDLLTypeData%initialized DstBladedDLLTypeData%NumLogChannels = SrcBladedDLLTypeData%NumLogChannels if (allocated(SrcBladedDLLTypeData%LogChannels_OutParam)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%LogChannels_OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%LogChannels_OutParam, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%LogChannels_OutParam) + UB(1:1) = ubound(SrcBladedDLLTypeData%LogChannels_OutParam) if (.not. allocated(DstBladedDLLTypeData%LogChannels_OutParam)) then allocate(DstBladedDLLTypeData%LogChannels_OutParam(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1626,8 +1741,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end do end if if (allocated(SrcBladedDLLTypeData%LogChannels)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%LogChannels, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%LogChannels, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%LogChannels) + UB(1:1) = ubound(SrcBladedDLLTypeData%LogChannels) if (.not. allocated(DstBladedDLLTypeData%LogChannels)) then allocate(DstBladedDLLTypeData%LogChannels(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1648,8 +1763,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%OverrideYawRateWithTorque = SrcBladedDLLTypeData%OverrideYawRateWithTorque DstBladedDLLTypeData%YawTorqueDemand = SrcBladedDLLTypeData%YawTorqueDemand if (allocated(SrcBladedDLLTypeData%BlPitchInput)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%BlPitchInput, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%BlPitchInput, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%BlPitchInput) + UB(1:1) = ubound(SrcBladedDLLTypeData%BlPitchInput) if (.not. allocated(DstBladedDLLTypeData%BlPitchInput)) then allocate(DstBladedDLLTypeData%BlPitchInput(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1686,8 +1801,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%LSShftFys = SrcBladedDLLTypeData%LSShftFys DstBladedDLLTypeData%LSShftFzs = SrcBladedDLLTypeData%LSShftFzs if (allocated(SrcBladedDLLTypeData%LidSpeed)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%LidSpeed, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%LidSpeed, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%LidSpeed) + UB(1:1) = ubound(SrcBladedDLLTypeData%LidSpeed) if (.not. allocated(DstBladedDLLTypeData%LidSpeed)) then allocate(DstBladedDLLTypeData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1698,8 +1813,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%LidSpeed = SrcBladedDLLTypeData%LidSpeed end if if (allocated(SrcBladedDLLTypeData%MsrPositionsX)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsX, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsX, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsX) + UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsX) if (.not. allocated(DstBladedDLLTypeData%MsrPositionsX)) then allocate(DstBladedDLLTypeData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1710,8 +1825,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%MsrPositionsX = SrcBladedDLLTypeData%MsrPositionsX end if if (allocated(SrcBladedDLLTypeData%MsrPositionsY)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsY, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsY, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsY) + UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsY) if (.not. allocated(DstBladedDLLTypeData%MsrPositionsY)) then allocate(DstBladedDLLTypeData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1722,8 +1837,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%MsrPositionsY = SrcBladedDLLTypeData%MsrPositionsY end if if (allocated(SrcBladedDLLTypeData%MsrPositionsZ)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsZ, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsZ, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%MsrPositionsZ) + UB(1:1) = ubound(SrcBladedDLLTypeData%MsrPositionsZ) if (.not. allocated(DstBladedDLLTypeData%MsrPositionsZ)) then allocate(DstBladedDLLTypeData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1755,8 +1870,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%Ptch_Cntrl = SrcBladedDLLTypeData%Ptch_Cntrl DstBladedDLLTypeData%DLL_NumTrq = SrcBladedDLLTypeData%DLL_NumTrq if (allocated(SrcBladedDLLTypeData%GenSpd_TLU)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%GenSpd_TLU, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%GenSpd_TLU, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%GenSpd_TLU) + UB(1:1) = ubound(SrcBladedDLLTypeData%GenSpd_TLU) if (.not. allocated(DstBladedDLLTypeData%GenSpd_TLU)) then allocate(DstBladedDLLTypeData%GenSpd_TLU(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1767,8 +1882,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%GenSpd_TLU = SrcBladedDLLTypeData%GenSpd_TLU end if if (allocated(SrcBladedDLLTypeData%GenTrq_TLU)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%GenTrq_TLU, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%GenTrq_TLU, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%GenTrq_TLU) + UB(1:1) = ubound(SrcBladedDLLTypeData%GenTrq_TLU) if (.not. allocated(DstBladedDLLTypeData%GenTrq_TLU)) then allocate(DstBladedDLLTypeData%GenTrq_TLU(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1780,8 +1895,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if DstBladedDLLTypeData%Yaw_Cntrl = SrcBladedDLLTypeData%Yaw_Cntrl if (allocated(SrcBladedDLLTypeData%PrevCableDeltaL)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%PrevCableDeltaL, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%PrevCableDeltaL, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%PrevCableDeltaL) + UB(1:1) = ubound(SrcBladedDLLTypeData%PrevCableDeltaL) if (.not. allocated(DstBladedDLLTypeData%PrevCableDeltaL)) then allocate(DstBladedDLLTypeData%PrevCableDeltaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1792,8 +1907,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%PrevCableDeltaL = SrcBladedDLLTypeData%PrevCableDeltaL end if if (allocated(SrcBladedDLLTypeData%PrevCableDeltaLdot)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%PrevCableDeltaLdot, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%PrevCableDeltaLdot, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%PrevCableDeltaLdot) + UB(1:1) = ubound(SrcBladedDLLTypeData%PrevCableDeltaLdot) if (.not. allocated(DstBladedDLLTypeData%PrevCableDeltaLdot)) then allocate(DstBladedDLLTypeData%PrevCableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1804,8 +1919,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%PrevCableDeltaLdot = SrcBladedDLLTypeData%PrevCableDeltaLdot end if if (allocated(SrcBladedDLLTypeData%CableDeltaL)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaL, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%CableDeltaL, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaL) + UB(1:1) = ubound(SrcBladedDLLTypeData%CableDeltaL) if (.not. allocated(DstBladedDLLTypeData%CableDeltaL)) then allocate(DstBladedDLLTypeData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1816,8 +1931,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%CableDeltaL = SrcBladedDLLTypeData%CableDeltaL end if if (allocated(SrcBladedDLLTypeData%CableDeltaLdot)) then - LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaLdot, kind=B8Ki) - UB(1:1) = ubound(SrcBladedDLLTypeData%CableDeltaLdot, kind=B8Ki) + LB(1:1) = lbound(SrcBladedDLLTypeData%CableDeltaLdot) + UB(1:1) = ubound(SrcBladedDLLTypeData%CableDeltaLdot) if (.not. allocated(DstBladedDLLTypeData%CableDeltaLdot)) then allocate(DstBladedDLLTypeData%CableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1828,8 +1943,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%CableDeltaLdot = SrcBladedDLLTypeData%CableDeltaLdot end if if (allocated(SrcBladedDLLTypeData%PrevStCCmdStiff)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdStiff, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdStiff, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdStiff) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdStiff) if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdStiff)) then allocate(DstBladedDLLTypeData%PrevStCCmdStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1840,8 +1955,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%PrevStCCmdStiff = SrcBladedDLLTypeData%PrevStCCmdStiff end if if (allocated(SrcBladedDLLTypeData%PrevStCCmdDamp)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdDamp, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdDamp, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdDamp) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdDamp) if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdDamp)) then allocate(DstBladedDLLTypeData%PrevStCCmdDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1852,8 +1967,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%PrevStCCmdDamp = SrcBladedDLLTypeData%PrevStCCmdDamp end if if (allocated(SrcBladedDLLTypeData%PrevStCCmdBrake)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdBrake, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdBrake, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdBrake) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdBrake) if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdBrake)) then allocate(DstBladedDLLTypeData%PrevStCCmdBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1864,8 +1979,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%PrevStCCmdBrake = SrcBladedDLLTypeData%PrevStCCmdBrake end if if (allocated(SrcBladedDLLTypeData%PrevStCCmdForce)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdForce, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdForce, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdForce) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdForce) if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdForce)) then allocate(DstBladedDLLTypeData%PrevStCCmdForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1876,8 +1991,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%PrevStCCmdForce = SrcBladedDLLTypeData%PrevStCCmdForce end if if (allocated(SrcBladedDLLTypeData%StCCmdStiff)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdStiff, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdStiff, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdStiff) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdStiff) if (.not. allocated(DstBladedDLLTypeData%StCCmdStiff)) then allocate(DstBladedDLLTypeData%StCCmdStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1888,8 +2003,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%StCCmdStiff = SrcBladedDLLTypeData%StCCmdStiff end if if (allocated(SrcBladedDLLTypeData%StCCmdDamp)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdDamp, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdDamp, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdDamp) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdDamp) if (.not. allocated(DstBladedDLLTypeData%StCCmdDamp)) then allocate(DstBladedDLLTypeData%StCCmdDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1900,8 +2015,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%StCCmdDamp = SrcBladedDLLTypeData%StCCmdDamp end if if (allocated(SrcBladedDLLTypeData%StCCmdBrake)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdBrake, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdBrake, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdBrake) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdBrake) if (.not. allocated(DstBladedDLLTypeData%StCCmdBrake)) then allocate(DstBladedDLLTypeData%StCCmdBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1912,8 +2027,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%StCCmdBrake = SrcBladedDLLTypeData%StCCmdBrake end if if (allocated(SrcBladedDLLTypeData%StCCmdForce)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdForce, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdForce, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdForce) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdForce) if (.not. allocated(DstBladedDLLTypeData%StCCmdForce)) then allocate(DstBladedDLLTypeData%StCCmdForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1924,8 +2039,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%StCCmdForce = SrcBladedDLLTypeData%StCCmdForce end if if (allocated(SrcBladedDLLTypeData%StCMeasDisp)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasDisp, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasDisp, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasDisp) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasDisp) if (.not. allocated(DstBladedDLLTypeData%StCMeasDisp)) then allocate(DstBladedDLLTypeData%StCMeasDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1936,8 +2051,8 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%StCMeasDisp = SrcBladedDLLTypeData%StCMeasDisp end if if (allocated(SrcBladedDLLTypeData%StCMeasVel)) then - LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasVel, kind=B8Ki) - UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasVel, kind=B8Ki) + LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasVel) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasVel) if (.not. allocated(DstBladedDLLTypeData%StCMeasVel)) then allocate(DstBladedDLLTypeData%StCMeasVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1953,8 +2068,8 @@ subroutine SrvD_DestroyBladedDLLType(BladedDLLTypeData, ErrStat, ErrMsg) type(BladedDLLType), intent(inout) :: BladedDLLTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyBladedDLLType' @@ -1967,8 +2082,8 @@ subroutine SrvD_DestroyBladedDLLType(BladedDLLTypeData, ErrStat, ErrMsg) deallocate(BladedDLLTypeData%toSC) end if if (allocated(BladedDLLTypeData%LogChannels_OutParam)) then - LB(1:1) = lbound(BladedDLLTypeData%LogChannels_OutParam, kind=B8Ki) - UB(1:1) = ubound(BladedDLLTypeData%LogChannels_OutParam, kind=B8Ki) + LB(1:1) = lbound(BladedDLLTypeData%LogChannels_OutParam) + UB(1:1) = ubound(BladedDLLTypeData%LogChannels_OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(BladedDLLTypeData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2047,8 +2162,8 @@ subroutine SrvD_PackBladedDLLType(RF, Indata) type(RegFile), intent(inout) :: RF type(BladedDLLType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackBladedDLLType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%avrSWAP) call RegPack(RF, InData%HSSBrTrqDemand) @@ -2066,9 +2181,9 @@ subroutine SrvD_PackBladedDLLType(RF, Indata) call RegPack(RF, InData%NumLogChannels) call RegPack(RF, allocated(InData%LogChannels_OutParam)) if (allocated(InData%LogChannels_OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%LogChannels_OutParam, kind=B8Ki), ubound(InData%LogChannels_OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%LogChannels_OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%LogChannels_OutParam, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%LogChannels_OutParam), ubound(InData%LogChannels_OutParam)) + LB(1:1) = lbound(InData%LogChannels_OutParam) + UB(1:1) = ubound(InData%LogChannels_OutParam) do i1 = LB(1), UB(1) call NWTC_Library_PackOutParmType(RF, InData%LogChannels_OutParam(i1)) end do @@ -2160,8 +2275,8 @@ subroutine SrvD_UnPackBladedDLLType(RF, OutData) type(RegFile), intent(inout) :: RF type(BladedDLLType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackBladedDLLType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2280,8 +2395,8 @@ subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyContState' @@ -2289,8 +2404,8 @@ subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS ErrMsg = '' DstContStateData%DummyContState = SrcContStateData%DummyContState if (allocated(SrcContStateData%BStC)) then - LB(1:1) = lbound(SrcContStateData%BStC, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%BStC, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%BStC) + UB(1:1) = ubound(SrcContStateData%BStC) if (.not. allocated(DstContStateData%BStC)) then allocate(DstContStateData%BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2305,8 +2420,8 @@ subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS end do end if if (allocated(SrcContStateData%NStC)) then - LB(1:1) = lbound(SrcContStateData%NStC, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%NStC, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%NStC) + UB(1:1) = ubound(SrcContStateData%NStC) if (.not. allocated(DstContStateData%NStC)) then allocate(DstContStateData%NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2321,8 +2436,8 @@ subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS end do end if if (allocated(SrcContStateData%TStC)) then - LB(1:1) = lbound(SrcContStateData%TStC, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%TStC, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%TStC) + UB(1:1) = ubound(SrcContStateData%TStC) if (.not. allocated(DstContStateData%TStC)) then allocate(DstContStateData%TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2337,8 +2452,8 @@ subroutine SrvD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrS end do end if if (allocated(SrcContStateData%SStC)) then - LB(1:1) = lbound(SrcContStateData%SStC, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%SStC, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%SStC) + UB(1:1) = ubound(SrcContStateData%SStC) if (.not. allocated(DstContStateData%SStC)) then allocate(DstContStateData%SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2358,16 +2473,16 @@ subroutine SrvD_DestroyContState(ContStateData, ErrStat, ErrMsg) type(SrvD_ContinuousStateType), intent(inout) :: ContStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ContStateData%BStC)) then - LB(1:1) = lbound(ContStateData%BStC, kind=B8Ki) - UB(1:1) = ubound(ContStateData%BStC, kind=B8Ki) + LB(1:1) = lbound(ContStateData%BStC) + UB(1:1) = ubound(ContStateData%BStC) do i1 = LB(1), UB(1) call StC_DestroyContState(ContStateData%BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2375,8 +2490,8 @@ subroutine SrvD_DestroyContState(ContStateData, ErrStat, ErrMsg) deallocate(ContStateData%BStC) end if if (allocated(ContStateData%NStC)) then - LB(1:1) = lbound(ContStateData%NStC, kind=B8Ki) - UB(1:1) = ubound(ContStateData%NStC, kind=B8Ki) + LB(1:1) = lbound(ContStateData%NStC) + UB(1:1) = ubound(ContStateData%NStC) do i1 = LB(1), UB(1) call StC_DestroyContState(ContStateData%NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2384,8 +2499,8 @@ subroutine SrvD_DestroyContState(ContStateData, ErrStat, ErrMsg) deallocate(ContStateData%NStC) end if if (allocated(ContStateData%TStC)) then - LB(1:1) = lbound(ContStateData%TStC, kind=B8Ki) - UB(1:1) = ubound(ContStateData%TStC, kind=B8Ki) + LB(1:1) = lbound(ContStateData%TStC) + UB(1:1) = ubound(ContStateData%TStC) do i1 = LB(1), UB(1) call StC_DestroyContState(ContStateData%TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2393,8 +2508,8 @@ subroutine SrvD_DestroyContState(ContStateData, ErrStat, ErrMsg) deallocate(ContStateData%TStC) end if if (allocated(ContStateData%SStC)) then - LB(1:1) = lbound(ContStateData%SStC, kind=B8Ki) - UB(1:1) = ubound(ContStateData%SStC, kind=B8Ki) + LB(1:1) = lbound(ContStateData%SStC) + UB(1:1) = ubound(ContStateData%SStC) do i1 = LB(1), UB(1) call StC_DestroyContState(ContStateData%SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2407,42 +2522,42 @@ subroutine SrvD_PackContState(RF, Indata) type(RegFile), intent(inout) :: RF type(SrvD_ContinuousStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DummyContState) call RegPack(RF, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) - LB(1:1) = lbound(InData%BStC, kind=B8Ki) - UB(1:1) = ubound(InData%BStC, kind=B8Ki) + 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_PackContState(RF, InData%BStC(i1)) end do end if call RegPack(RF, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%NStC, kind=B8Ki) - UB(1:1) = ubound(InData%NStC, kind=B8Ki) + 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_PackContState(RF, InData%NStC(i1)) end do end if call RegPack(RF, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%TStC, kind=B8Ki) - UB(1:1) = ubound(InData%TStC, kind=B8Ki) + 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_PackContState(RF, InData%TStC(i1)) end do end if call RegPack(RF, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%SStC, kind=B8Ki) - UB(1:1) = ubound(InData%SStC, kind=B8Ki) + 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_PackContState(RF, InData%SStC(i1)) end do @@ -2454,8 +2569,8 @@ subroutine SrvD_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackContState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2520,8 +2635,8 @@ subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyDiscState' @@ -2529,8 +2644,8 @@ subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS ErrMsg = '' DstDiscStateData%CtrlOffset = SrcDiscStateData%CtrlOffset if (allocated(SrcDiscStateData%BStC)) then - LB(1:1) = lbound(SrcDiscStateData%BStC, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%BStC, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%BStC) + UB(1:1) = ubound(SrcDiscStateData%BStC) if (.not. allocated(DstDiscStateData%BStC)) then allocate(DstDiscStateData%BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2545,8 +2660,8 @@ subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS end do end if if (allocated(SrcDiscStateData%NStC)) then - LB(1:1) = lbound(SrcDiscStateData%NStC, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%NStC, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%NStC) + UB(1:1) = ubound(SrcDiscStateData%NStC) if (.not. allocated(DstDiscStateData%NStC)) then allocate(DstDiscStateData%NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2561,8 +2676,8 @@ subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS end do end if if (allocated(SrcDiscStateData%TStC)) then - LB(1:1) = lbound(SrcDiscStateData%TStC, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%TStC, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%TStC) + UB(1:1) = ubound(SrcDiscStateData%TStC) if (.not. allocated(DstDiscStateData%TStC)) then allocate(DstDiscStateData%TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2577,8 +2692,8 @@ subroutine SrvD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrS end do end if if (allocated(SrcDiscStateData%SStC)) then - LB(1:1) = lbound(SrcDiscStateData%SStC, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%SStC, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%SStC) + UB(1:1) = ubound(SrcDiscStateData%SStC) if (.not. allocated(DstDiscStateData%SStC)) then allocate(DstDiscStateData%SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2598,16 +2713,16 @@ subroutine SrvD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) type(SrvD_DiscreteStateType), intent(inout) :: DiscStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(DiscStateData%BStC)) then - LB(1:1) = lbound(DiscStateData%BStC, kind=B8Ki) - UB(1:1) = ubound(DiscStateData%BStC, kind=B8Ki) + LB(1:1) = lbound(DiscStateData%BStC) + UB(1:1) = ubound(DiscStateData%BStC) do i1 = LB(1), UB(1) call StC_DestroyDiscState(DiscStateData%BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2615,8 +2730,8 @@ subroutine SrvD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) deallocate(DiscStateData%BStC) end if if (allocated(DiscStateData%NStC)) then - LB(1:1) = lbound(DiscStateData%NStC, kind=B8Ki) - UB(1:1) = ubound(DiscStateData%NStC, kind=B8Ki) + LB(1:1) = lbound(DiscStateData%NStC) + UB(1:1) = ubound(DiscStateData%NStC) do i1 = LB(1), UB(1) call StC_DestroyDiscState(DiscStateData%NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2624,8 +2739,8 @@ subroutine SrvD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) deallocate(DiscStateData%NStC) end if if (allocated(DiscStateData%TStC)) then - LB(1:1) = lbound(DiscStateData%TStC, kind=B8Ki) - UB(1:1) = ubound(DiscStateData%TStC, kind=B8Ki) + LB(1:1) = lbound(DiscStateData%TStC) + UB(1:1) = ubound(DiscStateData%TStC) do i1 = LB(1), UB(1) call StC_DestroyDiscState(DiscStateData%TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2633,8 +2748,8 @@ subroutine SrvD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) deallocate(DiscStateData%TStC) end if if (allocated(DiscStateData%SStC)) then - LB(1:1) = lbound(DiscStateData%SStC, kind=B8Ki) - UB(1:1) = ubound(DiscStateData%SStC, kind=B8Ki) + LB(1:1) = lbound(DiscStateData%SStC) + UB(1:1) = ubound(DiscStateData%SStC) do i1 = LB(1), UB(1) call StC_DestroyDiscState(DiscStateData%SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2647,42 +2762,42 @@ subroutine SrvD_PackDiscState(RF, Indata) type(RegFile), intent(inout) :: RF type(SrvD_DiscreteStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%CtrlOffset) call RegPack(RF, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) - LB(1:1) = lbound(InData%BStC, kind=B8Ki) - UB(1:1) = ubound(InData%BStC, kind=B8Ki) + 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_PackDiscState(RF, InData%BStC(i1)) end do end if call RegPack(RF, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%NStC, kind=B8Ki) - UB(1:1) = ubound(InData%NStC, kind=B8Ki) + 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_PackDiscState(RF, InData%NStC(i1)) end do end if call RegPack(RF, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%TStC, kind=B8Ki) - UB(1:1) = ubound(InData%TStC, kind=B8Ki) + 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_PackDiscState(RF, InData%TStC(i1)) end do end if call RegPack(RF, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%SStC, kind=B8Ki) - UB(1:1) = ubound(InData%SStC, kind=B8Ki) + 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_PackDiscState(RF, InData%SStC(i1)) end do @@ -2694,8 +2809,8 @@ subroutine SrvD_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackDiscState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2760,8 +2875,8 @@ subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyConstrState' @@ -2769,8 +2884,8 @@ subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode ErrMsg = '' DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState if (allocated(SrcConstrStateData%BStC)) then - LB(1:1) = lbound(SrcConstrStateData%BStC, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%BStC, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%BStC) + UB(1:1) = ubound(SrcConstrStateData%BStC) if (.not. allocated(DstConstrStateData%BStC)) then allocate(DstConstrStateData%BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2785,8 +2900,8 @@ subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode end do end if if (allocated(SrcConstrStateData%NStC)) then - LB(1:1) = lbound(SrcConstrStateData%NStC, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%NStC, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%NStC) + UB(1:1) = ubound(SrcConstrStateData%NStC) if (.not. allocated(DstConstrStateData%NStC)) then allocate(DstConstrStateData%NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2801,8 +2916,8 @@ subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode end do end if if (allocated(SrcConstrStateData%TStC)) then - LB(1:1) = lbound(SrcConstrStateData%TStC, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%TStC, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%TStC) + UB(1:1) = ubound(SrcConstrStateData%TStC) if (.not. allocated(DstConstrStateData%TStC)) then allocate(DstConstrStateData%TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2817,8 +2932,8 @@ subroutine SrvD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode end do end if if (allocated(SrcConstrStateData%SStC)) then - LB(1:1) = lbound(SrcConstrStateData%SStC, kind=B8Ki) - UB(1:1) = ubound(SrcConstrStateData%SStC, kind=B8Ki) + LB(1:1) = lbound(SrcConstrStateData%SStC) + UB(1:1) = ubound(SrcConstrStateData%SStC) if (.not. allocated(DstConstrStateData%SStC)) then allocate(DstConstrStateData%SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -2838,16 +2953,16 @@ subroutine SrvD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) type(SrvD_ConstraintStateType), intent(inout) :: ConstrStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyConstrState' ErrStat = ErrID_None ErrMsg = '' if (allocated(ConstrStateData%BStC)) then - LB(1:1) = lbound(ConstrStateData%BStC, kind=B8Ki) - UB(1:1) = ubound(ConstrStateData%BStC, kind=B8Ki) + LB(1:1) = lbound(ConstrStateData%BStC) + UB(1:1) = ubound(ConstrStateData%BStC) do i1 = LB(1), UB(1) call StC_DestroyConstrState(ConstrStateData%BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2855,8 +2970,8 @@ subroutine SrvD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) deallocate(ConstrStateData%BStC) end if if (allocated(ConstrStateData%NStC)) then - LB(1:1) = lbound(ConstrStateData%NStC, kind=B8Ki) - UB(1:1) = ubound(ConstrStateData%NStC, kind=B8Ki) + LB(1:1) = lbound(ConstrStateData%NStC) + UB(1:1) = ubound(ConstrStateData%NStC) do i1 = LB(1), UB(1) call StC_DestroyConstrState(ConstrStateData%NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2864,8 +2979,8 @@ subroutine SrvD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) deallocate(ConstrStateData%NStC) end if if (allocated(ConstrStateData%TStC)) then - LB(1:1) = lbound(ConstrStateData%TStC, kind=B8Ki) - UB(1:1) = ubound(ConstrStateData%TStC, kind=B8Ki) + LB(1:1) = lbound(ConstrStateData%TStC) + UB(1:1) = ubound(ConstrStateData%TStC) do i1 = LB(1), UB(1) call StC_DestroyConstrState(ConstrStateData%TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2873,8 +2988,8 @@ subroutine SrvD_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) deallocate(ConstrStateData%TStC) end if if (allocated(ConstrStateData%SStC)) then - LB(1:1) = lbound(ConstrStateData%SStC, kind=B8Ki) - UB(1:1) = ubound(ConstrStateData%SStC, kind=B8Ki) + LB(1:1) = lbound(ConstrStateData%SStC) + UB(1:1) = ubound(ConstrStateData%SStC) do i1 = LB(1), UB(1) call StC_DestroyConstrState(ConstrStateData%SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2887,42 +3002,42 @@ subroutine SrvD_PackConstrState(RF, Indata) type(RegFile), intent(inout) :: RF type(SrvD_ConstraintStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackConstrState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DummyConstrState) call RegPack(RF, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) - LB(1:1) = lbound(InData%BStC, kind=B8Ki) - UB(1:1) = ubound(InData%BStC, kind=B8Ki) + 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_PackConstrState(RF, InData%BStC(i1)) end do end if call RegPack(RF, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%NStC, kind=B8Ki) - UB(1:1) = ubound(InData%NStC, kind=B8Ki) + 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_PackConstrState(RF, InData%NStC(i1)) end do end if call RegPack(RF, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%TStC, kind=B8Ki) - UB(1:1) = ubound(InData%TStC, kind=B8Ki) + 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_PackConstrState(RF, InData%TStC(i1)) end do end if call RegPack(RF, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%SStC, kind=B8Ki) - UB(1:1) = ubound(InData%SStC, kind=B8Ki) + 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_PackConstrState(RF, InData%SStC(i1)) end do @@ -2934,8 +3049,8 @@ subroutine SrvD_UnPackConstrState(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_ConstraintStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackConstrState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3000,16 +3115,16 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%BegPitMan)) then - LB(1:1) = lbound(SrcOtherStateData%BegPitMan, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%BegPitMan, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%BegPitMan) + UB(1:1) = ubound(SrcOtherStateData%BegPitMan) if (.not. allocated(DstOtherStateData%BegPitMan)) then allocate(DstOtherStateData%BegPitMan(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3020,8 +3135,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%BegPitMan = SrcOtherStateData%BegPitMan end if if (allocated(SrcOtherStateData%BlPitchI)) then - LB(1:1) = lbound(SrcOtherStateData%BlPitchI, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%BlPitchI, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%BlPitchI) + UB(1:1) = ubound(SrcOtherStateData%BlPitchI) if (.not. allocated(DstOtherStateData%BlPitchI)) then allocate(DstOtherStateData%BlPitchI(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3032,8 +3147,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%BlPitchI = SrcOtherStateData%BlPitchI end if if (allocated(SrcOtherStateData%TPitManE)) then - LB(1:1) = lbound(SrcOtherStateData%TPitManE, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%TPitManE, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%TPitManE) + UB(1:1) = ubound(SrcOtherStateData%TPitManE) if (.not. allocated(DstOtherStateData%TPitManE)) then allocate(DstOtherStateData%TPitManE(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3048,8 +3163,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%TYawManE = SrcOtherStateData%TYawManE DstOtherStateData%YawPosComInt = SrcOtherStateData%YawPosComInt if (allocated(SrcOtherStateData%BegTpBr)) then - LB(1:1) = lbound(SrcOtherStateData%BegTpBr, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%BegTpBr, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%BegTpBr) + UB(1:1) = ubound(SrcOtherStateData%BegTpBr) if (.not. allocated(DstOtherStateData%BegTpBr)) then allocate(DstOtherStateData%BegTpBr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3060,8 +3175,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%BegTpBr = SrcOtherStateData%BegTpBr end if if (allocated(SrcOtherStateData%TTpBrDp)) then - LB(1:1) = lbound(SrcOtherStateData%TTpBrDp, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%TTpBrDp, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%TTpBrDp) + UB(1:1) = ubound(SrcOtherStateData%TTpBrDp) if (.not. allocated(DstOtherStateData%TTpBrDp)) then allocate(DstOtherStateData%TTpBrDp(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3072,8 +3187,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%TTpBrDp = SrcOtherStateData%TTpBrDp end if if (allocated(SrcOtherStateData%TTpBrFl)) then - LB(1:1) = lbound(SrcOtherStateData%TTpBrFl, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%TTpBrFl, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%TTpBrFl) + UB(1:1) = ubound(SrcOtherStateData%TTpBrFl) if (.not. allocated(DstOtherStateData%TTpBrFl)) then allocate(DstOtherStateData%TTpBrFl(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3086,8 +3201,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E DstOtherStateData%Off4Good = SrcOtherStateData%Off4Good DstOtherStateData%GenOnLine = SrcOtherStateData%GenOnLine if (allocated(SrcOtherStateData%BStC)) then - LB(1:1) = lbound(SrcOtherStateData%BStC, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%BStC, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%BStC) + UB(1:1) = ubound(SrcOtherStateData%BStC) if (.not. allocated(DstOtherStateData%BStC)) then allocate(DstOtherStateData%BStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3102,8 +3217,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end do end if if (allocated(SrcOtherStateData%NStC)) then - LB(1:1) = lbound(SrcOtherStateData%NStC, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%NStC, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%NStC) + UB(1:1) = ubound(SrcOtherStateData%NStC) if (.not. allocated(DstOtherStateData%NStC)) then allocate(DstOtherStateData%NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3118,8 +3233,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end do end if if (allocated(SrcOtherStateData%TStC)) then - LB(1:1) = lbound(SrcOtherStateData%TStC, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%TStC, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%TStC) + UB(1:1) = ubound(SrcOtherStateData%TStC) if (.not. allocated(DstOtherStateData%TStC)) then allocate(DstOtherStateData%TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3134,8 +3249,8 @@ subroutine SrvD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, E end do end if if (allocated(SrcOtherStateData%SStC)) then - LB(1:1) = lbound(SrcOtherStateData%SStC, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%SStC, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%SStC) + UB(1:1) = ubound(SrcOtherStateData%SStC) if (.not. allocated(DstOtherStateData%SStC)) then allocate(DstOtherStateData%SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3155,8 +3270,8 @@ subroutine SrvD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(SrvD_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyOtherState' @@ -3181,8 +3296,8 @@ subroutine SrvD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) deallocate(OtherStateData%TTpBrFl) end if if (allocated(OtherStateData%BStC)) then - LB(1:1) = lbound(OtherStateData%BStC, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%BStC, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%BStC) + UB(1:1) = ubound(OtherStateData%BStC) do i1 = LB(1), UB(1) call StC_DestroyOtherState(OtherStateData%BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3190,8 +3305,8 @@ subroutine SrvD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) deallocate(OtherStateData%BStC) end if if (allocated(OtherStateData%NStC)) then - LB(1:1) = lbound(OtherStateData%NStC, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%NStC, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%NStC) + UB(1:1) = ubound(OtherStateData%NStC) do i1 = LB(1), UB(1) call StC_DestroyOtherState(OtherStateData%NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3199,8 +3314,8 @@ subroutine SrvD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) deallocate(OtherStateData%NStC) end if if (allocated(OtherStateData%TStC)) then - LB(1:1) = lbound(OtherStateData%TStC, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%TStC, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%TStC) + UB(1:1) = ubound(OtherStateData%TStC) do i1 = LB(1), UB(1) call StC_DestroyOtherState(OtherStateData%TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3208,8 +3323,8 @@ subroutine SrvD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) deallocate(OtherStateData%TStC) end if if (allocated(OtherStateData%SStC)) then - LB(1:1) = lbound(OtherStateData%SStC, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%SStC, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%SStC) + UB(1:1) = ubound(OtherStateData%SStC) do i1 = LB(1), UB(1) call StC_DestroyOtherState(OtherStateData%SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3222,8 +3337,8 @@ subroutine SrvD_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(SrvD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%BegPitMan) call RegPackAlloc(RF, InData%BlPitchI) @@ -3239,36 +3354,36 @@ subroutine SrvD_PackOtherState(RF, Indata) call RegPack(RF, InData%GenOnLine) call RegPack(RF, allocated(InData%BStC)) if (allocated(InData%BStC)) then - call RegPackBounds(RF, 1, lbound(InData%BStC, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) - LB(1:1) = lbound(InData%BStC, kind=B8Ki) - UB(1:1) = ubound(InData%BStC, kind=B8Ki) + 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_PackOtherState(RF, InData%BStC(i1)) end do end if call RegPack(RF, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%NStC, kind=B8Ki) - UB(1:1) = ubound(InData%NStC, kind=B8Ki) + 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_PackOtherState(RF, InData%NStC(i1)) end do end if call RegPack(RF, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%TStC, kind=B8Ki) - UB(1:1) = ubound(InData%TStC, kind=B8Ki) + 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_PackOtherState(RF, InData%TStC(i1)) end do end if call RegPack(RF, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%SStC, kind=B8Ki) - UB(1:1) = ubound(InData%SStC, kind=B8Ki) + 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_PackOtherState(RF, InData%SStC(i1)) end do @@ -3280,8 +3395,8 @@ subroutine SrvD_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3357,16 +3472,16 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_CopyModuleMapType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcModuleMapTypeData%u_BStC_Mot2_BStC)) then - LB(1:2) = lbound(SrcModuleMapTypeData%u_BStC_Mot2_BStC, kind=B8Ki) - UB(1:2) = ubound(SrcModuleMapTypeData%u_BStC_Mot2_BStC, kind=B8Ki) + LB(1:2) = lbound(SrcModuleMapTypeData%u_BStC_Mot2_BStC) + UB(1:2) = ubound(SrcModuleMapTypeData%u_BStC_Mot2_BStC) if (.not. allocated(DstModuleMapTypeData%u_BStC_Mot2_BStC)) then allocate(DstModuleMapTypeData%u_BStC_Mot2_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3383,8 +3498,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%u_NStC_Mot2_NStC)) then - LB(1:1) = lbound(SrcModuleMapTypeData%u_NStC_Mot2_NStC, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%u_NStC_Mot2_NStC, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%u_NStC_Mot2_NStC) + UB(1:1) = ubound(SrcModuleMapTypeData%u_NStC_Mot2_NStC) if (.not. allocated(DstModuleMapTypeData%u_NStC_Mot2_NStC)) then allocate(DstModuleMapTypeData%u_NStC_Mot2_NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3399,8 +3514,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%u_TStC_Mot2_TStC)) then - LB(1:1) = lbound(SrcModuleMapTypeData%u_TStC_Mot2_TStC, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%u_TStC_Mot2_TStC, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%u_TStC_Mot2_TStC) + UB(1:1) = ubound(SrcModuleMapTypeData%u_TStC_Mot2_TStC) if (.not. allocated(DstModuleMapTypeData%u_TStC_Mot2_TStC)) then allocate(DstModuleMapTypeData%u_TStC_Mot2_TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3415,8 +3530,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%u_SStC_Mot2_SStC)) then - LB(1:1) = lbound(SrcModuleMapTypeData%u_SStC_Mot2_SStC, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%u_SStC_Mot2_SStC, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%u_SStC_Mot2_SStC) + UB(1:1) = ubound(SrcModuleMapTypeData%u_SStC_Mot2_SStC) if (.not. allocated(DstModuleMapTypeData%u_SStC_Mot2_SStC)) then allocate(DstModuleMapTypeData%u_SStC_Mot2_SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3431,8 +3546,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%BStC_Frc2_y_BStC)) then - LB(1:2) = lbound(SrcModuleMapTypeData%BStC_Frc2_y_BStC, kind=B8Ki) - UB(1:2) = ubound(SrcModuleMapTypeData%BStC_Frc2_y_BStC, kind=B8Ki) + LB(1:2) = lbound(SrcModuleMapTypeData%BStC_Frc2_y_BStC) + UB(1:2) = ubound(SrcModuleMapTypeData%BStC_Frc2_y_BStC) if (.not. allocated(DstModuleMapTypeData%BStC_Frc2_y_BStC)) then allocate(DstModuleMapTypeData%BStC_Frc2_y_BStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3449,8 +3564,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%NStC_Frc2_y_NStC)) then - LB(1:1) = lbound(SrcModuleMapTypeData%NStC_Frc2_y_NStC, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%NStC_Frc2_y_NStC, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%NStC_Frc2_y_NStC) + UB(1:1) = ubound(SrcModuleMapTypeData%NStC_Frc2_y_NStC) if (.not. allocated(DstModuleMapTypeData%NStC_Frc2_y_NStC)) then allocate(DstModuleMapTypeData%NStC_Frc2_y_NStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3465,8 +3580,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%TStC_Frc2_y_TStC)) then - LB(1:1) = lbound(SrcModuleMapTypeData%TStC_Frc2_y_TStC, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%TStC_Frc2_y_TStC, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%TStC_Frc2_y_TStC) + UB(1:1) = ubound(SrcModuleMapTypeData%TStC_Frc2_y_TStC) if (.not. allocated(DstModuleMapTypeData%TStC_Frc2_y_TStC)) then allocate(DstModuleMapTypeData%TStC_Frc2_y_TStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3481,8 +3596,8 @@ subroutine SrvD_CopyModuleMapType(SrcModuleMapTypeData, DstModuleMapTypeData, Ct end do end if if (allocated(SrcModuleMapTypeData%SStC_Frc2_y_SStC)) then - LB(1:1) = lbound(SrcModuleMapTypeData%SStC_Frc2_y_SStC, kind=B8Ki) - UB(1:1) = ubound(SrcModuleMapTypeData%SStC_Frc2_y_SStC, kind=B8Ki) + LB(1:1) = lbound(SrcModuleMapTypeData%SStC_Frc2_y_SStC) + UB(1:1) = ubound(SrcModuleMapTypeData%SStC_Frc2_y_SStC) if (.not. allocated(DstModuleMapTypeData%SStC_Frc2_y_SStC)) then allocate(DstModuleMapTypeData%SStC_Frc2_y_SStC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -3502,16 +3617,16 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) type(SrvD_ModuleMapType), intent(inout) :: ModuleMapTypeData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SrvD_DestroyModuleMapType' ErrStat = ErrID_None ErrMsg = '' if (allocated(ModuleMapTypeData%u_BStC_Mot2_BStC)) then - LB(1:2) = lbound(ModuleMapTypeData%u_BStC_Mot2_BStC, kind=B8Ki) - UB(1:2) = ubound(ModuleMapTypeData%u_BStC_Mot2_BStC, kind=B8Ki) + LB(1:2) = lbound(ModuleMapTypeData%u_BStC_Mot2_BStC) + UB(1:2) = ubound(ModuleMapTypeData%u_BStC_Mot2_BStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_BStC_Mot2_BStC(i1,i2), ErrStat2, ErrMsg2) @@ -3521,8 +3636,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%u_BStC_Mot2_BStC) end if if (allocated(ModuleMapTypeData%u_NStC_Mot2_NStC)) then - LB(1:1) = lbound(ModuleMapTypeData%u_NStC_Mot2_NStC, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%u_NStC_Mot2_NStC, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%u_NStC_Mot2_NStC) + UB(1:1) = ubound(ModuleMapTypeData%u_NStC_Mot2_NStC) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_NStC_Mot2_NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3530,8 +3645,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%u_NStC_Mot2_NStC) end if if (allocated(ModuleMapTypeData%u_TStC_Mot2_TStC)) then - LB(1:1) = lbound(ModuleMapTypeData%u_TStC_Mot2_TStC, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%u_TStC_Mot2_TStC, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%u_TStC_Mot2_TStC) + UB(1:1) = ubound(ModuleMapTypeData%u_TStC_Mot2_TStC) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_TStC_Mot2_TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3539,8 +3654,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%u_TStC_Mot2_TStC) end if if (allocated(ModuleMapTypeData%u_SStC_Mot2_SStC)) then - LB(1:1) = lbound(ModuleMapTypeData%u_SStC_Mot2_SStC, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%u_SStC_Mot2_SStC, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%u_SStC_Mot2_SStC) + UB(1:1) = ubound(ModuleMapTypeData%u_SStC_Mot2_SStC) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%u_SStC_Mot2_SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3548,8 +3663,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%u_SStC_Mot2_SStC) end if if (allocated(ModuleMapTypeData%BStC_Frc2_y_BStC)) then - LB(1:2) = lbound(ModuleMapTypeData%BStC_Frc2_y_BStC, kind=B8Ki) - UB(1:2) = ubound(ModuleMapTypeData%BStC_Frc2_y_BStC, kind=B8Ki) + LB(1:2) = lbound(ModuleMapTypeData%BStC_Frc2_y_BStC) + UB(1:2) = ubound(ModuleMapTypeData%BStC_Frc2_y_BStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%BStC_Frc2_y_BStC(i1,i2), ErrStat2, ErrMsg2) @@ -3559,8 +3674,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%BStC_Frc2_y_BStC) end if if (allocated(ModuleMapTypeData%NStC_Frc2_y_NStC)) then - LB(1:1) = lbound(ModuleMapTypeData%NStC_Frc2_y_NStC, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%NStC_Frc2_y_NStC, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%NStC_Frc2_y_NStC) + UB(1:1) = ubound(ModuleMapTypeData%NStC_Frc2_y_NStC) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%NStC_Frc2_y_NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3568,8 +3683,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%NStC_Frc2_y_NStC) end if if (allocated(ModuleMapTypeData%TStC_Frc2_y_TStC)) then - LB(1:1) = lbound(ModuleMapTypeData%TStC_Frc2_y_TStC, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%TStC_Frc2_y_TStC, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%TStC_Frc2_y_TStC) + UB(1:1) = ubound(ModuleMapTypeData%TStC_Frc2_y_TStC) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%TStC_Frc2_y_TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3577,8 +3692,8 @@ subroutine SrvD_DestroyModuleMapType(ModuleMapTypeData, ErrStat, ErrMsg) deallocate(ModuleMapTypeData%TStC_Frc2_y_TStC) end if if (allocated(ModuleMapTypeData%SStC_Frc2_y_SStC)) then - LB(1:1) = lbound(ModuleMapTypeData%SStC_Frc2_y_SStC, kind=B8Ki) - UB(1:1) = ubound(ModuleMapTypeData%SStC_Frc2_y_SStC, kind=B8Ki) + LB(1:1) = lbound(ModuleMapTypeData%SStC_Frc2_y_SStC) + UB(1:1) = ubound(ModuleMapTypeData%SStC_Frc2_y_SStC) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(ModuleMapTypeData%SStC_Frc2_y_SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3591,14 +3706,14 @@ subroutine SrvD_PackModuleMapType(RF, Indata) type(RegFile), intent(inout) :: RF type(SrvD_ModuleMapType), intent(in) :: InData character(*), parameter :: RoutineName = 'SrvD_PackModuleMapType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%u_BStC_Mot2_BStC)) if (allocated(InData%u_BStC_Mot2_BStC)) then - call RegPackBounds(RF, 2, lbound(InData%u_BStC_Mot2_BStC, kind=B8Ki), ubound(InData%u_BStC_Mot2_BStC, kind=B8Ki)) - LB(1:2) = lbound(InData%u_BStC_Mot2_BStC, kind=B8Ki) - UB(1:2) = ubound(InData%u_BStC_Mot2_BStC, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%u_BStC_Mot2_BStC), ubound(InData%u_BStC_Mot2_BStC)) + LB(1:2) = lbound(InData%u_BStC_Mot2_BStC) + UB(1:2) = ubound(InData%u_BStC_Mot2_BStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%u_BStC_Mot2_BStC(i1,i2)) @@ -3607,36 +3722,36 @@ subroutine SrvD_PackModuleMapType(RF, Indata) end if call RegPack(RF, allocated(InData%u_NStC_Mot2_NStC)) if (allocated(InData%u_NStC_Mot2_NStC)) then - call RegPackBounds(RF, 1, lbound(InData%u_NStC_Mot2_NStC, kind=B8Ki), ubound(InData%u_NStC_Mot2_NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%u_NStC_Mot2_NStC, kind=B8Ki) - UB(1:1) = ubound(InData%u_NStC_Mot2_NStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%u_NStC_Mot2_NStC), ubound(InData%u_NStC_Mot2_NStC)) + LB(1:1) = lbound(InData%u_NStC_Mot2_NStC) + UB(1:1) = ubound(InData%u_NStC_Mot2_NStC) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%u_NStC_Mot2_NStC(i1)) end do end if call RegPack(RF, allocated(InData%u_TStC_Mot2_TStC)) if (allocated(InData%u_TStC_Mot2_TStC)) then - call RegPackBounds(RF, 1, lbound(InData%u_TStC_Mot2_TStC, kind=B8Ki), ubound(InData%u_TStC_Mot2_TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%u_TStC_Mot2_TStC, kind=B8Ki) - UB(1:1) = ubound(InData%u_TStC_Mot2_TStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%u_TStC_Mot2_TStC), ubound(InData%u_TStC_Mot2_TStC)) + LB(1:1) = lbound(InData%u_TStC_Mot2_TStC) + UB(1:1) = ubound(InData%u_TStC_Mot2_TStC) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%u_TStC_Mot2_TStC(i1)) end do end if call RegPack(RF, allocated(InData%u_SStC_Mot2_SStC)) if (allocated(InData%u_SStC_Mot2_SStC)) then - call RegPackBounds(RF, 1, lbound(InData%u_SStC_Mot2_SStC, kind=B8Ki), ubound(InData%u_SStC_Mot2_SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%u_SStC_Mot2_SStC, kind=B8Ki) - UB(1:1) = ubound(InData%u_SStC_Mot2_SStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%u_SStC_Mot2_SStC), ubound(InData%u_SStC_Mot2_SStC)) + LB(1:1) = lbound(InData%u_SStC_Mot2_SStC) + UB(1:1) = ubound(InData%u_SStC_Mot2_SStC) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%u_SStC_Mot2_SStC(i1)) end do end if call RegPack(RF, allocated(InData%BStC_Frc2_y_BStC)) if (allocated(InData%BStC_Frc2_y_BStC)) then - call RegPackBounds(RF, 2, lbound(InData%BStC_Frc2_y_BStC, kind=B8Ki), ubound(InData%BStC_Frc2_y_BStC, kind=B8Ki)) - LB(1:2) = lbound(InData%BStC_Frc2_y_BStC, kind=B8Ki) - UB(1:2) = ubound(InData%BStC_Frc2_y_BStC, kind=B8Ki) + call RegPackBounds(RF, 2, lbound(InData%BStC_Frc2_y_BStC), ubound(InData%BStC_Frc2_y_BStC)) + LB(1:2) = lbound(InData%BStC_Frc2_y_BStC) + UB(1:2) = ubound(InData%BStC_Frc2_y_BStC) do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%BStC_Frc2_y_BStC(i1,i2)) @@ -3645,27 +3760,27 @@ subroutine SrvD_PackModuleMapType(RF, Indata) end if call RegPack(RF, allocated(InData%NStC_Frc2_y_NStC)) if (allocated(InData%NStC_Frc2_y_NStC)) then - call RegPackBounds(RF, 1, lbound(InData%NStC_Frc2_y_NStC, kind=B8Ki), ubound(InData%NStC_Frc2_y_NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%NStC_Frc2_y_NStC, kind=B8Ki) - UB(1:1) = ubound(InData%NStC_Frc2_y_NStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%NStC_Frc2_y_NStC), ubound(InData%NStC_Frc2_y_NStC)) + LB(1:1) = lbound(InData%NStC_Frc2_y_NStC) + UB(1:1) = ubound(InData%NStC_Frc2_y_NStC) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%NStC_Frc2_y_NStC(i1)) end do end if call RegPack(RF, allocated(InData%TStC_Frc2_y_TStC)) if (allocated(InData%TStC_Frc2_y_TStC)) then - call RegPackBounds(RF, 1, lbound(InData%TStC_Frc2_y_TStC, kind=B8Ki), ubound(InData%TStC_Frc2_y_TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%TStC_Frc2_y_TStC, kind=B8Ki) - UB(1:1) = ubound(InData%TStC_Frc2_y_TStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%TStC_Frc2_y_TStC), ubound(InData%TStC_Frc2_y_TStC)) + LB(1:1) = lbound(InData%TStC_Frc2_y_TStC) + UB(1:1) = ubound(InData%TStC_Frc2_y_TStC) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%TStC_Frc2_y_TStC(i1)) end do end if call RegPack(RF, allocated(InData%SStC_Frc2_y_SStC)) if (allocated(InData%SStC_Frc2_y_SStC)) then - call RegPackBounds(RF, 1, lbound(InData%SStC_Frc2_y_SStC, kind=B8Ki), ubound(InData%SStC_Frc2_y_SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%SStC_Frc2_y_SStC, kind=B8Ki) - UB(1:1) = ubound(InData%SStC_Frc2_y_SStC, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%SStC_Frc2_y_SStC), ubound(InData%SStC_Frc2_y_SStC)) + LB(1:1) = lbound(InData%SStC_Frc2_y_SStC) + UB(1:1) = ubound(InData%SStC_Frc2_y_SStC) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%SStC_Frc2_y_SStC(i1)) end do @@ -3677,8 +3792,8 @@ subroutine SrvD_UnPackModuleMapType(RF, OutData) type(RegFile), intent(inout) :: RF type(SrvD_ModuleMapType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SrvD_UnPackModuleMapType' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -3792,526 +3907,901 @@ 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(B8Ki) :: i1, i2 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%xd_BlPitchFilter, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%BStC, kind=B8Ki) - 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 + DstParamData%BlPitchF = SrcParamData%BlPitchF + end if + if (allocated(SrcParamData%PitManRat)) then + LB(1:1) = lbound(SrcParamData%PitManRat) + UB(1:1) = ubound(SrcParamData%PitManRat) + if (.not. allocated(DstParamData%PitManRat)) then + allocate(DstParamData%PitManRat(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PitManRat.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PitManRat = SrcParamData%PitManRat + end if + DstParamData%YawManRat = SrcParamData%YawManRat + DstParamData%NacYawF = SrcParamData%NacYawF + DstParamData%SpdGenOn = SrcParamData%SpdGenOn + DstParamData%THSSBrDp = SrcParamData%THSSBrDp + DstParamData%THSSBrFl = SrcParamData%THSSBrFl + DstParamData%TimGenOf = SrcParamData%TimGenOf + DstParamData%TimGenOn = SrcParamData%TimGenOn + DstParamData%TPCOn = SrcParamData%TPCOn + if (allocated(SrcParamData%TPitManS)) then + LB(1:1) = lbound(SrcParamData%TPitManS) + UB(1:1) = ubound(SrcParamData%TPitManS) + if (.not. allocated(DstParamData%TPitManS)) then + allocate(DstParamData%TPitManS(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TPitManS.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TPitManS = SrcParamData%TPitManS + end if + DstParamData%TYawManS = SrcParamData%TYawManS + DstParamData%TYCOn = SrcParamData%TYCOn + DstParamData%VS_RtGnSp = SrcParamData%VS_RtGnSp + DstParamData%VS_RtTq = SrcParamData%VS_RtTq + DstParamData%VS_Slope = SrcParamData%VS_Slope + DstParamData%VS_SlPc = SrcParamData%VS_SlPc + DstParamData%VS_SySp = SrcParamData%VS_SySp + DstParamData%VS_TrGnSp = SrcParamData%VS_TrGnSp + DstParamData%YawPosCom = SrcParamData%YawPosCom + DstParamData%YawRateCom = SrcParamData%YawRateCom + DstParamData%GenModel = SrcParamData%GenModel + DstParamData%HSSBrMode = SrcParamData%HSSBrMode + DstParamData%PCMode = SrcParamData%PCMode + DstParamData%VSContrl = SrcParamData%VSContrl + DstParamData%YCMode = SrcParamData%YCMode + DstParamData%GenTiStp = SrcParamData%GenTiStp + DstParamData%GenTiStr = SrcParamData%GenTiStr + DstParamData%VS_Rgn2K = SrcParamData%VS_Rgn2K + DstParamData%YawNeut = SrcParamData%YawNeut + DstParamData%YawSpr = SrcParamData%YawSpr + DstParamData%YawDamp = SrcParamData%YawDamp + DstParamData%TpBrDT = SrcParamData%TpBrDT + if (allocated(SrcParamData%TBDepISp)) then + LB(1:1) = lbound(SrcParamData%TBDepISp) + UB(1:1) = ubound(SrcParamData%TBDepISp) + if (.not. allocated(DstParamData%TBDepISp)) then + allocate(DstParamData%TBDepISp(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TBDepISp.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%TBDepISp = SrcParamData%TBDepISp + end if + DstParamData%TBDrConN = SrcParamData%TBDrConN + DstParamData%TBDrConD = SrcParamData%TBDrConD + DstParamData%NumBl = SrcParamData%NumBl + DstParamData%NumBStC = SrcParamData%NumBStC + DstParamData%NumNStC = SrcParamData%NumNStC + DstParamData%NumTStC = SrcParamData%NumTStC + DstParamData%NumSStC = SrcParamData%NumSStC + DstParamData%AfCmode = SrcParamData%AfCmode + DstParamData%AfC_Mean = SrcParamData%AfC_Mean + DstParamData%AfC_Amp = SrcParamData%AfC_Amp + DstParamData%AfC_Phase = SrcParamData%AfC_Phase + DstParamData%CCmode = SrcParamData%CCmode + DstParamData%StCCmode = SrcParamData%StCCmode + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumOuts_DLL = SrcParamData%NumOuts_DLL + DstParamData%RootName = SrcParamData%RootName + 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) return end if end if do i1 = LB(1), UB(1) - call StC_CopyMisc(SrcMiscData%BStC(i1), DstMiscData%BStC(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 - if (allocated(SrcMiscData%NStC)) then - LB(1:1) = lbound(SrcMiscData%NStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%NStC, kind=B8Ki) - if (.not. allocated(DstMiscData%NStC)) then - allocate(DstMiscData%NStC(LB(1):UB(1)), 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%NStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BStC.', 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 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%TStC)) then - LB(1:1) = lbound(SrcMiscData%TStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%TStC, kind=B8Ki) - if (.not. allocated(DstMiscData%TStC)) then - allocate(DstMiscData%TStC(LB(1):UB(1)), 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%TStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NStC.', 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 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%SStC)) then - LB(1:1) = lbound(SrcMiscData%SStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SStC, kind=B8Ki) - if (.not. allocated(DstMiscData%SStC)) then - allocate(DstMiscData%SStC(LB(1):UB(1)), 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%SStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TStC.', 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 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%u_BStC)) then - LB(1:2) = lbound(SrcMiscData%u_BStC, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%u_BStC, kind=B8Ki) - if (.not. allocated(DstMiscData%u_BStC)) then - allocate(DstMiscData%u_BStC(LB(1):UB(1),LB(2):UB(2)), 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%u_BStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%SStC.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_CopyInput(SrcMiscData%u_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 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%u_NStC)) then - LB(1:2) = lbound(SrcMiscData%u_NStC, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%u_NStC, kind=B8Ki) - if (.not. allocated(DstMiscData%u_NStC)) then - allocate(DstMiscData%u_NStC(LB(1):UB(1),LB(2):UB(2)), 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%u_NStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StCMeasNumPerChan.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_CopyInput(SrcMiscData%u_NStC(i1,i2), DstMiscData%u_NStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do + DstParamData%StCMeasNumPerChan = SrcParamData%StCMeasNumPerChan end if - if (allocated(SrcMiscData%u_TStC)) then - LB(1:2) = lbound(SrcMiscData%u_TStC, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%u_TStC, kind=B8Ki) - if (.not. allocated(DstMiscData%u_TStC)) then - allocate(DstMiscData%u_TStC(LB(1):UB(1),LB(2):UB(2)), 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%u_TStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_CopyInput(SrcMiscData%u_TStC(i1,i2), DstMiscData%u_TStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx end if - if (allocated(SrcMiscData%u_SStC)) then - LB(1:2) = lbound(SrcMiscData%u_SStC, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%u_SStC, kind=B8Ki) - if (.not. allocated(DstMiscData%u_SStC)) then - allocate(DstMiscData%u_SStC(LB(1):UB(1),LB(2):UB(2)), 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%u_SStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_x_indx.', ErrStat, ErrMsg, RoutineName) return end if end if - do i2 = LB(2), UB(2) - do i1 = LB(1), UB(1) - call StC_CopyInput(SrcMiscData%u_SStC(i1,i2), DstMiscData%u_SStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end do + DstParamData%Jac_x_indx = SrcParamData%Jac_x_indx end if - if (allocated(SrcMiscData%y_BStC)) then - LB(1:1) = lbound(SrcMiscData%y_BStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%y_BStC, kind=B8Ki) - if (.not. allocated(DstMiscData%y_BStC)) then - allocate(DstMiscData%y_BStC(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%y_BStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyOutput(SrcMiscData%y_BStC(i1), DstMiscData%y_BStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstParamData%du = SrcParamData%du end if - if (allocated(SrcMiscData%y_NStC)) then - LB(1:1) = lbound(SrcMiscData%y_NStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%y_NStC, kind=B8Ki) - if (.not. allocated(DstMiscData%y_NStC)) then - allocate(DstMiscData%y_NStC(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%y_NStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', 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%dx = SrcParamData%dx end if - if (allocated(SrcMiscData%y_TStC)) then - LB(1:1) = lbound(SrcMiscData%y_TStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%y_TStC, kind=B8Ki) - if (.not. allocated(DstMiscData%y_TStC)) then - allocate(DstMiscData%y_TStC(LB(1):UB(1)), stat=ErrStat2) + 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 DstMiscData%y_TStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_u.', 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_Idx_BStC_u = SrcParamData%Jac_Idx_BStC_u end if - if (allocated(SrcMiscData%y_SStC)) then - LB(1:1) = lbound(SrcMiscData%y_SStC, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%y_SStC, kind=B8Ki) - if (.not. allocated(DstMiscData%y_SStC)) then - allocate(DstMiscData%y_SStC(LB(1):UB(1)), stat=ErrStat2) + 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 DstMiscData%y_SStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_u.', 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 + DstParamData%Jac_Idx_NStC_u = SrcParamData%Jac_Idx_NStC_u + end if + if (allocated(SrcParamData%Jac_Idx_TStC_u)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_u) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_u) + if (.not. allocated(DstParamData%Jac_Idx_TStC_u)) then + allocate(DstParamData%Jac_Idx_TStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_TStC_u = SrcParamData%Jac_Idx_TStC_u + end if + if (allocated(SrcParamData%Jac_Idx_SStC_u)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_u) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_u) + if (.not. allocated(DstParamData%Jac_Idx_SStC_u)) then + allocate(DstParamData%Jac_Idx_SStC_u(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_SStC_u = SrcParamData%Jac_Idx_SStC_u + end if + if (allocated(SrcParamData%Jac_Idx_BStC_x)) then + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_x) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_x) + if (.not. allocated(DstParamData%Jac_Idx_BStC_x)) then + allocate(DstParamData%Jac_Idx_BStC_x(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_BStC_x = SrcParamData%Jac_Idx_BStC_x + end if + if (allocated(SrcParamData%Jac_Idx_NStC_x)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_x) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_x) + if (.not. allocated(DstParamData%Jac_Idx_NStC_x)) then + allocate(DstParamData%Jac_Idx_NStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_NStC_x = SrcParamData%Jac_Idx_NStC_x + end if + if (allocated(SrcParamData%Jac_Idx_TStC_x)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_x) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_x) + if (.not. allocated(DstParamData%Jac_Idx_TStC_x)) then + allocate(DstParamData%Jac_Idx_TStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_TStC_x = SrcParamData%Jac_Idx_TStC_x + end if + if (allocated(SrcParamData%Jac_Idx_SStC_x)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_x) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_x) + if (.not. allocated(DstParamData%Jac_Idx_SStC_x)) then + allocate(DstParamData%Jac_Idx_SStC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_SStC_x = SrcParamData%Jac_Idx_SStC_x + end if + if (allocated(SrcParamData%Jac_Idx_BStC_y)) then + LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_y) + UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_y) + if (.not. allocated(DstParamData%Jac_Idx_BStC_y)) then + allocate(DstParamData%Jac_Idx_BStC_y(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_BStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_BStC_y = SrcParamData%Jac_Idx_BStC_y + end if + if (allocated(SrcParamData%Jac_Idx_NStC_y)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_y) + UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_y) + if (.not. allocated(DstParamData%Jac_Idx_NStC_y)) then + allocate(DstParamData%Jac_Idx_NStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_NStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_NStC_y = SrcParamData%Jac_Idx_NStC_y + end if + if (allocated(SrcParamData%Jac_Idx_TStC_y)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_y) + UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_y) + if (.not. allocated(DstParamData%Jac_Idx_TStC_y)) then + allocate(DstParamData%Jac_Idx_TStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_TStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_TStC_y = SrcParamData%Jac_Idx_TStC_y + end if + if (allocated(SrcParamData%Jac_Idx_SStC_y)) then + LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_y) + UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_y) + if (.not. allocated(DstParamData%Jac_Idx_SStC_y)) then + allocate(DstParamData%Jac_Idx_SStC_y(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_Idx_SStC_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Jac_Idx_SStC_y = SrcParamData%Jac_Idx_SStC_y + end if + DstParamData%SensorType = SrcParamData%SensorType + DstParamData%NumBeam = SrcParamData%NumBeam + DstParamData%NumPulseGate = SrcParamData%NumPulseGate + DstParamData%PulseSpacing = SrcParamData%PulseSpacing + DstParamData%URefLid = SrcParamData%URefLid + 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 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 +subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SrvD_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: 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_DestroyMisc' + character(*), parameter :: RoutineName = 'SrvD_DestroyParam' 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) + if (allocated(ParamData%BlPitchInit)) then + deallocate(ParamData%BlPitchInit) end if - if (allocated(MiscData%BStC)) then - LB(1:1) = lbound(MiscData%BStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%BStC, kind=B8Ki) - 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(ParamData%BlPitchF)) then + deallocate(ParamData%BlPitchF) end if - if (allocated(MiscData%NStC)) then - LB(1:1) = lbound(MiscData%NStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%NStC, kind=B8Ki) - 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(ParamData%PitManRat)) then + deallocate(ParamData%PitManRat) end if - if (allocated(MiscData%TStC)) then - LB(1:1) = lbound(MiscData%TStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%TStC, kind=B8Ki) - 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) + if (allocated(ParamData%TPitManS)) then + deallocate(ParamData%TPitManS) end if - if (allocated(MiscData%SStC)) then - LB(1:1) = lbound(MiscData%SStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%SStC, kind=B8Ki) + 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_DestroyMisc(MiscData%SStC(i1), ErrStat2, ErrMsg2) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(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, kind=B8Ki) - UB(1:2) = ubound(MiscData%u_BStC, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(MiscData%u_NStC, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(MiscData%u_TStC, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(MiscData%u_SStC, kind=B8Ki) - 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) + deallocate(ParamData%OutParam) end if - if (allocated(MiscData%y_BStC)) then - LB(1:1) = lbound(MiscData%y_BStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%y_BStC, kind=B8Ki) + 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_BStC(i1), ErrStat2, ErrMsg2) + call StC_DestroyParam(ParamData%BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%y_BStC) + deallocate(ParamData%BStC) end if - if (allocated(MiscData%y_NStC)) then - LB(1:1) = lbound(MiscData%y_NStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%y_NStC, kind=B8Ki) + 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_NStC(i1), ErrStat2, ErrMsg2) + call StC_DestroyParam(ParamData%NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%y_NStC) + deallocate(ParamData%NStC) end if - if (allocated(MiscData%y_TStC)) then - LB(1:1) = lbound(MiscData%y_TStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%y_TStC, kind=B8Ki) + 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_TStC(i1), ErrStat2, ErrMsg2) + call StC_DestroyParam(ParamData%TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%y_TStC) + deallocate(ParamData%TStC) end if - if (allocated(MiscData%y_SStC)) then - LB(1:1) = lbound(MiscData%y_SStC, kind=B8Ki) - UB(1:1) = ubound(MiscData%y_SStC, kind=B8Ki) + 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_DestroyOutput(MiscData%y_SStC(i1), ErrStat2, ErrMsg2) + call StC_DestroyParam(ParamData%SStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(MiscData%y_SStC) + 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 - call SrvD_DestroyModuleMapType(MiscData%SrvD_MeshMap, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine -subroutine SrvD_PackMisc(RF, Indata) +subroutine SrvD_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF - type(SrvD_MiscVarType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SrvD_PackMisc' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + 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%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, 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, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) - LB(1:1) = lbound(InData%BStC, kind=B8Ki) - UB(1:1) = ubound(InData%BStC, kind=B8Ki) + 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)) + call StC_PackParam(RF, InData%BStC(i1)) end do end if call RegPack(RF, allocated(InData%NStC)) if (allocated(InData%NStC)) then - call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%NStC, kind=B8Ki) - UB(1:1) = ubound(InData%NStC, kind=B8Ki) + 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)) + call StC_PackParam(RF, InData%NStC(i1)) end do end if call RegPack(RF, allocated(InData%TStC)) if (allocated(InData%TStC)) then - call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%TStC, kind=B8Ki) - UB(1:1) = ubound(InData%TStC, kind=B8Ki) + 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)) + call StC_PackParam(RF, InData%TStC(i1)) end do end if call RegPack(RF, allocated(InData%SStC)) if (allocated(InData%SStC)) then - call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%SStC, kind=B8Ki) - UB(1:1) = ubound(InData%SStC, kind=B8Ki) + 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)) + call StC_PackParam(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, kind=B8Ki), ubound(InData%u_BStC, kind=B8Ki)) - LB(1:2) = lbound(InData%u_BStC, kind=B8Ki) - UB(1:2) = ubound(InData%u_BStC, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%u_NStC, kind=B8Ki)) - LB(1:2) = lbound(InData%u_NStC, kind=B8Ki) - UB(1:2) = ubound(InData%u_NStC, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%u_TStC, kind=B8Ki)) - LB(1:2) = lbound(InData%u_TStC, kind=B8Ki) - UB(1:2) = ubound(InData%u_TStC, kind=B8Ki) - 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 - end if - call RegPack(RF, allocated(InData%u_SStC)) - if (allocated(InData%u_SStC)) then - call RegPackBounds(RF, 2, lbound(InData%u_SStC, kind=B8Ki), ubound(InData%u_SStC, kind=B8Ki)) - LB(1:2) = lbound(InData%u_SStC, kind=B8Ki) - UB(1:2) = ubound(InData%u_SStC, kind=B8Ki) - 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 - end if - call RegPack(RF, allocated(InData%y_BStC)) - if (allocated(InData%y_BStC)) then - call RegPackBounds(RF, 1, lbound(InData%y_BStC, kind=B8Ki), ubound(InData%y_BStC, kind=B8Ki)) - LB(1:1) = lbound(InData%y_BStC, kind=B8Ki) - UB(1:1) = ubound(InData%y_BStC, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%y_NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%y_NStC, kind=B8Ki) - UB(1:1) = ubound(InData%y_NStC, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%y_TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%y_TStC, kind=B8Ki) - UB(1:1) = ubound(InData%y_TStC, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%y_SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%y_SStC, kind=B8Ki) - UB(1:1) = ubound(InData%y_SStC, kind=B8Ki) - do i1 = LB(1), UB(1) - call StC_PackOutput(RF, InData%y_SStC(i1)) - 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 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(B8Ki) :: i1, i2 - integer(B8Ki) :: 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,1997 +4851,1703 @@ subroutine SrvD_UnPackMisc(RF, OutData) return end if do i1 = LB(1), UB(1) - call StC_UnpackMisc(RF, OutData%SStC(i1)) ! SStC + call StC_UnpackParam(RF, OutData%SStC(i1)) ! SStC end do end if - if (allocated(OutData%u_BStC)) deallocate(OutData%u_BStC) + 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_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 + 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_BStC(i1,i2)) ! u_BStC - end do - end do + else + OutData%Vars => null() end if - 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%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 - end if - do i1 = LB(1), UB(1) - call StC_UnpackOutput(RF, OutData%y_BStC(i1)) ! y_BStC - end do - 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 - end if - do i1 = LB(1), UB(1) - call StC_UnpackOutput(RF, OutData%y_NStC(i1)) ! y_NStC - end do - 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 - end if - do i1 = LB(1), UB(1) - call StC_UnpackOutput(RF, OutData%y_TStC(i1)) ! y_TStC - end do - 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 - 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 end subroutine -subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) - type(SrvD_ParameterType), intent(in) :: SrcParamData - type(SrvD_ParameterType), intent(inout) :: DstParamData +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(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SrvD_CopyParam' + character(*), parameter :: RoutineName = 'SrvD_CopyInput' 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BlPitchInit, kind=B8Ki) - if (.not. allocated(DstParamData%BlPitchInit)) then - allocate(DstParamData%BlPitchInit(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlPitchInit.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%BlPitchInit = SrcParamData%BlPitchInit - end if - if (allocated(SrcParamData%BlPitchF)) then - LB(1:1) = lbound(SrcParamData%BlPitchF, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BlPitchF, kind=B8Ki) - if (.not. allocated(DstParamData%BlPitchF)) then - allocate(DstParamData%BlPitchF(LB(1):UB(1)), stat=ErrStat2) + 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 DstParamData%BlPitchF.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BlPitch.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%BlPitchF = SrcParamData%BlPitchF + DstInputData%BlPitch = SrcInputData%BlPitch end if - if (allocated(SrcParamData%PitManRat)) then - LB(1:1) = lbound(SrcParamData%PitManRat, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%PitManRat, kind=B8Ki) - if (.not. allocated(DstParamData%PitManRat)) then - allocate(DstParamData%PitManRat(LB(1):UB(1)), stat=ErrStat2) + 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 DstParamData%PitManRat.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlPitchCom.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%PitManRat = SrcParamData%PitManRat + DstInputData%ExternalBlPitchCom = SrcInputData%ExternalBlPitchCom 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%TPitManS, kind=B8Ki) - if (.not. allocated(DstParamData%TPitManS)) then - allocate(DstParamData%TPitManS(LB(1):UB(1)), stat=ErrStat2) + 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 DstParamData%TPitManS.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalBlAirfoilCom.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%TPitManS = SrcParamData%TPitManS + DstInputData%ExternalBlAirfoilCom = SrcInputData%ExternalBlAirfoilCom 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%TBDepISp, kind=B8Ki) - if (.not. allocated(DstParamData%TBDepISp)) then - allocate(DstParamData%TBDepISp(LB(1):UB(1)), stat=ErrStat2) + 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 DstParamData%TBDepISp.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaL.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%TBDepISp = SrcParamData%TBDepISp + DstInputData%ExternalCableDeltaL = SrcInputData%ExternalCableDeltaL 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) - if (.not. allocated(DstParamData%OutParam)) then - allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + 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 DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%ExternalCableDeltaLdot.', 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 + DstInputData%ExternalCableDeltaLdot = SrcInputData%ExternalCableDeltaLdot 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%BStC, kind=B8Ki) - if (.not. allocated(DstParamData%BStC)) then - allocate(DstParamData%BStC(LB(1):UB(1)), stat=ErrStat2) + 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 DstParamData%BStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSC.', ErrStat, ErrMsg, RoutineName) return end if end if - do i1 = LB(1), UB(1) - call StC_CopyParam(SrcParamData%BStC(i1), DstParamData%BStC(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do + DstInputData%fromSC = SrcInputData%fromSC end if - if (allocated(SrcParamData%NStC)) then - LB(1:1) = lbound(SrcParamData%NStC, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NStC, kind=B8Ki) - if (.not. allocated(DstParamData%NStC)) then - allocate(DstParamData%NStC(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%NStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%fromSCglob.', 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%fromSCglob = SrcInputData%fromSCglob end if - if (allocated(SrcParamData%TStC)) then - LB(1:1) = lbound(SrcParamData%TStC, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%TStC, kind=B8Ki) - if (.not. allocated(DstParamData%TStC)) then - allocate(DstParamData%TStC(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%TStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%BStCMotionMesh.', 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 + 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%SStC)) then - LB(1:1) = lbound(SrcParamData%SStC, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%SStC, kind=B8Ki) - if (.not. allocated(DstParamData%SStC)) then - allocate(DstParamData%SStC(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%SStC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%NStCMotionMesh.', 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 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%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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%StCMeasNumPerChan, kind=B8Ki) - if (.not. allocated(DstParamData%StCMeasNumPerChan)) then - allocate(DstParamData%StCMeasNumPerChan(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%StCMeasNumPerChan.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%StCMeasNumPerChan = SrcParamData%StCMeasNumPerChan - end if - DstParamData%UseSC = SrcParamData%UseSC - if (allocated(SrcParamData%Jac_u_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_u_indx)) then - allocate(DstParamData%Jac_u_indx(LB(1):UB(1),LB(2):UB(2)), 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%Jac_u_indx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%TStCMotionMesh.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%TStCMotionMesh(i1), DstInputData%TStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcParamData%Jac_x_indx)) then - LB(1:2) = lbound(SrcParamData%Jac_x_indx, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_x_indx, kind=B8Ki) - if (.not. allocated(DstParamData%Jac_x_indx)) then - allocate(DstParamData%Jac_x_indx(LB(1):UB(1),LB(2):UB(2)), 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%Jac_x_indx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%SStCMotionMesh.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%Jac_x_indx = SrcParamData%Jac_x_indx + do i1 = LB(1), UB(1) + call MeshCopy(SrcInputData%SStCMotionMesh(i1), DstInputData%SStCMotionMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do end if - if (allocated(SrcParamData%du)) then - LB(1:1) = lbound(SrcParamData%du, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) - if (.not. allocated(DstParamData%du)) then - allocate(DstParamData%du(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%du.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%LidSpeed.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%du = SrcParamData%du + DstInputData%LidSpeed = SrcInputData%LidSpeed end if - if (allocated(SrcParamData%dx)) then - LB(1:1) = lbound(SrcParamData%dx, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%dx, kind=B8Ki) - if (.not. allocated(DstParamData%dx)) then - allocate(DstParamData%dx(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%dx.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsX.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%dx = SrcParamData%dx + DstInputData%MsrPositionsX = SrcInputData%MsrPositionsX 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, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_u, kind=B8Ki) - 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 (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%Jac_Idx_BStC_u.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsY.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%Jac_Idx_BStC_u = SrcParamData%Jac_Idx_BStC_u + DstInputData%MsrPositionsY = SrcInputData%MsrPositionsY end if - if (allocated(SrcParamData%Jac_Idx_NStC_u)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_u, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_u, kind=B8Ki) - 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 (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%Jac_Idx_NStC_u.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%MsrPositionsZ.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%Jac_Idx_NStC_u = SrcParamData%Jac_Idx_NStC_u + DstInputData%MsrPositionsZ = SrcInputData%MsrPositionsZ end if - if (allocated(SrcParamData%Jac_Idx_TStC_u)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_u, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_u, kind=B8Ki) - 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 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_Idx_SStC_u)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_u, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_u, kind=B8Ki) - 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 + if (allocated(InputData%ExternalBlPitchCom)) then + deallocate(InputData%ExternalBlPitchCom) end if - if (allocated(SrcParamData%Jac_Idx_BStC_x)) then - LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_x, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_x, kind=B8Ki) - 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 + if (allocated(InputData%ExternalBlAirfoilCom)) then + deallocate(InputData%ExternalBlAirfoilCom) end if - if (allocated(SrcParamData%Jac_Idx_NStC_x)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_x, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_x, kind=B8Ki) - 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 + if (allocated(InputData%ExternalCableDeltaL)) then + deallocate(InputData%ExternalCableDeltaL) end if - if (allocated(SrcParamData%Jac_Idx_TStC_x)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_TStC_x, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_x, kind=B8Ki) - 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 + if (allocated(InputData%ExternalCableDeltaLdot)) then + deallocate(InputData%ExternalCableDeltaLdot) end if - if (allocated(SrcParamData%Jac_Idx_SStC_x)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_SStC_x, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_x, kind=B8Ki) - 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 + if (allocated(InputData%fromSC)) then + deallocate(InputData%fromSC) end if - if (allocated(SrcParamData%Jac_Idx_BStC_y)) then - LB(1:3) = lbound(SrcParamData%Jac_Idx_BStC_y, kind=B8Ki) - UB(1:3) = ubound(SrcParamData%Jac_Idx_BStC_y, kind=B8Ki) - 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 + if (allocated(InputData%fromSCglob)) then + deallocate(InputData%fromSCglob) end if - if (allocated(SrcParamData%Jac_Idx_NStC_y)) then - LB(1:2) = lbound(SrcParamData%Jac_Idx_NStC_y, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_NStC_y, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_TStC_y, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_Idx_SStC_y, kind=B8Ki) - 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(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) - do i1 = LB(1), UB(1) - call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%OutParam) - end if - call FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2) + call MeshDestroy( InputData%PtfmMotionMesh, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (allocated(ParamData%BStC)) then - LB(1:1) = lbound(ParamData%BStC, kind=B8Ki) - UB(1:1) = ubound(ParamData%BStC, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(ParamData%NStC, kind=B8Ki) + 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, kind=B8Ki) - UB(1:1) = ubound(ParamData%TStC, kind=B8Ki) + 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, kind=B8Ki) - UB(1:1) = ubound(ParamData%SStC, kind=B8Ki) + 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) - 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) + deallocate(InputData%SStCMotionMesh) end if - if (allocated(ParamData%Jac_Idx_BStC_y)) then - deallocate(ParamData%Jac_Idx_BStC_y) + if (allocated(InputData%LidSpeed)) then + deallocate(InputData%LidSpeed) end if - if (allocated(ParamData%Jac_Idx_NStC_y)) then - deallocate(ParamData%Jac_Idx_NStC_y) + if (allocated(InputData%MsrPositionsX)) then + deallocate(InputData%MsrPositionsX) end if - if (allocated(ParamData%Jac_Idx_TStC_y)) then - deallocate(ParamData%Jac_Idx_TStC_y) + if (allocated(InputData%MsrPositionsY)) then + deallocate(InputData%MsrPositionsY) 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(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: 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, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) - 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, kind=B8Ki), ubound(InData%BStC, kind=B8Ki)) - LB(1:1) = lbound(InData%BStC, kind=B8Ki) - UB(1:1) = ubound(InData%BStC, kind=B8Ki) - do i1 = LB(1), UB(1) - call StC_PackParam(RF, InData%BStC(i1)) - end do - end if - call RegPack(RF, allocated(InData%NStC)) - if (allocated(InData%NStC)) then - call RegPackBounds(RF, 1, lbound(InData%NStC, kind=B8Ki), ubound(InData%NStC, kind=B8Ki)) - LB(1:1) = lbound(InData%NStC, kind=B8Ki) - UB(1:1) = ubound(InData%NStC, kind=B8Ki) - do i1 = LB(1), UB(1) - call StC_PackParam(RF, InData%NStC(i1)) - end do - end if - call RegPack(RF, allocated(InData%TStC)) - if (allocated(InData%TStC)) then - call RegPackBounds(RF, 1, lbound(InData%TStC, kind=B8Ki), ubound(InData%TStC, kind=B8Ki)) - LB(1:1) = lbound(InData%TStC, kind=B8Ki) - UB(1:1) = ubound(InData%TStC, kind=B8Ki) - do i1 = LB(1), UB(1) - call StC_PackParam(RF, InData%TStC(i1)) - end do - end if - call RegPack(RF, allocated(InData%SStC)) - if (allocated(InData%SStC)) then - call RegPackBounds(RF, 1, lbound(InData%SStC, kind=B8Ki), ubound(InData%SStC, kind=B8Ki)) - LB(1:1) = lbound(InData%SStC, kind=B8Ki) - UB(1:1) = ubound(InData%SStC, kind=B8Ki) - do i1 = LB(1), UB(1) - call StC_PackParam(RF, InData%SStC(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) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine SrvD_UnPackParam(RF, OutData) - type(RegFile), intent(inout) :: RF - type(SrvD_ParameterType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SrvD_UnPackParam' - integer(B8Ki) :: i1, i2, i3 - integer(B8Ki) :: LB(3), UB(3) - 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 + 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%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 NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + call MeshPack(RF, InData%NStCMotionMesh(i1)) 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 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 MeshPack(RF, InData%TStCMotionMesh(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) + do i1 = LB(1), UB(1) + call MeshPack(RF, InData%SStCMotionMesh(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) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SrvD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + 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 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 - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + 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, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%BlPitch, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%ExternalBlPitchCom, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%ExternalBlAirfoilCom, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%ExternalCableDeltaL, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%ExternalCableDeltaLdot, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%fromSC, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%fromSCglob, kind=B8Ki) - 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 + DstOutputData%CableDeltaLdot = SrcOutputData%CableDeltaLdot 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, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%BStCMotionMesh, kind=B8Ki) - if (.not. allocated(DstInputData%BStCMotionMesh)) then - allocate(DstInputData%BStCMotionMesh(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + 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, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%NStCMotionMesh, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%TStCMotionMesh, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%SStCMotionMesh, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%LidSpeed, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%MsrPositionsX, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%MsrPositionsY, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%MsrPositionsZ, kind=B8Ki) - 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(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + 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, kind=B8Ki) - UB(1:2) = ubound(InputData%BStCMotionMesh, kind=B8Ki) + 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, kind=B8Ki) - UB(1:1) = ubound(InputData%NStCMotionMesh, kind=B8Ki) + 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, kind=B8Ki) - UB(1:1) = ubound(InputData%TStCMotionMesh, kind=B8Ki) + 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, kind=B8Ki) - UB(1:1) = ubound(InputData%SStCMotionMesh, kind=B8Ki) + 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' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + 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, kind=B8Ki), ubound(InData%BStCMotionMesh, kind=B8Ki)) - LB(1:2) = lbound(InData%BStCMotionMesh, kind=B8Ki) - UB(1:2) = ubound(InData%BStCMotionMesh, kind=B8Ki) + 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, kind=B8Ki), ubound(InData%NStCMotionMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%NStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(InData%NStCMotionMesh, kind=B8Ki) + 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, kind=B8Ki), ubound(InData%TStCMotionMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%TStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(InData%TStCMotionMesh, kind=B8Ki) + 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, kind=B8Ki), ubound(InData%SStCMotionMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%SStCMotionMesh, kind=B8Ki) - UB(1:1) = ubound(InData%SStCMotionMesh, kind=B8Ki) + 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' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + 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%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 + call RegUnpackAlloc(RF, OutData%toSC); 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 +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(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SrvD_CopyOutput' + character(*), parameter :: RoutineName = 'SrvD_CopyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) - if (.not. allocated(DstOutputData%WriteOutput)) then - allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + 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 DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%xd_BlPitchFilter.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%WriteOutput = SrcOutputData%WriteOutput + DstMiscData%xd_BlPitchFilter = SrcMiscData%xd_BlPitchFilter end if - if (allocated(SrcOutputData%BlPitchCom)) then - LB(1:1) = lbound(SrcOutputData%BlPitchCom, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BlPitchCom, kind=B8Ki) - if (.not. allocated(DstOutputData%BlPitchCom)) then - allocate(DstOutputData%BlPitchCom(LB(1):UB(1)), stat=ErrStat2) + 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 DstOutputData%BlPitchCom.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BStC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%BlPitchCom = SrcOutputData%BlPitchCom + 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(SrcOutputData%BlAirfoilCom)) then - LB(1:1) = lbound(SrcOutputData%BlAirfoilCom, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BlAirfoilCom, kind=B8Ki) - if (.not. allocated(DstOutputData%BlAirfoilCom)) then - allocate(DstOutputData%BlAirfoilCom(LB(1):UB(1)), stat=ErrStat2) + 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 DstOutputData%BlAirfoilCom.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%NStC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%BlAirfoilCom = SrcOutputData%BlAirfoilCom + 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 - 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, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%TBDrCon, kind=B8Ki) - if (.not. allocated(DstOutputData%TBDrCon)) then - allocate(DstOutputData%TBDrCon(LB(1):UB(1)), stat=ErrStat2) + 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 DstOutputData%TBDrCon.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%TStC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%TBDrCon = SrcOutputData%TBDrCon + 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(SrcOutputData%CableDeltaL)) then - LB(1:1) = lbound(SrcOutputData%CableDeltaL, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%CableDeltaL, kind=B8Ki) - if (.not. allocated(DstOutputData%CableDeltaL)) then - allocate(DstOutputData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) + 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 DstOutputData%CableDeltaL.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SStC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%CableDeltaL = SrcOutputData%CableDeltaL + 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(SrcOutputData%CableDeltaLdot)) then - LB(1:1) = lbound(SrcOutputData%CableDeltaLdot, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%CableDeltaLdot, kind=B8Ki) - if (.not. allocated(DstOutputData%CableDeltaLdot)) then - allocate(DstOutputData%CableDeltaLdot(LB(1):UB(1)), stat=ErrStat2) + 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 DstOutputData%CableDeltaLdot.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_BStC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%CableDeltaLdot = SrcOutputData%CableDeltaLdot + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_BStC(i1,i2), DstMiscData%u_BStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcMiscData%u_NStC)) then + LB(1:2) = lbound(SrcMiscData%u_NStC) + UB(1:2) = ubound(SrcMiscData%u_NStC) + if (.not. allocated(DstMiscData%u_NStC)) then + allocate(DstMiscData%u_NStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_NStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_NStC(i1,i2), DstMiscData%u_NStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do + end if + if (allocated(SrcMiscData%u_TStC)) then + LB(1:2) = lbound(SrcMiscData%u_TStC) + UB(1:2) = ubound(SrcMiscData%u_TStC) + if (.not. allocated(DstMiscData%u_TStC)) then + allocate(DstMiscData%u_TStC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_TStC.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_CopyInput(SrcMiscData%u_TStC(i1,i2), DstMiscData%u_TStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end do end if - if (allocated(SrcOutputData%BStCLoadMesh)) then - LB(1:2) = lbound(SrcOutputData%BStCLoadMesh, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%BStCLoadMesh, kind=B8Ki) - if (.not. allocated(DstOutputData%BStCLoadMesh)) then - allocate(DstOutputData%BStCLoadMesh(LB(1):UB(1),LB(2):UB(2)), 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%BStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_SStC.', ErrStat, ErrMsg, RoutineName) return end if end if do i2 = LB(2), UB(2) do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%BStCLoadMesh(i1,i2), DstOutputData%BStCLoadMesh(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + call StC_CopyInput(SrcMiscData%u_SStC(i1,i2), DstMiscData%u_SStC(i1,i2), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end do end do end if - if (allocated(SrcOutputData%NStCLoadMesh)) then - LB(1:1) = lbound(SrcOutputData%NStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%NStCLoadMesh, kind=B8Ki) - if (.not. allocated(DstOutputData%NStCLoadMesh)) then - allocate(DstOutputData%NStCLoadMesh(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%NStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_BStC.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%NStCLoadMesh(i1), DstOutputData%NStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call 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%TStCLoadMesh)) then - LB(1:1) = lbound(SrcOutputData%TStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%TStCLoadMesh, kind=B8Ki) - if (.not. allocated(DstOutputData%TStCLoadMesh)) then - allocate(DstOutputData%TStCLoadMesh(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%TStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_NStC.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%TStCLoadMesh(i1), DstOutputData%TStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call 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%SStCLoadMesh)) then - LB(1:1) = lbound(SrcOutputData%SStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%SStCLoadMesh, kind=B8Ki) - if (.not. allocated(DstOutputData%SStCLoadMesh)) then - allocate(DstOutputData%SStCLoadMesh(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%SStCLoadMesh.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_TStC.', ErrStat, ErrMsg, RoutineName) return end if end if do i1 = LB(1), UB(1) - call MeshCopy(SrcOutputData%SStCLoadMesh(i1), DstOutputData%SStCLoadMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + call 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%toSC)) then - LB(1:1) = lbound(SrcOutputData%toSC, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%toSC, kind=B8Ki) - if (.not. allocated(DstOutputData%toSC)) then - allocate(DstOutputData%toSC(LB(1):UB(1)), 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%toSC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%y_SStC.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%toSC = SrcOutputData%toSC + 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_DestroyOutput(OutputData, ErrStat, ErrMsg) - type(SrvD_OutputType), intent(inout) :: OutputData +subroutine SrvD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SrvD_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SrvD_DestroyOutput' + character(*), parameter :: RoutineName = 'SrvD_DestroyMisc' ErrStat = ErrID_None ErrMsg = '' - if (allocated(OutputData%WriteOutput)) then - deallocate(OutputData%WriteOutput) + 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(OutputData%BlPitchCom)) then - deallocate(OutputData%BlPitchCom) + 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(OutputData%BlAirfoilCom)) then - deallocate(OutputData%BlAirfoilCom) + 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(OutputData%TBDrCon)) then - deallocate(OutputData%TBDrCon) + 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(OutputData%CableDeltaL)) then - deallocate(OutputData%CableDeltaL) + 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(OutputData%CableDeltaLdot)) then - deallocate(OutputData%CableDeltaLdot) + 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(OutputData%BStCLoadMesh)) then - LB(1:2) = lbound(OutputData%BStCLoadMesh, kind=B8Ki) - UB(1:2) = ubound(OutputData%BStCLoadMesh, kind=B8Ki) + 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 MeshDestroy( OutputData%BStCLoadMesh(i1,i2), ErrStat2, ErrMsg2) + call StC_DestroyInput(MiscData%u_NStC(i1,i2), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do end do - deallocate(OutputData%BStCLoadMesh) + deallocate(MiscData%u_NStC) end if - if (allocated(OutputData%NStCLoadMesh)) then - LB(1:1) = lbound(OutputData%NStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%NStCLoadMesh, kind=B8Ki) + if (allocated(MiscData%u_TStC)) then + LB(1:2) = lbound(MiscData%u_TStC) + UB(1:2) = ubound(MiscData%u_TStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_TStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_TStC) + end if + if (allocated(MiscData%u_SStC)) then + LB(1:2) = lbound(MiscData%u_SStC) + UB(1:2) = ubound(MiscData%u_SStC) + do i2 = LB(2), UB(2) + do i1 = LB(1), UB(1) + call StC_DestroyInput(MiscData%u_SStC(i1,i2), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + end do + deallocate(MiscData%u_SStC) + end if + if (allocated(MiscData%y_BStC)) then + LB(1:1) = lbound(MiscData%y_BStC) + UB(1:1) = ubound(MiscData%y_BStC) do i1 = LB(1), UB(1) - call MeshDestroy( OutputData%NStCLoadMesh(i1), ErrStat2, ErrMsg2) + call StC_DestroyOutput(MiscData%y_BStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(OutputData%NStCLoadMesh) + deallocate(MiscData%y_BStC) end if - if (allocated(OutputData%TStCLoadMesh)) then - LB(1:1) = lbound(OutputData%TStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%TStCLoadMesh, kind=B8Ki) + 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 MeshDestroy( OutputData%TStCLoadMesh(i1), ErrStat2, ErrMsg2) + call StC_DestroyOutput(MiscData%y_NStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(OutputData%TStCLoadMesh) + deallocate(MiscData%y_NStC) end if - if (allocated(OutputData%SStCLoadMesh)) then - LB(1:1) = lbound(OutputData%SStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%SStCLoadMesh, kind=B8Ki) + 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 MeshDestroy( OutputData%SStCLoadMesh(i1), ErrStat2, ErrMsg2) + call StC_DestroyOutput(MiscData%y_TStC(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do - deallocate(OutputData%SStCLoadMesh) + deallocate(MiscData%y_TStC) end if - if (allocated(OutputData%toSC)) then - deallocate(OutputData%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_PackOutput(RF, Indata) +subroutine SrvD_PackMisc(RF, Indata) type(RegFile), intent(inout) :: RF - type(SrvD_OutputType), intent(in) :: InData - character(*), parameter :: RoutineName = 'SrvD_PackOutput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + 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 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, kind=B8Ki), ubound(InData%BStCLoadMesh, kind=B8Ki)) - LB(1:2) = lbound(InData%BStCLoadMesh, kind=B8Ki) - UB(1:2) = ubound(InData%BStCLoadMesh, kind=B8Ki) + 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 + 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 + 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 + 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 + 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 + 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 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, kind=B8Ki), ubound(InData%NStCLoadMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%NStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(InData%NStCLoadMesh, kind=B8Ki) + 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 MeshPack(RF, InData%NStCLoadMesh(i1)) + call StC_PackOutput(RF, InData%y_BStC(i1)) end do end if - call RegPack(RF, allocated(InData%TStCLoadMesh)) - if (allocated(InData%TStCLoadMesh)) then - call RegPackBounds(RF, 1, lbound(InData%TStCLoadMesh, kind=B8Ki), ubound(InData%TStCLoadMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%TStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(InData%TStCLoadMesh, kind=B8Ki) + 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%TStCLoadMesh(i1)) + call StC_PackOutput(RF, InData%y_NStC(i1)) end do end if - call RegPack(RF, allocated(InData%SStCLoadMesh)) - if (allocated(InData%SStCLoadMesh)) then - call RegPackBounds(RF, 1, lbound(InData%SStCLoadMesh, kind=B8Ki), ubound(InData%SStCLoadMesh, kind=B8Ki)) - LB(1:1) = lbound(InData%SStCLoadMesh, kind=B8Ki) - UB(1:1) = ubound(InData%SStCLoadMesh, kind=B8Ki) + 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%SStCLoadMesh(i1)) + call StC_PackOutput(RF, InData%y_TStC(i1)) end do end if - call RegPackAlloc(RF, InData%toSC) + 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) + 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' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + 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) @@ -6454,7 +6650,7 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN - DO i1 = LBOUND(u_out%BlPitch,1, kind=B8Ki),UBOUND(u_out%BlPitch,1, kind=B8Ki) + do i1 = lbound(u_out%BlPitch,1),ubound(u_out%BlPitch,1) CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) END DO END IF ! check if allocated @@ -6466,7 +6662,7 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) u_out%ExternalYawRateCom = a1*u1%ExternalYawRateCom + a2*u2%ExternalYawRateCom IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN - DO i1 = LBOUND(u_out%ExternalBlPitchCom,1, kind=B8Ki),UBOUND(u_out%ExternalBlPitchCom,1, kind=B8Ki) + do i1 = lbound(u_out%ExternalBlPitchCom,1),ubound(u_out%ExternalBlPitchCom,1) CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) END DO END IF ! check if allocated @@ -6515,27 +6711,27 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL MeshExtrapInterp1(u1%PtfmMotionMesh, u2%PtfmMotionMesh, tin, u_out%PtfmMotionMesh, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%BStCMotionMesh) .AND. ALLOCATED(u1%BStCMotionMesh)) THEN - DO i2 = LBOUND(u_out%BStCMotionMesh,2, kind=B8Ki),UBOUND(u_out%BStCMotionMesh,2, kind=B8Ki) - DO i1 = LBOUND(u_out%BStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%BStCMotionMesh,1, kind=B8Ki) + do i2 = lbound(u_out%BStCMotionMesh,2),ubound(u_out%BStCMotionMesh,2) + do i1 = lbound(u_out%BStCMotionMesh,1),ubound(u_out%BStCMotionMesh,1) CALL MeshExtrapInterp1(u1%BStCMotionMesh(i1,i2), u2%BStCMotionMesh(i1,i2), tin, u_out%BStCMotionMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END DO END IF ! check if allocated IF (ALLOCATED(u_out%NStCMotionMesh) .AND. ALLOCATED(u1%NStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%NStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%NStCMotionMesh,1, kind=B8Ki) + do i1 = lbound(u_out%NStCMotionMesh,1),ubound(u_out%NStCMotionMesh,1) CALL MeshExtrapInterp1(u1%NStCMotionMesh(i1), u2%NStCMotionMesh(i1), tin, u_out%NStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(u_out%TStCMotionMesh) .AND. ALLOCATED(u1%TStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%TStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%TStCMotionMesh,1, kind=B8Ki) + do i1 = lbound(u_out%TStCMotionMesh,1),ubound(u_out%TStCMotionMesh,1) CALL MeshExtrapInterp1(u1%TStCMotionMesh(i1), u2%TStCMotionMesh(i1), tin, u_out%TStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(u_out%SStCMotionMesh) .AND. ALLOCATED(u1%SStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%SStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%SStCMotionMesh,1, kind=B8Ki) + do i1 = lbound(u_out%SStCMotionMesh,1),ubound(u_out%SStCMotionMesh,1) CALL MeshExtrapInterp1(u1%SStCMotionMesh(i1), u2%SStCMotionMesh(i1), tin, u_out%SStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -6612,7 +6808,7 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN - DO i1 = LBOUND(u_out%BlPitch,1, kind=B8Ki),UBOUND(u_out%BlPitch,1, kind=B8Ki) + do i1 = lbound(u_out%BlPitch,1),ubound(u_out%BlPitch,1) CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), u3%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) END DO END IF ! check if allocated @@ -6624,7 +6820,7 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, u3%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) u_out%ExternalYawRateCom = a1*u1%ExternalYawRateCom + a2*u2%ExternalYawRateCom + a3*u3%ExternalYawRateCom IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN - DO i1 = LBOUND(u_out%ExternalBlPitchCom,1, kind=B8Ki),UBOUND(u_out%ExternalBlPitchCom,1, kind=B8Ki) + do i1 = lbound(u_out%ExternalBlPitchCom,1),ubound(u_out%ExternalBlPitchCom,1) CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), u3%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) END DO END IF ! check if allocated @@ -6673,27 +6869,27 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL MeshExtrapInterp2(u1%PtfmMotionMesh, u2%PtfmMotionMesh, u3%PtfmMotionMesh, tin, u_out%PtfmMotionMesh, tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%BStCMotionMesh) .AND. ALLOCATED(u1%BStCMotionMesh)) THEN - DO i2 = LBOUND(u_out%BStCMotionMesh,2, kind=B8Ki),UBOUND(u_out%BStCMotionMesh,2, kind=B8Ki) - DO i1 = LBOUND(u_out%BStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%BStCMotionMesh,1, kind=B8Ki) + do i2 = lbound(u_out%BStCMotionMesh,2),ubound(u_out%BStCMotionMesh,2) + do i1 = lbound(u_out%BStCMotionMesh,1),ubound(u_out%BStCMotionMesh,1) CALL MeshExtrapInterp2(u1%BStCMotionMesh(i1,i2), u2%BStCMotionMesh(i1,i2), u3%BStCMotionMesh(i1,i2), tin, u_out%BStCMotionMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END DO END IF ! check if allocated IF (ALLOCATED(u_out%NStCMotionMesh) .AND. ALLOCATED(u1%NStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%NStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%NStCMotionMesh,1, kind=B8Ki) + do i1 = lbound(u_out%NStCMotionMesh,1),ubound(u_out%NStCMotionMesh,1) CALL MeshExtrapInterp2(u1%NStCMotionMesh(i1), u2%NStCMotionMesh(i1), u3%NStCMotionMesh(i1), tin, u_out%NStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(u_out%TStCMotionMesh) .AND. ALLOCATED(u1%TStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%TStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%TStCMotionMesh,1, kind=B8Ki) + do i1 = lbound(u_out%TStCMotionMesh,1),ubound(u_out%TStCMotionMesh,1) CALL MeshExtrapInterp2(u1%TStCMotionMesh(i1), u2%TStCMotionMesh(i1), u3%TStCMotionMesh(i1), tin, u_out%TStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(u_out%SStCMotionMesh) .AND. ALLOCATED(u1%SStCMotionMesh)) THEN - DO i1 = LBOUND(u_out%SStCMotionMesh,1, kind=B8Ki),UBOUND(u_out%SStCMotionMesh,1, kind=B8Ki) + do i1 = lbound(u_out%SStCMotionMesh,1),ubound(u_out%SStCMotionMesh,1) CALL MeshExtrapInterp2(u1%SStCMotionMesh(i1), u2%SStCMotionMesh(i1), u3%SStCMotionMesh(i1), tin, u_out%SStCMotionMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -6815,7 +7011,7 @@ SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput END IF ! check if allocated IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN - DO i1 = LBOUND(y_out%BlPitchCom,1, kind=B8Ki),UBOUND(y_out%BlPitchCom,1, kind=B8Ki) + do i1 = lbound(y_out%BlPitchCom,1),ubound(y_out%BlPitchCom,1) CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) END DO END IF ! check if allocated @@ -6838,27 +7034,27 @@ SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs y_out%CableDeltaLdot = a1*y1%CableDeltaLdot + a2*y2%CableDeltaLdot END IF ! check if allocated IF (ALLOCATED(y_out%BStCLoadMesh) .AND. ALLOCATED(y1%BStCLoadMesh)) THEN - DO i2 = LBOUND(y_out%BStCLoadMesh,2, kind=B8Ki),UBOUND(y_out%BStCLoadMesh,2, kind=B8Ki) - DO i1 = LBOUND(y_out%BStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%BStCLoadMesh,1, kind=B8Ki) + do i2 = lbound(y_out%BStCLoadMesh,2),ubound(y_out%BStCLoadMesh,2) + do i1 = lbound(y_out%BStCLoadMesh,1),ubound(y_out%BStCLoadMesh,1) CALL MeshExtrapInterp1(y1%BStCLoadMesh(i1,i2), y2%BStCLoadMesh(i1,i2), tin, y_out%BStCLoadMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END DO END IF ! check if allocated IF (ALLOCATED(y_out%NStCLoadMesh) .AND. ALLOCATED(y1%NStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%NStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%NStCLoadMesh,1, kind=B8Ki) + do i1 = lbound(y_out%NStCLoadMesh,1),ubound(y_out%NStCLoadMesh,1) CALL MeshExtrapInterp1(y1%NStCLoadMesh(i1), y2%NStCLoadMesh(i1), tin, y_out%NStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%TStCLoadMesh) .AND. ALLOCATED(y1%TStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%TStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%TStCLoadMesh,1, kind=B8Ki) + do i1 = lbound(y_out%TStCLoadMesh,1),ubound(y_out%TStCLoadMesh,1) CALL MeshExtrapInterp1(y1%TStCLoadMesh(i1), y2%TStCLoadMesh(i1), tin, y_out%TStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%SStCLoadMesh) .AND. ALLOCATED(y1%SStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%SStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%SStCLoadMesh,1, kind=B8Ki) + do i1 = lbound(y_out%SStCLoadMesh,1),ubound(y_out%SStCLoadMesh,1) CALL MeshExtrapInterp1(y1%SStCLoadMesh(i1), y2%SStCLoadMesh(i1), tin, y_out%SStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -6929,7 +7125,7 @@ SUBROUTINE SrvD_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 IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN - DO i1 = LBOUND(y_out%BlPitchCom,1, kind=B8Ki),UBOUND(y_out%BlPitchCom,1, kind=B8Ki) + do i1 = lbound(y_out%BlPitchCom,1),ubound(y_out%BlPitchCom,1) CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), y3%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) END DO END IF ! check if allocated @@ -6952,27 +7148,27 @@ SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E y_out%CableDeltaLdot = a1*y1%CableDeltaLdot + a2*y2%CableDeltaLdot + a3*y3%CableDeltaLdot END IF ! check if allocated IF (ALLOCATED(y_out%BStCLoadMesh) .AND. ALLOCATED(y1%BStCLoadMesh)) THEN - DO i2 = LBOUND(y_out%BStCLoadMesh,2, kind=B8Ki),UBOUND(y_out%BStCLoadMesh,2, kind=B8Ki) - DO i1 = LBOUND(y_out%BStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%BStCLoadMesh,1, kind=B8Ki) + do i2 = lbound(y_out%BStCLoadMesh,2),ubound(y_out%BStCLoadMesh,2) + do i1 = lbound(y_out%BStCLoadMesh,1),ubound(y_out%BStCLoadMesh,1) CALL MeshExtrapInterp2(y1%BStCLoadMesh(i1,i2), y2%BStCLoadMesh(i1,i2), y3%BStCLoadMesh(i1,i2), tin, y_out%BStCLoadMesh(i1,i2), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END DO END IF ! check if allocated IF (ALLOCATED(y_out%NStCLoadMesh) .AND. ALLOCATED(y1%NStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%NStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%NStCLoadMesh,1, kind=B8Ki) + do i1 = lbound(y_out%NStCLoadMesh,1),ubound(y_out%NStCLoadMesh,1) CALL MeshExtrapInterp2(y1%NStCLoadMesh(i1), y2%NStCLoadMesh(i1), y3%NStCLoadMesh(i1), tin, y_out%NStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%TStCLoadMesh) .AND. ALLOCATED(y1%TStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%TStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%TStCLoadMesh,1, kind=B8Ki) + do i1 = lbound(y_out%TStCLoadMesh,1),ubound(y_out%TStCLoadMesh,1) CALL MeshExtrapInterp2(y1%TStCLoadMesh(i1), y2%TStCLoadMesh(i1), y3%TStCLoadMesh(i1), tin, y_out%TStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO END IF ! check if allocated IF (ALLOCATED(y_out%SStCLoadMesh) .AND. ALLOCATED(y1%SStCLoadMesh)) THEN - DO i1 = LBOUND(y_out%SStCLoadMesh,1, kind=B8Ki),UBOUND(y_out%SStCLoadMesh,1, kind=B8Ki) + do i1 = lbound(y_out%SStCLoadMesh,1),ubound(y_out%SStCLoadMesh,1) CALL MeshExtrapInterp2(y1%SStCLoadMesh(i1), y2%SStCLoadMesh(i1), y3%SStCLoadMesh(i1), tin, y_out%SStCLoadMesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -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 b11f6b1805..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 @@ -256,7 +267,7 @@ subroutine StC_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'StC_CopyInputFile' ErrStat = ErrID_None @@ -323,8 +334,8 @@ subroutine StC_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%NKInpSt = SrcInputFileData%NKInpSt DstInputFileData%StC_F_TBL_FILE = SrcInputFileData%StC_F_TBL_FILE if (allocated(SrcInputFileData%F_TBL)) then - LB(1:2) = lbound(SrcInputFileData%F_TBL, kind=B8Ki) - UB(1:2) = ubound(SrcInputFileData%F_TBL, kind=B8Ki) + LB(1:2) = lbound(SrcInputFileData%F_TBL) + UB(1:2) = ubound(SrcInputFileData%F_TBL) if (.not. allocated(DstInputFileData%F_TBL)) then allocate(DstInputFileData%F_TBL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -337,8 +348,8 @@ subroutine StC_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%PrescribedForcesCoordSys = SrcInputFileData%PrescribedForcesCoordSys DstInputFileData%PrescribedForcesFile = SrcInputFileData%PrescribedForcesFile if (allocated(SrcInputFileData%StC_PrescribedForce)) then - LB(1:2) = lbound(SrcInputFileData%StC_PrescribedForce, kind=B8Ki) - UB(1:2) = ubound(SrcInputFileData%StC_PrescribedForce, kind=B8Ki) + LB(1:2) = lbound(SrcInputFileData%StC_PrescribedForce) + UB(1:2) = ubound(SrcInputFileData%StC_PrescribedForce) if (.not. allocated(DstInputFileData%StC_PrescribedForce)) then allocate(DstInputFileData%StC_PrescribedForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -349,8 +360,8 @@ subroutine StC_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%StC_PrescribedForce = SrcInputFileData%StC_PrescribedForce end if if (allocated(SrcInputFileData%StC_CChan)) then - LB(1:1) = lbound(SrcInputFileData%StC_CChan, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%StC_CChan, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%StC_CChan) + UB(1:1) = ubound(SrcInputFileData%StC_CChan) if (.not. allocated(DstInputFileData%StC_CChan)) then allocate(DstInputFileData%StC_CChan(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -458,7 +469,7 @@ subroutine StC_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(StC_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackInputFile' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -536,7 +547,7 @@ subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'StC_CopyInitInput' @@ -547,8 +558,8 @@ subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%Gravity = SrcInitInputData%Gravity DstInitInputData%NumMeshPts = SrcInitInputData%NumMeshPts if (allocated(SrcInitInputData%InitRefPos)) then - LB(1:2) = lbound(SrcInitInputData%InitRefPos, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%InitRefPos, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%InitRefPos) + UB(1:2) = ubound(SrcInitInputData%InitRefPos) if (.not. allocated(DstInitInputData%InitRefPos)) then allocate(DstInitInputData%InitRefPos(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -559,8 +570,8 @@ subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%InitRefPos = SrcInitInputData%InitRefPos end if if (allocated(SrcInitInputData%InitTransDisp)) then - LB(1:2) = lbound(SrcInitInputData%InitTransDisp, kind=B8Ki) - UB(1:2) = ubound(SrcInitInputData%InitTransDisp, kind=B8Ki) + LB(1:2) = lbound(SrcInitInputData%InitTransDisp) + UB(1:2) = ubound(SrcInitInputData%InitTransDisp) if (.not. allocated(DstInitInputData%InitTransDisp)) then allocate(DstInitInputData%InitTransDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -571,8 +582,8 @@ subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%InitTransDisp = SrcInitInputData%InitTransDisp end if if (allocated(SrcInitInputData%InitOrient)) then - LB(1:3) = lbound(SrcInitInputData%InitOrient, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%InitOrient, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%InitOrient) + UB(1:3) = ubound(SrcInitInputData%InitOrient) if (.not. allocated(DstInitInputData%InitOrient)) then allocate(DstInitInputData%InitOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -583,8 +594,8 @@ subroutine StC_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%InitOrient = SrcInitInputData%InitOrient end if if (allocated(SrcInitInputData%InitRefOrient)) then - LB(1:3) = lbound(SrcInitInputData%InitRefOrient, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%InitRefOrient, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%InitRefOrient) + UB(1:3) = ubound(SrcInitInputData%InitRefOrient) if (.not. allocated(DstInitInputData%InitRefOrient)) then allocate(DstInitInputData%InitRefOrient(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -655,7 +666,7 @@ subroutine StC_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(StC_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackInitInput' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -679,14 +690,14 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'StC_CopyCtrlChanInitInfoType' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcCtrlChanInitInfoTypeData%Requestor)) then - LB(1:1) = lbound(SrcCtrlChanInitInfoTypeData%Requestor, kind=B8Ki) - UB(1:1) = ubound(SrcCtrlChanInitInfoTypeData%Requestor, kind=B8Ki) + LB(1:1) = lbound(SrcCtrlChanInitInfoTypeData%Requestor) + UB(1:1) = ubound(SrcCtrlChanInitInfoTypeData%Requestor) if (.not. allocated(DstCtrlChanInitInfoTypeData%Requestor)) then allocate(DstCtrlChanInitInfoTypeData%Requestor(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -697,8 +708,8 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan DstCtrlChanInitInfoTypeData%Requestor = SrcCtrlChanInitInfoTypeData%Requestor end if if (allocated(SrcCtrlChanInitInfoTypeData%InitStiff)) then - LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitStiff, kind=B8Ki) - UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitStiff, kind=B8Ki) + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitStiff) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitStiff) if (.not. allocated(DstCtrlChanInitInfoTypeData%InitStiff)) then allocate(DstCtrlChanInitInfoTypeData%InitStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -709,8 +720,8 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan DstCtrlChanInitInfoTypeData%InitStiff = SrcCtrlChanInitInfoTypeData%InitStiff end if if (allocated(SrcCtrlChanInitInfoTypeData%InitDamp)) then - LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitDamp, kind=B8Ki) - UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitDamp, kind=B8Ki) + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitDamp) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitDamp) if (.not. allocated(DstCtrlChanInitInfoTypeData%InitDamp)) then allocate(DstCtrlChanInitInfoTypeData%InitDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -721,8 +732,8 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan DstCtrlChanInitInfoTypeData%InitDamp = SrcCtrlChanInitInfoTypeData%InitDamp end if if (allocated(SrcCtrlChanInitInfoTypeData%InitBrake)) then - LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitBrake, kind=B8Ki) - UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitBrake, kind=B8Ki) + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitBrake) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitBrake) if (.not. allocated(DstCtrlChanInitInfoTypeData%InitBrake)) then allocate(DstCtrlChanInitInfoTypeData%InitBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -733,8 +744,8 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan DstCtrlChanInitInfoTypeData%InitBrake = SrcCtrlChanInitInfoTypeData%InitBrake end if if (allocated(SrcCtrlChanInitInfoTypeData%InitForce)) then - LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitForce, kind=B8Ki) - UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitForce, kind=B8Ki) + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitForce) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitForce) if (.not. allocated(DstCtrlChanInitInfoTypeData%InitForce)) then allocate(DstCtrlChanInitInfoTypeData%InitForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -745,8 +756,8 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan DstCtrlChanInitInfoTypeData%InitForce = SrcCtrlChanInitInfoTypeData%InitForce end if if (allocated(SrcCtrlChanInitInfoTypeData%InitMeasDisp)) then - LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasDisp, kind=B8Ki) - UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasDisp, kind=B8Ki) + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasDisp) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasDisp) if (.not. allocated(DstCtrlChanInitInfoTypeData%InitMeasDisp)) then allocate(DstCtrlChanInitInfoTypeData%InitMeasDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -757,8 +768,8 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan DstCtrlChanInitInfoTypeData%InitMeasDisp = SrcCtrlChanInitInfoTypeData%InitMeasDisp end if if (allocated(SrcCtrlChanInitInfoTypeData%InitMeasVel)) then - LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasVel, kind=B8Ki) - UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasVel, kind=B8Ki) + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasVel) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasVel) if (.not. allocated(DstCtrlChanInitInfoTypeData%InitMeasVel)) then allocate(DstCtrlChanInitInfoTypeData%InitMeasVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -819,7 +830,7 @@ subroutine StC_UnPackCtrlChanInitInfoType(RF, OutData) type(RegFile), intent(inout) :: RF type(StC_CtrlChanInitInfoType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackCtrlChanInitInfoType' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -838,14 +849,14 @@ subroutine StC_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'StC_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%RelPosition)) then - LB(1:2) = lbound(SrcInitOutputData%RelPosition, kind=B8Ki) - UB(1:2) = ubound(SrcInitOutputData%RelPosition, kind=B8Ki) + LB(1:2) = lbound(SrcInitOutputData%RelPosition) + UB(1:2) = ubound(SrcInitOutputData%RelPosition) if (.not. allocated(DstInitOutputData%RelPosition)) then allocate(DstInitOutputData%RelPosition(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -882,7 +893,7 @@ subroutine StC_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(StC_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackInitOutput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -895,14 +906,14 @@ subroutine StC_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'StC_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%StC_x)) then - LB(1:2) = lbound(SrcContStateData%StC_x, kind=B8Ki) - UB(1:2) = ubound(SrcContStateData%StC_x, kind=B8Ki) + LB(1:2) = lbound(SrcContStateData%StC_x) + UB(1:2) = ubound(SrcContStateData%StC_x) if (.not. allocated(DstContStateData%StC_x)) then allocate(DstContStateData%StC_x(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -939,7 +950,7 @@ subroutine StC_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(StC_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackContState' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1066,14 +1077,14 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'StC_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%F_stop)) then - LB(1:2) = lbound(SrcMiscData%F_stop, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_stop, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_stop) + UB(1:2) = ubound(SrcMiscData%F_stop) if (.not. allocated(DstMiscData%F_stop)) then allocate(DstMiscData%F_stop(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1084,8 +1095,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_stop = SrcMiscData%F_stop end if if (allocated(SrcMiscData%F_ext)) then - LB(1:2) = lbound(SrcMiscData%F_ext, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_ext, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_ext) + UB(1:2) = ubound(SrcMiscData%F_ext) if (.not. allocated(DstMiscData%F_ext)) then allocate(DstMiscData%F_ext(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1096,8 +1107,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_ext = SrcMiscData%F_ext end if if (allocated(SrcMiscData%F_fr)) then - LB(1:2) = lbound(SrcMiscData%F_fr, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_fr, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_fr) + UB(1:2) = ubound(SrcMiscData%F_fr) if (.not. allocated(DstMiscData%F_fr)) then allocate(DstMiscData%F_fr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1108,8 +1119,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_fr = SrcMiscData%F_fr end if if (allocated(SrcMiscData%K)) then - LB(1:2) = lbound(SrcMiscData%K, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%K, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%K) + UB(1:2) = ubound(SrcMiscData%K) if (.not. allocated(DstMiscData%K)) then allocate(DstMiscData%K(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1120,8 +1131,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%K = SrcMiscData%K end if if (allocated(SrcMiscData%C_ctrl)) then - LB(1:2) = lbound(SrcMiscData%C_ctrl, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%C_ctrl, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%C_ctrl) + UB(1:2) = ubound(SrcMiscData%C_ctrl) if (.not. allocated(DstMiscData%C_ctrl)) then allocate(DstMiscData%C_ctrl(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1132,8 +1143,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%C_ctrl = SrcMiscData%C_ctrl end if if (allocated(SrcMiscData%C_Brake)) then - LB(1:2) = lbound(SrcMiscData%C_Brake, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%C_Brake, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%C_Brake) + UB(1:2) = ubound(SrcMiscData%C_Brake) if (.not. allocated(DstMiscData%C_Brake)) then allocate(DstMiscData%C_Brake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1144,8 +1155,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%C_Brake = SrcMiscData%C_Brake end if if (allocated(SrcMiscData%F_table)) then - LB(1:2) = lbound(SrcMiscData%F_table, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_table, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_table) + UB(1:2) = ubound(SrcMiscData%F_table) if (.not. allocated(DstMiscData%F_table)) then allocate(DstMiscData%F_table(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1156,8 +1167,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_table = SrcMiscData%F_table end if if (allocated(SrcMiscData%F_k)) then - LB(1:2) = lbound(SrcMiscData%F_k, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_k, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_k) + UB(1:2) = ubound(SrcMiscData%F_k) if (.not. allocated(DstMiscData%F_k)) then allocate(DstMiscData%F_k(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1168,8 +1179,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_k = SrcMiscData%F_k end if if (allocated(SrcMiscData%a_G)) then - LB(1:2) = lbound(SrcMiscData%a_G, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%a_G, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%a_G) + UB(1:2) = ubound(SrcMiscData%a_G) if (.not. allocated(DstMiscData%a_G)) then allocate(DstMiscData%a_G(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1180,8 +1191,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%a_G = SrcMiscData%a_G end if if (allocated(SrcMiscData%rdisp_P)) then - LB(1:2) = lbound(SrcMiscData%rdisp_P, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%rdisp_P, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%rdisp_P) + UB(1:2) = ubound(SrcMiscData%rdisp_P) if (.not. allocated(DstMiscData%rdisp_P)) then allocate(DstMiscData%rdisp_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1192,8 +1203,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rdisp_P = SrcMiscData%rdisp_P end if if (allocated(SrcMiscData%rdot_P)) then - LB(1:2) = lbound(SrcMiscData%rdot_P, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%rdot_P, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%rdot_P) + UB(1:2) = ubound(SrcMiscData%rdot_P) if (.not. allocated(DstMiscData%rdot_P)) then allocate(DstMiscData%rdot_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1204,8 +1215,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rdot_P = SrcMiscData%rdot_P end if if (allocated(SrcMiscData%rddot_P)) then - LB(1:2) = lbound(SrcMiscData%rddot_P, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%rddot_P, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%rddot_P) + UB(1:2) = ubound(SrcMiscData%rddot_P) if (.not. allocated(DstMiscData%rddot_P)) then allocate(DstMiscData%rddot_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1216,8 +1227,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%rddot_P = SrcMiscData%rddot_P end if if (allocated(SrcMiscData%omega_P)) then - LB(1:2) = lbound(SrcMiscData%omega_P, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%omega_P, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%omega_P) + UB(1:2) = ubound(SrcMiscData%omega_P) if (.not. allocated(DstMiscData%omega_P)) then allocate(DstMiscData%omega_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1228,8 +1239,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%omega_P = SrcMiscData%omega_P end if if (allocated(SrcMiscData%alpha_P)) then - LB(1:2) = lbound(SrcMiscData%alpha_P, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%alpha_P, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%alpha_P) + UB(1:2) = ubound(SrcMiscData%alpha_P) if (.not. allocated(DstMiscData%alpha_P)) then allocate(DstMiscData%alpha_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1240,8 +1251,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%alpha_P = SrcMiscData%alpha_P end if if (allocated(SrcMiscData%F_P)) then - LB(1:2) = lbound(SrcMiscData%F_P, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%F_P, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%F_P) + UB(1:2) = ubound(SrcMiscData%F_P) if (.not. allocated(DstMiscData%F_P)) then allocate(DstMiscData%F_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1252,8 +1263,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%F_P = SrcMiscData%F_P end if if (allocated(SrcMiscData%M_P)) then - LB(1:2) = lbound(SrcMiscData%M_P, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%M_P, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%M_P) + UB(1:2) = ubound(SrcMiscData%M_P) if (.not. allocated(DstMiscData%M_P)) then allocate(DstMiscData%M_P(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1264,8 +1275,8 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%M_P = SrcMiscData%M_P end if if (allocated(SrcMiscData%Acc)) then - LB(1:2) = lbound(SrcMiscData%Acc, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%Acc, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%Acc) + UB(1:2) = ubound(SrcMiscData%Acc) if (.not. allocated(DstMiscData%Acc)) then allocate(DstMiscData%Acc(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1368,7 +1379,7 @@ subroutine StC_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(StC_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackMisc' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1398,7 +1409,7 @@ subroutine StC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'StC_CopyParam' ErrStat = ErrID_None @@ -1450,8 +1461,8 @@ subroutine StC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%rho_Y = SrcParamData%rho_Y DstParamData%Use_F_TBL = SrcParamData%Use_F_TBL if (allocated(SrcParamData%F_TBL)) then - LB(1:2) = lbound(SrcParamData%F_TBL, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%F_TBL, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%F_TBL) + UB(1:2) = ubound(SrcParamData%F_TBL) if (.not. allocated(DstParamData%F_TBL)) then allocate(DstParamData%F_TBL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1464,8 +1475,8 @@ subroutine StC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumMeshPts = SrcParamData%NumMeshPts DstParamData%PrescribedForcesCoordSys = SrcParamData%PrescribedForcesCoordSys if (allocated(SrcParamData%StC_PrescribedForce)) then - LB(1:2) = lbound(SrcParamData%StC_PrescribedForce, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%StC_PrescribedForce, kind=B8Ki) + LB(1:2) = lbound(SrcParamData%StC_PrescribedForce) + UB(1:2) = ubound(SrcParamData%StC_PrescribedForce) if (.not. allocated(DstParamData%StC_PrescribedForce)) then allocate(DstParamData%StC_PrescribedForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1476,8 +1487,8 @@ subroutine StC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%StC_PrescribedForce = SrcParamData%StC_PrescribedForce end if if (allocated(SrcParamData%StC_CChan)) then - LB(1:1) = lbound(SrcParamData%StC_CChan, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%StC_CChan, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%StC_CChan) + UB(1:1) = ubound(SrcParamData%StC_CChan) if (.not. allocated(DstParamData%StC_CChan)) then allocate(DstParamData%StC_CChan(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1570,7 +1581,7 @@ subroutine StC_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(StC_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackParam' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1633,16 +1644,16 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'StC_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInputData%Mesh)) then - LB(1:1) = lbound(SrcInputData%Mesh, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%Mesh, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%Mesh) + UB(1:1) = ubound(SrcInputData%Mesh) if (.not. allocated(DstInputData%Mesh)) then allocate(DstInputData%Mesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1657,8 +1668,8 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcInputData%CmdStiff)) then - LB(1:2) = lbound(SrcInputData%CmdStiff, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%CmdStiff, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%CmdStiff) + UB(1:2) = ubound(SrcInputData%CmdStiff) if (.not. allocated(DstInputData%CmdStiff)) then allocate(DstInputData%CmdStiff(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1669,8 +1680,8 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%CmdStiff = SrcInputData%CmdStiff end if if (allocated(SrcInputData%CmdDamp)) then - LB(1:2) = lbound(SrcInputData%CmdDamp, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%CmdDamp, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%CmdDamp) + UB(1:2) = ubound(SrcInputData%CmdDamp) if (.not. allocated(DstInputData%CmdDamp)) then allocate(DstInputData%CmdDamp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1681,8 +1692,8 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%CmdDamp = SrcInputData%CmdDamp end if if (allocated(SrcInputData%CmdBrake)) then - LB(1:2) = lbound(SrcInputData%CmdBrake, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%CmdBrake, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%CmdBrake) + UB(1:2) = ubound(SrcInputData%CmdBrake) if (.not. allocated(DstInputData%CmdBrake)) then allocate(DstInputData%CmdBrake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1693,8 +1704,8 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%CmdBrake = SrcInputData%CmdBrake end if if (allocated(SrcInputData%CmdForce)) then - LB(1:2) = lbound(SrcInputData%CmdForce, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%CmdForce, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%CmdForce) + UB(1:2) = ubound(SrcInputData%CmdForce) if (.not. allocated(DstInputData%CmdForce)) then allocate(DstInputData%CmdForce(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1710,16 +1721,16 @@ subroutine StC_DestroyInput(InputData, ErrStat, ErrMsg) type(StC_InputType), intent(inout) :: InputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'StC_DestroyInput' ErrStat = ErrID_None ErrMsg = '' if (allocated(InputData%Mesh)) then - LB(1:1) = lbound(InputData%Mesh, kind=B8Ki) - UB(1:1) = ubound(InputData%Mesh, kind=B8Ki) + LB(1:1) = lbound(InputData%Mesh) + UB(1:1) = ubound(InputData%Mesh) do i1 = LB(1), UB(1) call MeshDestroy( InputData%Mesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1744,14 +1755,14 @@ subroutine StC_PackInput(RF, Indata) type(RegFile), intent(inout) :: RF type(StC_InputType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%Mesh)) if (allocated(InData%Mesh)) then - call RegPackBounds(RF, 1, lbound(InData%Mesh, kind=B8Ki), ubound(InData%Mesh, kind=B8Ki)) - LB(1:1) = lbound(InData%Mesh, kind=B8Ki) - UB(1:1) = ubound(InData%Mesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Mesh), ubound(InData%Mesh)) + LB(1:1) = lbound(InData%Mesh) + UB(1:1) = ubound(InData%Mesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%Mesh(i1)) end do @@ -1767,8 +1778,8 @@ subroutine StC_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(StC_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackInput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1797,16 +1808,16 @@ subroutine StC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'StC_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%Mesh)) then - LB(1:1) = lbound(SrcOutputData%Mesh, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%Mesh, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%Mesh) + UB(1:1) = ubound(SrcOutputData%Mesh) if (.not. allocated(DstOutputData%Mesh)) then allocate(DstOutputData%Mesh(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1821,8 +1832,8 @@ subroutine StC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs end do end if if (allocated(SrcOutputData%MeasDisp)) then - LB(1:2) = lbound(SrcOutputData%MeasDisp, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%MeasDisp, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%MeasDisp) + UB(1:2) = ubound(SrcOutputData%MeasDisp) if (.not. allocated(DstOutputData%MeasDisp)) then allocate(DstOutputData%MeasDisp(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1833,8 +1844,8 @@ subroutine StC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%MeasDisp = SrcOutputData%MeasDisp end if if (allocated(SrcOutputData%MeasVel)) then - LB(1:2) = lbound(SrcOutputData%MeasVel, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%MeasVel, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%MeasVel) + UB(1:2) = ubound(SrcOutputData%MeasVel) if (.not. allocated(DstOutputData%MeasVel)) then allocate(DstOutputData%MeasVel(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1850,16 +1861,16 @@ subroutine StC_DestroyOutput(OutputData, ErrStat, ErrMsg) type(StC_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'StC_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%Mesh)) then - LB(1:1) = lbound(OutputData%Mesh, kind=B8Ki) - UB(1:1) = ubound(OutputData%Mesh, kind=B8Ki) + LB(1:1) = lbound(OutputData%Mesh) + UB(1:1) = ubound(OutputData%Mesh) do i1 = LB(1), UB(1) call MeshDestroy( OutputData%Mesh(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1878,14 +1889,14 @@ subroutine StC_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(StC_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'StC_PackOutput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%Mesh)) if (allocated(InData%Mesh)) then - call RegPackBounds(RF, 1, lbound(InData%Mesh, kind=B8Ki), ubound(InData%Mesh, kind=B8Ki)) - LB(1:1) = lbound(InData%Mesh, kind=B8Ki) - UB(1:1) = ubound(InData%Mesh, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%Mesh), ubound(InData%Mesh)) + LB(1:1) = lbound(InData%Mesh) + UB(1:1) = ubound(InData%Mesh) do i1 = LB(1), UB(1) call MeshPack(RF, InData%Mesh(i1)) end do @@ -1899,8 +1910,8 @@ subroutine StC_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(StC_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'StC_UnPackOutput' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2021,7 +2032,7 @@ SUBROUTINE StC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(u_out%Mesh) .AND. ALLOCATED(u1%Mesh)) THEN - DO i1 = LBOUND(u_out%Mesh,1, kind=B8Ki),UBOUND(u_out%Mesh,1, kind=B8Ki) + do i1 = lbound(u_out%Mesh,1),ubound(u_out%Mesh,1) CALL MeshExtrapInterp1(u1%Mesh(i1), u2%Mesh(i1), tin, u_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -2098,7 +2109,7 @@ SUBROUTINE StC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(u_out%Mesh) .AND. ALLOCATED(u1%Mesh)) THEN - DO i1 = LBOUND(u_out%Mesh,1, kind=B8Ki),UBOUND(u_out%Mesh,1, kind=B8Ki) + do i1 = lbound(u_out%Mesh,1),ubound(u_out%Mesh,1) CALL MeshExtrapInterp2(u1%Mesh(i1), u2%Mesh(i1), u3%Mesh(i1), tin, u_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -2217,7 +2228,7 @@ SUBROUTINE StC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(y_out%Mesh) .AND. ALLOCATED(y1%Mesh)) THEN - DO i1 = LBOUND(y_out%Mesh,1, kind=B8Ki),UBOUND(y_out%Mesh,1, kind=B8Ki) + do i1 = lbound(y_out%Mesh,1),ubound(y_out%Mesh,1) CALL MeshExtrapInterp1(y1%Mesh(i1), y2%Mesh(i1), tin, y_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -2288,7 +2299,7 @@ SUBROUTINE StC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%Mesh) .AND. ALLOCATED(y1%Mesh)) THEN - DO i1 = LBOUND(y_out%Mesh,1, kind=B8Ki),UBOUND(y_out%Mesh,1, kind=B8Ki) + do i1 = lbound(y_out%Mesh,1),ubound(y_out%Mesh,1) CALL MeshExtrapInterp2(y1%Mesh(i1), y2%Mesh(i1), y3%Mesh(i1), tin, y_out%Mesh(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -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 e0ce34c480..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 @@ -188,7 +218,7 @@ subroutine SED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SED_CopyInputFile' ErrStat = ErrID_None @@ -217,8 +247,8 @@ subroutine SED_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%SumPrint = SrcInputFileData%SumPrint DstInputFileData%NumOuts = SrcInputFileData%NumOuts if (allocated(SrcInputFileData%OutList)) then - LB(1:1) = lbound(SrcInputFileData%OutList, kind=B8Ki) - UB(1:1) = ubound(SrcInputFileData%OutList, kind=B8Ki) + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) if (.not. allocated(DstInputFileData%OutList)) then allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -278,7 +308,7 @@ subroutine SED_UnPackInputFile(RF, OutData) type(RegFile), intent(inout) :: RF type(SED_InputFile), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SED_UnPackInputFile' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -372,15 +402,15 @@ subroutine SED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -391,8 +421,8 @@ subroutine SED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -407,8 +437,8 @@ subroutine SED_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Er if (ErrStat >= AbortErrLev) return DstInitOutputData%NumBl = SrcInitOutputData%NumBl if (allocated(SrcInitOutputData%BlPitch)) then - LB(1:1) = lbound(SrcInitOutputData%BlPitch, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%BlPitch, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%BlPitch) + UB(1:1) = ubound(SrcInitOutputData%BlPitch) if (.not. allocated(DstInitOutputData%BlPitch)) then allocate(DstInitOutputData%BlPitch(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -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 @@ -473,7 +509,7 @@ subroutine SED_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SED_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SED_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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) @@ -497,7 +534,7 @@ subroutine SED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_CopyInput' @@ -509,8 +546,8 @@ subroutine SED_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%HSSBrTrqC = SrcInputData%HSSBrTrqC DstInputData%GenTrq = SrcInputData%GenTrq if (allocated(SrcInputData%BlPitchCom)) then - LB(1:1) = lbound(SrcInputData%BlPitchCom, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%BlPitchCom, kind=B8Ki) + 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 @@ -558,7 +595,7 @@ subroutine SED_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SED_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SED_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -576,16 +613,16 @@ subroutine SED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%BladeRootMotion)) then - LB(1:1) = lbound(SrcOutputData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BladeRootMotion, kind=B8Ki) + 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 @@ -619,8 +656,8 @@ subroutine SED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%Yaw = SrcOutputData%Yaw DstOutputData%YawRate = SrcOutputData%YawRate if (allocated(SrcOutputData%BlPitch)) then - LB(1:1) = lbound(SrcOutputData%BlPitch, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%BlPitch, kind=B8Ki) + 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 @@ -631,8 +668,8 @@ subroutine SED_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs DstOutputData%BlPitch = SrcOutputData%BlPitch end if if (allocated(SrcOutputData%WriteOutput)) then - LB(1:1) = lbound(SrcOutputData%WriteOutput, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) + 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 @@ -648,16 +685,16 @@ subroutine SED_DestroyOutput(OutputData, ErrStat, ErrMsg) type(SED_OutputType), intent(inout) :: OutputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_DestroyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(OutputData%BladeRootMotion)) then - LB(1:1) = lbound(OutputData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(OutputData%BladeRootMotion, kind=B8Ki) + 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) @@ -684,14 +721,14 @@ subroutine SED_PackOutput(RF, Indata) type(RegFile), intent(inout) :: RF type(SED_OutputType), intent(in) :: InData character(*), parameter :: RoutineName = 'SED_PackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%BladeRootMotion)) if (allocated(InData%BladeRootMotion)) then - call RegPackBounds(RF, 1, lbound(InData%BladeRootMotion, kind=B8Ki), ubound(InData%BladeRootMotion, kind=B8Ki)) - LB(1:1) = lbound(InData%BladeRootMotion, kind=B8Ki) - UB(1:1) = ubound(InData%BladeRootMotion, kind=B8Ki) + 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 @@ -716,8 +753,8 @@ subroutine SED_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SED_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SED_UnPackOutput' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -755,14 +792,14 @@ subroutine SED_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSt integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SED_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%QT)) then - LB(1:1) = lbound(SrcContStateData%QT, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%QT, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%QT) + UB(1:1) = ubound(SrcContStateData%QT) if (.not. allocated(DstContStateData%QT)) then allocate(DstContStateData%QT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -773,8 +810,8 @@ subroutine SED_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSt DstContStateData%QT = SrcContStateData%QT end if if (allocated(SrcContStateData%QDT)) then - LB(1:1) = lbound(SrcContStateData%QDT, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%QDT, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%QDT) + UB(1:1) = ubound(SrcContStateData%QDT) if (.not. allocated(DstContStateData%QDT)) then allocate(DstContStateData%QDT(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -815,7 +852,7 @@ subroutine SED_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(SED_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SED_UnPackContState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -905,16 +942,16 @@ subroutine SED_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Er integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' DstOtherStateData%n = SrcOtherStateData%n - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) do i1 = LB(1), UB(1) call SED_CopyContState(SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -931,15 +968,15 @@ subroutine SED_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(SED_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call SED_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -950,12 +987,12 @@ subroutine SED_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(SED_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SED_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%n) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call SED_PackContState(RF, InData%xdot(i1)) end do @@ -971,12 +1008,12 @@ subroutine SED_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(SED_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SED_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat /= ErrID_None) return call RegUnpack(RF, OutData%n); if (RegCheckErr(RF, RoutineName)) return - LB(1:1) = lbound(OutData%xdot, kind=B8Ki) - UB(1:1) = ubound(OutData%xdot, kind=B8Ki) + LB(1:1) = lbound(OutData%xdot) + UB(1:1) = ubound(OutData%xdot) do i1 = LB(1), UB(1) call SED_UnpackContState(RF, OutData%xdot(i1)) ! xdot end do @@ -993,8 +1030,8 @@ subroutine SED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_CopyParam' @@ -1025,8 +1062,8 @@ subroutine SED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%HubHt = SrcParamData%HubHt DstParamData%NumOuts = SrcParamData%NumOuts if (allocated(SrcParamData%OutParam)) then - LB(1:1) = lbound(SrcParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) + 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 @@ -1046,16 +1083,16 @@ subroutine SED_DestroyParam(ParamData, ErrStat, ErrMsg) type(SED_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_DestroyParam' ErrStat = ErrID_None ErrMsg = '' if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + 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) @@ -1068,8 +1105,8 @@ subroutine SED_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(SED_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SED_PackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%RootName) call RegPack(RF, InData%GenDOF) @@ -1097,9 +1134,9 @@ subroutine SED_PackParam(RF, Indata) call RegPack(RF, InData%NumOuts) call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + 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 @@ -1111,8 +1148,8 @@ subroutine SED_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(SED_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SED_UnPackParam' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1161,16 +1198,16 @@ subroutine SED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%AllOuts)) then - LB(1:1) = lbound(SrcMiscData%AllOuts, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) + 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 @@ -1184,8 +1221,8 @@ subroutine SED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcMiscData%mapHub2Root)) then - LB(1:1) = lbound(SrcMiscData%mapHub2Root, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%mapHub2Root, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%mapHub2Root) + UB(1:1) = ubound(SrcMiscData%mapHub2Root) if (.not. allocated(DstMiscData%mapHub2Root)) then allocate(DstMiscData%mapHub2Root(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1200,8 +1237,8 @@ subroutine SED_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end do end if if (allocated(SrcMiscData%QD2T)) then - LB(1:1) = lbound(SrcMiscData%QD2T, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%QD2T, kind=B8Ki) + 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 @@ -1212,14 +1249,29 @@ 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) type(SED_MiscVarType), intent(inout) :: MiscData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SED_DestroyMisc' @@ -1231,8 +1283,8 @@ subroutine SED_DestroyMisc(MiscData, ErrStat, ErrMsg) call NWTC_Library_DestroyMeshMapType(MiscData%mapNac2Hub, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(MiscData%mapHub2Root)) then - LB(1:1) = lbound(MiscData%mapHub2Root, kind=B8Ki) - UB(1:1) = ubound(MiscData%mapHub2Root, kind=B8Ki) + LB(1:1) = lbound(MiscData%mapHub2Root) + UB(1:1) = ubound(MiscData%mapHub2Root) do i1 = LB(1), UB(1) call NWTC_Library_DestroyMeshMapType(MiscData%mapHub2Root(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1242,28 +1294,43 @@ 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) type(RegFile), intent(inout) :: RF type(SED_MiscVarType), intent(in) :: InData character(*), parameter :: RoutineName = 'SED_PackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%AllOuts) call NWTC_Library_PackMeshMapType(RF, InData%mapNac2Hub) call RegPack(RF, allocated(InData%mapHub2Root)) if (allocated(InData%mapHub2Root)) then - call RegPackBounds(RF, 1, lbound(InData%mapHub2Root, kind=B8Ki), ubound(InData%mapHub2Root, kind=B8Ki)) - LB(1:1) = lbound(InData%mapHub2Root, kind=B8Ki) - UB(1:1) = ubound(InData%mapHub2Root, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%mapHub2Root), ubound(InData%mapHub2Root)) + LB(1:1) = lbound(InData%mapHub2Root) + UB(1:1) = ubound(InData%mapHub2Root) do i1 = LB(1), UB(1) call NWTC_Library_PackMeshMapType(RF, InData%mapHub2Root(i1)) end do 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 @@ -1271,8 +1338,8 @@ subroutine SED_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(SED_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SED_UnPackMisc' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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) @@ -1397,7 +1469,7 @@ SUBROUTINE SED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg u_out%HSSBrTrqC = a1*u1%HSSBrTrqC + a2*u2%HSSBrTrqC u_out%GenTrq = a1*u1%GenTrq + a2*u2%GenTrq IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - DO i1 = LBOUND(u_out%BlPitchCom,1, kind=B8Ki),UBOUND(u_out%BlPitchCom,1, kind=B8Ki) + do i1 = lbound(u_out%BlPitchCom,1),ubound(u_out%BlPitchCom,1) CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) END DO END IF ! check if allocated @@ -1465,7 +1537,7 @@ SUBROUTINE SED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err u_out%HSSBrTrqC = a1*u1%HSSBrTrqC + a2*u2%HSSBrTrqC + a3*u3%HSSBrTrqC u_out%GenTrq = a1*u1%GenTrq + a2*u2%GenTrq + a3*u3%GenTrq IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - DO i1 = LBOUND(u_out%BlPitchCom,1, kind=B8Ki),UBOUND(u_out%BlPitchCom,1, kind=B8Ki) + do i1 = lbound(u_out%BlPitchCom,1),ubound(u_out%BlPitchCom,1) CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), u3%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) END DO END IF ! check if allocated @@ -1571,7 +1643,7 @@ SUBROUTINE SED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg a2 = t_out/t(2) IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i1 = LBOUND(y_out%BladeRootMotion,1, kind=B8Ki),UBOUND(y_out%BladeRootMotion,1, kind=B8Ki) + do i1 = lbound(y_out%BladeRootMotion,1),ubound(y_out%BladeRootMotion,1) CALL MeshExtrapInterp1(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -1592,7 +1664,7 @@ SUBROUTINE SED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg y_out%Yaw = a1*y1%Yaw + a2*y2%Yaw y_out%YawRate = a1*y1%YawRate + a2*y2%YawRate IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - DO i1 = LBOUND(y_out%BlPitch,1, kind=B8Ki),UBOUND(y_out%BlPitch,1, kind=B8Ki) + do i1 = lbound(y_out%BlPitch,1),ubound(y_out%BlPitch,1) CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) END DO END IF ! check if allocated @@ -1657,7 +1729,7 @@ SUBROUTINE SED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i1 = LBOUND(y_out%BladeRootMotion,1, kind=B8Ki),UBOUND(y_out%BladeRootMotion,1, kind=B8Ki) + do i1 = lbound(y_out%BladeRootMotion,1),ubound(y_out%BladeRootMotion,1) CALL MeshExtrapInterp2(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), y3%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END DO @@ -1678,7 +1750,7 @@ SUBROUTINE SED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er y_out%Yaw = a1*y1%Yaw + a2*y2%Yaw + a3*y3%Yaw y_out%YawRate = a1*y1%YawRate + a2*y2%YawRate + a3*y3%YawRate IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - DO i1 = LBOUND(y_out%BlPitch,1, kind=B8Ki),UBOUND(y_out%BlPitch,1, kind=B8Ki) + do i1 = lbound(y_out%BlPitch,1),ubound(y_out%BlPitch,1) CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), y3%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) END DO END IF ! check if allocated @@ -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/SD_FEM.f90 b/modules/subdyn/src/SD_FEM.f90 index f2284d8ba8..27e72964b0 100644 --- a/modules/subdyn/src/SD_FEM.f90 +++ b/modules/subdyn/src/SD_FEM.f90 @@ -1249,6 +1249,9 @@ SUBROUTINE AssembleKM(Init, p, ErrStat, ErrMsg) ENDDO ! Add concentrated mass to mass matrix + CALL AllocAry( p%CMassNode, Init%nCMass, 'p%CMassNode', ErrStat2, ErrMsg2); if(Failed()) return; + CALL AllocAry( p%CMassWeight, Init%nCMass, 'p%CMassWeight', ErrStat2, ErrMsg2); if(Failed()) return; + CALL AllocAry( p%CMassOffset, Init%nCMass, 3, 'p%CMassOffset', ErrStat2, ErrMsg2); if(Failed()) return; DO I = 1, Init%nCMass iNode = NINT(Init%CMass(I, 1)) ! Note index where concentrated mass is to be added ! Safety check (otherwise we might have more than 6 DOF) @@ -1271,14 +1274,20 @@ SUBROUTINE AssembleKM(Init, p, ErrStat, ErrMsg) Init%M(jGlob, kGlob) = Init%M(jGlob, kGlob) + M66(J,K) ENDDO ENDDO - ENDDO ! Loop on concentrated mass - ! Add concentrated mass induced gravity force - DO I = 1, Init%nCMass - iNode = NINT(Init%CMass(I, 1)) ! Note index where concentrated mass is to be added - iGlob = p%NodesDOF(iNode)%List(3) ! uz - p%FG(iGlob) = p%FG(iGlob) - Init%CMass(I, 2)*Init%g - ENDDO + ! Add concentrated mass contribution to gravity force and moment + iGlob = p%NodesDOF(iNode)%List(3); p%FG(iGlob) = p%FG(iGlob) - m*Init%g ! uz: -mg + iGlob = p%NodesDOF(iNode)%List(4); p%FG(iGlob) = p%FG(iGlob) - m*Init%g * y ! tx: -mgy + iGlob = p%NodesDOF(iNode)%List(5); p%FG(iGlob) = p%FG(iGlob) + m*Init%g * x ! ty: mgx + + ! Save concentrated mass information for GuyanLoadCorrection + p%CMassNode(I) = iNode + p%CMassWeight(I) = m*Init%g + p%CMassOffset(I,1) = x + p%CMassOffset(I,2) = y + p%CMassOffset(I,3) = z + + ENDDO ! Loop on concentrated mass CALL CleanUp_AssembleKM() diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index e10cf1a022..2fba9a0ebc 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)) @@ -914,7 +994,7 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) CHARACTER(64), ALLOCATABLE :: StrArray(:) ! Array of strings, for better control of table inputs LOGICAL :: Echo LOGICAL :: LegacyFormat -LOGICAL :: bNumeric, bInteger +LOGICAL :: bNumeric, bInteger, bCableHasPretension INTEGER(IntKi) :: UnIn INTEGER(IntKi) :: nColumns, nColValid, nColNumeric INTEGER(IntKi) :: IOS @@ -1297,6 +1377,7 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) CALL ReadCom ( UnIn, SDInputFile, 'Cable properties Unit ' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return IF (Check( Init%NPropSetsC < 0, 'NPropSetsCable must be >=0')) return CALL AllocAry(Init%PropSetsC, Init%NPropSetsC, PropSetsCCol, 'PropSetsC', ErrStat2, ErrMsg2); if(Failed()) return + bCableHasPretension = .false. DO I = 1, Init%NPropSetsC !CALL ReadAry( UnIn, SDInputFile, Init%PropSetsC(I,:), PropSetsCCol, 'PropSetsC', 'PropSetsC ID and values ', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return READ(UnIn, FMT='(A)', IOSTAT=ErrStat2) Line; ErrMsg2='Error reading cable property line'; if (Failed()) return @@ -1309,7 +1390,18 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) call LegacyWarning('Using 4 values instead of 5 for cable properties. Cable will have constant properties and wont be controllable.') Init%PropSetsC(:,5:PropSetsCCol)=0 ! No CtrlChannel endif + if (Init%PropSetsC(I,4)>0.0) then + bCableHasPretension = .true. + end if ENDDO + if (bCableHasPretension) then + call WrScr('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!') + call WrScr('Warning: Cable with non-zero pretension specified.') + call WrScr(' SubDyn currently does not account for geometric stiffness from pretension.' ) + call WrScr(' Avoid non-zero cable pretension if possible.' ) + call WrScr('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!') + end if + !----------------------- RIGID LINK PROPERTIES ------------------------------------ CALL ReadCom ( UnIn, SDInputFile, 'Rigid link properties' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return CALL ReadIVar ( UnIn, SDInputFile, Init%NPropSetsR, 'NPropSetsR', 'Number of rigid link properties' ,ErrStat2, ErrMsg2, UnEc ); if(Failed()) return @@ -2014,7 +2106,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 @@ -2030,103 +2123,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 @@ -2142,103 +2241,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 !---------------------------------------------------------------------------------------------------------------------------------- @@ -2307,130 +2419,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 @@ -3144,11 +3133,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 @@ -3156,7 +3148,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 @@ -3175,7 +3169,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) @@ -3185,7 +3179,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 @@ -3255,7 +3249,7 @@ SUBROUTINE GetExtForceOnInternalDOF(u, p, x, m, F_L, ErrStat, ErrMsg, GuyanLoadC real(ReKi) :: CableTension ! Controllable Cable force real(ReKi) :: DeltaL ! Change of length real(ReKi) :: rotations(3) - real(ReKi) :: du(3), Moment(3), Force(3) + real(ReKi) :: du(3), Moment(3), Force(3), CMassOffset(3), CMassWeight(3) real(ReKi) :: u_TP(6) real(FEKi) :: FGe(12) ! element gravity force vector ! Variables for Guyan Rigid motion @@ -3264,6 +3258,10 @@ 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(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 ErrStat = ErrID_None ErrMsg = "" @@ -3327,9 +3325,9 @@ SUBROUTINE GetExtForceOnInternalDOF(u, p, x, m, F_L, ErrStat, ErrMsg, GuyanLoadC ! --- Build vector of external moment ! For floating structure with potentially large Guyan (rigid-body) rotation, nodal self-weight needs to be recomputed based on the current rigid-body orientation m%FG = 0.0_R8Ki - if ( RotateLoads ) then + if ( RotateLoads ) then ! if and only if floating Rb2g = transpose(Rg2b) ! Body (Guyan) to global - do i = 1, size(p%ElemProps) + do i = 1, size(p%ElemProps) ! Loop through all elements ! --- Element Fg in the earth-fixed frame CALL ElemG(p%ElemProps(i)%Area, p%ElemProps(i)%Length, p%ElemProps(i)%Rho, matmul(Rb2g,p%ElemProps(i)%DirCos), FGe, p%g) ! --- Element Fg in the Guyan rigid-body frame @@ -3341,6 +3339,25 @@ SUBROUTINE GetExtForceOnInternalDOF(u, p, x, m, F_L, ErrStat, ErrMsg, GuyanLoadC IDOF = p%ElemsDOF(1:12,i) m%FG( IDOF ) = m%FG( IDOF ) + FGe(1:12) end do + do i = 1,size(p%CMassNode) ! Loop through all concentrated masses + iNode = p%CMassNode(i) + IDOF(1:6) = p%NodesDOF(iNode)%List(1:6) + CMassOffset = p%CMassOffset(i,:) + CMassWeight = matmul(Rg2b, (/0.0,0.0,-p%CMassWeight(i)/) ) + m%FG(IDOF(1:3)) = m%FG(IDOF(1:3)) + CMassWeight + m%FG(IDOF(4:6)) = m%FG(IDOF(4:6)) + cross_product(CMassOffset,CMassWeight) + end do + end if + + if (GuyanLoadCorrection) then ! if and only if fixed-bottom + ! Additional GuyanLoadCorrection coming from the weight of concentrated masses with CoG offset + do i = 1,size(p%CMassNode) ! Loop through all concentrated masses + iNode = p%CMassNode(i) + IDOF(4:6) = p%NodesDOF(iNode)%List(4:6) + call SmllRotTrans('Nodal rotation',m%DU_full(IDOF(4)),m%DU_full(IDOF(5)),m%DU_full(IDOF(6)),orientation,'',ErrStat2,ErrMsg2); if(Failed()) return + CMassOffset = matmul(p%CMassOffset(i,:),orientation) + m%Fext(IDOF(4:6)) = m%Fext(IDOF(4:6)) + cross_product( CMassOffset-p%CMassOffset(i,:), (/0.0,0.0,-p%CMassWeight(i)/) ) + end do end if do iNode = 1,p%nNodes @@ -3355,7 +3372,7 @@ SUBROUTINE GetExtForceOnInternalDOF(u, p, x, m, F_L, ErrStat, ErrMsg, GuyanLoadC endif ! Extra moment dm = Delta u x (fe + fg) - if (GuyanLoadCorrection) then + if (GuyanLoadCorrection) then ! if and only if fixed-bottom du = m%DU_full(p%NodesDOF(iNode)%List(1:3)) ! Lever arm Moment(1) = Moment(1) + du(2) * Force(3) - du(3) * Force(2) Moment(2) = Moment(2) + du(3) * Force(1) - du(1) * Force(3) @@ -3380,8 +3397,14 @@ SUBROUTINE GetExtForceOnInternalDOF(u, p, x, m, F_L, ErrStat, ErrMsg, GuyanLoadC contains subroutine Fatal(ErrMsg_in) character(len=*), intent(in) :: ErrMsg_in - call SetErrStat(ErrID_Fatal, ErrMsg_in, ErrStat, ErrMsg, 'GetExtForce'); + call SetErrStat(ErrID_Fatal, ErrMsg_in, ErrStat, ErrMsg, 'GetExtForceOnInternalDOF'); end subroutine Fatal + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'GetExtForceOnInternalDOF') + Failed = ErrStat >= AbortErrLev + end function Failed + END SUBROUTINE GetExtForceOnInternalDOF !------------------------------------------------------------------------------------------------------ @@ -4239,7 +4262,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) @@ -4254,22 +4278,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 1fb738e12d..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 @@ -207,10 +178,13 @@ typedef ^ ParameterType IntKi Nmembers - - - "Number of mem typedef ^ ParameterType IntKi Elems {:}{:} - - "Element nodes connections" typedef ^ ParameterType ElemPropType ElemProps {:} - - "List of element properties" typedef ^ ParameterType R8Ki FC {:} - - "Initial cable force T0, not reduced" N -typedef ^ ParameterType R8Ki FG {:} - - "Gravity force vector (with initial cable force T0), not reduced" N +typedef ^ ParameterType R8Ki FG {:} - - "Gravity force vector, not reduced" N typedef ^ ParameterType ReKi DP0 {:}{:} - - "Vector from TP to a Node at t=0, used for Floating Rigid Body motion" m typedef ^ ParameterType ReKi rPG {:} - - "Vector from TP to rigid-body CoG in the Guyan (rigid-body) frame, used for Floating Rigid Body Motion" m typedef ^ ParameterType IntKi NodeID2JointID {:} - - "Store Joint ID for each NodeID since SubDyn re-label nodes (and add more nodes)" "-" +typedef ^ ParameterType IntKi CMassNode {:} - - "Node indices for concentrated masses" +typedef ^ ParameterType ReKi CMassWeight {:} - - "Weight of concentrated masses" N +typedef ^ ParameterType ReKi CMassOffset {:}{:} - - "Concentrated mass CoG offset from attached nodes" m # --- Parameters - Constraints reduction typedef ^ ParameterType Logical reduced - - - "True if system has been reduced to account for constraints" "-" typedef ^ ParameterType R8Ki T_red {:}{:} - - "Transformation matrix performing the constraint reduction x = T. xtilde" "-" @@ -303,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" @@ -321,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 7b8a836d20..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 [-] @@ -256,10 +229,13 @@ MODULE SubDyn_Types INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Elems !< Element nodes connections [-] TYPE(ElemPropType) , DIMENSION(:), ALLOCATABLE :: ElemProps !< List of element properties [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: FC !< Initial cable force T0, not reduced [N] - REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: FG !< Gravity force vector (with initial cable force T0), not reduced [N] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: FG !< Gravity force vector, not reduced [N] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DP0 !< Vector from TP to a Node at t=0, used for Floating Rigid Body motion [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rPG !< Vector from TP to rigid-body CoG in the Guyan (rigid-body) frame, used for Floating Rigid Body Motion [m] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NodeID2JointID !< Store Joint ID for each NodeID since SubDyn re-label nodes (and add more nodes) [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: CMassNode !< Node indices for concentrated masses [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CMassWeight !< Weight of concentrated masses [N] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CMassOffset !< Concentrated mass CoG offset from attached nodes [m] LOGICAL :: reduced = .false. !< True if system has been reduced to account for constraints [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: T_red !< Transformation matrix performing the constraint reduction x = T. xtilde [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: T_red_T !< Transpose of T_red [-] @@ -347,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 ======= @@ -370,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 @@ -378,14 +399,14 @@ subroutine SD_CopyIList(SrcIListData, DstIListData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SD_CopyIList' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcIListData%List)) then - LB(1:1) = lbound(SrcIListData%List, kind=B8Ki) - UB(1:1) = ubound(SrcIListData%List, kind=B8Ki) + LB(1:1) = lbound(SrcIListData%List) + UB(1:1) = ubound(SrcIListData%List) if (.not. allocated(DstIListData%List)) then allocate(DstIListData%List(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -422,7 +443,7 @@ subroutine SD_UnPackIList(RF, OutData) type(RegFile), intent(inout) :: RF type(IList), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackIList' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -435,7 +456,7 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SD_CopyMeshAuxDataType' ErrStat = ErrID_None @@ -443,8 +464,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%MemberID = SrcMeshAuxDataTypeData%MemberID DstMeshAuxDataTypeData%NOutCnt = SrcMeshAuxDataTypeData%NOutCnt if (allocated(SrcMeshAuxDataTypeData%NodeCnt)) then - LB(1:1) = lbound(SrcMeshAuxDataTypeData%NodeCnt, kind=B8Ki) - UB(1:1) = ubound(SrcMeshAuxDataTypeData%NodeCnt, kind=B8Ki) + LB(1:1) = lbound(SrcMeshAuxDataTypeData%NodeCnt) + UB(1:1) = ubound(SrcMeshAuxDataTypeData%NodeCnt) if (.not. allocated(DstMeshAuxDataTypeData%NodeCnt)) then allocate(DstMeshAuxDataTypeData%NodeCnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -455,8 +476,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%NodeCnt = SrcMeshAuxDataTypeData%NodeCnt end if if (allocated(SrcMeshAuxDataTypeData%NodeIDs)) then - LB(1:1) = lbound(SrcMeshAuxDataTypeData%NodeIDs, kind=B8Ki) - UB(1:1) = ubound(SrcMeshAuxDataTypeData%NodeIDs, kind=B8Ki) + LB(1:1) = lbound(SrcMeshAuxDataTypeData%NodeIDs) + UB(1:1) = ubound(SrcMeshAuxDataTypeData%NodeIDs) if (.not. allocated(DstMeshAuxDataTypeData%NodeIDs)) then allocate(DstMeshAuxDataTypeData%NodeIDs(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -467,8 +488,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%NodeIDs = SrcMeshAuxDataTypeData%NodeIDs end if if (allocated(SrcMeshAuxDataTypeData%ElmIDs)) then - LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmIDs, kind=B8Ki) - UB(1:2) = ubound(SrcMeshAuxDataTypeData%ElmIDs, kind=B8Ki) + LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmIDs) + UB(1:2) = ubound(SrcMeshAuxDataTypeData%ElmIDs) if (.not. allocated(DstMeshAuxDataTypeData%ElmIDs)) then allocate(DstMeshAuxDataTypeData%ElmIDs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -479,8 +500,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%ElmIDs = SrcMeshAuxDataTypeData%ElmIDs end if if (allocated(SrcMeshAuxDataTypeData%ElmNds)) then - LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmNds, kind=B8Ki) - UB(1:2) = ubound(SrcMeshAuxDataTypeData%ElmNds, kind=B8Ki) + LB(1:2) = lbound(SrcMeshAuxDataTypeData%ElmNds) + UB(1:2) = ubound(SrcMeshAuxDataTypeData%ElmNds) if (.not. allocated(DstMeshAuxDataTypeData%ElmNds)) then allocate(DstMeshAuxDataTypeData%ElmNds(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -491,8 +512,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%ElmNds = SrcMeshAuxDataTypeData%ElmNds end if if (allocated(SrcMeshAuxDataTypeData%Me)) then - LB(1:4) = lbound(SrcMeshAuxDataTypeData%Me, kind=B8Ki) - UB(1:4) = ubound(SrcMeshAuxDataTypeData%Me, kind=B8Ki) + LB(1:4) = lbound(SrcMeshAuxDataTypeData%Me) + UB(1:4) = ubound(SrcMeshAuxDataTypeData%Me) if (.not. allocated(DstMeshAuxDataTypeData%Me)) then allocate(DstMeshAuxDataTypeData%Me(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -503,8 +524,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%Me = SrcMeshAuxDataTypeData%Me end if if (allocated(SrcMeshAuxDataTypeData%Ke)) then - LB(1:4) = lbound(SrcMeshAuxDataTypeData%Ke, kind=B8Ki) - UB(1:4) = ubound(SrcMeshAuxDataTypeData%Ke, kind=B8Ki) + LB(1:4) = lbound(SrcMeshAuxDataTypeData%Ke) + UB(1:4) = ubound(SrcMeshAuxDataTypeData%Ke) if (.not. allocated(DstMeshAuxDataTypeData%Ke)) then allocate(DstMeshAuxDataTypeData%Ke(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3),LB(4):UB(4)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -515,8 +536,8 @@ subroutine SD_CopyMeshAuxDataType(SrcMeshAuxDataTypeData, DstMeshAuxDataTypeData DstMeshAuxDataTypeData%Ke = SrcMeshAuxDataTypeData%Ke end if if (allocated(SrcMeshAuxDataTypeData%Fg)) then - LB(1:3) = lbound(SrcMeshAuxDataTypeData%Fg, kind=B8Ki) - UB(1:3) = ubound(SrcMeshAuxDataTypeData%Fg, kind=B8Ki) + LB(1:3) = lbound(SrcMeshAuxDataTypeData%Fg) + UB(1:3) = ubound(SrcMeshAuxDataTypeData%Fg) if (.not. allocated(DstMeshAuxDataTypeData%Fg)) then allocate(DstMeshAuxDataTypeData%Fg(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -579,7 +600,7 @@ subroutine SD_UnPackMeshAuxDataType(RF, OutData) type(RegFile), intent(inout) :: RF type(MeshAuxDataType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackMeshAuxDataType' - integer(B8Ki) :: LB(4), UB(4) + integer(B4Ki) :: LB(4), UB(4) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -600,14 +621,14 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SD_CopyCB_MatArrays' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcCB_MatArraysData%MBB)) then - LB(1:2) = lbound(SrcCB_MatArraysData%MBB, kind=B8Ki) - UB(1:2) = ubound(SrcCB_MatArraysData%MBB, kind=B8Ki) + LB(1:2) = lbound(SrcCB_MatArraysData%MBB) + UB(1:2) = ubound(SrcCB_MatArraysData%MBB) if (.not. allocated(DstCB_MatArraysData%MBB)) then allocate(DstCB_MatArraysData%MBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -618,8 +639,8 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod DstCB_MatArraysData%MBB = SrcCB_MatArraysData%MBB end if if (allocated(SrcCB_MatArraysData%MBM)) then - LB(1:2) = lbound(SrcCB_MatArraysData%MBM, kind=B8Ki) - UB(1:2) = ubound(SrcCB_MatArraysData%MBM, kind=B8Ki) + LB(1:2) = lbound(SrcCB_MatArraysData%MBM) + UB(1:2) = ubound(SrcCB_MatArraysData%MBM) if (.not. allocated(DstCB_MatArraysData%MBM)) then allocate(DstCB_MatArraysData%MBM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -630,8 +651,8 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod DstCB_MatArraysData%MBM = SrcCB_MatArraysData%MBM end if if (allocated(SrcCB_MatArraysData%KBB)) then - LB(1:2) = lbound(SrcCB_MatArraysData%KBB, kind=B8Ki) - UB(1:2) = ubound(SrcCB_MatArraysData%KBB, kind=B8Ki) + LB(1:2) = lbound(SrcCB_MatArraysData%KBB) + UB(1:2) = ubound(SrcCB_MatArraysData%KBB) if (.not. allocated(DstCB_MatArraysData%KBB)) then allocate(DstCB_MatArraysData%KBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -642,8 +663,8 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod DstCB_MatArraysData%KBB = SrcCB_MatArraysData%KBB end if if (allocated(SrcCB_MatArraysData%PhiL)) then - LB(1:2) = lbound(SrcCB_MatArraysData%PhiL, kind=B8Ki) - UB(1:2) = ubound(SrcCB_MatArraysData%PhiL, kind=B8Ki) + LB(1:2) = lbound(SrcCB_MatArraysData%PhiL) + UB(1:2) = ubound(SrcCB_MatArraysData%PhiL) if (.not. allocated(DstCB_MatArraysData%PhiL)) then allocate(DstCB_MatArraysData%PhiL(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -654,8 +675,8 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod DstCB_MatArraysData%PhiL = SrcCB_MatArraysData%PhiL end if if (allocated(SrcCB_MatArraysData%PhiR)) then - LB(1:2) = lbound(SrcCB_MatArraysData%PhiR, kind=B8Ki) - UB(1:2) = ubound(SrcCB_MatArraysData%PhiR, kind=B8Ki) + LB(1:2) = lbound(SrcCB_MatArraysData%PhiR) + UB(1:2) = ubound(SrcCB_MatArraysData%PhiR) if (.not. allocated(DstCB_MatArraysData%PhiR)) then allocate(DstCB_MatArraysData%PhiR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -666,8 +687,8 @@ subroutine SD_CopyCB_MatArrays(SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCod DstCB_MatArraysData%PhiR = SrcCB_MatArraysData%PhiR end if if (allocated(SrcCB_MatArraysData%OmegaL)) then - LB(1:1) = lbound(SrcCB_MatArraysData%OmegaL, kind=B8Ki) - UB(1:1) = ubound(SrcCB_MatArraysData%OmegaL, kind=B8Ki) + LB(1:1) = lbound(SrcCB_MatArraysData%OmegaL) + UB(1:1) = ubound(SrcCB_MatArraysData%OmegaL) if (.not. allocated(DstCB_MatArraysData%OmegaL)) then allocate(DstCB_MatArraysData%OmegaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -724,7 +745,7 @@ subroutine SD_UnPackCB_MatArrays(RF, OutData) type(RegFile), intent(inout) :: RF type(CB_MatArrays), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackCB_MatArrays' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -885,7 +906,7 @@ subroutine SD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyInitInput' @@ -898,8 +919,8 @@ subroutine SD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%TP_RefPoint = SrcInitInputData%TP_RefPoint DstInitInputData%SubRotateZ = SrcInitInputData%SubRotateZ if (allocated(SrcInitInputData%SoilStiffness)) then - LB(1:3) = lbound(SrcInitInputData%SoilStiffness, kind=B8Ki) - UB(1:3) = ubound(SrcInitInputData%SoilStiffness, kind=B8Ki) + LB(1:3) = lbound(SrcInitInputData%SoilStiffness) + UB(1:3) = ubound(SrcInitInputData%SoilStiffness) if (.not. allocated(DstInitInputData%SoilStiffness)) then allocate(DstInitInputData%SoilStiffness(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -952,7 +973,7 @@ subroutine SD_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SD_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackInitInput' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -973,15 +994,15 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -992,8 +1013,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1006,9 +1027,12 @@ 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, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) + 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 @@ -1019,8 +1043,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y end if if (allocated(SrcInitOutputData%LinNames_x)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%LinNames_x) + UB(1:1) = ubound(SrcInitOutputData%LinNames_x) if (.not. allocated(DstInitOutputData%LinNames_x)) then allocate(DstInitOutputData%LinNames_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1031,8 +1055,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x end if if (allocated(SrcInitOutputData%LinNames_u)) then - LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) + 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 @@ -1043,8 +1067,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u end if if (allocated(SrcInitOutputData%RotFrame_y)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + 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 @@ -1055,8 +1079,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y end if if (allocated(SrcInitOutputData%RotFrame_x)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%RotFrame_x) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_x) if (.not. allocated(DstInitOutputData%RotFrame_x)) then allocate(DstInitOutputData%RotFrame_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1067,8 +1091,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x end if if (allocated(SrcInitOutputData%RotFrame_u)) then - LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + 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 @@ -1079,8 +1103,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u end if if (allocated(SrcInitOutputData%IsLoad_u)) then - LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + 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 @@ -1091,8 +1115,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u end if if (allocated(SrcInitOutputData%DerivOrder_x)) then - LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%DerivOrder_x) + UB(1:1) = ubound(SrcInitOutputData%DerivOrder_x) if (.not. allocated(DstInitOutputData%DerivOrder_x)) then allocate(DstInitOutputData%DerivOrder_x(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1103,8 +1127,8 @@ subroutine SD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x end if if (allocated(SrcInitOutputData%CableCChanRqst)) then - LB(1:1) = lbound(SrcInitOutputData%CableCChanRqst, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%CableCChanRqst, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%CableCChanRqst) + UB(1:1) = ubound(SrcInitOutputData%CableCChanRqst) if (.not. allocated(DstInitOutputData%CableCChanRqst)) then allocate(DstInitOutputData%CableCChanRqst(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1133,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 @@ -1170,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) @@ -1186,13 +1213,14 @@ subroutine SD_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc 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 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 @@ -1210,7 +1238,7 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SD_CopyInitType' ErrStat = ErrID_None @@ -1232,8 +1260,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%NDiv = SrcInitTypeData%NDiv DstInitTypeData%CBMod = SrcInitTypeData%CBMod if (allocated(SrcInitTypeData%Joints)) then - LB(1:2) = lbound(SrcInitTypeData%Joints, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%Joints, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%Joints) + UB(1:2) = ubound(SrcInitTypeData%Joints) if (.not. allocated(DstInitTypeData%Joints)) then allocate(DstInitTypeData%Joints(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1244,8 +1272,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%Joints = SrcInitTypeData%Joints end if if (allocated(SrcInitTypeData%PropSetsB)) then - LB(1:2) = lbound(SrcInitTypeData%PropSetsB, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%PropSetsB, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%PropSetsB) + UB(1:2) = ubound(SrcInitTypeData%PropSetsB) if (.not. allocated(DstInitTypeData%PropSetsB)) then allocate(DstInitTypeData%PropSetsB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1256,8 +1284,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropSetsB = SrcInitTypeData%PropSetsB end if if (allocated(SrcInitTypeData%PropSetsC)) then - LB(1:2) = lbound(SrcInitTypeData%PropSetsC, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%PropSetsC, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%PropSetsC) + UB(1:2) = ubound(SrcInitTypeData%PropSetsC) if (.not. allocated(DstInitTypeData%PropSetsC)) then allocate(DstInitTypeData%PropSetsC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1268,8 +1296,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropSetsC = SrcInitTypeData%PropSetsC end if if (allocated(SrcInitTypeData%PropSetsR)) then - LB(1:2) = lbound(SrcInitTypeData%PropSetsR, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%PropSetsR, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%PropSetsR) + UB(1:2) = ubound(SrcInitTypeData%PropSetsR) if (.not. allocated(DstInitTypeData%PropSetsR)) then allocate(DstInitTypeData%PropSetsR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1280,8 +1308,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropSetsR = SrcInitTypeData%PropSetsR end if if (allocated(SrcInitTypeData%PropSetsS)) then - LB(1:2) = lbound(SrcInitTypeData%PropSetsS, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%PropSetsS, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%PropSetsS) + UB(1:2) = ubound(SrcInitTypeData%PropSetsS) if (.not. allocated(DstInitTypeData%PropSetsS)) then allocate(DstInitTypeData%PropSetsS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1292,8 +1320,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropSetsS = SrcInitTypeData%PropSetsS end if if (allocated(SrcInitTypeData%PropSetsX)) then - LB(1:2) = lbound(SrcInitTypeData%PropSetsX, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%PropSetsX, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%PropSetsX) + UB(1:2) = ubound(SrcInitTypeData%PropSetsX) if (.not. allocated(DstInitTypeData%PropSetsX)) then allocate(DstInitTypeData%PropSetsX(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1304,8 +1332,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropSetsX = SrcInitTypeData%PropSetsX end if if (allocated(SrcInitTypeData%COSMs)) then - LB(1:2) = lbound(SrcInitTypeData%COSMs, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%COSMs, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%COSMs) + UB(1:2) = ubound(SrcInitTypeData%COSMs) if (.not. allocated(DstInitTypeData%COSMs)) then allocate(DstInitTypeData%COSMs(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1316,8 +1344,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%COSMs = SrcInitTypeData%COSMs end if if (allocated(SrcInitTypeData%CMass)) then - LB(1:2) = lbound(SrcInitTypeData%CMass, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%CMass, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%CMass) + UB(1:2) = ubound(SrcInitTypeData%CMass) if (.not. allocated(DstInitTypeData%CMass)) then allocate(DstInitTypeData%CMass(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1328,8 +1356,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%CMass = SrcInitTypeData%CMass end if if (allocated(SrcInitTypeData%JDampings)) then - LB(1:1) = lbound(SrcInitTypeData%JDampings, kind=B8Ki) - UB(1:1) = ubound(SrcInitTypeData%JDampings, kind=B8Ki) + LB(1:1) = lbound(SrcInitTypeData%JDampings) + UB(1:1) = ubound(SrcInitTypeData%JDampings) if (.not. allocated(DstInitTypeData%JDampings)) then allocate(DstInitTypeData%JDampings(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1343,8 +1371,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%RayleighDamp = SrcInitTypeData%RayleighDamp DstInitTypeData%GuyanDampMat = SrcInitTypeData%GuyanDampMat if (allocated(SrcInitTypeData%Members)) then - LB(1:2) = lbound(SrcInitTypeData%Members, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%Members, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%Members) + UB(1:2) = ubound(SrcInitTypeData%Members) if (.not. allocated(DstInitTypeData%Members)) then allocate(DstInitTypeData%Members(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1355,8 +1383,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%Members = SrcInitTypeData%Members end if if (allocated(SrcInitTypeData%SSOutList)) then - LB(1:1) = lbound(SrcInitTypeData%SSOutList, kind=B8Ki) - UB(1:1) = ubound(SrcInitTypeData%SSOutList, kind=B8Ki) + LB(1:1) = lbound(SrcInitTypeData%SSOutList) + UB(1:1) = ubound(SrcInitTypeData%SSOutList) if (.not. allocated(DstInitTypeData%SSOutList)) then allocate(DstInitTypeData%SSOutList(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1369,8 +1397,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%OutCOSM = SrcInitTypeData%OutCOSM DstInitTypeData%TabDelim = SrcInitTypeData%TabDelim if (allocated(SrcInitTypeData%SSIK)) then - LB(1:2) = lbound(SrcInitTypeData%SSIK, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%SSIK, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%SSIK) + UB(1:2) = ubound(SrcInitTypeData%SSIK) if (.not. allocated(DstInitTypeData%SSIK)) then allocate(DstInitTypeData%SSIK(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1381,8 +1409,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%SSIK = SrcInitTypeData%SSIK end if if (allocated(SrcInitTypeData%SSIM)) then - LB(1:2) = lbound(SrcInitTypeData%SSIM, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%SSIM, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%SSIM) + UB(1:2) = ubound(SrcInitTypeData%SSIM) if (.not. allocated(DstInitTypeData%SSIM)) then allocate(DstInitTypeData%SSIM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1393,8 +1421,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%SSIM = SrcInitTypeData%SSIM end if if (allocated(SrcInitTypeData%SSIfile)) then - LB(1:1) = lbound(SrcInitTypeData%SSIfile, kind=B8Ki) - UB(1:1) = ubound(SrcInitTypeData%SSIfile, kind=B8Ki) + LB(1:1) = lbound(SrcInitTypeData%SSIfile) + UB(1:1) = ubound(SrcInitTypeData%SSIfile) if (.not. allocated(DstInitTypeData%SSIfile)) then allocate(DstInitTypeData%SSIfile(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1405,8 +1433,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%SSIfile = SrcInitTypeData%SSIfile end if if (allocated(SrcInitTypeData%Soil_K)) then - LB(1:3) = lbound(SrcInitTypeData%Soil_K, kind=B8Ki) - UB(1:3) = ubound(SrcInitTypeData%Soil_K, kind=B8Ki) + LB(1:3) = lbound(SrcInitTypeData%Soil_K) + UB(1:3) = ubound(SrcInitTypeData%Soil_K) if (.not. allocated(DstInitTypeData%Soil_K)) then allocate(DstInitTypeData%Soil_K(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1417,8 +1445,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%Soil_K = SrcInitTypeData%Soil_K end if if (allocated(SrcInitTypeData%Soil_Points)) then - LB(1:2) = lbound(SrcInitTypeData%Soil_Points, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%Soil_Points, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%Soil_Points) + UB(1:2) = ubound(SrcInitTypeData%Soil_Points) if (.not. allocated(DstInitTypeData%Soil_Points)) then allocate(DstInitTypeData%Soil_Points(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1429,8 +1457,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%Soil_Points = SrcInitTypeData%Soil_Points end if if (allocated(SrcInitTypeData%Soil_Nodes)) then - LB(1:1) = lbound(SrcInitTypeData%Soil_Nodes, kind=B8Ki) - UB(1:1) = ubound(SrcInitTypeData%Soil_Nodes, kind=B8Ki) + LB(1:1) = lbound(SrcInitTypeData%Soil_Nodes) + UB(1:1) = ubound(SrcInitTypeData%Soil_Nodes) if (.not. allocated(DstInitTypeData%Soil_Nodes)) then allocate(DstInitTypeData%Soil_Nodes(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1446,8 +1474,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%NPropR = SrcInitTypeData%NPropR DstInitTypeData%NPropS = SrcInitTypeData%NPropS if (allocated(SrcInitTypeData%Nodes)) then - LB(1:2) = lbound(SrcInitTypeData%Nodes, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%Nodes, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%Nodes) + UB(1:2) = ubound(SrcInitTypeData%Nodes) if (.not. allocated(DstInitTypeData%Nodes)) then allocate(DstInitTypeData%Nodes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1458,8 +1486,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%Nodes = SrcInitTypeData%Nodes end if if (allocated(SrcInitTypeData%PropsB)) then - LB(1:2) = lbound(SrcInitTypeData%PropsB, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%PropsB, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%PropsB) + UB(1:2) = ubound(SrcInitTypeData%PropsB) if (.not. allocated(DstInitTypeData%PropsB)) then allocate(DstInitTypeData%PropsB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1470,8 +1498,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropsB = SrcInitTypeData%PropsB end if if (allocated(SrcInitTypeData%PropsC)) then - LB(1:2) = lbound(SrcInitTypeData%PropsC, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%PropsC, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%PropsC) + UB(1:2) = ubound(SrcInitTypeData%PropsC) if (.not. allocated(DstInitTypeData%PropsC)) then allocate(DstInitTypeData%PropsC(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1482,8 +1510,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropsC = SrcInitTypeData%PropsC end if if (allocated(SrcInitTypeData%PropsR)) then - LB(1:2) = lbound(SrcInitTypeData%PropsR, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%PropsR, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%PropsR) + UB(1:2) = ubound(SrcInitTypeData%PropsR) if (.not. allocated(DstInitTypeData%PropsR)) then allocate(DstInitTypeData%PropsR(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1494,8 +1522,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropsR = SrcInitTypeData%PropsR end if if (allocated(SrcInitTypeData%PropsS)) then - LB(1:2) = lbound(SrcInitTypeData%PropsS, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%PropsS, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%PropsS) + UB(1:2) = ubound(SrcInitTypeData%PropsS) if (.not. allocated(DstInitTypeData%PropsS)) then allocate(DstInitTypeData%PropsS(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1506,8 +1534,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%PropsS = SrcInitTypeData%PropsS end if if (allocated(SrcInitTypeData%K)) then - LB(1:2) = lbound(SrcInitTypeData%K, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%K, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%K) + UB(1:2) = ubound(SrcInitTypeData%K) if (.not. allocated(DstInitTypeData%K)) then allocate(DstInitTypeData%K(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1518,8 +1546,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%K = SrcInitTypeData%K end if if (allocated(SrcInitTypeData%M)) then - LB(1:2) = lbound(SrcInitTypeData%M, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%M, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%M) + UB(1:2) = ubound(SrcInitTypeData%M) if (.not. allocated(DstInitTypeData%M)) then allocate(DstInitTypeData%M(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1530,8 +1558,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%M = SrcInitTypeData%M end if if (allocated(SrcInitTypeData%ElemProps)) then - LB(1:2) = lbound(SrcInitTypeData%ElemProps, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%ElemProps, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%ElemProps) + UB(1:2) = ubound(SrcInitTypeData%ElemProps) if (.not. allocated(DstInitTypeData%ElemProps)) then allocate(DstInitTypeData%ElemProps(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1542,8 +1570,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%ElemProps = SrcInitTypeData%ElemProps end if if (allocated(SrcInitTypeData%MemberNodes)) then - LB(1:2) = lbound(SrcInitTypeData%MemberNodes, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%MemberNodes, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%MemberNodes) + UB(1:2) = ubound(SrcInitTypeData%MemberNodes) if (.not. allocated(DstInitTypeData%MemberNodes)) then allocate(DstInitTypeData%MemberNodes(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1554,8 +1582,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%MemberNodes = SrcInitTypeData%MemberNodes end if if (allocated(SrcInitTypeData%NodesConnN)) then - LB(1:2) = lbound(SrcInitTypeData%NodesConnN, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%NodesConnN, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%NodesConnN) + UB(1:2) = ubound(SrcInitTypeData%NodesConnN) if (.not. allocated(DstInitTypeData%NodesConnN)) then allocate(DstInitTypeData%NodesConnN(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1566,8 +1594,8 @@ subroutine SD_CopyInitType(SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, DstInitTypeData%NodesConnN = SrcInitTypeData%NodesConnN end if if (allocated(SrcInitTypeData%NodesConnE)) then - LB(1:2) = lbound(SrcInitTypeData%NodesConnE, kind=B8Ki) - UB(1:2) = ubound(SrcInitTypeData%NodesConnE, kind=B8Ki) + LB(1:2) = lbound(SrcInitTypeData%NodesConnE) + UB(1:2) = ubound(SrcInitTypeData%NodesConnE) if (.not. allocated(DstInitTypeData%NodesConnE)) then allocate(DstInitTypeData%NodesConnE(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1740,7 +1768,7 @@ subroutine SD_UnPackInitType(RF, OutData) type(RegFile), intent(inout) :: RF type(SD_InitType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackInitType' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1807,14 +1835,14 @@ subroutine SD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SD_CopyContState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcContStateData%qm)) then - LB(1:1) = lbound(SrcContStateData%qm, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%qm, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%qm) + UB(1:1) = ubound(SrcContStateData%qm) if (.not. allocated(DstContStateData%qm)) then allocate(DstContStateData%qm(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1825,8 +1853,8 @@ subroutine SD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrSta DstContStateData%qm = SrcContStateData%qm end if if (allocated(SrcContStateData%qmdot)) then - LB(1:1) = lbound(SrcContStateData%qmdot, kind=B8Ki) - UB(1:1) = ubound(SrcContStateData%qmdot, kind=B8Ki) + LB(1:1) = lbound(SrcContStateData%qmdot) + UB(1:1) = ubound(SrcContStateData%qmdot) if (.not. allocated(DstContStateData%qmdot)) then allocate(DstContStateData%qmdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1867,7 +1895,7 @@ subroutine SD_UnPackContState(RF, OutData) type(RegFile), intent(inout) :: RF type(SD_ContinuousStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackContState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1957,16 +1985,16 @@ subroutine SD_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOtherStateData%xdot)) then - LB(1:1) = lbound(SrcOtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(SrcOtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(SrcOtherStateData%xdot) + UB(1:1) = ubound(SrcOtherStateData%xdot) if (.not. allocated(DstOtherStateData%xdot)) then allocate(DstOtherStateData%xdot(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1987,16 +2015,16 @@ subroutine SD_DestroyOtherState(OtherStateData, ErrStat, ErrMsg) type(SD_OtherStateType), intent(inout) :: OtherStateData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_DestroyOtherState' ErrStat = ErrID_None ErrMsg = '' if (allocated(OtherStateData%xdot)) then - LB(1:1) = lbound(OtherStateData%xdot, kind=B8Ki) - UB(1:1) = ubound(OtherStateData%xdot, kind=B8Ki) + LB(1:1) = lbound(OtherStateData%xdot) + UB(1:1) = ubound(OtherStateData%xdot) do i1 = LB(1), UB(1) call SD_DestroyContState(OtherStateData%xdot(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2009,14 +2037,14 @@ subroutine SD_PackOtherState(RF, Indata) type(RegFile), intent(inout) :: RF type(SD_OtherStateType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%xdot)) if (allocated(InData%xdot)) then - call RegPackBounds(RF, 1, lbound(InData%xdot, kind=B8Ki), ubound(InData%xdot, kind=B8Ki)) - LB(1:1) = lbound(InData%xdot, kind=B8Ki) - UB(1:1) = ubound(InData%xdot, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%xdot), ubound(InData%xdot)) + LB(1:1) = lbound(InData%xdot) + UB(1:1) = ubound(InData%xdot) do i1 = LB(1), UB(1) call SD_PackContState(RF, InData%xdot(i1)) end do @@ -2029,8 +2057,8 @@ subroutine SD_UnPackOtherState(RF, OutData) type(RegFile), intent(inout) :: RF type(SD_OtherStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackOtherState' - integer(B8Ki) :: i1 - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -2050,1343 +2078,886 @@ 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(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%qmdotdot, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_L, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%F_L2, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UR_bar, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UR_bar_dot, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UR_bar_dotdot, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_NS, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_dot, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_dotdot, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%DU_full, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full_NS, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full_dot, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full_dotdot, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_full_elast, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%U_red, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FC_unit, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%SDWrOutput, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%AllOuts, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Fext, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Fext_red, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%FG, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_SIM, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%UL_0m, kind=B8Ki) - 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) - end if - if (allocated(MiscData%F_L)) then - deallocate(MiscData%F_L) - end if - if (allocated(MiscData%F_L2)) then - deallocate(MiscData%F_L2) + DstParamData%D1_142 = SrcParamData%D1_142 end if - if (allocated(MiscData%UR_bar)) then - deallocate(MiscData%UR_bar) + 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%UR_bar_dot)) then - deallocate(MiscData%UR_bar_dot) + 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_dotdot)) then - deallocate(MiscData%UR_bar_dotdot) + 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%UL)) then - deallocate(MiscData%UL) + 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%UL_NS)) then - deallocate(MiscData%UL_NS) + if (allocated(SrcParamData%D2_63)) then + LB(1:2) = lbound(SrcParamData%D2_63) + UB(1:2) = ubound(SrcParamData%D2_63) + if (.not. allocated(DstParamData%D2_63)) then + allocate(DstParamData%D2_63(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_63.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%D2_63 = SrcParamData%D2_63 end if - if (allocated(MiscData%UL_dot)) then - deallocate(MiscData%UL_dot) + if (allocated(SrcParamData%D2_64)) then + LB(1:2) = lbound(SrcParamData%D2_64) + UB(1:2) = ubound(SrcParamData%D2_64) + if (.not. allocated(DstParamData%D2_64)) then + allocate(DstParamData%D2_64(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_64.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%D2_64 = SrcParamData%D2_64 end if - if (allocated(MiscData%UL_dotdot)) then - deallocate(MiscData%UL_dotdot) + if (allocated(SrcParamData%MBB)) then + LB(1:2) = lbound(SrcParamData%MBB) + UB(1:2) = ubound(SrcParamData%MBB) + if (.not. allocated(DstParamData%MBB)) then + allocate(DstParamData%MBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MBB = SrcParamData%MBB end if - if (allocated(MiscData%DU_full)) then - deallocate(MiscData%DU_full) + if (allocated(SrcParamData%KBB)) then + LB(1:2) = lbound(SrcParamData%KBB) + UB(1:2) = ubound(SrcParamData%KBB) + if (.not. allocated(DstParamData%KBB)) then + allocate(DstParamData%KBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%KBB = SrcParamData%KBB end if - if (allocated(MiscData%U_full)) then - deallocate(MiscData%U_full) + if (allocated(SrcParamData%CBB)) then + LB(1:2) = lbound(SrcParamData%CBB) + UB(1:2) = ubound(SrcParamData%CBB) + if (.not. allocated(DstParamData%CBB)) then + allocate(DstParamData%CBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CBB.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CBB = SrcParamData%CBB end if - if (allocated(MiscData%U_full_NS)) then - deallocate(MiscData%U_full_NS) + if (allocated(SrcParamData%CMM)) then + LB(1:2) = lbound(SrcParamData%CMM) + UB(1:2) = ubound(SrcParamData%CMM) + if (.not. allocated(DstParamData%CMM)) then + allocate(DstParamData%CMM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%CMM = SrcParamData%CMM end if - if (allocated(MiscData%U_full_dot)) then - deallocate(MiscData%U_full_dot) + if (allocated(SrcParamData%MBM)) then + LB(1:2) = lbound(SrcParamData%MBM) + UB(1:2) = ubound(SrcParamData%MBM) + if (.not. allocated(DstParamData%MBM)) then + allocate(DstParamData%MBM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBM.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%MBM = SrcParamData%MBM end if - if (allocated(MiscData%U_full_dotdot)) then - deallocate(MiscData%U_full_dotdot) + if (allocated(SrcParamData%PhiL_T)) then + LB(1:2) = lbound(SrcParamData%PhiL_T) + UB(1:2) = ubound(SrcParamData%PhiL_T) + if (.not. allocated(DstParamData%PhiL_T)) then + allocate(DstParamData%PhiL_T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiL_T.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PhiL_T = SrcParamData%PhiL_T end if - if (allocated(MiscData%U_full_elast)) then - deallocate(MiscData%U_full_elast) + if (allocated(SrcParamData%PhiLInvOmgL2)) then + LB(1:2) = lbound(SrcParamData%PhiLInvOmgL2) + UB(1:2) = ubound(SrcParamData%PhiLInvOmgL2) + if (.not. allocated(DstParamData%PhiLInvOmgL2)) then + allocate(DstParamData%PhiLInvOmgL2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiLInvOmgL2.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%PhiLInvOmgL2 = SrcParamData%PhiLInvOmgL2 end if - if (allocated(MiscData%U_red)) then - deallocate(MiscData%U_red) + if (allocated(SrcParamData%KLLm1)) then + LB(1:2) = lbound(SrcParamData%KLLm1) + UB(1:2) = ubound(SrcParamData%KLLm1) + if (.not. allocated(DstParamData%KLLm1)) then + allocate(DstParamData%KLLm1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KLLm1.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%KLLm1 = SrcParamData%KLLm1 end if - if (allocated(MiscData%FC_unit)) then - deallocate(MiscData%FC_unit) + if (allocated(SrcParamData%AM2Jac)) then + LB(1:2) = lbound(SrcParamData%AM2Jac) + UB(1:2) = ubound(SrcParamData%AM2Jac) + if (.not. allocated(DstParamData%AM2Jac)) then + allocate(DstParamData%AM2Jac(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2Jac.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%AM2Jac = SrcParamData%AM2Jac end if - if (allocated(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(B8Ki) :: 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(B8Ki) :: i1, i2 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Elems, kind=B8Ki) - if (.not. allocated(DstParamData%Elems)) then - allocate(DstParamData%Elems(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%Elems.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2JacPiv.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%Elems = SrcParamData%Elems + DstParamData%AM2JacPiv = SrcParamData%AM2JacPiv end if - if (allocated(SrcParamData%ElemProps)) then - LB(1:1) = lbound(SrcParamData%ElemProps, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ElemProps, kind=B8Ki) - if (.not. allocated(DstParamData%ElemProps)) then - allocate(DstParamData%ElemProps(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%ElemProps.', 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_CopyElemPropType(SrcParamData%ElemProps(i1), DstParamData%ElemProps(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%FC)) then - LB(1:1) = lbound(SrcParamData%FC, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%FC, kind=B8Ki) - if (.not. allocated(DstParamData%FC)) then - allocate(DstParamData%FC(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%FC.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TIreact.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%FC = SrcParamData%FC + DstParamData%TIreact = SrcParamData%TIreact end if - if (allocated(SrcParamData%FG)) then - LB(1:1) = lbound(SrcParamData%FG, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%FG, kind=B8Ki) - if (.not. allocated(DstParamData%FG)) then - allocate(DstParamData%FG(LB(1):UB(1)), 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%FG.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_I.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%FG = SrcParamData%FG + DstParamData%Nodes_I = SrcParamData%Nodes_I end if - if (allocated(SrcParamData%DP0)) then - LB(1:2) = lbound(SrcParamData%DP0, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%DP0, kind=B8Ki) - if (.not. allocated(DstParamData%DP0)) then - allocate(DstParamData%DP0(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%DP0.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_L.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%DP0 = SrcParamData%DP0 + DstParamData%Nodes_L = SrcParamData%Nodes_L end if - if (allocated(SrcParamData%rPG)) then - LB(1:1) = lbound(SrcParamData%rPG, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%rPG, kind=B8Ki) - if (.not. allocated(DstParamData%rPG)) then - allocate(DstParamData%rPG(LB(1):UB(1)), 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%rPG.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_C.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%rPG = SrcParamData%rPG + DstParamData%Nodes_C = SrcParamData%Nodes_C end if - if (allocated(SrcParamData%NodeID2JointID)) then - LB(1:1) = lbound(SrcParamData%NodeID2JointID, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NodeID2JointID, kind=B8Ki) - if (.not. allocated(DstParamData%NodeID2JointID)) then - allocate(DstParamData%NodeID2JointID(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%NodeID2JointID.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI__.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%NodeID2JointID = SrcParamData%NodeID2JointID + DstParamData%IDI__ = SrcParamData%IDI__ end if - DstParamData%reduced = SrcParamData%reduced - if (allocated(SrcParamData%T_red)) then - LB(1:2) = lbound(SrcParamData%T_red, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%T_red, kind=B8Ki) - if (.not. allocated(DstParamData%T_red)) then - allocate(DstParamData%T_red(LB(1):UB(1),LB(2):UB(2)), 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%T_red.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_Rb.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%T_red = SrcParamData%T_red + DstParamData%IDI_Rb = SrcParamData%IDI_Rb end if - if (allocated(SrcParamData%T_red_T)) then - LB(1:2) = lbound(SrcParamData%T_red_T, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%T_red_T, kind=B8Ki) - 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%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%T_red_T.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_F.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%T_red_T = SrcParamData%T_red_T + DstParamData%IDI_F = SrcParamData%IDI_F end if - if (allocated(SrcParamData%NodesDOF)) then - LB(1:1) = lbound(SrcParamData%NodesDOF, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NodesDOF, kind=B8Ki) - if (.not. allocated(DstParamData%NodesDOF)) then - allocate(DstParamData%NodesDOF(LB(1):UB(1)), 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%NodesDOF.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDL_L.', 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%IDL_L = SrcParamData%IDL_L end if - if (allocated(SrcParamData%NodesDOFred)) then - LB(1:1) = lbound(SrcParamData%NodesDOFred, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%NodesDOFred, kind=B8Ki) - if (.not. allocated(DstParamData%NodesDOFred)) then - allocate(DstParamData%NodesDOFred(LB(1):UB(1)), 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%NodesDOFred.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC__.', 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%IDC__ = SrcParamData%IDC__ end if - if (allocated(SrcParamData%ElemsDOF)) then - LB(1:2) = lbound(SrcParamData%ElemsDOF, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%ElemsDOF, kind=B8Ki) - if (.not. allocated(DstParamData%ElemsDOF)) then - allocate(DstParamData%ElemsDOF(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%ElemsDOF.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_Rb.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%ElemsDOF = SrcParamData%ElemsDOF + DstParamData%IDC_Rb = SrcParamData%IDC_Rb end if - if (allocated(SrcParamData%DOFred2Nodes)) then - LB(1:2) = lbound(SrcParamData%DOFred2Nodes, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%DOFred2Nodes, kind=B8Ki) - if (.not. allocated(DstParamData%DOFred2Nodes)) then - allocate(DstParamData%DOFred2Nodes(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%DOFred2Nodes.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_L.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%DOFred2Nodes = SrcParamData%DOFred2Nodes + DstParamData%IDC_L = SrcParamData%IDC_L end if - if (allocated(SrcParamData%CtrlElem2Channel)) then - LB(1:2) = lbound(SrcParamData%CtrlElem2Channel, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%CtrlElem2Channel, kind=B8Ki) - if (.not. allocated(DstParamData%CtrlElem2Channel)) then - allocate(DstParamData%CtrlElem2Channel(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%CtrlElem2Channel.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_F.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%CtrlElem2Channel = SrcParamData%CtrlElem2Channel + DstParamData%IDC_F = SrcParamData%IDC_F 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%KMMDiag, kind=B8Ki) - if (.not. allocated(DstParamData%KMMDiag)) then - allocate(DstParamData%KMMDiag(LB(1):UB(1)), 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%KMMDiag.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDR__.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%KMMDiag = SrcParamData%KMMDiag + DstParamData%IDR__ = SrcParamData%IDR__ end if - if (allocated(SrcParamData%CMMDiag)) then - LB(1:1) = lbound(SrcParamData%CMMDiag, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%CMMDiag, kind=B8Ki) - if (.not. allocated(DstParamData%CMMDiag)) then - allocate(DstParamData%CMMDiag(LB(1):UB(1)), 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%CMMDiag.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__Rb.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%CMMDiag = SrcParamData%CMMDiag + DstParamData%ID__Rb = SrcParamData%ID__Rb end if - if (allocated(SrcParamData%MMB)) then - LB(1:2) = lbound(SrcParamData%MMB, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%MMB, kind=B8Ki) - if (.not. allocated(DstParamData%MMB)) then - allocate(DstParamData%MMB(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%MMB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__L.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%MMB = SrcParamData%MMB + DstParamData%ID__L = SrcParamData%ID__L end if - if (allocated(SrcParamData%MBmmB)) then - LB(1:2) = lbound(SrcParamData%MBmmB, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%MBmmB, kind=B8Ki) - if (.not. allocated(DstParamData%MBmmB)) then - allocate(DstParamData%MBmmB(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%MBmmB.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ID__F.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%MBmmB = SrcParamData%MBmmB + DstParamData%ID__F = SrcParamData%ID__F end if - if (allocated(SrcParamData%C1_11)) then - LB(1:2) = lbound(SrcParamData%C1_11, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C1_11, kind=B8Ki) - if (.not. allocated(DstParamData%C1_11)) then - allocate(DstParamData%C1_11(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%C1_11.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%C1_11 = SrcParamData%C1_11 + 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%C1_12)) then - LB(1:2) = lbound(SrcParamData%C1_12, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C1_12, kind=B8Ki) - if (.not. allocated(DstParamData%C1_12)) then - allocate(DstParamData%C1_12(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%C1_12.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst2.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%C1_12 = SrcParamData%C1_12 + 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%D1_141)) then - LB(1:2) = lbound(SrcParamData%D1_141, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%D1_141, kind=B8Ki) - if (.not. allocated(DstParamData%D1_141)) then - allocate(DstParamData%D1_141(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%D1_141.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MoutLst3.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%D1_141 = SrcParamData%D1_141 + 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%D1_142)) then - LB(1:2) = lbound(SrcParamData%D1_142, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%D1_142, kind=B8Ki) - if (.not. allocated(DstParamData%D1_142)) then - allocate(DstParamData%D1_142(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%D1_142.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%D1_142 = SrcParamData%D1_142 + 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%PhiM)) then - LB(1:2) = lbound(SrcParamData%PhiM, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PhiM, kind=B8Ki) - 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 + 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%C2_61)) then - LB(1:2) = lbound(SrcParamData%C2_61, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C2_61, kind=B8Ki) - 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 + 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%C2_62)) then - LB(1:2) = lbound(SrcParamData%C2_62, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%C2_62, kind=B8Ki) - 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 + if (allocated(ParamData%FC)) then + deallocate(ParamData%FC) end if - if (allocated(SrcParamData%PhiRb_TI)) then - LB(1:2) = lbound(SrcParamData%PhiRb_TI, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PhiRb_TI, kind=B8Ki) - 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 + if (allocated(ParamData%FG)) then + deallocate(ParamData%FG) end if - if (allocated(SrcParamData%D2_63)) then - LB(1:2) = lbound(SrcParamData%D2_63, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%D2_63, kind=B8Ki) - if (.not. allocated(DstParamData%D2_63)) then - allocate(DstParamData%D2_63(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_63.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%D2_63 = SrcParamData%D2_63 + if (allocated(ParamData%DP0)) then + deallocate(ParamData%DP0) end if - if (allocated(SrcParamData%D2_64)) then - LB(1:2) = lbound(SrcParamData%D2_64, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%D2_64, kind=B8Ki) - if (.not. allocated(DstParamData%D2_64)) then - allocate(DstParamData%D2_64(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%D2_64.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%D2_64 = SrcParamData%D2_64 + if (allocated(ParamData%rPG)) then + deallocate(ParamData%rPG) end if - if (allocated(SrcParamData%MBB)) then - LB(1:2) = lbound(SrcParamData%MBB, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%MBB, kind=B8Ki) - if (.not. allocated(DstParamData%MBB)) then - allocate(DstParamData%MBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBB.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%MBB = SrcParamData%MBB + if (allocated(ParamData%NodeID2JointID)) then + deallocate(ParamData%NodeID2JointID) end if - if (allocated(SrcParamData%KBB)) then - LB(1:2) = lbound(SrcParamData%KBB, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%KBB, kind=B8Ki) - if (.not. allocated(DstParamData%KBB)) then - allocate(DstParamData%KBB(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KBB.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%KBB = SrcParamData%KBB + if (allocated(ParamData%CMassNode)) then + deallocate(ParamData%CMassNode) end if - if (allocated(SrcParamData%CBB)) then - LB(1:2) = lbound(SrcParamData%CBB, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%CBB, kind=B8Ki) - 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 + if (allocated(ParamData%CMassWeight)) then + deallocate(ParamData%CMassWeight) end if - if (allocated(SrcParamData%CMM)) then - LB(1:2) = lbound(SrcParamData%CMM, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%CMM, kind=B8Ki) - if (.not. allocated(DstParamData%CMM)) then - allocate(DstParamData%CMM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%CMM.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%CMM = SrcParamData%CMM - end if - if (allocated(SrcParamData%MBM)) then - LB(1:2) = lbound(SrcParamData%MBM, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%MBM, kind=B8Ki) - if (.not. allocated(DstParamData%MBM)) then - allocate(DstParamData%MBM(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%MBM.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%MBM = SrcParamData%MBM - end if - if (allocated(SrcParamData%PhiL_T)) then - LB(1:2) = lbound(SrcParamData%PhiL_T, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PhiL_T, kind=B8Ki) - if (.not. allocated(DstParamData%PhiL_T)) then - allocate(DstParamData%PhiL_T(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiL_T.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%PhiL_T = SrcParamData%PhiL_T - end if - if (allocated(SrcParamData%PhiLInvOmgL2)) then - LB(1:2) = lbound(SrcParamData%PhiLInvOmgL2, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%PhiLInvOmgL2, kind=B8Ki) - if (.not. allocated(DstParamData%PhiLInvOmgL2)) then - allocate(DstParamData%PhiLInvOmgL2(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PhiLInvOmgL2.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%PhiLInvOmgL2 = SrcParamData%PhiLInvOmgL2 - end if - if (allocated(SrcParamData%KLLm1)) then - LB(1:2) = lbound(SrcParamData%KLLm1, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%KLLm1, kind=B8Ki) - if (.not. allocated(DstParamData%KLLm1)) then - allocate(DstParamData%KLLm1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%KLLm1.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%KLLm1 = SrcParamData%KLLm1 - end if - if (allocated(SrcParamData%AM2Jac)) then - LB(1:2) = lbound(SrcParamData%AM2Jac, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%AM2Jac, kind=B8Ki) - if (.not. allocated(DstParamData%AM2Jac)) then - allocate(DstParamData%AM2Jac(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2Jac.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%AM2Jac = SrcParamData%AM2Jac - end if - if (allocated(SrcParamData%AM2JacPiv)) then - LB(1:1) = lbound(SrcParamData%AM2JacPiv, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%AM2JacPiv, kind=B8Ki) - if (.not. allocated(DstParamData%AM2JacPiv)) then - allocate(DstParamData%AM2JacPiv(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AM2JacPiv.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%AM2JacPiv = SrcParamData%AM2JacPiv - end if - if (allocated(SrcParamData%TI)) then - LB(1:2) = lbound(SrcParamData%TI, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%TI, kind=B8Ki) - if (.not. allocated(DstParamData%TI)) then - allocate(DstParamData%TI(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TI.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%TI = SrcParamData%TI - end if - if (allocated(SrcParamData%TIreact)) then - LB(1:2) = lbound(SrcParamData%TIreact, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%TIreact, kind=B8Ki) - if (.not. allocated(DstParamData%TIreact)) then - allocate(DstParamData%TIreact(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TIreact.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%TIreact = SrcParamData%TIreact - end if - DstParamData%nNodes = SrcParamData%nNodes - DstParamData%nNodes_I = SrcParamData%nNodes_I - DstParamData%nNodes_L = SrcParamData%nNodes_L - DstParamData%nNodes_C = SrcParamData%nNodes_C - if (allocated(SrcParamData%Nodes_I)) then - LB(1:2) = lbound(SrcParamData%Nodes_I, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Nodes_I, kind=B8Ki) - if (.not. allocated(DstParamData%Nodes_I)) then - allocate(DstParamData%Nodes_I(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_I.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Nodes_I = SrcParamData%Nodes_I - end if - if (allocated(SrcParamData%Nodes_L)) then - LB(1:2) = lbound(SrcParamData%Nodes_L, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Nodes_L, kind=B8Ki) - if (.not. allocated(DstParamData%Nodes_L)) then - allocate(DstParamData%Nodes_L(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_L.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Nodes_L = SrcParamData%Nodes_L - end if - if (allocated(SrcParamData%Nodes_C)) then - LB(1:2) = lbound(SrcParamData%Nodes_C, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Nodes_C, kind=B8Ki) - if (.not. allocated(DstParamData%Nodes_C)) then - allocate(DstParamData%Nodes_C(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Nodes_C.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%Nodes_C = SrcParamData%Nodes_C - end if - DstParamData%nDOFI__ = SrcParamData%nDOFI__ - DstParamData%nDOFI_Rb = SrcParamData%nDOFI_Rb - DstParamData%nDOFI_F = SrcParamData%nDOFI_F - DstParamData%nDOFL_L = SrcParamData%nDOFL_L - DstParamData%nDOFC__ = SrcParamData%nDOFC__ - DstParamData%nDOFC_Rb = SrcParamData%nDOFC_Rb - DstParamData%nDOFC_L = SrcParamData%nDOFC_L - DstParamData%nDOFC_F = SrcParamData%nDOFC_F - DstParamData%nDOFR__ = SrcParamData%nDOFR__ - DstParamData%nDOF__Rb = SrcParamData%nDOF__Rb - DstParamData%nDOF__L = SrcParamData%nDOF__L - DstParamData%nDOF__F = SrcParamData%nDOF__F - if (allocated(SrcParamData%IDI__)) then - LB(1:1) = lbound(SrcParamData%IDI__, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDI__, kind=B8Ki) - if (.not. allocated(DstParamData%IDI__)) then - allocate(DstParamData%IDI__(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI__.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDI__ = SrcParamData%IDI__ - end if - if (allocated(SrcParamData%IDI_Rb)) then - LB(1:1) = lbound(SrcParamData%IDI_Rb, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDI_Rb, kind=B8Ki) - if (.not. allocated(DstParamData%IDI_Rb)) then - allocate(DstParamData%IDI_Rb(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_Rb.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDI_Rb = SrcParamData%IDI_Rb - end if - if (allocated(SrcParamData%IDI_F)) then - LB(1:1) = lbound(SrcParamData%IDI_F, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDI_F, kind=B8Ki) - if (.not. allocated(DstParamData%IDI_F)) then - allocate(DstParamData%IDI_F(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDI_F.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDI_F = SrcParamData%IDI_F - end if - if (allocated(SrcParamData%IDL_L)) then - LB(1:1) = lbound(SrcParamData%IDL_L, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDL_L, kind=B8Ki) - if (.not. allocated(DstParamData%IDL_L)) then - allocate(DstParamData%IDL_L(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDL_L.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDL_L = SrcParamData%IDL_L - end if - if (allocated(SrcParamData%IDC__)) then - LB(1:1) = lbound(SrcParamData%IDC__, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDC__, kind=B8Ki) - if (.not. allocated(DstParamData%IDC__)) then - allocate(DstParamData%IDC__(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC__.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDC__ = SrcParamData%IDC__ - end if - if (allocated(SrcParamData%IDC_Rb)) then - LB(1:1) = lbound(SrcParamData%IDC_Rb, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDC_Rb, kind=B8Ki) - if (.not. allocated(DstParamData%IDC_Rb)) then - allocate(DstParamData%IDC_Rb(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_Rb.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDC_Rb = SrcParamData%IDC_Rb - end if - if (allocated(SrcParamData%IDC_L)) then - LB(1:1) = lbound(SrcParamData%IDC_L, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDC_L, kind=B8Ki) - if (.not. allocated(DstParamData%IDC_L)) then - allocate(DstParamData%IDC_L(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_L.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDC_L = SrcParamData%IDC_L - end if - if (allocated(SrcParamData%IDC_F)) then - LB(1:1) = lbound(SrcParamData%IDC_F, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDC_F, kind=B8Ki) - if (.not. allocated(DstParamData%IDC_F)) then - allocate(DstParamData%IDC_F(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IDC_F.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%IDC_F = SrcParamData%IDC_F - end if - if (allocated(SrcParamData%IDR__)) then - LB(1:1) = lbound(SrcParamData%IDR__, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%IDR__, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ID__Rb, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ID__L, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ID__F, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%MoutLst, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%MoutLst2, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%MoutLst3, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%OutParam, kind=B8Ki) - 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, kind=B8Ki) - UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) - 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, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%du, kind=B8Ki) - 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(B8Ki) :: i1, i2 - integer(B8Ki) :: 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, kind=B8Ki) - UB(1:1) = ubound(ParamData%ElemProps, kind=B8Ki) - 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) + if (allocated(ParamData%CMassOffset)) then + deallocate(ParamData%CMassOffset) end if if (allocated(ParamData%T_red)) then deallocate(ParamData%T_red) @@ -3395,8 +2966,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%T_red_T) end if if (allocated(ParamData%NodesDOF)) then - LB(1:1) = lbound(ParamData%NodesDOF, kind=B8Ki) - UB(1:1) = ubound(ParamData%NodesDOF, kind=B8Ki) + 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) @@ -3404,8 +2975,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%NodesDOF) end if if (allocated(ParamData%NodesDOFred)) then - LB(1:1) = lbound(ParamData%NodesDOFred, kind=B8Ki) - UB(1:1) = ubound(ParamData%NodesDOFred, kind=B8Ki) + 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) @@ -3545,8 +3116,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%ID__F) end if if (allocated(ParamData%MoutLst)) then - LB(1:1) = lbound(ParamData%MoutLst, kind=B8Ki) - UB(1:1) = ubound(ParamData%MoutLst, kind=B8Ki) + LB(1:1) = lbound(ParamData%MoutLst) + UB(1:1) = ubound(ParamData%MoutLst) do i1 = LB(1), UB(1) call SD_DestroyMeshAuxDataType(ParamData%MoutLst(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3554,8 +3125,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%MoutLst) end if if (allocated(ParamData%MoutLst2)) then - LB(1:1) = lbound(ParamData%MoutLst2, kind=B8Ki) - UB(1:1) = ubound(ParamData%MoutLst2, kind=B8Ki) + LB(1:1) = lbound(ParamData%MoutLst2) + UB(1:1) = ubound(ParamData%MoutLst2) do i1 = LB(1), UB(1) call SD_DestroyMeshAuxDataType(ParamData%MoutLst2(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3563,8 +3134,8 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%MoutLst2) end if if (allocated(ParamData%MoutLst3)) then - LB(1:1) = lbound(ParamData%MoutLst3, kind=B8Ki) - UB(1:1) = ubound(ParamData%MoutLst3, kind=B8Ki) + LB(1:1) = lbound(ParamData%MoutLst3) + UB(1:1) = ubound(ParamData%MoutLst3) do i1 = LB(1), UB(1) call SD_DestroyMeshAuxDataType(ParamData%MoutLst3(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3572,29 +3143,29 @@ subroutine SD_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%MoutLst3) end if if (allocated(ParamData%OutParam)) then - LB(1:1) = lbound(ParamData%OutParam, kind=B8Ki) - UB(1:1) = ubound(ParamData%OutParam, kind=B8Ki) + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) do i1 = LB(1), UB(1) call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end do deallocate(ParamData%OutParam) end if - if (allocated(ParamData%Jac_u_indx)) then - deallocate(ParamData%Jac_u_indx) - end if - if (allocated(ParamData%du)) then - deallocate(ParamData%du) - end if end subroutine subroutine SD_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(SD_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'SD_PackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + 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) @@ -3604,9 +3175,9 @@ subroutine SD_PackParam(RF, Indata) call RegPackAlloc(RF, InData%Elems) call RegPack(RF, allocated(InData%ElemProps)) if (allocated(InData%ElemProps)) then - call RegPackBounds(RF, 1, lbound(InData%ElemProps, kind=B8Ki), ubound(InData%ElemProps, kind=B8Ki)) - LB(1:1) = lbound(InData%ElemProps, kind=B8Ki) - UB(1:1) = ubound(InData%ElemProps, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%ElemProps), ubound(InData%ElemProps)) + LB(1:1) = lbound(InData%ElemProps) + UB(1:1) = ubound(InData%ElemProps) do i1 = LB(1), UB(1) call SD_PackElemPropType(RF, InData%ElemProps(i1)) end do @@ -3616,23 +3187,26 @@ subroutine SD_PackParam(RF, Indata) call RegPackAlloc(RF, InData%DP0) call RegPackAlloc(RF, InData%rPG) call RegPackAlloc(RF, InData%NodeID2JointID) + call RegPackAlloc(RF, InData%CMassNode) + call RegPackAlloc(RF, InData%CMassWeight) + call RegPackAlloc(RF, InData%CMassOffset) call RegPack(RF, InData%reduced) call RegPackAlloc(RF, InData%T_red) call RegPackAlloc(RF, InData%T_red_T) call RegPack(RF, allocated(InData%NodesDOF)) if (allocated(InData%NodesDOF)) then - call RegPackBounds(RF, 1, lbound(InData%NodesDOF, kind=B8Ki), ubound(InData%NodesDOF, kind=B8Ki)) - LB(1:1) = lbound(InData%NodesDOF, kind=B8Ki) - UB(1:1) = ubound(InData%NodesDOF, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%NodesDOF), ubound(InData%NodesDOF)) + LB(1:1) = lbound(InData%NodesDOF) + UB(1:1) = ubound(InData%NodesDOF) do i1 = LB(1), UB(1) call SD_PackIList(RF, InData%NodesDOF(i1)) end do end if call RegPack(RF, allocated(InData%NodesDOFred)) if (allocated(InData%NodesDOFred)) then - call RegPackBounds(RF, 1, lbound(InData%NodesDOFred, kind=B8Ki), ubound(InData%NodesDOFred, kind=B8Ki)) - LB(1:1) = lbound(InData%NodesDOFred, kind=B8Ki) - UB(1:1) = ubound(InData%NodesDOFred, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%NodesDOFred), ubound(InData%NodesDOFred)) + LB(1:1) = lbound(InData%NodesDOFred) + UB(1:1) = ubound(InData%NodesDOFred) do i1 = LB(1), UB(1) call SD_PackIList(RF, InData%NodesDOFred(i1)) end do @@ -3710,36 +3284,36 @@ subroutine SD_PackParam(RF, Indata) call RegPack(RF, InData%OutSFmt) call RegPack(RF, allocated(InData%MoutLst)) if (allocated(InData%MoutLst)) then - call RegPackBounds(RF, 1, lbound(InData%MoutLst, kind=B8Ki), ubound(InData%MoutLst, kind=B8Ki)) - LB(1:1) = lbound(InData%MoutLst, kind=B8Ki) - UB(1:1) = ubound(InData%MoutLst, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MoutLst), ubound(InData%MoutLst)) + LB(1:1) = lbound(InData%MoutLst) + UB(1:1) = ubound(InData%MoutLst) do i1 = LB(1), UB(1) call SD_PackMeshAuxDataType(RF, InData%MoutLst(i1)) end do end if call RegPack(RF, allocated(InData%MoutLst2)) if (allocated(InData%MoutLst2)) then - call RegPackBounds(RF, 1, lbound(InData%MoutLst2, kind=B8Ki), ubound(InData%MoutLst2, kind=B8Ki)) - LB(1:1) = lbound(InData%MoutLst2, kind=B8Ki) - UB(1:1) = ubound(InData%MoutLst2, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MoutLst2), ubound(InData%MoutLst2)) + LB(1:1) = lbound(InData%MoutLst2) + UB(1:1) = ubound(InData%MoutLst2) do i1 = LB(1), UB(1) call SD_PackMeshAuxDataType(RF, InData%MoutLst2(i1)) end do end if call RegPack(RF, allocated(InData%MoutLst3)) if (allocated(InData%MoutLst3)) then - call RegPackBounds(RF, 1, lbound(InData%MoutLst3, kind=B8Ki), ubound(InData%MoutLst3, kind=B8Ki)) - LB(1:1) = lbound(InData%MoutLst3, kind=B8Ki) - UB(1:1) = ubound(InData%MoutLst3, kind=B8Ki) + call RegPackBounds(RF, 1, lbound(InData%MoutLst3), ubound(InData%MoutLst3)) + LB(1:1) = lbound(InData%MoutLst3) + UB(1:1) = ubound(InData%MoutLst3) do i1 = LB(1), UB(1) call SD_PackMeshAuxDataType(RF, InData%MoutLst3(i1)) end do end if call RegPack(RF, allocated(InData%OutParam)) if (allocated(InData%OutParam)) then - call RegPackBounds(RF, 1, lbound(InData%OutParam, kind=B8Ki), ubound(InData%OutParam, kind=B8Ki)) - LB(1:1) = lbound(InData%OutParam, kind=B8Ki) - UB(1:1) = ubound(InData%OutParam, kind=B8Ki) + 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 @@ -3751,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 @@ -3764,11 +3332,17 @@ subroutine SD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(SD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SD_UnPackParam' - integer(B8Ki) :: i1, i2 - integer(B8Ki) :: LB(2), UB(2) + 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%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 @@ -3794,6 +3368,9 @@ subroutine SD_UnPackParam(RF, OutData) call RegUnpackAlloc(RF, OutData%DP0); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%rPG); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%NodeID2JointID); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CMassNode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CMassWeight); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CMassOffset); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%reduced); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%T_red); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%T_red_T); if (RegCheckErr(RF, RoutineName)) return @@ -3953,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) @@ -3967,7 +3538,7 @@ subroutine SD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SD_CopyInput' @@ -3980,8 +3551,8 @@ subroutine SD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return if (allocated(SrcInputData%CableDeltaL)) then - LB(1:1) = lbound(SrcInputData%CableDeltaL, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%CableDeltaL, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%CableDeltaL) + UB(1:1) = ubound(SrcInputData%CableDeltaL) if (.not. allocated(DstInputData%CableDeltaL)) then allocate(DstInputData%CableDeltaL(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -4022,98 +3593,633 @@ subroutine SD_PackInput(RF, Indata) if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine SD_UnPackInput(RF, OutData) +subroutine SD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SD_UnPackInput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%TPMesh) ! TPMesh + call MeshUnpack(RF, OutData%LMesh) ! LMesh + call RegUnpackAlloc(RF, OutData%CableDeltaL); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) + type(SD_OutputType), intent(inout) :: SrcOutputData + type(SD_OutputType), intent(inout) :: DstOutputData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshCopy(SrcOutputData%Y1Mesh, DstOutputData%Y1Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%Y2Mesh, DstOutputData%Y2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call MeshCopy(SrcOutputData%Y3Mesh, DstOutputData%Y3Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + end if +end subroutine + +subroutine SD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( OutputData%Y1Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%Y2Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call MeshDestroy( OutputData%Y3Mesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if +end subroutine + +subroutine SD_PackOutput(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_InputType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'SD_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + 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%TPMesh) ! TPMesh - call MeshUnpack(RF, OutData%LMesh) ! LMesh - call RegUnpackAlloc(RF, OutData%CableDeltaL); if (RegCheckErr(RF, RoutineName)) 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_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) - type(SD_OutputType), intent(inout) :: SrcOutputData - type(SD_OutputType), intent(inout) :: DstOutputData +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(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SD_CopyOutput' + character(*), parameter :: RoutineName = 'SD_CopyMisc' ErrStat = ErrID_None ErrMsg = '' - call MeshCopy(SrcOutputData%Y1Mesh, DstOutputData%Y1Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcOutputData%Y2Mesh, DstOutputData%Y2Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SD_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call MeshCopy(SrcOutputData%Y3Mesh, DstOutputData%Y3Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SD_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, 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, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%WriteOutput, kind=B8Ki) - if (.not. allocated(DstOutputData%WriteOutput)) then - allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + 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 DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Fext_red.', ErrStat, ErrMsg, RoutineName) return end if end if - DstOutputData%WriteOutput = SrcOutputData%WriteOutput + 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 + 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' - integer(B8Ki) :: LB(1), UB(1) + 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) @@ -4459,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 a01f31e191..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 @@ -357,14 +361,14 @@ subroutine SC_DX_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SC_DX_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcInputData%toSC)) then - LB(1:1) = lbound(SrcInputData%toSC, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%toSC, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%toSC) + UB(1:1) = ubound(SrcInputData%toSC) if (.not. associated(DstInputData%toSC)) then allocate(DstInputData%toSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -412,7 +416,7 @@ subroutine SC_DX_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SC_DX_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_DX_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -475,7 +479,7 @@ SUBROUTINE SC_DX_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%toSC_Len = SIZE(InputData%toSC) IF (InputData%C_obj%toSC_Len > 0) & - InputData%C_obj%toSC = C_LOC(InputData%toSC(LBOUND(InputData%toSC,1, kind=B8Ki))) + InputData%C_obj%toSC = C_LOC(InputData%toSC(lbound(InputData%toSC,1))) END IF END IF END SUBROUTINE @@ -486,14 +490,14 @@ subroutine SC_DX_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SC_DX_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcOutputData%fromSC)) then - LB(1:1) = lbound(SrcOutputData%fromSC, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%fromSC, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%fromSC) + UB(1:1) = ubound(SrcOutputData%fromSC) if (.not. associated(DstOutputData%fromSC)) then allocate(DstOutputData%fromSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -507,8 +511,8 @@ subroutine SC_DX_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err DstOutputData%fromSC = SrcOutputData%fromSC end if if (associated(SrcOutputData%fromSCglob)) then - LB(1:1) = lbound(SrcOutputData%fromSCglob, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%fromSCglob, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%fromSCglob) + UB(1:1) = ubound(SrcOutputData%fromSCglob) if (.not. associated(DstOutputData%fromSCglob)) then allocate(DstOutputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -563,7 +567,7 @@ subroutine SC_DX_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SC_DX_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_DX_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -640,7 +644,7 @@ SUBROUTINE SC_DX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%fromSC_Len = SIZE(OutputData%fromSC) IF (OutputData%C_obj%fromSC_Len > 0) & - OutputData%C_obj%fromSC = C_LOC(OutputData%fromSC(LBOUND(OutputData%fromSC,1, kind=B8Ki))) + OutputData%C_obj%fromSC = C_LOC(OutputData%fromSC(lbound(OutputData%fromSC,1))) END IF END IF @@ -652,9 +656,149 @@ SUBROUTINE SC_DX_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%fromSCglob_Len = SIZE(OutputData%fromSCglob) IF (OutputData%C_obj%fromSCglob_Len > 0) & - OutputData%C_obj%fromSCglob = C_LOC(OutputData%fromSCglob(LBOUND(OutputData%fromSCglob,1, kind=B8Ki))) + OutputData%C_obj%fromSCglob = C_LOC(OutputData%fromSCglob(lbound(OutputData%fromSCglob,1))) 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 5e37b5f366..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 @@ -386,7 +393,7 @@ subroutine SC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SC_CopyParam' @@ -413,8 +420,8 @@ subroutine SC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumParamTurbine = SrcParamData%NumParamTurbine DstParamData%C_obj%NumParamTurbine = SrcParamData%C_obj%NumParamTurbine if (associated(SrcParamData%ParamGlobal)) then - LB(1:1) = lbound(SrcParamData%ParamGlobal, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ParamGlobal, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ParamGlobal) + UB(1:1) = ubound(SrcParamData%ParamGlobal) if (.not. associated(DstParamData%ParamGlobal)) then allocate(DstParamData%ParamGlobal(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -428,8 +435,8 @@ subroutine SC_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%ParamGlobal = SrcParamData%ParamGlobal end if if (associated(SrcParamData%ParamTurbine)) then - LB(1:1) = lbound(SrcParamData%ParamTurbine, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%ParamTurbine, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%ParamTurbine) + UB(1:1) = ubound(SrcParamData%ParamTurbine) if (.not. associated(DstParamData%ParamTurbine)) then allocate(DstParamData%ParamTurbine(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -500,7 +507,7 @@ subroutine SC_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(SC_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackParam' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -618,7 +625,7 @@ SUBROUTINE SC_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%ParamGlobal_Len = SIZE(ParamData%ParamGlobal) IF (ParamData%C_obj%ParamGlobal_Len > 0) & - ParamData%C_obj%ParamGlobal = C_LOC(ParamData%ParamGlobal(LBOUND(ParamData%ParamGlobal,1, kind=B8Ki))) + ParamData%C_obj%ParamGlobal = C_LOC(ParamData%ParamGlobal(lbound(ParamData%ParamGlobal,1))) END IF END IF @@ -630,7 +637,7 @@ SUBROUTINE SC_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) ELSE ParamData%C_obj%ParamTurbine_Len = SIZE(ParamData%ParamTurbine) IF (ParamData%C_obj%ParamTurbine_Len > 0) & - ParamData%C_obj%ParamTurbine = C_LOC(ParamData%ParamTurbine(LBOUND(ParamData%ParamTurbine,1, kind=B8Ki))) + ParamData%C_obj%ParamTurbine = C_LOC(ParamData%ParamTurbine(lbound(ParamData%ParamTurbine,1))) END IF END IF END SUBROUTINE @@ -641,14 +648,14 @@ subroutine SC_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SC_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcDiscStateData%Global)) then - LB(1:1) = lbound(SrcDiscStateData%Global, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%Global, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%Global) + UB(1:1) = ubound(SrcDiscStateData%Global) if (.not. associated(DstDiscStateData%Global)) then allocate(DstDiscStateData%Global(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -662,8 +669,8 @@ subroutine SC_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Global = SrcDiscStateData%Global end if if (associated(SrcDiscStateData%Turbine)) then - LB(1:1) = lbound(SrcDiscStateData%Turbine, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%Turbine, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%Turbine) + UB(1:1) = ubound(SrcDiscStateData%Turbine) if (.not. associated(DstDiscStateData%Turbine)) then allocate(DstDiscStateData%Turbine(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -718,7 +725,7 @@ subroutine SC_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(SC_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackDiscState' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -795,7 +802,7 @@ SUBROUTINE SC_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) ELSE DiscStateData%C_obj%Global_Len = SIZE(DiscStateData%Global) IF (DiscStateData%C_obj%Global_Len > 0) & - DiscStateData%C_obj%Global = C_LOC(DiscStateData%Global(LBOUND(DiscStateData%Global,1, kind=B8Ki))) + DiscStateData%C_obj%Global = C_LOC(DiscStateData%Global(lbound(DiscStateData%Global,1))) END IF END IF @@ -807,7 +814,7 @@ SUBROUTINE SC_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) ELSE DiscStateData%C_obj%Turbine_Len = SIZE(DiscStateData%Turbine) IF (DiscStateData%C_obj%Turbine_Len > 0) & - DiscStateData%C_obj%Turbine = C_LOC(DiscStateData%Turbine(LBOUND(DiscStateData%Turbine,1, kind=B8Ki))) + DiscStateData%C_obj%Turbine = C_LOC(DiscStateData%Turbine(lbound(DiscStateData%Turbine,1))) END IF END IF END SUBROUTINE @@ -1138,14 +1145,14 @@ subroutine SC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SC_CopyInput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcInputData%toSCglob)) then - LB(1:1) = lbound(SrcInputData%toSCglob, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%toSCglob, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%toSCglob) + UB(1:1) = ubound(SrcInputData%toSCglob) if (.not. associated(DstInputData%toSCglob)) then allocate(DstInputData%toSCglob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1159,8 +1166,8 @@ subroutine SC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%toSCglob = SrcInputData%toSCglob end if if (associated(SrcInputData%toSC)) then - LB(1:1) = lbound(SrcInputData%toSC, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%toSC, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%toSC) + UB(1:1) = ubound(SrcInputData%toSC) if (.not. associated(DstInputData%toSC)) then allocate(DstInputData%toSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1215,7 +1222,7 @@ subroutine SC_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(SC_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackInput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1292,7 +1299,7 @@ SUBROUTINE SC_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%toSCglob_Len = SIZE(InputData%toSCglob) IF (InputData%C_obj%toSCglob_Len > 0) & - InputData%C_obj%toSCglob = C_LOC(InputData%toSCglob(LBOUND(InputData%toSCglob,1, kind=B8Ki))) + InputData%C_obj%toSCglob = C_LOC(InputData%toSCglob(lbound(InputData%toSCglob,1))) END IF END IF @@ -1304,7 +1311,7 @@ SUBROUTINE SC_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) ELSE InputData%C_obj%toSC_Len = SIZE(InputData%toSC) IF (InputData%C_obj%toSC_Len > 0) & - InputData%C_obj%toSC = C_LOC(InputData%toSC(LBOUND(InputData%toSC,1, kind=B8Ki))) + InputData%C_obj%toSC = C_LOC(InputData%toSC(lbound(InputData%toSC,1))) END IF END IF END SUBROUTINE @@ -1315,14 +1322,14 @@ subroutine SC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'SC_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (associated(SrcOutputData%fromSCglob)) then - LB(1:1) = lbound(SrcOutputData%fromSCglob, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%fromSCglob, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%fromSCglob) + UB(1:1) = ubound(SrcOutputData%fromSCglob) if (.not. associated(DstOutputData%fromSCglob)) then allocate(DstOutputData%fromSCglob(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1336,8 +1343,8 @@ subroutine SC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%fromSCglob = SrcOutputData%fromSCglob end if if (associated(SrcOutputData%fromSC)) then - LB(1:1) = lbound(SrcOutputData%fromSC, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%fromSC, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%fromSC) + UB(1:1) = ubound(SrcOutputData%fromSC) if (.not. associated(DstOutputData%fromSC)) then allocate(DstOutputData%fromSC(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1392,7 +1399,7 @@ subroutine SC_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(SC_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'SC_UnPackOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc integer(B8Ki) :: PtrIdx @@ -1469,7 +1476,7 @@ SUBROUTINE SC_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%fromSCglob_Len = SIZE(OutputData%fromSCglob) IF (OutputData%C_obj%fromSCglob_Len > 0) & - OutputData%C_obj%fromSCglob = C_LOC(OutputData%fromSCglob(LBOUND(OutputData%fromSCglob,1, kind=B8Ki))) + OutputData%C_obj%fromSCglob = C_LOC(OutputData%fromSCglob(lbound(OutputData%fromSCglob,1))) END IF END IF @@ -1481,7 +1488,7 @@ SUBROUTINE SC_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) ELSE OutputData%C_obj%fromSC_Len = SIZE(OutputData%fromSC) IF (OutputData%C_obj%fromSC_Len > 0) & - OutputData%C_obj%fromSC = C_LOC(OutputData%fromSC(LBOUND(OutputData%fromSC,1, kind=B8Ki))) + OutputData%C_obj%fromSC = C_LOC(OutputData%fromSC(lbound(OutputData%fromSC,1))) END IF END IF END SUBROUTINE @@ -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 2814beed3d..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 @@ -459,15 +484,15 @@ subroutine WD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'WD_CopyInitOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcInitOutputData%WriteOutputHdr)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -478,8 +503,8 @@ subroutine WD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, Err DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr end if if (allocated(SrcInitOutputData%WriteOutputUnt)) then - LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) - UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt, kind=B8Ki) + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -528,7 +553,7 @@ subroutine WD_UnPackInitOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(WD_InitOutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackInitOutput' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -581,14 +606,14 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'WD_CopyDiscState' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcDiscStateData%xhat_plane)) then - LB(1:2) = lbound(SrcDiscStateData%xhat_plane, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%xhat_plane, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%xhat_plane) + UB(1:2) = ubound(SrcDiscStateData%xhat_plane) if (.not. allocated(DstDiscStateData%xhat_plane)) then allocate(DstDiscStateData%xhat_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -599,8 +624,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%xhat_plane = SrcDiscStateData%xhat_plane end if if (allocated(SrcDiscStateData%YawErr_filt)) then - LB(1:1) = lbound(SrcDiscStateData%YawErr_filt, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%YawErr_filt, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%YawErr_filt) + UB(1:1) = ubound(SrcDiscStateData%YawErr_filt) if (.not. allocated(DstDiscStateData%YawErr_filt)) then allocate(DstDiscStateData%YawErr_filt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -613,8 +638,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%psi_skew_filt = SrcDiscStateData%psi_skew_filt DstDiscStateData%chi_skew_filt = SrcDiscStateData%chi_skew_filt if (allocated(SrcDiscStateData%V_plane_filt)) then - LB(1:2) = lbound(SrcDiscStateData%V_plane_filt, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%V_plane_filt, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%V_plane_filt) + UB(1:2) = ubound(SrcDiscStateData%V_plane_filt) if (.not. allocated(DstDiscStateData%V_plane_filt)) then allocate(DstDiscStateData%V_plane_filt(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -625,8 +650,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%V_plane_filt = SrcDiscStateData%V_plane_filt end if if (allocated(SrcDiscStateData%p_plane)) then - LB(1:2) = lbound(SrcDiscStateData%p_plane, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%p_plane, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%p_plane) + UB(1:2) = ubound(SrcDiscStateData%p_plane) if (.not. allocated(DstDiscStateData%p_plane)) then allocate(DstDiscStateData%p_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -637,8 +662,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%p_plane = SrcDiscStateData%p_plane end if if (allocated(SrcDiscStateData%x_plane)) then - LB(1:1) = lbound(SrcDiscStateData%x_plane, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%x_plane, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%x_plane) + UB(1:1) = ubound(SrcDiscStateData%x_plane) if (.not. allocated(DstDiscStateData%x_plane)) then allocate(DstDiscStateData%x_plane(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -649,8 +674,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%x_plane = SrcDiscStateData%x_plane end if if (allocated(SrcDiscStateData%Vx_wake)) then - LB(1:2) = lbound(SrcDiscStateData%Vx_wake, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Vx_wake, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Vx_wake) + UB(1:2) = ubound(SrcDiscStateData%Vx_wake) if (.not. allocated(DstDiscStateData%Vx_wake)) then allocate(DstDiscStateData%Vx_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -661,8 +686,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Vx_wake = SrcDiscStateData%Vx_wake end if if (allocated(SrcDiscStateData%Vr_wake)) then - LB(1:2) = lbound(SrcDiscStateData%Vr_wake, kind=B8Ki) - UB(1:2) = ubound(SrcDiscStateData%Vr_wake, kind=B8Ki) + LB(1:2) = lbound(SrcDiscStateData%Vr_wake) + UB(1:2) = ubound(SrcDiscStateData%Vr_wake) if (.not. allocated(DstDiscStateData%Vr_wake)) then allocate(DstDiscStateData%Vr_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -673,8 +698,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Vr_wake = SrcDiscStateData%Vr_wake end if if (allocated(SrcDiscStateData%Vx_wake2)) then - LB(1:3) = lbound(SrcDiscStateData%Vx_wake2, kind=B8Ki) - UB(1:3) = ubound(SrcDiscStateData%Vx_wake2, kind=B8Ki) + LB(1:3) = lbound(SrcDiscStateData%Vx_wake2) + UB(1:3) = ubound(SrcDiscStateData%Vx_wake2) if (.not. allocated(DstDiscStateData%Vx_wake2)) then allocate(DstDiscStateData%Vx_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -685,8 +710,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Vx_wake2 = SrcDiscStateData%Vx_wake2 end if if (allocated(SrcDiscStateData%Vy_wake2)) then - LB(1:3) = lbound(SrcDiscStateData%Vy_wake2, kind=B8Ki) - UB(1:3) = ubound(SrcDiscStateData%Vy_wake2, kind=B8Ki) + LB(1:3) = lbound(SrcDiscStateData%Vy_wake2) + UB(1:3) = ubound(SrcDiscStateData%Vy_wake2) if (.not. allocated(DstDiscStateData%Vy_wake2)) then allocate(DstDiscStateData%Vy_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -697,8 +722,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Vy_wake2 = SrcDiscStateData%Vy_wake2 end if if (allocated(SrcDiscStateData%Vz_wake2)) then - LB(1:3) = lbound(SrcDiscStateData%Vz_wake2, kind=B8Ki) - UB(1:3) = ubound(SrcDiscStateData%Vz_wake2, kind=B8Ki) + LB(1:3) = lbound(SrcDiscStateData%Vz_wake2) + UB(1:3) = ubound(SrcDiscStateData%Vz_wake2) if (.not. allocated(DstDiscStateData%Vz_wake2)) then allocate(DstDiscStateData%Vz_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -709,8 +734,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Vz_wake2 = SrcDiscStateData%Vz_wake2 end if if (allocated(SrcDiscStateData%Vx_wind_disk_filt)) then - LB(1:1) = lbound(SrcDiscStateData%Vx_wind_disk_filt, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%Vx_wind_disk_filt, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%Vx_wind_disk_filt) + UB(1:1) = ubound(SrcDiscStateData%Vx_wind_disk_filt) if (.not. allocated(DstDiscStateData%Vx_wind_disk_filt)) then allocate(DstDiscStateData%Vx_wind_disk_filt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -721,8 +746,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Vx_wind_disk_filt = SrcDiscStateData%Vx_wind_disk_filt end if if (allocated(SrcDiscStateData%TI_amb_filt)) then - LB(1:1) = lbound(SrcDiscStateData%TI_amb_filt, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%TI_amb_filt, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%TI_amb_filt) + UB(1:1) = ubound(SrcDiscStateData%TI_amb_filt) if (.not. allocated(DstDiscStateData%TI_amb_filt)) then allocate(DstDiscStateData%TI_amb_filt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -733,8 +758,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%TI_amb_filt = SrcDiscStateData%TI_amb_filt end if if (allocated(SrcDiscStateData%D_rotor_filt)) then - LB(1:1) = lbound(SrcDiscStateData%D_rotor_filt, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%D_rotor_filt, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%D_rotor_filt) + UB(1:1) = ubound(SrcDiscStateData%D_rotor_filt) if (.not. allocated(DstDiscStateData%D_rotor_filt)) then allocate(DstDiscStateData%D_rotor_filt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -746,8 +771,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if DstDiscStateData%Vx_rel_disk_filt = SrcDiscStateData%Vx_rel_disk_filt if (allocated(SrcDiscStateData%Ct_azavg_filt)) then - LB(1:1) = lbound(SrcDiscStateData%Ct_azavg_filt, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%Ct_azavg_filt, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%Ct_azavg_filt) + UB(1:1) = ubound(SrcDiscStateData%Ct_azavg_filt) if (.not. allocated(DstDiscStateData%Ct_azavg_filt)) then allocate(DstDiscStateData%Ct_azavg_filt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -758,8 +783,8 @@ subroutine WD_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta DstDiscStateData%Ct_azavg_filt = SrcDiscStateData%Ct_azavg_filt end if if (allocated(SrcDiscStateData%Cq_azavg_filt)) then - LB(1:1) = lbound(SrcDiscStateData%Cq_azavg_filt, kind=B8Ki) - UB(1:1) = ubound(SrcDiscStateData%Cq_azavg_filt, kind=B8Ki) + LB(1:1) = lbound(SrcDiscStateData%Cq_azavg_filt) + UB(1:1) = ubound(SrcDiscStateData%Cq_azavg_filt) if (.not. allocated(DstDiscStateData%Cq_azavg_filt)) then allocate(DstDiscStateData%Cq_azavg_filt(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -855,7 +880,7 @@ subroutine WD_UnPackDiscState(RF, OutData) type(RegFile), intent(inout) :: RF type(WD_DiscreteStateType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackDiscState' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -961,14 +986,14 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'WD_CopyMisc' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcMiscData%dvtdr)) then - LB(1:1) = lbound(SrcMiscData%dvtdr, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%dvtdr, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%dvtdr) + UB(1:1) = ubound(SrcMiscData%dvtdr) if (.not. allocated(DstMiscData%dvtdr)) then allocate(DstMiscData%dvtdr(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -979,8 +1004,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%dvtdr = SrcMiscData%dvtdr end if if (allocated(SrcMiscData%vt_tot)) then - LB(1:2) = lbound(SrcMiscData%vt_tot, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%vt_tot, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%vt_tot) + UB(1:2) = ubound(SrcMiscData%vt_tot) if (.not. allocated(DstMiscData%vt_tot)) then allocate(DstMiscData%vt_tot(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -991,8 +1016,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vt_tot = SrcMiscData%vt_tot end if if (allocated(SrcMiscData%vt_amb)) then - LB(1:2) = lbound(SrcMiscData%vt_amb, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%vt_amb, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%vt_amb) + UB(1:2) = ubound(SrcMiscData%vt_amb) if (.not. allocated(DstMiscData%vt_amb)) then allocate(DstMiscData%vt_amb(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1003,8 +1028,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vt_amb = SrcMiscData%vt_amb end if if (allocated(SrcMiscData%vt_shr)) then - LB(1:2) = lbound(SrcMiscData%vt_shr, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%vt_shr, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%vt_shr) + UB(1:2) = ubound(SrcMiscData%vt_shr) if (.not. allocated(DstMiscData%vt_shr)) then allocate(DstMiscData%vt_shr(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1015,8 +1040,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vt_shr = SrcMiscData%vt_shr end if if (allocated(SrcMiscData%vt_tot2)) then - LB(1:3) = lbound(SrcMiscData%vt_tot2, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%vt_tot2, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%vt_tot2) + UB(1:3) = ubound(SrcMiscData%vt_tot2) if (.not. allocated(DstMiscData%vt_tot2)) then allocate(DstMiscData%vt_tot2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1027,8 +1052,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vt_tot2 = SrcMiscData%vt_tot2 end if if (allocated(SrcMiscData%vt_amb2)) then - LB(1:3) = lbound(SrcMiscData%vt_amb2, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%vt_amb2, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%vt_amb2) + UB(1:3) = ubound(SrcMiscData%vt_amb2) if (.not. allocated(DstMiscData%vt_amb2)) then allocate(DstMiscData%vt_amb2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1039,8 +1064,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vt_amb2 = SrcMiscData%vt_amb2 end if if (allocated(SrcMiscData%vt_shr2)) then - LB(1:3) = lbound(SrcMiscData%vt_shr2, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%vt_shr2, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%vt_shr2) + UB(1:3) = ubound(SrcMiscData%vt_shr2) if (.not. allocated(DstMiscData%vt_shr2)) then allocate(DstMiscData%vt_shr2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1051,8 +1076,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%vt_shr2 = SrcMiscData%vt_shr2 end if if (allocated(SrcMiscData%dvx_dy)) then - LB(1:3) = lbound(SrcMiscData%dvx_dy, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%dvx_dy, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%dvx_dy) + UB(1:3) = ubound(SrcMiscData%dvx_dy) if (.not. allocated(DstMiscData%dvx_dy)) then allocate(DstMiscData%dvx_dy(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1063,8 +1088,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%dvx_dy = SrcMiscData%dvx_dy end if if (allocated(SrcMiscData%dvx_dz)) then - LB(1:3) = lbound(SrcMiscData%dvx_dz, kind=B8Ki) - UB(1:3) = ubound(SrcMiscData%dvx_dz, kind=B8Ki) + LB(1:3) = lbound(SrcMiscData%dvx_dz) + UB(1:3) = ubound(SrcMiscData%dvx_dz) if (.not. allocated(DstMiscData%dvx_dz)) then allocate(DstMiscData%dvx_dz(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1075,8 +1100,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%dvx_dz = SrcMiscData%dvx_dz end if if (allocated(SrcMiscData%nu_dvx_dy)) then - LB(1:2) = lbound(SrcMiscData%nu_dvx_dy, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%nu_dvx_dy, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%nu_dvx_dy) + UB(1:2) = ubound(SrcMiscData%nu_dvx_dy) if (.not. allocated(DstMiscData%nu_dvx_dy)) then allocate(DstMiscData%nu_dvx_dy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1087,8 +1112,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%nu_dvx_dy = SrcMiscData%nu_dvx_dy end if if (allocated(SrcMiscData%nu_dvx_dz)) then - LB(1:2) = lbound(SrcMiscData%nu_dvx_dz, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%nu_dvx_dz, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%nu_dvx_dz) + UB(1:2) = ubound(SrcMiscData%nu_dvx_dz) if (.not. allocated(DstMiscData%nu_dvx_dz)) then allocate(DstMiscData%nu_dvx_dz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1099,8 +1124,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%nu_dvx_dz = SrcMiscData%nu_dvx_dz end if if (allocated(SrcMiscData%dnuvx_dy)) then - LB(1:2) = lbound(SrcMiscData%dnuvx_dy, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%dnuvx_dy, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%dnuvx_dy) + UB(1:2) = ubound(SrcMiscData%dnuvx_dy) if (.not. allocated(DstMiscData%dnuvx_dy)) then allocate(DstMiscData%dnuvx_dy(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1111,8 +1136,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%dnuvx_dy = SrcMiscData%dnuvx_dy end if if (allocated(SrcMiscData%dnuvx_dz)) then - LB(1:2) = lbound(SrcMiscData%dnuvx_dz, kind=B8Ki) - UB(1:2) = ubound(SrcMiscData%dnuvx_dz, kind=B8Ki) + LB(1:2) = lbound(SrcMiscData%dnuvx_dz) + UB(1:2) = ubound(SrcMiscData%dnuvx_dz) if (.not. allocated(DstMiscData%dnuvx_dz)) then allocate(DstMiscData%dnuvx_dz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1123,8 +1148,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%dnuvx_dz = SrcMiscData%dnuvx_dz end if if (allocated(SrcMiscData%a)) then - LB(1:1) = lbound(SrcMiscData%a, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%a, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%a) + UB(1:1) = ubound(SrcMiscData%a) if (.not. allocated(DstMiscData%a)) then allocate(DstMiscData%a(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1135,8 +1160,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%a = SrcMiscData%a end if if (allocated(SrcMiscData%b)) then - LB(1:1) = lbound(SrcMiscData%b, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%b, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%b) + UB(1:1) = ubound(SrcMiscData%b) if (.not. allocated(DstMiscData%b)) then allocate(DstMiscData%b(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1147,8 +1172,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%b = SrcMiscData%b end if if (allocated(SrcMiscData%c)) then - LB(1:1) = lbound(SrcMiscData%c, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%c, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%c) + UB(1:1) = ubound(SrcMiscData%c) if (.not. allocated(DstMiscData%c)) then allocate(DstMiscData%c(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1159,8 +1184,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%c = SrcMiscData%c end if if (allocated(SrcMiscData%d)) then - LB(1:1) = lbound(SrcMiscData%d, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%d, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%d) + UB(1:1) = ubound(SrcMiscData%d) if (.not. allocated(DstMiscData%d)) then allocate(DstMiscData%d(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1171,8 +1196,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%d = SrcMiscData%d end if if (allocated(SrcMiscData%r_wake)) then - LB(1:1) = lbound(SrcMiscData%r_wake, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%r_wake, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%r_wake) + UB(1:1) = ubound(SrcMiscData%r_wake) if (.not. allocated(DstMiscData%r_wake)) then allocate(DstMiscData%r_wake(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1183,8 +1208,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%r_wake = SrcMiscData%r_wake end if if (allocated(SrcMiscData%Vx_high)) then - LB(1:1) = lbound(SrcMiscData%Vx_high, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Vx_high, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%Vx_high) + UB(1:1) = ubound(SrcMiscData%Vx_high) if (.not. allocated(DstMiscData%Vx_high)) then allocate(DstMiscData%Vx_high(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1195,8 +1220,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Vx_high = SrcMiscData%Vx_high end if if (allocated(SrcMiscData%Vx_polar)) then - LB(1:1) = lbound(SrcMiscData%Vx_polar, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Vx_polar, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%Vx_polar) + UB(1:1) = ubound(SrcMiscData%Vx_polar) if (.not. allocated(DstMiscData%Vx_polar)) then allocate(DstMiscData%Vx_polar(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1207,8 +1232,8 @@ subroutine WD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) DstMiscData%Vx_polar = SrcMiscData%Vx_polar end if if (allocated(SrcMiscData%Vt_wake)) then - LB(1:1) = lbound(SrcMiscData%Vt_wake, kind=B8Ki) - UB(1:1) = ubound(SrcMiscData%Vt_wake, kind=B8Ki) + LB(1:1) = lbound(SrcMiscData%Vt_wake) + UB(1:1) = ubound(SrcMiscData%Vt_wake) if (.not. allocated(DstMiscData%Vt_wake)) then allocate(DstMiscData%Vt_wake(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1329,7 +1354,7 @@ subroutine WD_UnPackMisc(RF, OutData) type(RegFile), intent(inout) :: RF type(WD_MiscVarType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackMisc' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1364,7 +1389,7 @@ subroutine WD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'WD_CopyParam' ErrStat = ErrID_None @@ -1374,8 +1399,8 @@ subroutine WD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%NumRadii = SrcParamData%NumRadii DstParamData%dr = SrcParamData%dr if (allocated(SrcParamData%r)) then - LB(1:1) = lbound(SrcParamData%r, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%r, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%r) + UB(1:1) = ubound(SrcParamData%r) if (.not. allocated(DstParamData%r)) then allocate(DstParamData%r(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1386,8 +1411,8 @@ subroutine WD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%r = SrcParamData%r end if if (allocated(SrcParamData%y)) then - LB(1:1) = lbound(SrcParamData%y, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%y, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%y) + UB(1:1) = ubound(SrcParamData%y) if (.not. allocated(DstParamData%y)) then allocate(DstParamData%y(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1398,8 +1423,8 @@ subroutine WD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%y = SrcParamData%y end if if (allocated(SrcParamData%z)) then - LB(1:1) = lbound(SrcParamData%z, kind=B8Ki) - UB(1:1) = ubound(SrcParamData%z, kind=B8Ki) + LB(1:1) = lbound(SrcParamData%z) + UB(1:1) = ubound(SrcParamData%z) if (.not. allocated(DstParamData%z)) then allocate(DstParamData%z(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1530,7 +1555,7 @@ subroutine WD_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(WD_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackParam' - integer(B8Ki) :: LB(1), UB(1) + integer(B4Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1590,7 +1615,7 @@ subroutine WD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'WD_CopyInput' ErrStat = ErrID_None @@ -1601,8 +1626,8 @@ subroutine WD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%chi_skew = SrcInputData%chi_skew DstInputData%p_hub = SrcInputData%p_hub if (allocated(SrcInputData%V_plane)) then - LB(1:2) = lbound(SrcInputData%V_plane, kind=B8Ki) - UB(1:2) = ubound(SrcInputData%V_plane, kind=B8Ki) + LB(1:2) = lbound(SrcInputData%V_plane) + UB(1:2) = ubound(SrcInputData%V_plane) if (.not. allocated(DstInputData%V_plane)) then allocate(DstInputData%V_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1617,8 +1642,8 @@ subroutine WD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%D_rotor = SrcInputData%D_rotor DstInputData%Vx_rel_disk = SrcInputData%Vx_rel_disk if (allocated(SrcInputData%Ct_azavg)) then - LB(1:1) = lbound(SrcInputData%Ct_azavg, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%Ct_azavg, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%Ct_azavg) + UB(1:1) = ubound(SrcInputData%Ct_azavg) if (.not. allocated(DstInputData%Ct_azavg)) then allocate(DstInputData%Ct_azavg(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1629,8 +1654,8 @@ subroutine WD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) DstInputData%Ct_azavg = SrcInputData%Ct_azavg end if if (allocated(SrcInputData%Cq_azavg)) then - LB(1:1) = lbound(SrcInputData%Cq_azavg, kind=B8Ki) - UB(1:1) = ubound(SrcInputData%Cq_azavg, kind=B8Ki) + LB(1:1) = lbound(SrcInputData%Cq_azavg) + UB(1:1) = ubound(SrcInputData%Cq_azavg) if (.not. allocated(DstInputData%Cq_azavg)) then allocate(DstInputData%Cq_azavg(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1684,7 +1709,7 @@ subroutine WD_UnPackInput(RF, OutData) type(RegFile), intent(inout) :: RF type(WD_InputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackInput' - integer(B8Ki) :: LB(2), UB(2) + integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -1708,14 +1733,14 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'WD_CopyOutput' ErrStat = ErrID_None ErrMsg = '' if (allocated(SrcOutputData%xhat_plane)) then - LB(1:2) = lbound(SrcOutputData%xhat_plane, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%xhat_plane, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%xhat_plane) + UB(1:2) = ubound(SrcOutputData%xhat_plane) if (.not. allocated(DstOutputData%xhat_plane)) then allocate(DstOutputData%xhat_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1726,8 +1751,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%xhat_plane = SrcOutputData%xhat_plane end if if (allocated(SrcOutputData%p_plane)) then - LB(1:2) = lbound(SrcOutputData%p_plane, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%p_plane, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%p_plane) + UB(1:2) = ubound(SrcOutputData%p_plane) if (.not. allocated(DstOutputData%p_plane)) then allocate(DstOutputData%p_plane(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1738,8 +1763,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%p_plane = SrcOutputData%p_plane end if if (allocated(SrcOutputData%Vx_wake)) then - LB(1:2) = lbound(SrcOutputData%Vx_wake, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Vx_wake, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Vx_wake) + UB(1:2) = ubound(SrcOutputData%Vx_wake) if (.not. allocated(DstOutputData%Vx_wake)) then allocate(DstOutputData%Vx_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1750,8 +1775,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%Vx_wake = SrcOutputData%Vx_wake end if if (allocated(SrcOutputData%Vr_wake)) then - LB(1:2) = lbound(SrcOutputData%Vr_wake, kind=B8Ki) - UB(1:2) = ubound(SrcOutputData%Vr_wake, kind=B8Ki) + LB(1:2) = lbound(SrcOutputData%Vr_wake) + UB(1:2) = ubound(SrcOutputData%Vr_wake) if (.not. allocated(DstOutputData%Vr_wake)) then allocate(DstOutputData%Vr_wake(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1762,8 +1787,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%Vr_wake = SrcOutputData%Vr_wake end if if (allocated(SrcOutputData%Vx_wake2)) then - LB(1:3) = lbound(SrcOutputData%Vx_wake2, kind=B8Ki) - UB(1:3) = ubound(SrcOutputData%Vx_wake2, kind=B8Ki) + LB(1:3) = lbound(SrcOutputData%Vx_wake2) + UB(1:3) = ubound(SrcOutputData%Vx_wake2) if (.not. allocated(DstOutputData%Vx_wake2)) then allocate(DstOutputData%Vx_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1774,8 +1799,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%Vx_wake2 = SrcOutputData%Vx_wake2 end if if (allocated(SrcOutputData%Vy_wake2)) then - LB(1:3) = lbound(SrcOutputData%Vy_wake2, kind=B8Ki) - UB(1:3) = ubound(SrcOutputData%Vy_wake2, kind=B8Ki) + LB(1:3) = lbound(SrcOutputData%Vy_wake2) + UB(1:3) = ubound(SrcOutputData%Vy_wake2) if (.not. allocated(DstOutputData%Vy_wake2)) then allocate(DstOutputData%Vy_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1786,8 +1811,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%Vy_wake2 = SrcOutputData%Vy_wake2 end if if (allocated(SrcOutputData%Vz_wake2)) then - LB(1:3) = lbound(SrcOutputData%Vz_wake2, kind=B8Ki) - UB(1:3) = ubound(SrcOutputData%Vz_wake2, kind=B8Ki) + LB(1:3) = lbound(SrcOutputData%Vz_wake2) + UB(1:3) = ubound(SrcOutputData%Vz_wake2) if (.not. allocated(DstOutputData%Vz_wake2)) then allocate(DstOutputData%Vz_wake2(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1798,8 +1823,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%Vz_wake2 = SrcOutputData%Vz_wake2 end if if (allocated(SrcOutputData%D_wake)) then - LB(1:1) = lbound(SrcOutputData%D_wake, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%D_wake, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%D_wake) + UB(1:1) = ubound(SrcOutputData%D_wake) if (.not. allocated(DstOutputData%D_wake)) then allocate(DstOutputData%D_wake(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1810,8 +1835,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%D_wake = SrcOutputData%D_wake end if if (allocated(SrcOutputData%x_plane)) then - LB(1:1) = lbound(SrcOutputData%x_plane, kind=B8Ki) - UB(1:1) = ubound(SrcOutputData%x_plane, kind=B8Ki) + LB(1:1) = lbound(SrcOutputData%x_plane) + UB(1:1) = ubound(SrcOutputData%x_plane) if (.not. allocated(DstOutputData%x_plane)) then allocate(DstOutputData%x_plane(LB(1):UB(1)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1822,8 +1847,8 @@ subroutine WD_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg DstOutputData%x_plane = SrcOutputData%x_plane end if if (allocated(SrcOutputData%WAT_k)) then - LB(1:3) = lbound(SrcOutputData%WAT_k, kind=B8Ki) - UB(1:3) = ubound(SrcOutputData%WAT_k, kind=B8Ki) + LB(1:3) = lbound(SrcOutputData%WAT_k) + UB(1:3) = ubound(SrcOutputData%WAT_k) if (.not. allocated(DstOutputData%WAT_k)) then allocate(DstOutputData%WAT_k(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) if (ErrStat2 /= 0) then @@ -1896,7 +1921,7 @@ subroutine WD_UnPackOutput(RF, OutData) type(RegFile), intent(inout) :: RF type(WD_OutputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'WD_UnPackOutput' - integer(B8Ki) :: LB(3), UB(3) + integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return @@ -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_python/openfast_io/FAST_reader.py b/openfast_python/openfast_io/FAST_reader.py index f9e909d726..898bc66cb7 100644 --- a/openfast_python/openfast_io/FAST_reader.py +++ b/openfast_python/openfast_io/FAST_reader.py @@ -151,6 +151,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]) diff --git a/openfast_python/openfast_io/FAST_writer.py b/openfast_python/openfast_io/FAST_writer.py index 4d73dc16f1..c0821f3c47 100644 --- a/openfast_python/openfast_io/FAST_writer.py +++ b/openfast_python/openfast_io/FAST_writer.py @@ -207,7 +207,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') diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 8d48adcc3e..3ca39ddba9 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -299,7 +299,7 @@ endfunction(sed_regression) # 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") @@ -319,7 +319,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") @@ -383,6 +383,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 c218b76ef0..e35562f174 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 @@ -117,7 +117,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 f5b6457e8c..0745783cb8 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit f5b6457e8c763f187cefa30b3cb7d72ad5d725f4 +Subproject commit 0745783cb88a5d76dbb51ff5110e60a4d9b68e49 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/FAST-farm/FAST-Farm.vfproj b/vs-build/FAST-farm/FAST-Farm.vfproj index e7c3152f30..5f1d3153bd 100644 --- a/vs-build/FAST-farm/FAST-Farm.vfproj +++ b/vs-build/FAST-farm/FAST-Farm.vfproj @@ -25,7 +25,7 @@ - + @@ -35,7 +35,7 @@ - + @@ -55,7 +55,7 @@ - + diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index 9dd24a3ddc..4d87a023a7 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -23,7 +23,7 @@ - + @@ -32,7 +32,7 @@ - + @@ -50,7 +50,7 @@ - + @@ -68,7 +68,7 @@ - + @@ -86,7 +86,7 @@ - + @@ -104,7 +104,7 @@ - + @@ -122,7 +122,7 @@ - + diff --git a/vs-build/MAPlib/MAP_dll.vcxproj b/vs-build/MAPlib/MAP_dll.vcxproj index 022b29cb38..db43418ded 100644 --- a/vs-build/MAPlib/MAP_dll.vcxproj +++ b/vs-build/MAPlib/MAP_dll.vcxproj @@ -1,4 +1,4 @@ - + @@ -75,6 +75,7 @@ MAP_$(PlatformName) true ..\..\build\bin\ +$(PlatformName)\$(ConfigurationName) false @@ -85,6 +86,7 @@ MAP_$(PlatformName) false ..\..\build\bin\ +$(PlatformName)\$(ConfigurationName)