diff --git a/.gitignore b/.gitignore index 1634702f8b..95e68a0fc4 100644 --- a/.gitignore +++ b/.gitignore @@ -44,6 +44,7 @@ vs-build/ # backup files *.asv ~$*.xlsx +.*swp # LaTeX compiling files *.aux diff --git a/CMakeLists.txt b/CMakeLists.txt index 9d1d3dd61a..5dbe95b4e5 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -34,7 +34,7 @@ option(BUILD_SHARED_LIBS "Enable building shared libraries" off) option(DOUBLE_PRECISION "Treat REAL as double precision" on) option(USE_DLL_INTERFACE "Enable runtime loading of dynamic libraries" on) option(FPE_TRAP_ENABLED "Enable FPE trap in compiler options" off) -option(ORCA_DLL_LOAD "Enable OrcaFlex Library Load" on) +option(WIN_DLL_LOAD "Enable loading of Windows only DLL's (OrcaFlex, SoilDyn)" on) # This is mostly for testing purposes option(BUILD_OPENFAST_CPP_API "Enable building OpenFAST - C++ API" off) option(BUILD_FASTFARM "Enable building FAST.Farm" off) option(OPENMP "Enable OpenMP support" off) @@ -131,6 +131,7 @@ set(OPENFAST_MODULES aerodyn aerodyn14 servodyn + soildyn elastodyn beamdyn subdyn diff --git a/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.pdf b/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.pdf index 5d48814716..0502b424f8 100644 Binary files a/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.pdf and b/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.pdf differ diff --git a/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.tex b/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.tex index 8fbc455f9f..f13ebe8d28 100644 --- a/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.tex +++ b/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.tex @@ -24,7 +24,7 @@ \title{Solve Algorithms in OpenFAST} \author{Bonnie Jonkman} %\begin{abstract} -%This document is used to describe the algorithms implemented in FAST v8. +%This document is used to describe the algorithms implemented in OpenFAST v3.x %\end{abstract} \maketitle @@ -54,8 +54,9 @@ \section{Definitions and Nomenclature} InflowWind & IfW & IfW \\ IceFloe & IceFloe & IceF \\ IceDyn & IceD & IceD \\ + SoilDyn & SlD & SlD \\ \end{tabular} - \caption{Abbreviations for modules in FAST v8} + \caption{Abbreviations for modules in OpenFAST v3.0.x} \label{tab:Abbrev} \end{table} @@ -126,6 +127,10 @@ \section{Input-Output Relationships} \State $\mathit{u\_FEAM} \gets \Call{TransferMeshMotions}{\mathit{y\_ED}}$ \State $\mathit{u\_MD} \gets \Call{TransferMeshMotions}{\mathit{y\_ED}}$ \State $\mathit{u\_Orca} \gets \Call{TransferMeshMotions}{\mathit{y\_ED}}$ + +\State + \State $\mathit{y\_SD} \gets \Call{SD\_CalcOutput}{\mathit{p\_SD},\mathit{u\_SD},\mathit{x\_SD},\mathit{xd\_SD},\mathit{z\_SD}}$ + \State $\mathit{u\_SlD} \gets \Call{TransferMeshPosition}{\mathit{y\_SD}}$ \State $\mathit{u\_SrvD\%PtfmStC} \gets \Call{TransferMeshMotions}{\mathit{y\_ED}}$\footnote{Only if using ServoDyn Structural control with platform TMD.} % \end Transfer_ED_to_HD_SD_BD_Mooring %%%% @@ -152,11 +157,11 @@ \section{Input-Output Relationships} %\pagebreak %break here for now so that it doesn't look so strange -\subsection {Input-Output Solve for \textit{HydroDyn}, \textit{SubDyn}, \textit{OrcaFlexInterface}, \textit{BeamDyn}, \textit{ExtPtfm}, \textit{MAP}, \textit{FEAMooring}, \textit{MoorDyn}, +\subsection {Input-Output Solve for \textit{HydroDyn}, \textit{SubDyn}, \textit{OrcaFlexInterface}, \textit{BeamDyn}, \textit{SoilDyn}, \textit{ExtPtfm}, \textit{MAP}, \textit{FEAMooring}, \textit{MoorDyn}, \textit{FEAMooring}, \textit{IceFloe}, \textit{IceDyn}, and the Platform Reference Point Mesh in \textit{ElastoDyn}} This procedure implements Solve Option 1 for the accelerations and loads in -\emph{HydroDyn},\emph{SubDyn},\emph{MAP},\emph{FEAMooring},\emph{OrcaFlexInterface},\emph{MoorDyn}, \emph{BeamDyn}, \emph{ExtPtfm}, \emph{IceFloe}, \emph{IceDyn}, and \emph{ElastoDyn} (at its platform reference point mesh). +\emph{HydroDyn},\emph{SubDyn},\emph{MAP},\emph{FEAMooring},\emph{OrcaFlexInterface},\emph{MoorDyn},\emph{SoilDyn}, \emph{BeamDyn}, \emph{ExtPtfm}, \emph{IceFloe}, \emph{IceDyn}, and \emph{ElastoDyn} (at its platform reference point mesh). The other input-output relationships for these modules are solved using Solve Option 2. %\begin{algorithm}[ht] @@ -171,6 +176,7 @@ \section{Input-Output Relationships} \State $\mathit{y\_FEAM} \gets \Call{CalcOutput}{\mathit{p\_FEAM},\mathit{u\_FEAM},\mathit{x\_FEAM},\mathit{xd\_FEAM},\mathit{z\_FEAM}}$ \State $\mathit{y\_IceF} \gets \Call{CalcOutput}{\mathit{p\_IceF},\mathit{u\_IceF},\mathit{x\_IceF},\mathit{xd\_IceF},\mathit{z\_IceF}}$ \State $\mathit{y\_IceD(:)} \gets \Call{CalcOutput}{\mathit{p\_IceD(:)},\mathit{u\_IceD(:)},\mathit{x\_IceD(:)},\mathit{xd\_IceD(:)},\mathit{z\_IceD(:)}}$ + \State $\mathit{y\_SlD} \gets \Call{CalcOutput}{\mathit{p\_SlD},\mathit{u\_SlD},\mathit{x\_SlD},\mathit{xd\_SlD},\mathit{z\_SlD}}$ \State $\mathit{y\_SrvD} \gets \Call{CalcOutput}{\mathit{p\_SrvD},\mathit{u\_SrvD},\mathit{x\_SrvD},\mathit{xd\_SrvD},\mathit{z\_SrvD}}$\footnote{Only if using ServoDyn Structural control with platform TMD.} \State \State\Comment{Form $u$ vector using loads and accelerations from $\mathit{u\_HD}$, $\mathit{u\_BD}$, $\mathit{u\_SD}$, $\mathit{u\_Orca}$, $\mathit{u\_ExtPtfm}$, $\mathit{u\_SrvD}$\footnote{Only if using ServoDyn Structural control with platform TMD and SubDyn.} and platform reference input from $\mathit{u\_ED}$} @@ -196,6 +202,7 @@ \section{Input-Output Relationships} \State$\mathit{u\_MD\_tmp} \gets \Call{TransferMeshMotions}{y\_ED}$ \State$\mathit{u\_IceF\_tmp} \gets \Call{TransferMeshMotions}{y\_SD}$ \State$\mathit{u\_IceD\_tmp(:)} \gets \Call{TransferMeshMotions}{y\_SD}$ + \State$\mathit{u\_SlD\_tmp} \gets \Call{TransferMeshMotions}{y\_SD}$ \State$\mathit{u\_HD\_tmp} \gets \Call{TransferMeshMotions}{y\_ED,y\_SD}$ \State$\mathit{u\_SrvD\_tmp} \gets \Call{TransferMeshMotions}{y\_BD,y\_ED,y\_SD}$\footnote{Only if using ServoDyn Structural control.} \State$\mathit{u\_SD\_tmp} \gets \! @@ -207,6 +214,7 @@ \section{Input-Output Relationships} & \mathit{y\_HD}, \mathit{u\_HD\_tmp}, \\ & \mathit{y\_IceF}, \mathit{u\_IceF\_tmp}, \\ & \mathit{y\_IceD(:)}, \mathit{u\_IceD\_tmp(:)}, \\ + & \mathit{y\_SlD}, \mathit{u\_SlD\_tmp}) \\ \end{aligned} \end{aligned}$ \State$\mathit{u\_ED\_tmp} \gets \Call{TransferMeshLoads}{}( \! @@ -267,6 +275,7 @@ \section{Input-Output Relationships} \State $\mathit{u\_FEAM} \gets \Call{TransferMeshMotions}{\mathit{y\_ED}}$ \State $\mathit{u\_IceF} \gets \Call{TransferMeshMotions}{\mathit{y\_SD}}$ \State $\mathit{u\_IceD(:)} \gets \Call{TransferMeshMotions}{\mathit{y\_SD}}$ + \State $\mathit{u\_SlD} \gets \Call{TransferMeshPosition}{\mathit{y\_SD}}$ \State $\mathit{u\_SrvD} \gets \Call{TransferMeshMotions}{\mathit{y\_BD,y\_ED,y\_SD}}$\footnote{Only if using ServoDyn Structural control.} % For SrvD%PtfmStC \EndProcedure @@ -356,9 +365,19 @@ \section{Solve Option 2 Improvements} \State $\Call{AD\_UpdateStates}{\mathit{p\_AD},\mathit{u\_AD},\mathit{x\_AD},\mathit{xd\_AD},\mathit{z\_AD}}$ \State $\Call{SrvD\_UpdateStates}{\mathit{p\_SrvD},\mathit{u\_SrvD},\mathit{x\_SrvD},\mathit{xd\_SrvD},\mathit{z\_SrvD}}$ \State +\State $\mathit{u\_SD} \gets \Call{TransferMeshMotions}{\mathit{y\_ED}}$ +\State $\Call{SD\_UpdateStates}{\mathit{p\_SD},\mathit{u\_SD},\mathit{x\_SD},\mathit{xd\_SD},\mathit{z\_SD}}$ +\State +\If{CompSoil} + \State $\mathit{y\_SD} \gets \Call{SD\_CalcOutput}{\mathit{p\_SD},\mathit{u\_SD},\mathit{x\_SD},\mathit{xd\_SD},\mathit{z\_SD}}$ + \State $\mathit{u\_SlD} \gets \Call{TransferMeshPosition}{\mathit{y\_SD}}$ + \State $\Call{SlD\_UpdateStates}{\mathit{p\_SlD},\mathit{u\_SlD},\mathit{x\_SlD},\mathit{xd\_SlD},\mathit{z\_SlD}}$ +\EndIf +\State \State All other modules (used in Solve Option 1) advance their states \EndProcedure \end{algorithmic} +Note that SoilDyn is very sensitive to the motion of SubDyn, thus calculations of SubDyn are performed before the SoilDyn extrapolation. Note that AeroDyn and ServoDyn outputs get calculated inside the ${CalcOutputs\_And\_SolveForInputs}$ routine. ElastoDyn, BeamDyn, and InflowWind outputs do not get recalculated in ${CalcOutputs\_And\_SolveForInputs}$ except for the first time the routine is called diff --git a/docs/OtherSupporting/OpenFAST_Prescribing_Loads_at_Tower_Top.pdf b/docs/OtherSupporting/OpenFAST_Prescribing_Loads_at_Tower_Top.pdf new file mode 100644 index 0000000000..becf0dbad5 Binary files /dev/null and b/docs/OtherSupporting/OpenFAST_Prescribing_Loads_at_Tower_Top.pdf differ diff --git a/docs/OtherSupporting/OpenFAST_Using_a_Stiffness_Matrix_as_Boundary_Condition_in_SubDyn.pdf b/docs/OtherSupporting/OpenFAST_Using_a_Stiffness_Matrix_as_Boundary_Condition_in_SubDyn.pdf new file mode 100644 index 0000000000..f697381055 Binary files /dev/null and b/docs/OtherSupporting/OpenFAST_Using_a_Stiffness_Matrix_as_Boundary_Condition_in_SubDyn.pdf differ diff --git a/docs/OtherSupporting/OutListParameters.xlsx b/docs/OtherSupporting/OutListParameters.xlsx index 2b3c095965..138cd81b34 100644 Binary files a/docs/OtherSupporting/OutListParameters.xlsx and b/docs/OtherSupporting/OutListParameters.xlsx differ diff --git a/docs/source/install/index.rst b/docs/source/install/index.rst index ec6ffcbc78..909b95a10f 100644 --- a/docs/source/install/index.rst +++ b/docs/source/install/index.rst @@ -381,7 +381,7 @@ The CMake options specific to OpenFAST and their default settings are: FPE_TRAP_ENABLED - Enable Floating Point Exception (FPE) trap in compiler options (Default: OFF) GENERATE_TYPES - Use the openfast-registry to autogenerate types modules (Default: OFF) OPENMP - Enable OpenMP support (Default: OFF) - ORCA_DLL_LOAD - Enable OrcaFlex library load (Default: OFF) + WIN_DLL_LOAD - Enable loading of Windows DLLs for OrcaFlex and SoilDyn (Default: ON) USE_DLL_INTERFACE - Enable runtime loading of dynamic libraries (Default: ON) Additional system-specific options may exist for a given system, but those diff --git a/docs/source/user/api_change.rst b/docs/source/user/api_change.rst index 3592bbd5bf..1ca495b838 100644 --- a/docs/source/user/api_change.rst +++ b/docs/source/user/api_change.rst @@ -63,6 +63,7 @@ ServoDyn 75 CCmode 0 HydroDyn driver 6 WtrDens 1025 WtrDens - Water density (kg/m^3) HydroDyn driver 7 WtrDpth 200 WtrDpth - Water depth (m) HydroDyn driver 8 MSL2SWL 0 MSL2SWL - Offset between still-water level and mean sea level (m) [positive upward] +OpenFAST 20 CompSoil 0 CompSoil - Compute soil-structural dynamics (switch) {0=None; 1=with SubDyn mesh} OpenFAST 21 MHK 0 MHK - MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine} OpenFAST 22 N/A ---------------------- ENVIRONMENTAL CONDITIONS -------------------------------- OpenFAST 23 Gravity 9.80665 Gravity - Gravitational acceleration (m/s^2) @@ -74,6 +75,7 @@ OpenFAST 28 Patm 103500 Pa OpenFAST 29 Pvap 1700 Pvap - Vapour pressure of working fluid (Pa) [used only for an MHK turbine cavitation check] OpenFAST 30 WtrDpth 50 WtrDpth - Water depth (m) OpenFAST 31 MSL2SWL 0 MSL2SWL - Offset between still-water level and mean sea level (m) [positive upward] +OpenFAST 45 SoilFile "unused" SoilFile - Name of the file containing the SoilDyn input parameters (quoted string) AeroDyn 15 40 UAStartRad 0.25 UAStartRad - Starting radius for dynamic stall (fraction of rotor radius) [used only when AFAeroMod=2; if line is missing UAStartRad=0] AeroDyn 15 41 UAEndRad 0.95 UAEndRad - Ending radius for dynamic stall (fraction of rotor radius) [used only when AFAeroMod=2; if line is missing UAEndRad=1] AeroDyn driver 34 Twr2Shft 3.09343 Twr2Shft - Vertical distance from the tower-top to the rotor shaft (m) diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index b838662c2d..7f30d9396f 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -33,6 +33,7 @@ target_link_libraries(openfast_prelib elastodynlib beamdynlib subdynlib + soildynlib hydrodynlib orcaflexlib extptfm_mckflib diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index c806cef96f..6486d23878 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -17,6 +17,7 @@ usefrom ServoDyn_Registry.txt usefrom Registry-AD14.txt usefrom AeroDyn_Registry.txt usefrom SubDyn_Registry.txt +usefrom SoilDyn_Registry.txt usefrom HydroDyn.txt usefrom IceFloe_FASTRegistry.inp usefrom InflowWind.txt @@ -53,7 +54,8 @@ param ^ - INTEGER Module_MD - 14 - "MoorDyn" - param ^ - INTEGER Module_Orca - 15 - "OrcaFlex integration (HD/Mooring)" - param ^ - INTEGER Module_IceF - 16 - "IceFloe" - param ^ - INTEGER Module_IceD - 17 - "IceDyn" - -param ^ - INTEGER NumModules - 17 - "The number of modules available in FAST" - +param ^ - INTEGER Module_SlD - 18 - "SoilDyn" - +param ^ - INTEGER NumModules - 18 - "The number of modules available in FAST" - # Other Constants param ^ - INTEGER MaxNBlades - 3 - "Maximum number of blades allowed on a turbine" - param ^ - INTEGER 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" - @@ -112,9 +114,10 @@ typedef ^ FAST_ParameterType IntKi CompInflow - - - "Compute inflow wind conditi typedef ^ FAST_ParameterType IntKi CompAero - - - "Compute aerodynamic loads (switch) {Module_None; Module_AD14; Module_AD}" - typedef ^ FAST_ParameterType IntKi CompServo - - - "Compute control and electrical-drive dynamics (switch) {Module_None; Module_SrvD}" - typedef ^ FAST_ParameterType IntKi CompHydro - - - "Compute hydrodynamic loads (switch) {Module_None; Module_HD}" - -typedef ^ FAST_ParameterType IntKi CompSub - - - "Compute sub-structural dynamics (switch) {Module_None; Module_HD}" - +typedef ^ FAST_ParameterType IntKi CompSub - - - "Compute sub-structural dynamics (switch) {Module_None; Module_SD}" - typedef ^ FAST_ParameterType IntKi CompMooring - - - "Compute mooring system (switch) {Module_None; Module_MAP; Module_FEAM; Module_MD; Module_Orca}" - typedef ^ FAST_ParameterType IntKi CompIce - - - "Compute ice loading (switch) {Module_None; Module_IceF, Module_IceD}" - +typedef ^ FAST_ParameterType IntKi CompSoil - - - "Compute soil-structural dynamics (switch) {Module_None; Module_SlD}" - typedef ^ FAST_ParameterType IntKi MHK - - - "MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine}" - typedef ^ FAST_ParameterType LOGICAL UseDWM - - - "Use the DWM module in AeroDyn" - typedef ^ FAST_ParameterType LOGICAL Linearize - - - "Linearization analysis (flag)" - @@ -138,6 +141,7 @@ typedef ^ FAST_ParameterType CHARACTER(1024) HydroFile - - - "Name of file conta typedef ^ FAST_ParameterType CHARACTER(1024) SubFile - - - "Name of file containing sub-structural input parameters" - typedef ^ FAST_ParameterType CHARACTER(1024) MooringFile - - - "Name of file containing mooring system input parameters" - typedef ^ FAST_ParameterType CHARACTER(1024) IceFile - - - "Name of file containing ice loading input parameters" - +typedef ^ FAST_ParameterType CHARACTER(1024) SoilFile - - - "Name of file containing soil-structure input parameters" - # Parameters for file/screen output #typedef ^ FAST_ParameterType DbKi SttsTime - - - "Amount of time between screen status messages" s typedef ^ FAST_ParameterType DbKi TStart - - - "Time to begin tabular output" s @@ -485,6 +489,18 @@ typedef ^ ^ SD_OutputType Output {:} - - "Array of outputs associated with CalcS typedef ^ ^ SD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +# ..... SoilDyn data ....................................................................................................... +typedef FAST SoilDyn_Data SlD_ContinuousStateType x {2} - - "Continuous states" +typedef ^ ^ SlD_DiscreteStateType xd {2} - - "Discrete states" +typedef ^ ^ SlD_ConstraintStateType z {2} - - "Constraint states" +typedef ^ ^ SlD_OtherStateType OtherSt {2} - - "Other states" +typedef ^ ^ SlD_ParameterType p - - - "Parameters" +typedef ^ ^ SlD_InputType u - - - "System inputs" +typedef ^ ^ SlD_OutputType y - - - "System outputs" +typedef ^ ^ SlD_MiscVarType m - - - "Misc/optimization variables" +typedef ^ ^ SlD_InputType Input {:} - - "Array of inputs associated with InputTimes" +typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" + # ..... ExtPtfm data ....................................................................................................... typedef FAST ExtPtfm_Data ExtPtfm_ContinuousStateType x {2} - - "Continuous states" typedef ^ ^ ExtPtfm_DiscreteStateType xd {2} - - "Discrete states" @@ -632,6 +648,9 @@ typedef ^ FAST_ModuleMapType MeshMapType SDy3_P_2_IceF_P - - - "Map SubDyn y3Mes # IceD <-> SD typedef ^ FAST_ModuleMapType MeshMapType IceD_P_2_SD_P {:} - - "Map IceDyn point mesh to SubDyn LMesh point mesh" typedef ^ FAST_ModuleMapType MeshMapType SDy3_P_2_IceD_P {:} - - "Map SubDyn y3Mesh point mesh to IceDyn point mesh" +# SlD <-> SD +typedef ^ FAST_ModuleMapType MeshMapType SlD_P_3_SD_P - - - "Map SoilDyn point mesh to SubDyn y3Mesh point mesh" +typedef ^ FAST_ModuleMapType MeshMapType SD_P_3_SlD_P - - - "Map SubDyn y3Mesh point mesh to SoilDyn point mesh" # Stored Jacobians: typedef ^ FAST_ModuleMapType ReKi Jacobian_Opt1 {:}{:} - - "Stored Jacobian in ED_HD_InputOutputSolve or FullOpt1_InputOutputSolve" typedef ^ FAST_ModuleMapType Integer Jacobian_pivot {:} - - "Pivot array used for LU decomposition of Jacobian_Opt1" @@ -716,6 +735,8 @@ typedef ^ FAST_InitData IceFloe_InitInputType InData_IceF - - typedef ^ FAST_InitData IceFloe_InitOutputType OutData_IceF - - - "IceF Initialization output data" typedef ^ FAST_InitData IceD_InitInputType InData_IceD - - - "IceD Initialization input data" typedef ^ FAST_InitData IceD_InitOutputType OutData_IceD - - - "IceD Initialization output data (each instance will have the same output channels)" +typedef ^ FAST_InitData SlD_InitInputType InData_SlD - - - "SlD Initialization input data" +typedef ^ FAST_InitData SlD_InitOutputType OutData_SlD - - - "SlD Initialization output data" # ..... FAST External Initialization Input data ....................................................................................................... @@ -754,6 +775,7 @@ typedef ^ FAST_TurbineType OpenFOAM_Data OpFM - - - "Data for OpenFOAM integrati typedef ^ FAST_TurbineType SCDataEx_Data SC_DX - - - "Data for SuperController integration module" - typedef ^ FAST_TurbineType HydroDyn_Data HD - - - "Data for the HydroDyn module" - typedef ^ FAST_TurbineType SubDyn_Data SD - - - "Data for the SubDyn module" - +typedef ^ FAST_TurbineType SoilDyn_Data SlD - - - "Data for the SoilDyn module" - typedef ^ FAST_TurbineType MAP_Data MAP - - - "Data for the MAP (Mooring Analysis Program) module" - typedef ^ FAST_TurbineType FEAMooring_Data FEAM - - - "Data for the FEAMooring module" - typedef ^ FAST_TurbineType MoorDyn_Data MD - - - "Data for the MoorDyn module" - diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index 364d0b78cf..bf07aa04a7 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -40,6 +40,7 @@ MODULE FAST_Solver USE IceDyn USE IceFloe USE ServoDyn + USE SoilDyn USE SubDyn USE OpenFOAM Use ExtPtfm_MCKF @@ -1485,6 +1486,27 @@ SUBROUTINE IceD_InputSolve( u_IceD, y_SD, MeshMapData, legNum, ErrStat, ErrMsg ) END SUBROUTINE IceD_InputSolve !---------------------------------------------------------------------------------------------------------------------------------- +!> This routine sets the inputs required for SoilDyn. +SUBROUTINE SlD_InputSolve( u_SlD, y_SD, MeshMapData, ErrStat, ErrMsg ) +!.................................................................................................................................. + + ! Passed variables + TYPE(SlD_InputType), INTENT(INOUT) :: u_SlD !< SoilDyn input + TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< SubDyn outputs + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + !---------------------------------------------------------------------------------------------------- + ! Map SD outputs to SoilDyn inputs + !---------------------------------------------------------------------------------------------------- + ! motions: + CALL Transfer_Point_to_Point( y_SD%y3Mesh, u_SlD%SoilMesh, MeshMapData%SD_P_3_SlD_P, ErrStat, ErrMsg ) + +END SUBROUTINE SlD_InputSolve +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs required for BeamDyn. SUBROUTINE Transfer_ED_to_BD( y_ED, u_BD, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. @@ -2161,11 +2183,13 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & , u_IceF, y_IceF & , u_IceD, y_IceD & , u_SrvD, y_SrvD & + , u_SlD, y_SlD & , MeshMapData , ErrStat, ErrMsg, WriteThisStep ) !.................................................................................................................................. USE ElastoDyn USE SubDyn + USE SoilDyn USE HydroDyn USE BeamDyn USE OrcaFlexInterface @@ -2205,8 +2229,8 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & TYPE(SD_InputType) , INTENT(INOUT) :: u_SD !< System inputs TYPE(SD_OutputType) , INTENT(INOUT) :: y_SD !< System outputs TYPE(SD_MiscVarType) , INTENT(INOUT) :: m_SD !< misc/optimization variables - - !ExtPtfm: + + !ExtPtfm: TYPE(ExtPtfm_ContinuousStateType) , INTENT(IN ) :: x_ExtPtfm !< Continuous states TYPE(ExtPtfm_DiscreteStateType) , INTENT(IN ) :: xd_ExtPtfm !< Discrete states TYPE(ExtPtfm_ConstraintStateType) , INTENT(IN ) :: z_ExtPtfm !< Constraint states @@ -2235,6 +2259,10 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & TYPE(Orca_InputType) , INTENT(INOUT) :: u_Orca !< System inputs TYPE(Orca_OutputType) , INTENT(INOUT) :: y_Orca !< System outputs TYPE(Orca_MiscVarType) , INTENT(INOUT) :: m_Orca !< misc/optimization variables + + !SoilDyn: + TYPE(SlD_InputType), INTENT(INOUT) :: u_SlD !< System inputs + TYPE(SlD_OutputType), INTENT(IN ) :: y_SlD !< System outputs ! MAP/FEAM/MoorDyn/IceFloe/IceDyn: @@ -2685,7 +2713,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & CALL WrFileNR(UnJac, ' SD_TPMesh_RotationAcc_Z_'//TRIM(Num2LStr(TmpIndx))) END DO - IF ( p_FAST%CompHydro == Module_HD ) THEN ! this SD mesh linked only when HD is enabled + IF ( p_FAST%CompHydro == Module_HD .or. p_FAST%CompSoil == Module_SlD ) THEN ! this SD mesh linked only when HD or SlD are enabled DO TmpIndx=1,u_SD%LMesh%NNodes CALL WrFileNR(UnJac, ' SD_LMesh_Force_X_'//TRIM(Num2LStr(TmpIndx))) CALL WrFileNR(UnJac, ' SD_LMesh_Force_Y_'//TRIM(Num2LStr(TmpIndx))) @@ -2746,8 +2774,8 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & CALL WrFileNR(UnJac, ' ExtPtfm_PtfmMesh_RotationAcc_Y_'//TRIM(Num2LStr(TmpIndx))) CALL WrFileNR(UnJac, ' ExtPtfm_PtfmMesh_RotationAcc_Z_'//TRIM(Num2LStr(TmpIndx))) END DO - - + + WRITE(UnJac,'()') CALL WrMatrix(MeshMapData%Jacobian_Opt1,UnJac, p_FAST%OutFmt) @@ -2862,10 +2890,10 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & END IF - ! put the acceleration data (calucluted in this routine) back + ! put the acceleration data (calculated in this routine) back IF (MeshMapData%u_HD_M_Mesh%Committed) THEN u_HD%Morison%Mesh%RotationAcc = MeshMapData%u_HD_M_Mesh%RotationAcc - u_HD%Morison%Mesh%TranslationAcc = MeshMapData%u_HD_M_Mesh%TranslationAcc + u_HD%Morison%Mesh%TranslationAcc = MeshMapData%u_HD_M_Mesh%TranslationAcc ENDIF IF (MeshMapData%u_HD_W_Mesh%Committed) THEN @@ -2925,7 +2953,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & u_Orca%PtfmMesh%RotationAcc = MeshMapData%u_Orca_PtfmMesh%RotationAcc u_Orca%PtfmMesh%TranslationAcc = MeshMapData%u_Orca_PtfmMesh%TranslationAcc END IF - + !............................................... ! We're finished !............................................... @@ -3019,6 +3047,10 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, END IF + IF ( p_FAST%CompSoil == Module_SlD ) THEN + CALL SlD_InputSolve( u_SlD, y_SD2, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + END IF !.................. ! Set motions for the ServoDyn Structural control for platform inputs (this has accelerations, but we assume the loads generated are small) @@ -3078,6 +3110,9 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + !.................. + ! Ice + !.................. IF ( p_FAST%CompIce == Module_IceF ) THEN ! SD loads from IceFloe: @@ -3142,7 +3177,19 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ENDIF - + !.................. + ! SoilDyn force to SD + !.................. + + if (p_FAST%CompSoil == Module_SlD) then + ! SlD loads to SD + CALL Transfer_Point_to_Point( y_SlD%SoilMesh, MeshMapData%u_SD_LMesh_2, MeshMapData%SlD_P_3_SD_P, ErrStat2, ErrMsg2, u_SlD%SoilMesh, y_SD2%Y3Mesh ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//'Transfer_SlD_to_SD (y_SlD2%SoilMesh -> y_SD2%Y3Mesh)' ) + MeshMapData%u_SD_LMesh%Force = MeshMapData%u_SD_LMesh%Force + MeshMapData%u_SD_LMesh_2%Force + MeshMapData%u_SD_LMesh%Moment = MeshMapData%u_SD_LMesh%Moment + MeshMapData%u_SD_LMesh_2%Moment + endif ! SoilDyn + + !.................. ! Get SD motions input !.................. @@ -3414,7 +3461,7 @@ SUBROUTINE Init_FullOpt1_Jacobian( p_FAST, MeshMapData, ED_PlatformPtMesh, SD_TP p_FAST%SizeJac_Opt1(3) = SD_TPMesh%NNodes*6 ! SD inputs: 6 accelerations per node (size of SD input from ED) - IF ( p_FAST%CompHydro == Module_HD ) THEN + IF ( p_FAST%CompHydro == Module_HD .or. p_FAST%CompSoil == Module_SlD ) THEN p_FAST%SizeJac_Opt1(3) = p_FAST%SizeJac_Opt1(3) & + SD_LMesh%NNodes *6 ! SD inputs: 6 loads per node (size of SD input from HD) END IF @@ -3445,7 +3492,7 @@ SUBROUTINE Init_FullOpt1_Jacobian( p_FAST, MeshMapData, ED_PlatformPtMesh, SD_TP p_FAST%SizeJac_Opt1(9) = 0 end if - + p_FAST%SizeJac_Opt1(1) = sum( p_FAST%SizeJac_Opt1 ) ! all the inputs from these modules @@ -3543,7 +3590,7 @@ SUBROUTINE Init_FullOpt1_Jacobian( p_FAST, MeshMapData, ED_PlatformPtMesh, SD_TP end do !j end do !i - IF ( p_FAST%CompHydro == Module_HD ) THEN ! this SD mesh linked only when HD is enabled + if ( p_FAST%CompHydro == Module_HD .or. p_FAST%CompSoil == Module_SlD ) then ! this SD mesh linked only when HD, or SlD is enabled ! SD_LMesh do i=1,SD_LMesh%NNodes @@ -3685,7 +3732,7 @@ SUBROUTINE Init_FullOpt1_Jacobian( p_FAST, MeshMapData, ED_PlatformPtMesh, SD_TP end do !j end do !i - + END SUBROUTINE Init_FullOpt1_Jacobian !---------------------------------------------------------------------------------------------------------------------------------- !> This routine basically packs the relevant parts of the modules' input meshes for use in this InputOutput solve. @@ -3712,6 +3759,8 @@ SUBROUTINE Create_FullOpt1_UVector(u, ED_PlatformPtMesh, SD_TPMesh, SD_LMesh, HD ! local variables: INTEGER(IntKi) :: i, k, indx_first, indx_last + integer(IntKi) :: ErrStat2 ! error status from get small rot angles (we are completely ignoring it) + character(ErrMsgLen) :: ErrMsg2 ! error message from get small rot angles (we are completely ignoring it) !............... ! ED inputs: @@ -3757,7 +3806,7 @@ SUBROUTINE Create_FullOpt1_UVector(u, ED_PlatformPtMesh, SD_TPMesh, SD_LMesh, HD indx_first = indx_last + 1 end do - if ( p_FAST%CompHydro == Module_HD ) then ! this SD mesh linked only when HD is enabled + if ( p_FAST%CompHydro == Module_HD .or. p_FAST%CompSoil == Module_SlD ) then ! this SD mesh linked only when HD, or SlD is enabled ! SD inputs (SD_LMesh): do i=1,SD_LMesh%NNodes indx_last = indx_first + 2 @@ -3853,7 +3902,7 @@ SUBROUTINE Create_FullOpt1_UVector(u, ED_PlatformPtMesh, SD_TPMesh, SD_LMesh, HD indx_first = indx_last + 1 end do - + END SUBROUTINE Create_FullOpt1_UVector !---------------------------------------------------------------------------------------------------------------------------------- !> This routine adds u_delta to the corresponding mesh field and scales it as appropriate @@ -3937,7 +3986,7 @@ SUBROUTINE Add_FullOpt1_u_delta( p_FAST, Jac_u_indx, u_delta, u_ED, u_SD, u_HD, END SELECT END DO - + END SUBROUTINE Add_FullOpt1_u_delta !---------------------------------------------------------------------------------------------------------------------------------- !> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) @@ -4048,7 +4097,7 @@ SUBROUTINE Perturb_u_FullOpt1( p_FAST, Jac_u_indx, n, u_perturb, u_ED_perturb, u END SUBROUTINE Perturb_u_FullOpt1 !---------------------------------------------------------------------------------------------------------------------------------- !> This routine resets the remap flags on all of the meshes -SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD ) +SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD ) !............................................................................................................................... TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code @@ -4067,6 +4116,7 @@ SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp 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(SoilDyn_Data), INTENT(INOUT) :: SlD !< SoilDyn data !local variable(s) @@ -4254,10 +4304,18 @@ SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp END DO END IF + ! SoilDyn + IF ( p_FAST%CompSoil == Module_SlD ) THEN + IF (SlD%Input(1)%SoilMesh%Committed) THEN + SlD%Input(1)%SoilMesh%RemapFlag = .FALSE. + SlD%y%SoilMesh%RemapFlag = .FALSE. + END IF + END IF + END SUBROUTINE ResetRemapFlags !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes all of the mapping data structures needed between the various modules. -SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg) +SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD, MeshMapData, ErrStat, ErrMsg) !............................................................................................................................... TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code @@ -4276,6 +4334,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M 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(SoilDyn_Data), INTENT(INOUT) :: SlD !< SoilDyn data TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -4856,7 +4915,22 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M END IF ! SubDyn-IceFloe IF (ErrStat >= AbortErrLev ) RETURN - + +!------------------------- +! SubDyn <-> SoilDyn +!------------------------- + + IF ( p_FAST%CompSoil == Module_SlD ) THEN + ! SoilDyn output SoilMesh point mesh to SubDyn input LMesh point mesh + CALL MeshMapCreate( SlD%y%SoilMesh, SD%Input(1)%LMesh, MeshMapData%SlD_P_3_SD_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SlD_P_3_SD_P' ) + ! SubDyn output y2Mesh point mesh to SoilDyn input SoilMesh point mesh + CALL MeshMapCreate( SD%y%y3Mesh, SlD%Input(1)%SoilMesh, MeshMapData%SD_P_3_SlD_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SD_P_3_SlD_P' ) + END IF ! SubDyn-SoilDyn + + IF (ErrStat >= AbortErrLev ) RETURN + !............................................................................................................................ ! Initialize the Jacobian structures: !............................................................................................................................ @@ -4881,7 +4955,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !............................................................................................................................ ! reset the remap flags (do this before making the copies else the copies will always have remap = true) !............................................................................................................................ - CALL ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD ) + CALL ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD ) !............................................................................................................................ ! initialize the temporary input meshes (for input-output solves in Solve Option 1): @@ -4926,8 +5000,8 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M CALL MeshCopy ( SD%Input(1)%TPMesh, MeshMapData%u_SD_TPMesh, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_SD_TPMesh' ) - IF ( p_FAST%CompHydro == Module_HD ) THEN - + IF ( p_FAST%CompHydro == Module_HD .or. p_FAST%CompSoil == Module_SlD ) THEN + CALL MeshCopy ( SD%Input(1)%LMesh, MeshMapData%u_SD_LMesh, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_SD_LMesh' ) @@ -4985,7 +5059,7 @@ END SUBROUTINE InitModuleMappings !! *** Note that modules that do not have direct feedthrough should be called first. *** SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, calcJacobian, NextJacCalcTime, & p_FAST, m_FAST, WriteThisStep, ED, BD, & - SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, SlD, MeshMapData, ErrStat, ErrMsg ) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) INTEGER(IntKi) , intent(in ) :: n_t_global !< current time step (used only for SrvD hack) @@ -5012,6 +5086,7 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca 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(SoilDyn_Data), INTENT(INOUT) :: SlD !< SoilDyn data TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -5086,26 +5161,34 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca MAPp%Input(1), FEAM%Input(1), MD%Input(1), & Orca%Input(1), BD%Input(1,:), SrvD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - IF ( p_FAST%CompSub == Module_SD .and. p_FAST%CompHydro == Module_HD ) THEN + + ! Calculate SubDyn and transfer outputs to HydroDyn or SoilDyn + IF ( p_FAST%CompSub == Module_SD ) THEN CALL SD_CalcOutput( this_time, SD%Input(1), SD%p, SD%x(this_state), SD%xd(this_state), SD%z(this_state), SD%OtherSt(this_state), SD%y, SD%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call Transfer_SD_to_HD( SD%y, HD%Input(1)%WAMITMesh, HD%Input(1)%Morison%Mesh, MeshMapData, ErrStat, ErrMsg ) - - IF ( p_FAST%CompMooring == Module_MAP ) THEN - CALL Transfer_Point_to_Point( SD%y%y3Mesh, MAPp%Input(1)%PtFairDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) + IF ( p_FAST%CompSoil == Module_SlD ) THEN + CALL SlD_InputSolve( SlD%Input(1), SD%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN - CALL Transfer_Point_to_Point( SD%y%y3Mesh, MD%Input(1)%PtFairleadDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN - CALL Transfer_Point_to_Point( SD%y%y3Mesh, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - END IF + END IF + + IF ( p_FAST%CompHydro == Module_HD ) THEN + call Transfer_SD_to_HD( SD%y, HD%Input(1)%WAMITMesh, HD%Input(1)%Morison%Mesh, MeshMapData, ErrStat, ErrMsg ) + + IF ( p_FAST%CompMooring == Module_MAP ) THEN + CALL Transfer_Point_to_Point( SD%y%y3Mesh, MAPp%Input(1)%PtFairDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + CALL Transfer_Point_to_Point( SD%y%y3Mesh, MD%Input(1)%PtFairleadDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN + CALL Transfer_Point_to_Point( SD%y%y3Mesh, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + END IF + END IF END IF - + !> Solve option 1 (rigorous solve on loads/accelerations) - CALL SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, SrvD, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) + CALL SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, SrvD, SlD, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5161,14 +5244,14 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca ! Reset each mesh's RemapFlag (after calling all InputSolve routines): !..................................................................... - CALL ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + CALL ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD) END SUBROUTINE CalcOutputs_And_SolveForInputs !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the "option 1" solve for all inputs with direct links to HD, SD, ExtPtfm, MAP, OrcaFlex interface, and the ED !! platform reference point. Also in solve option 1 are the BD-ED blade root coupling. -SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, SrvD, MeshMapData, ErrStat, ErrMsg, WriteThisStep ) +SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, SrvD, SlD, MeshMapData, ErrStat, ErrMsg, WriteThisStep ) !............................................................................................................................... REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) @@ -5189,6 +5272,7 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, 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(SoilDyn_Data), INTENT(INOUT) :: SlD !< SoilDyn data TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -5249,7 +5333,15 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, END DO END IF - + + + ! SoilDyn + IF ( p_FAST%CompSoil == Module_SlD ) THEN + CALL SlD_CalcOutput( this_time, SlD%Input(1), SlD%p, SlD%x(this_state), SlD%xd(this_state), SlD%z(this_state), & + SlD%OtherSt(this_state), SlD%y, SlD%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + ! the Structural control (TMD) from ServoDyn requires recalculating SrvD if we are using it. While it uses accelerations, ! the masses involved are small enough compared to the platform that we don't need to account for them in the jacobian @@ -5264,7 +5356,8 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, IF (ErrStat >= AbortErrLev) RETURN IF ( p_FAST%CompSub /= Module_None .OR. (p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) .OR. p_FAST%CompMooring == Module_Orca ) THEN !.OR. p_FAST%CompHydro == Module_HD ) THEN - + ! .or. p_FAST%CompSoil == Module_SlD NOTE: this is only if CompSub /= Module_None + CALL FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & , ED%Input(1), ED%p, ED%x( this_state), ED%xd( this_state), ED%z( this_state), ED%OtherSt( this_state), ED%y, ED%m & , SD%Input(1), SD%p, SD%x( this_state), SD%xd( this_state), SD%z( this_state), SD%OtherSt( this_state), SD%y , SD%m & @@ -5278,6 +5371,7 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, , IceF%Input(1), IceF%y & , IceD%Input(1,:), IceD%y & ! bjj: I don't really want to make temp copies of input types. perhaps we should pass the whole Input() structure? (likewise for BD)... , SrvD%Input(1), SrvD%y & + , SlD%Input(1), SlD%y & ! only couples to SD at present , MeshMapData , ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5380,6 +5474,15 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, !print * !pause #endif + +!.................. +! Set SoilDyn inputs (which don't have acceleration fields) +!.................. + IF (p_FAST%CompSoil == Module_SlD) THEN + ! Map Subdyn motion to SoilDyn + CALL SlD_InputSolve( SlD%Input(1), SD%y, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + END IF END SUBROUTINE SolveOption1 !---------------------------------------------------------------------------------------------------------------------------------- @@ -5680,7 +5783,7 @@ END SUBROUTINE SolveOption2 !---------------------------------------------------------------------------------------------------------------------------------- !> This routines advances the states of each module SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg, WriteThisStep ) + MAPp, FEAM, MD, Orca, IceF, IceD, SlD, MeshMapData, ErrStat, ErrMsg, WriteThisStep ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial simulation time (almost always 0) INTEGER(IntKi), INTENT(IN ) :: n_t_global !< integer time step @@ -5703,6 +5806,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr 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(SoilDyn_Data), INTENT(INOUT) :: SlD !< SoilDyn data TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules (added to help BD get better root motion inputs) @@ -5880,7 +5984,6 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr END DO !j_ss END IF - ! HydroDyn: get predicted states IF ( p_FAST%CompHydro == Module_HD ) THEN CALL HydroDyn_CopyContState (HD%x( STATE_CURR), HD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -5906,6 +6009,13 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr ! SubDyn/ExtPtfm: get predicted states IF ( p_FAST%CompSub == Module_SD ) THEN + + ! Transfer platform ED to SD if SlD is active (Map ED (motion) outputs to SD inputs) + IF ( p_FAST%CompSoil == Module_SlD ) THEN + CALL Transfer_Point_to_Point( ED%y%PlatformPtMesh, SD%Input(1)%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + CALL SD_CopyContState (SD%x( STATE_CURR), SD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL SD_CopyDiscState (SD%xd(STATE_CURR), SD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -5945,6 +6055,37 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, Sr END IF + ! SoilDyn: get predicted states + IF (p_FAST%CompSoil == Module_SlD) THEN + ! Get SD output + CALL SD_CalcOutput( t_global_next, SD%Input(1), SD%p, SD%x(STATE_PRED), SD%xd(STATE_PRED), SD%z(STATE_PRED), SD%OtherSt(STATE_PRED), SD%y, SD%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Copy over SD outputs + CALL SlD_InputSolve( SlD%Input(1), SD%y, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + + CALL SlD_CopyContState (SlD%x( STATE_CURR), SlD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SlD_CopyDiscState (SlD%xd(STATE_CURR), SlD%xd(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SlD_CopyConstrState (SlD%z( STATE_CURR), SlD%z( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SlD_CopyOtherState( SlD%OtherSt(STATE_CURR), SlD%OtherSt(STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + DO j_ss = 1, p_FAST%n_substeps( Module_SlD ) + n_t_module = n_t_global*p_FAST%n_substeps( Module_SlD ) + j_ss - 1 + t_module = n_t_module*p_FAST%dt_module( Module_SlD ) + t_initial + + CALL SlD_UpdateStates( t_module, n_t_module, SlD%Input, SlD%InputTimes, SlD%p, SlD%x(STATE_PRED), SlD%xd(STATE_PRED), & + SlD%z(STATE_PRED), SlD%OtherSt(STATE_PRED), SlD%m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO !j_ss + END IF + + ! Mooring: MAP/FEAM/MD/Orca: get predicted states IF (p_FAST%CompMooring == Module_MAP) THEN CALL MAP_CopyContState (MAPp%x( STATE_CURR), MAPp%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -6074,7 +6215,7 @@ END SUBROUTINE FAST_AdvanceStates !---------------------------------------------------------------------------------------------------------------------------------- !> This routine extrapolates inputs to modules to give predicted values at t+dt. SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & - IceF, IceD, ErrStat, ErrMsg ) + IceF, IceD, SlD, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_global_next !< next global time step (t + dt), at which we're extrapolating inputs (and ED outputs) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code @@ -6095,6 +6236,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A 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(SoilDyn_Data), INTENT(INOUT) :: SlD !< SoilDyn data !TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData ! Data for mapping between modules @@ -6418,6 +6560,35 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, A END IF ! IceFloe/IceDyn + ! SoilDyn + IF ( p_FAST%CompSoil == Module_SlD ) THEN + + CALL SlD_Input_ExtrapInterp(SlD%Input, SlD%InputTimes, SlD%u, t_global_next, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + !CALL SlD_Output_ExtrapInterp(SlD_Output, SlD_OutputTimes, SlD%y, t_global_next, ErrStat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + + ! Shift "window" of SlD%Input and SlD_Output + + DO j = p_FAST%InterpOrder, 1, -1 + CALL SlD_CopyInput (SlD%Input(j), SlD%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + !CALL SlD_CopyOutput(SlD_Output(j), SlD_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + SlD%InputTimes(j+1) = SlD%InputTimes(j) + !SlD_OutputTimes(j+1) = SlD_OutputTimes(j) + END DO + + CALL SlD_CopyInput (SlD%u, SlD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + !CALL SlD_CopyOutput(SlD%y, SlD_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + SlD%InputTimes(1) = t_global_next + !SlD_OutputTimes(1) = t_global_next + + END IF ! SoilDyn + + END SUBROUTINE FAST_ExtrapInterpMods !---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 3a6fb654d4..dd09c68c31 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -51,18 +51,18 @@ SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, In CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX,& Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg, InFile, ExternInitData ) + Turbine%IceF, Turbine%IceD, Turbine%SlD, Turbine%MeshMapData, ErrStat, ErrMsg, InFile, ExternInitData ) ELSE CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX, & Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg, InFile ) + Turbine%IceF, Turbine%IceD, Turbine%SlD, Turbine%MeshMapData, ErrStat, ErrMsg, InFile ) END IF ELSE CALL FAST_InitializeAll( t_initial, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX, & Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + Turbine%IceF, Turbine%IceD, Turbine%SlD, Turbine%MeshMapData, ErrStat, ErrMsg ) END IF @@ -70,7 +70,7 @@ 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, BD, SrvD, AD14, AD, IfW, OpFM, SC_DX, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg, InFile, ExternInitData ) + MAPp, FEAM, MD, Orca, IceF, IceD, SlD, MeshMapData, ErrStat, ErrMsg, InFile, ExternInitData ) use ElastoDyn_Parameters, only: Method_RK4 @@ -89,6 +89,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, TYPE(SCDataEx_Data), INTENT(INOUT) :: SC_DX !< SuperController exchange data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(SoilDyn_Data), INTENT(INOUT) :: SlD !< SoilDyn 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 @@ -772,6 +773,44 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, END IF END IF ! CompHydro + ! ........................ + ! initialize SoilDyn + ! ........................ + ALLOCATE( SlD%Input( p_FAST%InterpOrder+1 ), SlD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating SlD%Input and SlD%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + IF ( p_FAST%CompSoil == Module_SlD .and. p_FAST%CompSub == Module_SD ) THEN + + IF ( p_FAST%CompHydro == Module_HD ) THEN + Init%InData_SlD%WtrDpth = Init%OutData_HD%WtrDpth + ELSE + Init%InData_SlD%WtrDpth = 0.0_ReKi + END IF + + !Init%InData_SlD%UseInputFile = .TRUE. + Init%InData_SlD%InputFile = p_FAST%SoilFile + Init%InData_SlD%RootName = p_FAST%OutFileRoot + Init%InData_SlD%SlDNonLinearForcePortionOnly = .true. ! SoilDyn will only return the Non-Linear portion of the reaction force + + CALL SlD_Init( Init%InData_SlD, SlD%Input(1), SlD%p, SlD%x(STATE_CURR), SlD%xd(STATE_CURR), SlD%z(STATE_CURR), & + SlD%OtherSt(STATE_CURR), SlD%y, SlD%m, p_FAST%dt_module( MODULE_SlD ), Init%OutData_SlD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(Module_SlD) = .TRUE. + CALL SetModuleSubstepTime(Module_SlD, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + ! Add interfaces as we develop them. + END IF + ! ........................ ! initialize SubDyn or ExtPtfm_MCKF ! ........................ @@ -803,8 +842,29 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, 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. Only used with SD driver, so set to 0 here. + + if ( p_FAST%CompSoil == Module_SlD ) then + ! Copy over the soil stiffness matrices + if (allocated(SlD%p%Stiffness)) then + call AllocAry(Init%InData_SD%SoilStiffness,size(SlD%p%Stiffness,1),size(SlD%p%Stiffness,2),size(SlD%p%Stiffness,3),'SoilStiffness',ErrStat2,ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + Init%InData_SD%SoilStiffness = SlD%p%Stiffness + endif + ! make a copy of the SoilMesh to pass over + if (SlD%Input(1)%SoilMesh%Initialized) then + CALL MeshCopy ( SrcMesh = SlD%y%SoilMesh & + , DestMesh = Init%InData_SD%SoilMesh & + , CtrlCode = MESH_COUSIN & + , IOS = COMPONENT_OUTPUT & + , ErrStat = ErrStat2 & + , ErrMess = ErrMsg2 ) + endif + endif 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 ) @@ -1309,7 +1369,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Initialize mesh-mapping data ! ------------------------------------------------------------------------- - CALL InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) + CALL InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD, MeshMapData, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN @@ -1651,6 +1711,7 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, y_FAST%Module_Ver( Module_Orca )%Name = 'OrcaFlexInterface' y_FAST%Module_Ver( Module_IceF )%Name = 'IceFloe' y_FAST%Module_Ver( Module_IceD )%Name = 'IceDyn' + y_FAST%Module_Ver( Module_SlD )%Name = 'SoilDyn' y_FAST%Module_Abrev( Module_Glue ) = 'FAST' y_FAST%Module_Abrev( Module_IfW ) = 'IfW' @@ -1668,8 +1729,9 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, y_FAST%Module_Abrev( Module_MD ) = 'MD' y_FAST%Module_Abrev( Module_Orca ) = 'Orca' y_FAST%Module_Abrev( Module_IceF ) = 'IceF' - y_FAST%Module_Abrev( Module_IceD ) = 'IceD' - + y_FAST%Module_Abrev( Module_IceD ) = 'IceD' + y_FAST%Module_Abrev( Module_SlD ) = 'SlD' + p%n_substeps = 1 ! number of substeps for between modules and global/FAST time p%BD_OutputSibling = .false. @@ -1810,6 +1872,7 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) IF (p%CompSub == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompSub must be 0 (None), 1 (SubDyn), or 2 (ExtPtfm_MCKF).', ErrStat, ErrMsg, RoutineName ) IF (p%CompMooring == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompMooring must be 0 (None), 1 (MAP), 2 (FEAMooring), 3 (MoorDyn), or 4 (OrcaFlex).', ErrStat, ErrMsg, RoutineName ) IF (p%CompIce == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompIce must be 0 (None) or 1 (IceFloe).', ErrStat, ErrMsg, RoutineName ) + IF (p%CompSoil == Module_Unknown) CALL SetErrStat( ErrID_Fatal, 'CompSoil must be 0 (None) or 1 (coupled to SubDyn).', ErrStat, ErrMsg, RoutineName ) IF (p%CompHydro /= Module_HD) THEN IF (p%CompMooring == Module_MAP) THEN CALL SetErrStat( ErrID_Fatal, 'HydroDyn must be used when MAP is used. Set CompHydro > 0 or CompMooring = 0 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) @@ -1831,8 +1894,9 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) IF (p%CompSub /= Module_SD) CALL SetErrStat( ErrID_Fatal, 'SubDyn must be used when IceDyn is used. Set CompSub > 0 or CompIce = 0 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) IF (p%CompHydro /= Module_HD) CALL SetErrStat( ErrID_Fatal, 'HydroDyn must be used when IceDyn is used. Set CompHydro > 0 or CompIce = 0 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) END IF - - IF (p%CompElast == Module_BD .and. p%CompAero == Module_AD14 ) CALL SetErrStat( ErrID_Fatal, 'AeroDyn14 cannot be used when BeamDyn is used. Change CompAero or CompElast in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + + IF (p%CompElast == Module_BD .and. p%CompAero == Module_AD14 ) CALL SetErrStat( ErrID_Fatal, 'AeroDyn14 cannot be used when BeamDyn is used. Change CompAero or CompElast in the FAST input file.', ErrStat, ErrMsg, RoutineName ) + IF (p%CompSoil == Module_SlD .and. .not. p%CompSub == Module_SD ) CALL SetErrStat( ErrID_Fatal, 'SoilDyn cannot be used without SubDyn. Change CompSub or CompSoil in the FAST input file.', ErrStat, ErrMsg, RoutineName ) IF (p%MHK /= 0) CALL SetErrStat( ErrID_Fatal, 'MHK switch must be 0 in the FAST input file. Functionality to model an MHK turbine has not yet been implemented.', ErrStat, ErrMsg, RoutineName ) ! hkr (4/6/21) Remove after MHK functionality is implemented @@ -2035,7 +2099,12 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_IceF ))) ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN y_FAST%Module_Ver( Module_IceD ) = Init%OutData_IceD%Ver - y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_IceD ))) + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_IceD ))) + END IF + + IF ( p_FAST%CompSoil == Module_SlD ) THEN + y_FAST%Module_Ver( Module_SlD ) = Init%OutData_SlD%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_SlD ))) END IF !...................................................... @@ -2064,8 +2133,9 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) IF ( ALLOCATED( Init%OutData_MD%WriteOutputHdr ) ) y_FAST%numOuts(Module_MD) = SIZE(Init%OutData_MD%WriteOutputHdr) IF ( ALLOCATED( Init%OutData_Orca%WriteOutputHdr ) ) y_FAST%numOuts(Module_Orca) = SIZE(Init%OutData_Orca%WriteOutputHdr) IF ( ALLOCATED( Init%OutData_IceF%WriteOutputHdr ) ) y_FAST%numOuts(Module_IceF) = SIZE(Init%OutData_IceF%WriteOutputHdr) - IF ( ALLOCATED( Init%OutData_IceD%WriteOutputHdr ) ) y_FAST%numOuts(Module_IceD) = SIZE(Init%OutData_IceD%WriteOutputHdr)*p_FAST%numIceLegs - + IF ( ALLOCATED( Init%OutData_IceD%WriteOutputHdr ) ) y_FAST%numOuts(Module_IceD) = SIZE(Init%OutData_IceD%WriteOutputHdr)*p_FAST%numIceLegs + IF ( ALLOCATED( Init%OutData_SlD%WriteOutputHdr ) ) y_FAST%numOuts(Module_SlD) = SIZE(Init%OutData_SlD%WriteOutputHdr) + !...................................................... ! Initialize the output channel names and units !...................................................... @@ -2187,7 +2257,13 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) indxNext = indxNext + 1 END DO ! J END DO ! I - END IF + END IF + + DO i=1,y_FAST%numOuts(Module_SlD) !SoilDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_SlD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_SlD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO !...................................................... @@ -2670,7 +2746,24 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS ELSE p%CompIce = Module_Unknown END IF - + + ! CompSoil - Compute sub-structural dynamics (switch) {0=None; 1=SoilDyn; 2=ExtPtfm_MCKF}: + CALL ReadVar( UnIn, InputFile, p%CompSoil, "CompSoil", "Compute soil-structural dynamics (switch) {0=None; 1=SoilDyn}", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! immediately convert to values used inside the code: + IF ( p%CompSoil == 0 ) THEN + p%CompSoil = Module_NONE + ELSEIF ( p%CompSoil == 1 ) THEN + p%CompSoil = Module_SlD + ELSE + p%CompSoil = Module_Unknown + END IF + ! MHK - MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine}: CALL ReadVar( UnIn, InputFile, p%MHK, "MHK", "MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine}", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2850,6 +2943,15 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS end if IF ( PathIsRelative( p%IceFile ) ) p%IceFile = TRIM(PriPath)//TRIM(p%IceFile) + ! SoilFile - Name of file containing soil-structural input parameters (-): + CALL ReadVar( UnIn, InputFile, p%SoilFile, "SoilFile", "Name of file containing soil-structural input parameters (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + IF ( PathIsRelative( p%SoilFile ) ) p%SoilFile = TRIM(PriPath)//TRIM(p%SoilFile) + !---------------------- OUTPUT -------------------------------------------------- CALL ReadCom( UnIn, InputFile, 'Section Header: Output', ErrStat2, ErrMsg2, UnEc ) @@ -3879,7 +3981,11 @@ SUBROUTINE FAST_WrSum( p_FAST, y_FAST, MeshMapData, ErrStat, ErrMsg ) IF ( p_FAST%CompIce /= Module_IceD ) DescStr = TRIM(DescStr)//NotUsedTxt WRITE (y_FAST%UnSum,Fmt) TRIM( DescStr ) + DescStr = GetNVD( y_FAST%Module_Ver( Module_SlD ) ) + IF ( p_FAST%CompSoil /= Module_SlD ) DescStr = TRIM(DescStr)//NotUsedTxt + WRITE (y_FAST%UnSum,Fmt) TRIM( DescStr ) + !.......................... Information from FAST input File ...................................... ! OTHER information we could print here: ! current working directory @@ -4029,13 +4135,13 @@ SUBROUTINE FAST_Solution0_T(Turbine, ErrStat, ErrMsg) CALL FAST_Solution0(Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX,& Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) - + Turbine%IceF, Turbine%IceD, Turbine%SlD, Turbine%MeshMapData, ErrStat, ErrMsg ) + END SUBROUTINE FAST_Solution0_T !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that calls CalcOutput for the first time of the simulation (at t=0). After the initial solve, data arrays are initialized. SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, SC_DX, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + MAPp, FEAM, MD, Orca, IceF, IceD, SlD, MeshMapData, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code @@ -4058,6 +4164,7 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O 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(SoilDyn_Data), INTENT(INOUT) :: SlD !< SoilDyn data TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -4096,7 +4203,7 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O CALL CalcOutputs_And_SolveForInputs( n_t_global, t_initial, STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & p_FAST, m_FAST, y_FAST%WriteThisStep, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + MAPp, FEAM, MD, Orca, IceF, IceD, SlD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (p_FAST%UseSC ) then @@ -4108,14 +4215,14 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O ! Check to see if we should output data this time step: !---------------------------------------------------------------------------------------- - CALL WriteOutputToFile(n_t_global_next, t_initial, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) + CALL WriteOutputToFile(n_t_global_next, t_initial, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD, 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, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + call WriteVTK(t_initial, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD) end if @@ -4128,7 +4235,7 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O ! Initialize Input-Output arrays for interpolation/extrapolation: CALL FAST_InitIOarrays( m_FAST%t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) + MAPp, FEAM, MD, Orca, IceF, IceD, SlD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -4138,7 +4245,7 @@ END SUBROUTINE FAST_Solution0 !! 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, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) + MAPp, FEAM, MD, Orca, IceF, IceD, SlD, 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 @@ -4160,6 +4267,7 @@ SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, A 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(SoilDyn_Data), INTENT(INOUT) :: SlD !< SoilDyn data INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -4588,6 +4696,35 @@ SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, A END IF ! CompIce + ! SoilDyn + IF (p_FAST%CompSoil == Module_SlD ) THEN + + ! Copy values for interpolation/extrapolation: + DO j = 1, p_FAST%InterpOrder + 1 + SlD%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt + !SlD_OutputTimes(i) = t_initial - (j - 1) * dt + END DO + + DO j = 2, p_FAST%InterpOrder + 1 + CALL SlD_CopyInput (SlD%Input(1), SlD%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + CALL SlD_CopyInput (SlD%Input(1), SlD%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 SlD_CopyContState (SlD%x( STATE_CURR), SlD%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SlD_CopyDiscState (SlD%xd(STATE_CURR), SlD%xd(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SlD_CopyConstrState (SlD%z( STATE_CURR), SlD%z( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SlD_CopyOtherState( SlD%OtherSt(STATE_CURR), SlD%OtherSt(STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF ! SoilDyn + END SUBROUTINE FAST_InitIOarrays !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that calls FAST_Solution for one instance of a Turbine data structure. This is a separate subroutine so that the FAST @@ -4603,13 +4740,13 @@ SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) CALL FAST_Solution(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%SC_DX, & Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + Turbine%IceF, Turbine%IceD, Turbine%SlD, 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, BD, SrvD, AD14, AD, IfW, OpFM, SC_DX, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + MAPp, FEAM, MD, Orca, IceF, IceD, SlD, MeshMapData, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter @@ -4635,6 +4772,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, 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(SoilDyn_Data), INTENT(INOUT) :: SlD !< SoilDyn data TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -4681,7 +4819,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, END IF ! 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 ( p_FAST%CompElast == Module_BD .or. p_FAST%CompSoil == Module_SlD ) THEN ! BD accelerations have fewer spikes with these corrections on the first several time steps, and SoilDyn works better with HydroDyn. 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 @@ -4708,7 +4846,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !! gives predicted values at t+dt !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ CALL FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) + MAPp, FEAM, MD, Orca, IceF, IceD, SlD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -4725,7 +4863,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ CALL FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep ) + MAPp, FEAM, MD, Orca, IceF, IceD, SlD, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN @@ -4738,7 +4876,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !END IF CALL CalcOutputs_And_SolveForInputs( n_t_global, t_global_next, STATE_PRED, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, WriteThisStep, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + p_FAST, m_FAST, WriteThisStep, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, SlD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN @@ -4963,7 +5101,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !---------------------------------------------------------------------------------------- CALL WriteOutputToFile(n_t_global_next, t_global_next, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & - SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) + SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD, MeshMapData, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !---------------------------------------------------------------------------------------- @@ -5000,7 +5138,7 @@ END FUNCTION NeedWriteOutput !! calls the routine to write to the files with the output data. It should be called after all the output solves for a given time !! have been completed, and assumes y_FAST\%WriteThisStep has been set. SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & - SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg) + SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD, MeshMapData, ErrStat, ErrMsg) !............................................................................................................................... INTEGER(IntKi), INTENT(IN ) :: n_t_global !< Current global time step REAL(DbKi), INTENT(IN ) :: t_global !< Current global time @@ -5023,6 +5161,7 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, 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 + TYPE(SoilDyn_Data), INTENT(IN ) :: SlD !< SoilDyn data TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation @@ -5042,14 +5181,14 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, ! Generate glue-code output file CALL WrOutputLine( t_global, p_FAST, y_FAST, IfW%y%WriteOutput, OpFM%y%WriteOutput, ED%y%WriteOutput, & AD%y, SrvD%y%WriteOutput, HD%y%WriteOutput, SD%y%WriteOutput, ExtPtfm%y%WriteOutput, MAPp%y%WriteOutput, & - FEAM%y%WriteOutput, MD%y%WriteOutput, Orca%y%WriteOutput, IceF%y%WriteOutput, IceD%y, BD%y, ErrStat, ErrMsg ) + FEAM%y%WriteOutput, MD%y%WriteOutput, Orca%y%WriteOutput, IceF%y%WriteOutput, SlD%y%WriteOutput, IceD%y, BD%y, ErrStat, ErrMsg ) ENDIF ! Write visualization data (and also note that we're ignoring any errors that occur doing so) IF ( p_FAST%WrVTK == VTK_Animate ) THEN IF ( MOD( n_t_global, p_FAST%n_VTKTime ) == 0 ) THEN - call WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + call WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD) END IF END IF @@ -5058,7 +5197,7 @@ END SUBROUTINE WriteOutputToFile !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes the module output to the primary output file(s). SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_AD, SrvDOutput, HDOutput, SDOutput, ExtPtfmOutput,& - MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, ErrStat, ErrMsg) + MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, SlDOutput, y_IceD, y_BD, ErrStat, ErrMsg) IMPLICIT NONE @@ -5081,6 +5220,7 @@ SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_A REAL(ReKi), ALLOCATABLE, INTENT(IN) :: MDOutput (:) !< MoorDyn WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: OrcaOutput (:) !< OrcaFlex interface WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: IceFOutput (:) !< IceFloe WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SlDOutput (:) !< SoilDyn WriteOutput values TYPE(IceD_OutputType), INTENT(IN) :: y_IceD (:) !< IceDyn outputs (WriteOutput values are subset) TYPE(BD_OutputType), INTENT(IN) :: y_BD (:) !< BeamDyn outputs (WriteOutput values are subset) @@ -5098,7 +5238,7 @@ SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_A ErrMsg = '' CALL FillOutputAry(p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_AD, SrvDOutput, HDOutput, SDOutput, ExtPtfmOutput, & - MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, OutputAry) + MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, SlDOutput, y_IceD, y_BD, OutputAry) IF (p_FAST%WrTxtOutFile) THEN @@ -5160,14 +5300,14 @@ SUBROUTINE FillOutputAry_T(Turbine, Outputs) Turbine%ED%y%WriteOutput, Turbine%AD%y, Turbine%SrvD%y%WriteOutput, & Turbine%HD%y%WriteOutput, Turbine%SD%y%WriteOutput, Turbine%ExtPtfm%y%WriteOutput, Turbine%MAP%y%WriteOutput, & Turbine%FEAM%y%WriteOutput, Turbine%MD%y%WriteOutput, Turbine%Orca%y%WriteOutput, & - Turbine%IceF%y%WriteOutput, Turbine%IceD%y, Turbine%BD%y, Outputs) + Turbine%IceF%y%WriteOutput, Turbine%SlD%y%WriteOutput, Turbine%IceD%y, Turbine%BD%y, Outputs) -END SUBROUTINE FillOutputAry_T +END SUBROUTINE FillOutputAry_T !---------------------------------------------------------------------------------------------------------------------------------- !> This routine concatenates all of the WriteOutput values from the module Output into one array to be written to the FAST !! output file. SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_AD, SrvDOutput, HDOutput, SDOutput, ExtPtfmOutput, & - MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, OutputAry) + MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, SlDOutput, y_IceD, y_BD, OutputAry) TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< Glue-code simulation parameters TYPE(FAST_OutputFileType),INTENT(IN) :: y_FAST !< Glue-code simulation outputs @@ -5185,6 +5325,7 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_AD, REAL(ReKi), ALLOCATABLE, INTENT(IN) :: MDOutput (:) !< MoorDyn WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: OrcaOutput (:) !< OrcaFlex interface WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: IceFOutput (:) !< IceFloe WriteOutput values + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SlDOutput (:) !< SoilDyn WriteOutput values TYPE(IceD_OutputType), INTENT(IN) :: y_IceD (:) !< IceDyn outputs (WriteOutput values are subset) TYPE(BD_OutputType), INTENT(IN) :: y_BD (:) !< BeamDyn outputs (WriteOutput values are subset) @@ -5292,9 +5433,15 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, y_AD, END DO END IF + IF ( y_FAST%numOuts(Module_SlD) > 0 ) THEN + indxLast = indxNext + SIZE(SlDOutput) - 1 + OutputAry(indxNext:indxLast) = SlDOutput + indxNext = IndxLast + 1 + END IF + END SUBROUTINE FillOutputAry !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD) REAL(DbKi), INTENT(IN ) :: t_global !< Current global time TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code (only because we're updating VTK_LastWaveIndx) @@ -5315,6 +5462,7 @@ SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM 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 + TYPE(SoilDyn_Data), INTENT(IN ) :: SlD !< SoilDyn data INTEGER(IntKi) :: ErrStat2 @@ -5323,11 +5471,11 @@ SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM IF ( p_FAST%VTK_Type == VTK_Surf ) THEN - CALL WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + CALL WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD) ELSE IF ( p_FAST%VTK_Type == VTK_Basic ) THEN - CALL WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + CALL WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD) ELSE IF ( p_FAST%VTK_Type == VTK_All ) THEN - CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD) ELSE IF (p_FAST%VTK_Type==VTK_Old) THEN CALL WriteInputMeshesToFile( ED%Input(1), AD%Input(1), SD%Input(1), HD%Input(1), MAPp%Input(1), BD%Input(1,:), TRIM(p_FAST%OutFileRoot)//'.InputMeshes.bin', ErrStat2, ErrMsg2) CALL WriteMotionMeshesToFile(t_global, ED%y, SD%Input(1), SD%y, HD%Input(1), MAPp%Input(1), BD%y, BD%Input(1,:), y_FAST%UnGra, ErrStat2, ErrMsg2, TRIM(p_FAST%OutFileRoot)//'.gra') @@ -5343,7 +5491,7 @@ SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM END SUBROUTINE WriteVTK !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes all the committed meshes to VTK-formatted files. It doesn't bother with returning an error code. -SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD) use FVW_IO, only: WrVTK_FVW TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code @@ -5365,6 +5513,7 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, H 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 + TYPE(SoilDyn_Data), INTENT(IN ) :: SlD !< SoilDyn data ! logical :: outputFields ! flag to determine if we want to output the HD mesh fields @@ -5599,12 +5748,19 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, H END IF +! SoilDyn + IF ( p_FAST%CompSoil == Module_SlD .and. allocated(SlD%Input)) THEN + call MeshWrVTK(p_FAST%TurbinePos, SlD%Input(1)%SoilMesh, trim(p_FAST%VTK_OutFileRoot)//'.SlD_u_SoilMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SlD%y%SoilMesh ) + + call MeshWrVTK(p_FAST%TurbinePos, SlD%y%SoilMesh, trim(p_FAST%VTK_OutFileRoot)//'.SlD_y_SoilMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SlD%Input(1)%SoilMesh ) + END IF + END SUBROUTINE WrVTK_AllMeshes !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes a minimal subset of meshes (enough to visualize the turbine) to VTK-formatted files. It doesn't bother with !! returning an error code. -SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD) 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 @@ -5624,6 +5780,7 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, 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 + TYPE(SoilDyn_Data), INTENT(IN ) :: SlD !< SoilDyn data logical :: OutputFields INTEGER(IntKi) :: NumBl, k @@ -5700,12 +5857,18 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, ! call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'FEAM_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! END IF +! SoilDyn +! IF ( p_FAST%CompSub == Module_SlD ) THEN +! call MeshWrVTK(p_FAST%TurbinePos, SlD%Input(1)%SoilMesh, trim(p_FAST%OutFileRoot)//'.SlD_uSoilMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, SlD%y%SoilMesh, trim(p_FAST%OutFileRoot)//'.SlD_ySoilMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! END IF + -END SUBROUTINE WrVTK_BasicMeshes +END SUBROUTINE WrVTK_BasicMeshes !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes a minimal subset of meshes with surfaces to VTK-formatted files. It doesn't bother with !! returning an error code. -SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD) use FVW_IO, only: WrVTK_FVW REAL(DbKi), INTENT(IN ) :: t_global !< Current global time @@ -5727,6 +5890,7 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW 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 + TYPE(SoilDyn_Data), INTENT(IN ) :: SlD !< SoilDyn data logical, parameter :: OutputFields = .FALSE. ! due to confusion about what fields mean on a surface, we are going to just output the basic meshes if people ask for fields @@ -5821,9 +5985,14 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW ! call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'FEAM_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) ! END IF +! SoilDyn +! IF ( p_FAST%CompSub == Module_SlD ) THEN +! call MeshWrVTK(p_FAST%TurbinePos, SlD%Input(1)%SoilMesh, trim(p_FAST%OutFileRoot)//'.SlD_uSoilMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, SlD%y%SoilMesh, trim(p_FAST%OutFileRoot)//'.SlD_ySoilMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! END IF if (p_FAST%VTK_fields) then - call WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + call WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD) end if @@ -6233,7 +6402,7 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) CALL CalcOutputs_And_SolveForInputs( -1, t_global, STATE_CURR, Turbine%m_FAST%calcJacobian, Turbine%m_FAST%NextJacCalcTime, & Turbine%p_FAST, Turbine%m_FAST, .false., Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, Turbine%SlD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN @@ -6296,15 +6465,15 @@ SUBROUTINE ExitThisProgram_T( Turbine, ErrLevel_in, StopTheProgram, ErrLocMsg, S CALL ExitThisProgram( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimes ) + Turbine%IceF, Turbine%IceD, Turbine%SlD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimes ) ELSE CALL ExitThisProgram( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, SkipRunTimeMsg=SkipRunTimes ) - + Turbine%IceF, Turbine%IceD, Turbine%SlD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, SkipRunTimeMsg=SkipRunTimes ) + END IF END SUBROUTINE ExitThisProgram_T @@ -6314,7 +6483,7 @@ END SUBROUTINE ExitThisProgram_T !! This routine should not be called from glue code (e.g., FAST_Prog.f90) or ExitThisProgram_T only. It should not be called in any !! of these driver routines. SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimeMsg ) + MAPp, FEAM, MD, Orca, IceF, IceD, SlD, MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimeMsg ) !............................................................................................................................... ! Passed arguments @@ -6338,6 +6507,7 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, 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(SoilDyn_Data), INTENT(INOUT) :: SlD !< SoilDyn data TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -6364,13 +6534,13 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, IF ( ErrorLevel >= AbortErrLev .AND. p_FAST%WrVTK > VTK_None .and. .not. m_FAST%Lin%FoundSteady) THEN p_FAST%VTK_OutFileRoot = trim(p_FAST%VTK_OutFileRoot)//'.DebugError' p_FAST%VTK_fields = .true. - CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD) end if ! End all modules - CALL FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) + CALL FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, SlD, ErrStat2, ErrMsg2 ) IF (ErrStat2 /= ErrID_None) THEN CALL WrScr( NewLine//RoutineName//':'//TRIM(ErrMsg2)//NewLine ) ErrorLevel = MAX(ErrorLevel,ErrStat2) @@ -6378,7 +6548,7 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ! Destroy all data associated with FAST variables: - CALL FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, SlD, MeshMapData, ErrStat2, ErrMsg2 ) IF (ErrStat2 /= ErrID_None) THEN CALL WrScr( NewLine//RoutineName//':'//TRIM(ErrMsg2)//NewLine ) ErrorLevel = MAX(ErrorLevel,ErrStat2) @@ -6508,7 +6678,7 @@ SUBROUTINE FAST_EndOutput( p_FAST, y_FAST, m_FAST, ErrStat, ErrMsg ) END SUBROUTINE FAST_EndOutput !---------------------------------------------------------------------------------------------------------------------------------- !> This routine calls the end routines for each module that was previously initialized. -SUBROUTINE FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) +SUBROUTINE FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, SlD, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code @@ -6529,6 +6699,7 @@ SUBROUTINE FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD 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(SoilDyn_Data), INTENT(INOUT) :: SlD !< SoilDyn data INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -6638,11 +6809,17 @@ SUBROUTINE FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD END IF + IF ( p_FAST%ModuleInitialized(Module_SlD) ) THEN + CALL SlD_End( SlD%Input(1), SlD%p, SlD%x(STATE_CURR), SlD%xd(STATE_CURR), SlD%z(STATE_CURR), SlD%OtherSt(STATE_CURR), & + SlD%y, SlD%m, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + END IF + END SUBROUTINE FAST_EndMods !---------------------------------------------------------------------------------------------------------------------------------- !> This routine calls the destroy routines for each module. (It is basically a duplicate of FAST_DestroyTurbineType().) SUBROUTINE FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + MAPp, FEAM, MD, Orca, IceF, IceD, SlD, MeshMapData, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code @@ -6664,6 +6841,7 @@ SUBROUTINE FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, 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(SoilDyn_Data), INTENT(INOUT) :: SlD !< SoilDyn data TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -6761,6 +6939,10 @@ SUBROUTINE FAST_DestroyAll( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, CALL FAST_DestroyIceDyn_Data( IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! SoilDyn + CALL FAST_DestroySoilDyn_Data( SlD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + ! Module (Mesh) Mapping data CALL FAST_DestroyModuleMapType( MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7207,7 +7389,7 @@ SUBROUTINE FAST_RestoreForVTKModeShape_Tary(t_initial, Turbine, InputFileName, E CALL FAST_RestoreForVTKModeShape_T(t_initial, Turbine(i_turb)%p_FAST, Turbine(i_turb)%y_FAST, Turbine(i_turb)%m_FAST, & Turbine(i_turb)%ED, Turbine(i_turb)%BD, Turbine(i_turb)%SrvD, Turbine(i_turb)%AD14, Turbine(i_turb)%AD, Turbine(i_turb)%IfW, Turbine(i_turb)%OpFM, & Turbine(i_turb)%HD, Turbine(i_turb)%SD, Turbine(i_turb)%ExtPtfm, Turbine(i_turb)%MAP, Turbine(i_turb)%FEAM, Turbine(i_turb)%MD, Turbine(i_turb)%Orca, & - Turbine(i_turb)%IceF, Turbine(i_turb)%IceD, Turbine(i_turb)%MeshMapData, trim(InputFileName), ErrStat2, ErrMsg2 ) + Turbine(i_turb)%IceF, Turbine(i_turb)%IceD, Turbine(i_turb)%SlD, Turbine(i_turb)%MeshMapData, trim(InputFileName), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO @@ -7217,7 +7399,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, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, InputFileName, ErrStat, ErrMsg ) + MAPp, FEAM, MD, Orca, IceF, IceD, SlD, MeshMapData, InputFileName, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time @@ -7241,6 +7423,7 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, 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(SoilDyn_Data), INTENT(INOUT) :: SlD !< SoilDyn data TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules CHARACTER(*), INTENT(IN ) :: InputFileName !< Name of the input file @@ -7313,11 +7496,11 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, IF (ErrStat >= AbortErrLev) RETURN CALL CalcOutputs_And_SolveForInputs( -1, m_FAST%Lin%LinTimes(iLinTime), STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, .true., ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + p_FAST, m_FAST, .true., ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, SlD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN - call WriteVTK(m_FAST%Lin%LinTimes(iLinTime), p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + call WriteVTK(m_FAST%Lin%LinTimes(iLinTime), p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD) end do ! iLinTime end do ! iMode @@ -7353,11 +7536,11 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, IF (ErrStat >= AbortErrLev) RETURN CALL CalcOutputs_And_SolveForInputs( -1, m_FAST%Lin%LinTimes(iLinTime), STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, .true., ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + p_FAST, m_FAST, .true., ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, SlD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN - call WriteVTK(m_FAST%Lin%LinTimes(iLinTime)+tprime, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + call WriteVTK(m_FAST%Lin%LinTimes(iLinTime)+tprime, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD) end do diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index d16e227aa9..37c72bc716 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -38,6 +38,7 @@ MODULE FAST_Types USE AeroDyn14_Types USE AeroDyn_Types USE SubDyn_Types +USE SoilDyn_Types USE HydroDyn_Types USE IceFloe_Types USE OpenFOAM_Types @@ -69,7 +70,8 @@ MODULE FAST_Types INTEGER(IntKi), PUBLIC, PARAMETER :: Module_Orca = 15 ! OrcaFlex integration (HD/Mooring) [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceF = 16 ! IceFloe [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceD = 17 ! IceDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 17 ! The number of modules available in FAST [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SlD = 18 ! SoilDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 18 ! 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 [-] ! ========= FAST_VTK_BLSurfaceType ======= @@ -130,9 +132,10 @@ MODULE FAST_Types INTEGER(IntKi) :: CompAero !< Compute aerodynamic loads (switch) {Module_None; Module_AD14; Module_AD} [-] INTEGER(IntKi) :: CompServo !< Compute control and electrical-drive dynamics (switch) {Module_None; Module_SrvD} [-] INTEGER(IntKi) :: CompHydro !< Compute hydrodynamic loads (switch) {Module_None; Module_HD} [-] - INTEGER(IntKi) :: CompSub !< Compute sub-structural dynamics (switch) {Module_None; Module_HD} [-] + INTEGER(IntKi) :: CompSub !< Compute sub-structural dynamics (switch) {Module_None; Module_SD} [-] INTEGER(IntKi) :: CompMooring !< Compute mooring system (switch) {Module_None; Module_MAP; Module_FEAM; Module_MD; Module_Orca} [-] INTEGER(IntKi) :: CompIce !< Compute ice loading (switch) {Module_None; Module_IceF, Module_IceD} [-] + INTEGER(IntKi) :: CompSoil !< Compute soil-structural dynamics (switch) {Module_None; Module_SlD} [-] INTEGER(IntKi) :: MHK !< MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine} [-] LOGICAL :: UseDWM !< Use the DWM module in AeroDyn [-] LOGICAL :: Linearize !< Linearization analysis (flag) [-] @@ -154,6 +157,7 @@ MODULE FAST_Types CHARACTER(1024) :: SubFile !< Name of file containing sub-structural input parameters [-] CHARACTER(1024) :: MooringFile !< Name of file containing mooring system input parameters [-] CHARACTER(1024) :: IceFile !< Name of file containing ice loading input parameters [-] + CHARACTER(1024) :: SoilFile !< Name of file containing soil-structure input parameters [-] REAL(DbKi) :: TStart !< Time to begin tabular output [s] REAL(DbKi) :: DT_Out !< Time step for tabular output [s] LOGICAL :: WrSttsTime !< Whether we should write the status times to the screen [-] @@ -499,6 +503,20 @@ MODULE FAST_Types REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE SubDyn_Data ! ======================= +! ========= SoilDyn_Data ======= + TYPE, PUBLIC :: SoilDyn_Data + TYPE(SlD_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] + TYPE(SlD_DiscreteStateType) , DIMENSION(1:2) :: xd !< Discrete states [-] + TYPE(SlD_ConstraintStateType) , DIMENSION(1:2) :: z !< Constraint states [-] + TYPE(SlD_OtherStateType) , DIMENSION(1:2) :: OtherSt !< Other states [-] + TYPE(SlD_ParameterType) :: p !< Parameters [-] + TYPE(SlD_InputType) :: u !< System inputs [-] + TYPE(SlD_OutputType) :: y !< System outputs [-] + TYPE(SlD_MiscVarType) :: m !< Misc/optimization variables [-] + TYPE(SlD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] + END TYPE SoilDyn_Data +! ======================= ! ========= ExtPtfm_Data ======= TYPE, PUBLIC :: ExtPtfm_Data TYPE(ExtPtfm_ContinuousStateType) , DIMENSION(1:2) :: x !< Continuous states [-] @@ -647,6 +665,8 @@ MODULE FAST_Types TYPE(MeshMapType) :: SDy3_P_2_IceF_P !< Map SubDyn y3Mesh point mesh to IceFloe point mesh [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: IceD_P_2_SD_P !< Map IceDyn point mesh to SubDyn LMesh point mesh [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: SDy3_P_2_IceD_P !< Map SubDyn y3Mesh point mesh to IceDyn point mesh [-] + TYPE(MeshMapType) :: SlD_P_3_SD_P !< Map SoilDyn point mesh to SubDyn y3Mesh point mesh [-] + TYPE(MeshMapType) :: SD_P_3_SlD_P !< Map SubDyn y3Mesh point mesh to SoilDyn point mesh [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Jacobian_Opt1 !< Stored Jacobian in ED_HD_InputOutputSolve or FullOpt1_InputOutputSolve [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: Jacobian_pivot !< Pivot array used for LU decomposition of Jacobian_Opt1 [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] @@ -732,6 +752,8 @@ MODULE FAST_Types TYPE(IceFloe_InitOutputType) :: OutData_IceF !< IceF Initialization output data [-] TYPE(IceD_InitInputType) :: InData_IceD !< IceD Initialization input data [-] TYPE(IceD_InitOutputType) :: OutData_IceD !< IceD Initialization output data (each instance will have the same output channels) [-] + TYPE(SlD_InitInputType) :: InData_SlD !< SlD Initialization input data [-] + TYPE(SlD_InitOutputType) :: OutData_SlD !< SlD Initialization output data [-] END TYPE FAST_InitData ! ======================= ! ========= FAST_ExternInitType ======= @@ -772,6 +794,7 @@ MODULE FAST_Types TYPE(SCDataEx_Data) :: SC_DX !< Data for SuperController integration module [-] TYPE(HydroDyn_Data) :: HD !< Data for the HydroDyn module [-] TYPE(SubDyn_Data) :: SD !< Data for the SubDyn module [-] + TYPE(SoilDyn_Data) :: SlD !< Data for the SoilDyn module [-] TYPE(MAP_Data) :: MAP !< Data for the MAP (Mooring Analysis Program) module [-] TYPE(FEAMooring_Data) :: FEAM !< Data for the FEAMooring module [-] TYPE(MoorDyn_Data) :: MD !< Data for the MoorDyn module [-] @@ -2113,6 +2136,7 @@ SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%CompSub = SrcParamData%CompSub DstParamData%CompMooring = SrcParamData%CompMooring DstParamData%CompIce = SrcParamData%CompIce + DstParamData%CompSoil = SrcParamData%CompSoil DstParamData%MHK = SrcParamData%MHK DstParamData%UseDWM = SrcParamData%UseDWM DstParamData%Linearize = SrcParamData%Linearize @@ -2134,6 +2158,7 @@ SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%SubFile = SrcParamData%SubFile DstParamData%MooringFile = SrcParamData%MooringFile DstParamData%IceFile = SrcParamData%IceFile + DstParamData%SoilFile = SrcParamData%SoilFile DstParamData%TStart = SrcParamData%TStart DstParamData%DT_Out = SrcParamData%DT_Out DstParamData%WrSttsTime = SrcParamData%WrSttsTime @@ -2256,6 +2281,7 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 1 ! CompSub Int_BufSz = Int_BufSz + 1 ! CompMooring Int_BufSz = Int_BufSz + 1 ! CompIce + Int_BufSz = Int_BufSz + 1 ! CompSoil Int_BufSz = Int_BufSz + 1 ! MHK Int_BufSz = Int_BufSz + 1 ! UseDWM Int_BufSz = Int_BufSz + 1 ! Linearize @@ -2277,6 +2303,7 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 1*LEN(InData%SubFile) ! SubFile Int_BufSz = Int_BufSz + 1*LEN(InData%MooringFile) ! MooringFile Int_BufSz = Int_BufSz + 1*LEN(InData%IceFile) ! IceFile + Int_BufSz = Int_BufSz + 1*LEN(InData%SoilFile) ! SoilFile Db_BufSz = Db_BufSz + 1 ! TStart Db_BufSz = Db_BufSz + 1 ! DT_Out Int_BufSz = Int_BufSz + 1 ! WrSttsTime @@ -2436,6 +2463,8 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%CompIce Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompSoil + Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%MHK Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%UseDWM, IntKiBuf(1)) @@ -2498,6 +2527,10 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf(Int_Xferred) = ICHAR(InData%IceFile(I:I), IntKi) Int_Xferred = Int_Xferred + 1 END DO ! I + DO I = 1, LEN(InData%SoilFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%SoilFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I DbKiBuf(Db_Xferred) = InData%TStart Db_Xferred = Db_Xferred + 1 DbKiBuf(Db_Xferred) = InData%DT_Out @@ -2749,6 +2782,8 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Xferred = Int_Xferred + 1 OutData%CompIce = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + OutData%CompSoil = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%MHK = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%UseDWM = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseDWM) @@ -2813,6 +2848,10 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%IceFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) Int_Xferred = Int_Xferred + 1 END DO ! I + DO I = 1, LEN(OutData%SoilFile) + OutData%SoilFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%TStart = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 OutData%DT_Out = DbKiBuf(Db_Xferred) @@ -26559,18 +26598,1326 @@ SUBROUTINE FAST_UnPackSCDataEx_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SC_DX_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SC_DX_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE FAST_UnPackSCDataEx_Data + + SUBROUTINE FAST_CopySubDyn_Data( SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SubDyn_Data), INTENT(INOUT) :: SrcSubDyn_DataData + TYPE(SubDyn_Data), INTENT(INOUT) :: DstSubDyn_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySubDyn_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcSubDyn_DataData%x,1), UBOUND(SrcSubDyn_DataData%x,1) + CALL SD_CopyContState( SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcSubDyn_DataData%xd,1), UBOUND(SrcSubDyn_DataData%xd,1) + CALL SD_CopyDiscState( SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcSubDyn_DataData%z,1), UBOUND(SrcSubDyn_DataData%z,1) + CALL SD_CopyConstrState( SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcSubDyn_DataData%OtherSt,1), UBOUND(SrcSubDyn_DataData%OtherSt,1) + CALL SD_CopyOtherState( SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL SD_CopyParam( SrcSubDyn_DataData%p, DstSubDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SD_CopyInput( SrcSubDyn_DataData%u, DstSubDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SD_CopyOutput( SrcSubDyn_DataData%y, DstSubDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SD_CopyMisc( SrcSubDyn_DataData%m, DstSubDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcSubDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcSubDyn_DataData%Input,1) + i1_u = UBOUND(SrcSubDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstSubDyn_DataData%Input)) THEN + ALLOCATE(DstSubDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcSubDyn_DataData%Input,1), UBOUND(SrcSubDyn_DataData%Input,1) + CALL SD_CopyInput( SrcSubDyn_DataData%Input(i1), DstSubDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcSubDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcSubDyn_DataData%Output,1) + i1_u = UBOUND(SrcSubDyn_DataData%Output,1) + IF (.NOT. ALLOCATED(DstSubDyn_DataData%Output)) THEN + ALLOCATE(DstSubDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcSubDyn_DataData%Output,1), UBOUND(SrcSubDyn_DataData%Output,1) + CALL SD_CopyOutput( SrcSubDyn_DataData%Output(i1), DstSubDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL SD_CopyOutput( SrcSubDyn_DataData%y_interp, DstSubDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcSubDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcSubDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcSubDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstSubDyn_DataData%InputTimes)) THEN + ALLOCATE(DstSubDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopySubDyn_Data + + SUBROUTINE FAST_DestroySubDyn_Data( SubDyn_DataData, ErrStat, ErrMsg ) + TYPE(SubDyn_Data), INTENT(INOUT) :: SubDyn_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySubDyn_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +DO i1 = LBOUND(SubDyn_DataData%x,1), UBOUND(SubDyn_DataData%x,1) + CALL SD_DestroyContState( SubDyn_DataData%x(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(SubDyn_DataData%xd,1), UBOUND(SubDyn_DataData%xd,1) + CALL SD_DestroyDiscState( SubDyn_DataData%xd(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(SubDyn_DataData%z,1), UBOUND(SubDyn_DataData%z,1) + CALL SD_DestroyConstrState( SubDyn_DataData%z(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(SubDyn_DataData%OtherSt,1), UBOUND(SubDyn_DataData%OtherSt,1) + CALL SD_DestroyOtherState( SubDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) +ENDDO + CALL SD_DestroyParam( SubDyn_DataData%p, ErrStat, ErrMsg ) + CALL SD_DestroyInput( SubDyn_DataData%u, ErrStat, ErrMsg ) + CALL SD_DestroyOutput( SubDyn_DataData%y, ErrStat, ErrMsg ) + CALL SD_DestroyMisc( SubDyn_DataData%m, ErrStat, ErrMsg ) +IF (ALLOCATED(SubDyn_DataData%Input)) THEN +DO i1 = LBOUND(SubDyn_DataData%Input,1), UBOUND(SubDyn_DataData%Input,1) + CALL SD_DestroyInput( SubDyn_DataData%Input(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(SubDyn_DataData%Input) +ENDIF +IF (ALLOCATED(SubDyn_DataData%Output)) THEN +DO i1 = LBOUND(SubDyn_DataData%Output,1), UBOUND(SubDyn_DataData%Output,1) + CALL SD_DestroyOutput( SubDyn_DataData%Output(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(SubDyn_DataData%Output) +ENDIF + CALL SD_DestroyOutput( SubDyn_DataData%y_interp, ErrStat, ErrMsg ) +IF (ALLOCATED(SubDyn_DataData%InputTimes)) THEN + DEALLOCATE(SubDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroySubDyn_Data + + SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SubDyn_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackSubDyn_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL SD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL SD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL SD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Output) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_PackSubDyn_Data + + SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SubDyn_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackSubDyn_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%x,1) + i1_u = UBOUND(OutData%x,1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FAST_UnPackSCDataEx_Data + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackSubDyn_Data - SUBROUTINE FAST_CopySubDyn_Data( SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SubDyn_Data), INTENT(INOUT) :: SrcSubDyn_DataData - TYPE(SubDyn_Data), INTENT(INOUT) :: DstSubDyn_DataData + SUBROUTINE FAST_CopySoilDyn_Data( SrcSoilDyn_DataData, DstSoilDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SoilDyn_Data), INTENT(INOUT) :: SrcSoilDyn_DataData + TYPE(SoilDyn_Data), INTENT(INOUT) :: DstSoilDyn_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -26579,139 +27926,113 @@ SUBROUTINE FAST_CopySubDyn_Data( SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCod INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySubDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySoilDyn_Data' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcSubDyn_DataData%x,1), UBOUND(SrcSubDyn_DataData%x,1) - CALL SD_CopyContState( SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcSoilDyn_DataData%x,1), UBOUND(SrcSoilDyn_DataData%x,1) + CALL SlD_CopyContState( SrcSoilDyn_DataData%x(i1), DstSoilDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%xd,1), UBOUND(SrcSubDyn_DataData%xd,1) - CALL SD_CopyDiscState( SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcSoilDyn_DataData%xd,1), UBOUND(SrcSoilDyn_DataData%xd,1) + CALL SlD_CopyDiscState( SrcSoilDyn_DataData%xd(i1), DstSoilDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%z,1), UBOUND(SrcSubDyn_DataData%z,1) - CALL SD_CopyConstrState( SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcSoilDyn_DataData%z,1), UBOUND(SrcSoilDyn_DataData%z,1) + CALL SlD_CopyConstrState( SrcSoilDyn_DataData%z(i1), DstSoilDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%OtherSt,1), UBOUND(SrcSubDyn_DataData%OtherSt,1) - CALL SD_CopyOtherState( SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcSoilDyn_DataData%OtherSt,1), UBOUND(SrcSoilDyn_DataData%OtherSt,1) + CALL SlD_CopyOtherState( SrcSoilDyn_DataData%OtherSt(i1), DstSoilDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - CALL SD_CopyParam( SrcSubDyn_DataData%p, DstSubDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SlD_CopyParam( SrcSoilDyn_DataData%p, DstSoilDyn_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 SlD_CopyInput( SrcSoilDyn_DataData%u, DstSoilDyn_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 SlD_CopyOutput( SrcSoilDyn_DataData%y, DstSoilDyn_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 SlD_CopyMisc( SrcSoilDyn_DataData%m, DstSoilDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcSubDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%Input,1) - i1_u = UBOUND(SrcSubDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%Input)) THEN - ALLOCATE(DstSubDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcSoilDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcSoilDyn_DataData%Input,1) + i1_u = UBOUND(SrcSoilDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstSoilDyn_DataData%Input)) THEN + ALLOCATE(DstSoilDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSoilDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcSubDyn_DataData%Input,1), UBOUND(SrcSubDyn_DataData%Input,1) - CALL SD_CopyInput( SrcSubDyn_DataData%Input(i1), DstSubDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcSoilDyn_DataData%Input,1), UBOUND(SrcSoilDyn_DataData%Input,1) + CALL SlD_CopyInput( SrcSoilDyn_DataData%Input(i1), DstSoilDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcSubDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%Output,1) - i1_u = UBOUND(SrcSubDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%Output)) THEN - ALLOCATE(DstSubDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcSoilDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcSoilDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcSoilDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstSoilDyn_DataData%InputTimes)) THEN + ALLOCATE(DstSoilDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSoilDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcSubDyn_DataData%Output,1), UBOUND(SrcSubDyn_DataData%Output,1) - CALL SD_CopyOutput( SrcSubDyn_DataData%Output(i1), DstSubDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO + DstSoilDyn_DataData%InputTimes = SrcSoilDyn_DataData%InputTimes ENDIF - CALL SD_CopyOutput( SrcSubDyn_DataData%y_interp, DstSubDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcSubDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcSubDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%InputTimes)) THEN - ALLOCATE(DstSubDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopySubDyn_Data + END SUBROUTINE FAST_CopySoilDyn_Data - SUBROUTINE FAST_DestroySubDyn_Data( SubDyn_DataData, ErrStat, ErrMsg ) - TYPE(SubDyn_Data), INTENT(INOUT) :: SubDyn_DataData + SUBROUTINE FAST_DestroySoilDyn_Data( SoilDyn_DataData, ErrStat, ErrMsg ) + TYPE(SoilDyn_Data), INTENT(INOUT) :: SoilDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySubDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySoilDyn_Data' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -DO i1 = LBOUND(SubDyn_DataData%x,1), UBOUND(SubDyn_DataData%x,1) - CALL SD_DestroyContState( SubDyn_DataData%x(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(SoilDyn_DataData%x,1), UBOUND(SoilDyn_DataData%x,1) + CALL SlD_DestroyContState( SoilDyn_DataData%x(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(SubDyn_DataData%xd,1), UBOUND(SubDyn_DataData%xd,1) - CALL SD_DestroyDiscState( SubDyn_DataData%xd(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(SoilDyn_DataData%xd,1), UBOUND(SoilDyn_DataData%xd,1) + CALL SlD_DestroyDiscState( SoilDyn_DataData%xd(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(SubDyn_DataData%z,1), UBOUND(SubDyn_DataData%z,1) - CALL SD_DestroyConstrState( SubDyn_DataData%z(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(SoilDyn_DataData%z,1), UBOUND(SoilDyn_DataData%z,1) + CALL SlD_DestroyConstrState( SoilDyn_DataData%z(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(SubDyn_DataData%OtherSt,1), UBOUND(SubDyn_DataData%OtherSt,1) - CALL SD_DestroyOtherState( SubDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(SoilDyn_DataData%OtherSt,1), UBOUND(SoilDyn_DataData%OtherSt,1) + CALL SlD_DestroyOtherState( SoilDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) ENDDO - CALL SD_DestroyParam( SubDyn_DataData%p, ErrStat, ErrMsg ) - CALL SD_DestroyInput( SubDyn_DataData%u, ErrStat, ErrMsg ) - CALL SD_DestroyOutput( SubDyn_DataData%y, ErrStat, ErrMsg ) - CALL SD_DestroyMisc( SubDyn_DataData%m, ErrStat, ErrMsg ) -IF (ALLOCATED(SubDyn_DataData%Input)) THEN -DO i1 = LBOUND(SubDyn_DataData%Input,1), UBOUND(SubDyn_DataData%Input,1) - CALL SD_DestroyInput( SubDyn_DataData%Input(i1), ErrStat, ErrMsg ) + CALL SlD_DestroyParam( SoilDyn_DataData%p, ErrStat, ErrMsg ) + CALL SlD_DestroyInput( SoilDyn_DataData%u, ErrStat, ErrMsg ) + CALL SlD_DestroyOutput( SoilDyn_DataData%y, ErrStat, ErrMsg ) + CALL SlD_DestroyMisc( SoilDyn_DataData%m, ErrStat, ErrMsg ) +IF (ALLOCATED(SoilDyn_DataData%Input)) THEN +DO i1 = LBOUND(SoilDyn_DataData%Input,1), UBOUND(SoilDyn_DataData%Input,1) + CALL SlD_DestroyInput( SoilDyn_DataData%Input(i1), ErrStat, ErrMsg ) ENDDO - DEALLOCATE(SubDyn_DataData%Input) + DEALLOCATE(SoilDyn_DataData%Input) ENDIF -IF (ALLOCATED(SubDyn_DataData%Output)) THEN -DO i1 = LBOUND(SubDyn_DataData%Output,1), UBOUND(SubDyn_DataData%Output,1) - CALL SD_DestroyOutput( SubDyn_DataData%Output(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(SubDyn_DataData%Output) +IF (ALLOCATED(SoilDyn_DataData%InputTimes)) THEN + DEALLOCATE(SoilDyn_DataData%InputTimes) ENDIF - CALL SD_DestroyOutput( SubDyn_DataData%y_interp, ErrStat, ErrMsg ) -IF (ALLOCATED(SubDyn_DataData%InputTimes)) THEN - DEALLOCATE(SubDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroySubDyn_Data + END SUBROUTINE FAST_DestroySoilDyn_Data - SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackSoilDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SubDyn_Data), INTENT(IN) :: InData + TYPE(SoilDyn_Data), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -26726,7 +28047,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackSubDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackSoilDyn_Data' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -26745,7 +28066,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SlD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26764,7 +28085,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END DO DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SlD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26783,7 +28104,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END DO DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SlD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26802,7 +28123,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END DO DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SlD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26820,7 +28141,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END IF END DO Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SlD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26837,7 +28158,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SlD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26854,7 +28175,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SlD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26871,7 +28192,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL SD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SlD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26892,7 +28213,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SlD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26910,46 +28231,6 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er END IF END DO END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_interp - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_interp - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_interp - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no IF ( ALLOCATED(InData%InputTimes) ) THEN Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension @@ -26983,7 +28264,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_Xferred = 1 DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SlD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27013,7 +28294,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ENDIF END DO DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SlD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27043,7 +28324,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ENDIF END DO DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SlD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27073,7 +28354,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ENDIF END DO DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SlD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27102,7 +28383,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - CALL SD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SlD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27130,7 +28411,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SlD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27158,7 +28439,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SlD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27186,7 +28467,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL SD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SlD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27225,7 +28506,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SlD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27255,75 +28536,6 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -27339,13 +28551,13 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = Db_Xferred + 1 END DO END IF - END SUBROUTINE FAST_PackSubDyn_Data + END SUBROUTINE FAST_PackSoilDyn_Data - SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackSoilDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SubDyn_Data), INTENT(INOUT) :: OutData + TYPE(SoilDyn_Data), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -27357,7 +28569,7 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackSubDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackSoilDyn_Data' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -27404,7 +28616,7 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SlD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27448,7 +28660,7 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SlD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27492,51 +28704,7 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SlD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27544,6 +28712,9 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27577,13 +28748,14 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SlD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27617,7 +28789,7 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SlD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27657,7 +28829,7 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SlD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27697,27 +28869,13 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SlD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27751,29 +28909,27 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SlD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27807,7 +28963,7 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL SlD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27816,46 +28972,6 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -27874,7 +28990,7 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Db_Xferred = Db_Xferred + 1 END DO END IF - END SUBROUTINE FAST_UnPackSubDyn_Data + END SUBROUTINE FAST_UnPackSoilDyn_Data SUBROUTINE FAST_CopyExtPtfm_Data( SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlCode, ErrStat, ErrMsg ) TYPE(ExtPtfm_Data), INTENT(INOUT) :: SrcExtPtfm_DataData @@ -36302,6 +37418,12 @@ SUBROUTINE FAST_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, C IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SlD_P_3_SD_P, DstModuleMapTypeData%SlD_P_3_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_P_3_SlD_P, DstModuleMapTypeData%SD_P_3_SlD_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN IF (ALLOCATED(SrcModuleMapTypeData%Jacobian_Opt1)) THEN i1_l = LBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) i1_u = UBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) @@ -36613,6 +37735,8 @@ SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) ENDDO DEALLOCATE(ModuleMapTypeData%SDy3_P_2_IceD_P) ENDIF + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SlD_P_3_SD_P, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_P_3_SlD_P, ErrStat, ErrMsg ) IF (ALLOCATED(ModuleMapTypeData%Jacobian_Opt1)) THEN DEALLOCATE(ModuleMapTypeData%Jacobian_Opt1) ENDIF @@ -37579,6 +38703,40 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF END DO END IF + Int_BufSz = Int_BufSz + 3 ! SlD_P_3_SD_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SlD_P_3_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! SlD_P_3_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SlD_P_3_SD_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SlD_P_3_SD_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SlD_P_3_SD_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! SD_P_3_SlD_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_3_SlD_P, ErrStat2, ErrMsg2, .TRUE. ) ! SD_P_3_SlD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SD_P_3_SlD_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SD_P_3_SlD_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SD_P_3_SlD_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 1 ! Jacobian_Opt1 allocated yes/no IF ( ALLOCATED(InData%Jacobian_Opt1) ) THEN Int_BufSz = Int_BufSz + 2*2 ! Jacobian_Opt1 upper/lower bounds for each dimension @@ -39459,6 +40617,62 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SlD_P_3_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! SlD_P_3_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_3_SlD_P, ErrStat2, ErrMsg2, OnlySize ) ! SD_P_3_SlD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF IF ( .NOT. ALLOCATED(InData%Jacobian_Opt1) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -42123,29 +43337,111 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2 ) ! IceD_P_2_SD_P + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2 ) ! IceD_P_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SDy3_P_2_IceD_P not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SDy3_P_2_IceD_P)) DEALLOCATE(OutData%SDy3_P_2_IceD_P) + ALLOCATE(OutData%SDy3_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDy3_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%SDy3_P_2_IceD_P,1), UBOUND(OutData%SDy3_P_2_IceD_P,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2 ) ! SDy3_P_2_IceD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SlD_P_3_SD_P, ErrStat2, ErrMsg2 ) ! SlD_P_3_SD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SDy3_P_2_IceD_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SDy3_P_2_IceD_P)) DEALLOCATE(OutData%SDy3_P_2_IceD_P) - ALLOCATE(OutData%SDy3_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDy3_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SDy3_P_2_IceD_P,1), UBOUND(OutData%SDy3_P_2_IceD_P,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -42179,15 +43475,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SDy3_P_2_IceD_P(i1), ErrStat2, ErrMsg2 ) ! SDy3_P_2_IceD_P + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_3_SlD_P, ErrStat2, ErrMsg2 ) ! SD_P_3_SlD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian_Opt1 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -43699,6 +44993,12 @@ SUBROUTINE FAST_CopyInitData( SrcInitDataData, DstInitDataData, CtrlCode, ErrSta CALL IceD_CopyInitOutput( SrcInitDataData%OutData_IceD, DstInitDataData%OutData_IceD, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL SlD_CopyInitInput( SrcInitDataData%InData_SlD, DstInitDataData%InData_SlD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SlD_CopyInitOutput( SrcInitDataData%OutData_SlD, DstInitDataData%OutData_SlD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE FAST_CopyInitData SUBROUTINE FAST_DestroyInitData( InitDataData, ErrStat, ErrMsg ) @@ -43747,6 +45047,8 @@ SUBROUTINE FAST_DestroyInitData( InitDataData, ErrStat, ErrMsg ) CALL IceFloe_DestroyInitOutput( InitDataData%OutData_IceF, ErrStat, ErrMsg ) CALL IceD_DestroyInitInput( InitDataData%InData_IceD, ErrStat, ErrMsg ) CALL IceD_DestroyInitOutput( InitDataData%OutData_IceD, ErrStat, ErrMsg ) + CALL SlD_DestroyInitInput( InitDataData%InData_SlD, ErrStat, ErrMsg ) + CALL SlD_DestroyInitOutput( InitDataData%OutData_SlD, ErrStat, ErrMsg ) END SUBROUTINE FAST_DestroyInitData SUBROUTINE FAST_PackInitData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -44335,6 +45637,40 @@ SUBROUTINE FAST_PackInitData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! InData_SlD: size of buffers for each call to pack subtype + CALL SlD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SlD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_SlD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_SlD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_SlD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_SlD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_SlD: size of buffers for each call to pack subtype + CALL SlD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SlD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_SlD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_SlD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_SlD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_SlD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -45271,6 +46607,62 @@ SUBROUTINE FAST_PackInitData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + CALL SlD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SlD, ErrStat2, ErrMsg2, OnlySize ) ! InData_SlD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SlD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SlD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_SlD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END SUBROUTINE FAST_PackInitData SUBROUTINE FAST_UnPackInitData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -46596,6 +47988,86 @@ SUBROUTINE FAST_UnPackInitData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SlD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_SlD, ErrStat2, ErrMsg2 ) ! InData_SlD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SlD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_SlD, ErrStat2, ErrMsg2 ) ! OutData_SlD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE FAST_UnPackInitData SUBROUTINE FAST_CopyExternInitType( SrcExternInitTypeData, DstExternInitTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -47000,6 +48472,9 @@ SUBROUTINE FAST_CopyTurbineType( SrcTurbineTypeData, DstTurbineTypeData, CtrlCod CALL FAST_Copysubdyn_data( SrcTurbineTypeData%SD, DstTurbineTypeData%SD, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL FAST_Copysoildyn_data( SrcTurbineTypeData%SlD, DstTurbineTypeData%SlD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN CALL FAST_Copymap_data( SrcTurbineTypeData%MAP, DstTurbineTypeData%MAP, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN @@ -47046,6 +48521,7 @@ SUBROUTINE FAST_DestroyTurbineType( TurbineTypeData, ErrStat, ErrMsg ) CALL FAST_Destroyscdataex_data( TurbineTypeData%SC_DX, ErrStat, ErrMsg ) CALL FAST_Destroyhydrodyn_data( TurbineTypeData%HD, ErrStat, ErrMsg ) CALL FAST_Destroysubdyn_data( TurbineTypeData%SD, ErrStat, ErrMsg ) + CALL FAST_Destroysoildyn_data( TurbineTypeData%SlD, ErrStat, ErrMsg ) CALL FAST_Destroymap_data( TurbineTypeData%MAP, ErrStat, ErrMsg ) CALL FAST_Destroyfeamooring_data( TurbineTypeData%FEAM, ErrStat, ErrMsg ) CALL FAST_Destroymoordyn_data( TurbineTypeData%MD, ErrStat, ErrMsg ) @@ -47330,6 +48806,23 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! SlD: size of buffers for each call to pack subtype + CALL FAST_Packsoildyn_data( Re_Buf, Db_Buf, Int_Buf, InData%SlD, ErrStat2, ErrMsg2, .TRUE. ) ! SlD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SlD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SlD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SlD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 3 ! MAP: size of buffers for each call to pack subtype CALL FAST_Packmap_data( Re_Buf, Db_Buf, Int_Buf, InData%MAP, ErrStat2, ErrMsg2, .TRUE. ) ! MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -47846,6 +49339,34 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL FAST_Packsoildyn_data( Re_Buf, Db_Buf, Int_Buf, InData%SlD, ErrStat2, ErrMsg2, OnlySize ) ! SlD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf @@ -48653,6 +50174,46 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FAST_Unpacksoildyn_data( Re_Buf, Db_Buf, Int_Buf, OutData%SlD, ErrStat2, ErrMsg2 ) ! SlD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) diff --git a/modules/orcaflex-interface/CMakeLists.txt b/modules/orcaflex-interface/CMakeLists.txt index fb6da14c5a..0d8a20510e 100644 --- a/modules/orcaflex-interface/CMakeLists.txt +++ b/modules/orcaflex-interface/CMakeLists.txt @@ -18,11 +18,11 @@ if (GENERATE_TYPES) generate_f90_types(src/OrcaFlexInterface.txt ${CMAKE_CURRENT_LIST_DIR}/src/OrcaFlexInterface_Types.f90) endif() -if (ORCA_DLL_LOAD) +if (WIN_DLL_LOAD) add_definitions(-DLibLoad) -else (ORCA_DLL_LOAD) +else (WIN_DLL_LOAD) add_definitions(-DNO_LibLoad) -endif (ORCA_DLL_LOAD) +endif (WIN_DLL_LOAD) add_library(orcaflexlib src/OrcaFlexInterface.f90 diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 801601b2e3..3924aea03e 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -17456,7 +17456,7 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg b = -(u1%LSShftFys - u2%LSShftFys) u_out%LSShftFys = u1%LSShftFys + b * ScaleFactor b = -(u1%LSShftFzs - u2%LSShftFzs) - u_out%LSShftFzs = u1%LSShftFzs + b * ScaleFactor + u_out%LSShftFzs = u1%LSShftFzs + b * ScaleFactor IF (ALLOCATED(u_out%fromSC) .AND. ALLOCATED(u1%fromSC)) THEN DO i1 = LBOUND(u_out%fromSC,1),UBOUND(u_out%fromSC,1) b = -(u1%fromSC(i1) - u2%fromSC(i1)) @@ -17688,7 +17688,7 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er u_out%LSShftFys = u1%LSShftFys + b + c * t_out b = (t(3)**2*(u1%LSShftFzs - u2%LSShftFzs) + t(2)**2*(-u1%LSShftFzs + u3%LSShftFzs))* scaleFactor c = ( (t(2)-t(3))*u1%LSShftFzs + t(3)*u2%LSShftFzs - t(2)*u3%LSShftFzs ) * scaleFactor - u_out%LSShftFzs = u1%LSShftFzs + b + c * t_out + u_out%LSShftFzs = u1%LSShftFzs + b + c * t_out IF (ALLOCATED(u_out%fromSC) .AND. ALLOCATED(u1%fromSC)) THEN DO i1 = LBOUND(u_out%fromSC,1),UBOUND(u_out%fromSC,1) b = (t(3)**2*(u1%fromSC(i1) - u2%fromSC(i1)) + t(2)**2*(-u1%fromSC(i1) + u3%fromSC(i1)))* scaleFactor diff --git a/modules/soildyn/CMakeLists.txt b/modules/soildyn/CMakeLists.txt new file mode 100644 index 0000000000..71109fd4e4 --- /dev/null +++ b/modules/soildyn/CMakeLists.txt @@ -0,0 +1,50 @@ +# +# Copyright 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. +# + +if (GENERATE_TYPES) + generate_f90_types(src/SoilDyn_Registry.txt ${CMAKE_CURRENT_LIST_DIR}/src/SoilDyn_Types.f90) +endif() + +if (WIN_DLL_LOAD) + add_definitions(-DLibLoad) +else (WIN_DLL_LOAD) + add_definitions(-DNO_LibLoad) +endif (WIN_DLL_LOAD) + +set(SlD_SOURCES + src/REDWINinterface.f90 + src/SoilDyn.f90 + src/SoilDyn_IO.f90 + src/SoilDyn_Types.f90 +) + +add_library(soildynlib ${SlD_SOURCES}) +target_link_libraries(soildynlib nwtclibs) + +set(SOILDYN_DRIVER_SOURCES + src/driver/SoilDyn_Driver_Types.f90 + src/driver/SoilDyn_Driver_Subs.f90 + src/driver/SoilDyn_Driver.f90 +) +add_executable(soildyn_driver ${SOILDYN_DRIVER_SOURCES}) +target_link_libraries(soildyn_driver soildynlib nwtclibs versioninfolib ${CMAKE_DL_LIBS}) + + +install(TARGETS soildynlib soildyn_driver + EXPORT "${CMAKE_PROJECT_NAME}Libraries" + RUNTIME DESTINATION bin + LIBRARY DESTINATION lib + ARCHIVE DESTINATION lib) diff --git a/modules/soildyn/README.md b/modules/soildyn/README.md new file mode 100644 index 0000000000..230c536dc9 --- /dev/null +++ b/modules/soildyn/README.md @@ -0,0 +1,3 @@ +# OpenFAST SoilDyn Module + +This directory contains the module SoilDyn. This module models the soil structure interface, and can be coupled to external DLL such as RedWin. diff --git a/modules/soildyn/src/REDWINinterface.f90 b/modules/soildyn/src/REDWINinterface.f90 new file mode 100644 index 0000000000..c699ca3988 --- /dev/null +++ b/modules/soildyn/src/REDWINinterface.f90 @@ -0,0 +1,535 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2013-2016 National Renewable Energy Laboratory +! +! This file is part of SoilDyn. +! +! 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 REDWINinterface + +!> NOTE: The REDWIN coordinate system is not the same as the OpenFAST global coordinate frame. The Y axis +!! is flipped, and the Z axis is flipped. However, because REDWIN does not have a preferred +!! directionality (it is the same response amplitude for the negative direction time series of +!! displacements), this does not matter. So we simply ignore the fact that the coordinate frames +!! are flipped on Y and Z. + + USE NWTC_Library, only: IntKi, ReKi, SiKi, DbKi, R8Ki, ProgDesc, DLL_Type, ErrMsgLen, PathIsRelative, & + OS_DESC, ErrID_None, ErrID_Info, ErrID_Warn, ErrID_Fatal, AbortErrLev, PathSep, & + NewLine, Num2LStr, Get_CWD, LoadDynamicLib, FreeDynamicLib, SetErrStat, DispNVD + USE SoilDyn_Types, only: REDWINdllType + + IMPLICIT NONE + + INTEGER(IntKi), PARAMETER :: IDtask_unkown = 0_IntKi ! Unknown task (placeholder for error checking) + INTEGER(IntKi), PARAMETER :: IDtask_init = 1_IntKi ! Initialize DLL + INTEGER(IntKi), PARAMETER :: IDtask_calc = 2_IntKi ! Calculate resultant force + INTEGER(IntKi), PARAMETER :: IDtask_stiff = 3_IntKi ! Return stiffness 6x6 + + !> Definition of the DLL Interface (from REDWIN): + abstract interface + subroutine REDWINdll_interface_v00(PROPSFILE, LDISPFILE, IDTask, nErrorCode, ErrorCode, Props, StVar, StVarPrint, Disp, Force, D) + USE, INTRINSIC :: ISO_C_Binding, only : C_INT, C_CHAR, C_DOUBLE + character(kind=c_char), intent(inout) :: PROPSFILE(45) + character(kind=c_char), intent(inout) :: LDISPFILE(45) + integer(c_int), intent(inout) :: IDTask + integer(c_int), intent(inout) :: nErrorCode + real(c_double), intent(inout) :: Props(1:100, 1:200) + real(c_double), intent(inout) :: StVar(1:12, 1:100) + integer(c_int), intent(inout) :: StVarPrint(1:12, 1:100) + real(c_double), intent(inout) :: Disp(1:6) ! meters and radians + real(c_double), intent(inout) :: Force(1:6) + real(c_double), intent(inout) :: D(1:6,1:6) + integer(c_int), intent(inout) :: ErrorCode(1:100) + end subroutine REDWINdll_interface_v00 + end interface + +#ifdef STATIC_DLL_LOAD + interface + ! DO NOT REMOVE or MODIFY LINES starting with "!DEC$" or "!GCC$" + ! !DEC$ specifies attributes for IVF and !GCC$ specifies attributes for gfortran + ! NOTE: BIND(C... does not appear to be built into the DLL from REDWIN. + subroutine INTERFACEFOUNDATION ( PROPSFILE, LDISPFILE, IDTask, nErrorCode, ErrorCode, Props, StVar, StVarPrint, Disp, Force, D ) !BIND(C, NAME='INTERFACEFOUNDATION') + !DEC$ ATTRIBUTES DLLIMPORT :: INTERFACEFOUNDATION + !GCC$ ATTRIBUTES DLLIMPORT :: INTERFACEFOUNDATION + USE, INTRINSIC :: ISO_C_Binding, only : C_INT, C_CHAR, C_DOUBLE + character(kind=c_char), intent(inout) :: PROPSFILE(45) + character(kind=c_char), intent(inout) :: LDISPFILE(45) + integer(c_int), intent(inout) :: IDTask + integer(c_int), intent(inout) :: nErrorCode + real(c_double), intent(inout) :: Props(1:100, 1:200) + real(c_double), intent(inout) :: StVar(1:12, 1:100) + integer(c_int), intent(inout) :: StVarPrint(1:12, 1:100) + real(c_double), intent(inout) :: Disp(1:6) ! meters and radians + real(c_double), intent(inout) :: Force(1:6) + real(c_double), intent(inout) :: D(1:6,1:6) + integer(c_int), intent(inout) :: ErrorCode(1:100) + end subroutine INTERFACEFOUNDATION + end interface +#endif + + type(ProgDesc), parameter :: REDWINinterface_Ver = ProgDesc( 'SoilDyn Interface for REDWIN soil interaction DLLs', 'using '//TRIM(OS_Desc), '28-Aug-2022' ) + + ! Interface version (in case we end up with multiple different versions supported at some later date) + INTEGER(IntKi), PARAMETER :: RW_v00 = 0 ! Version number + INTEGER(IntKi), PARAMETER :: RW_ver = RW_v00 ! Current version number (read from DLL file) + +CONTAINS +!================================================================================================================================== +!> This SUBROUTINE is used to call the REDWIN-style DLL. +subroutine CallREDWINdll ( DLL_Trgt, DLL_Model, dll_data, ErrStat, ErrMsg ) + USE, INTRINSIC :: ISO_C_Binding, only : C_F_PROCPOINTER + ! Passed Variables: + type(DLL_Type), intent(in ) :: DLL_Trgt ! The DLL to be called. + integer(IntKi), intent(in ) :: DLL_Model ! The DLL model type + type(REDWINdllType), intent(inout) :: dll_data ! data type containing the dll required arrays in DLL coordinate frame + + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + PROCEDURE(REDWINdll_interface_V00),POINTER:: REDWIN_Subroutine_v00 ! The address of the procedure in the RedWin DLL + +#ifdef STATIC_DLL_LOAD + ! if we're statically loading the library (i.e., OpenFOAM), we can just call INTERFACEFOUNDATION(); + CALL INTERFACEFOUNDATION( PROPSFILE, LDISPFILE, & + dll_data%IDTask, dll_data%nErrorCode, dll_data%ErrorCode, & + dll_data%Props, dll_data%StVar, dll_data%StVarPrint, & + dll_data%Disp, dll_data%Force, dll_data%D ) +#else + ! Call the DLL (first associate the address from the procedure in the DLL with the subroutine): + if (RW_Ver == RW_v00) then + CALL C_F_PROCPOINTER( DLL_Trgt%ProcAddr(1), REDWIN_Subroutine_v00) + CALL REDWIN_Subroutine_v00 ( dll_data%PROPSfile, dll_data%LDISPfile, & + dll_data%IDTask, dll_data%nErrorCode, dll_data%ErrorCode, & + dll_data%Props, dll_data%StVar, dll_data%StVarPrint, & + dll_data%Disp, dll_data%Force, dll_data%D ) + endif +#endif + + ! Call routine for error trapping the returned ErrorCodes + call CheckREDWINerrors( dll_data, DLL_Model, dll_data%SuppressWarn, ErrStat, ErrMsg ) + return +end subroutine CallREDWINdll + + +!================================================================================================================================== +!> This routine initializes variables used in the REDWIN DLL interface. +subroutine REDWINinterface_Init( DLL_FileName, DLL_ProcName, DLL_Trgt, DLL_Model, dll_data, UseREDWINinterface, ErrStat, ErrMsg ) + + character(1024), intent(in ) :: DLL_FileName !< DLL filename from input file + character(1024), intent(in ) :: DLL_ProcName !< Procedure name from input file + type(DLL_Type), intent(inout) :: DLL_Trgt !< The DLL to be called. + integer(IntKi), intent(in ) :: DLL_Model !< Model type of the DLL + type(REDWINdllType), intent(inout) :: dll_data !< DLL coordinate frame arrays in here + logical, intent( out) :: UseREDWINinterface !< Can use the interface + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + integer(IntKi) :: ErrStat2 ! The error status code + character(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred + character(*), parameter :: RoutineName = 'REDWINinterface_Init' + logical :: FileExist + character(1024) :: CwdPath !< Path of current working directory + character(1024) :: PropsLoc !< Full path to PropsFile location + character(1024) :: LDispLoc !< Full path to LDispFile location + + ErrStat = ErrID_None + ErrMsg= '' + + CALL DispNVD( REDWINinterface_Ver ) ! Display the version of this interface + + ! Get current working directory for checking DLL input files. + call Get_CWD( CwdPath, ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat( ErrID_Fatal,' Cannot get current working directory to check DLL input files.',ErrStat,ErrMsg,RoutineName ) + return + endif + CwdPath=trim(CwdPath)//PathSep + + call CheckPaths() + if (ErrStat >= AbortErrLev) return + + ! Define and load the DLL: + DLL_Trgt%FileName = DLL_FileName + DLL_Trgt%ProcName = "" ! initialize all procedures to empty so we try to load only one + DLL_Trgt%ProcName(1) = DLL_ProcName + CALL LoadDynamicLib ( DLL_Trgt, ErrStat2, ErrMsg2 ) + if(Failed()) return + + ! Initialize DLL + dll_data%IDtask = IDtask_init + CALL CallREDWINdll(DLL_Trgt, DLL_Model, dll_data, ErrStat2, ErrMsg2) + if(Failed()) return + + ! Checks on model version + ! NOTE: there is not a good way to tell exactly which DLL model is in use. The DLL does not return + ! much info that would identify it. Ideally we would add some checks here to figure out if + ! the model number we read from the input file matches the actual DLL model. + ! For Model 1, the Props(1,1) will indicate which runmode we are using. Test that here + + ! Set status flag: + UseREDWINinterface = .TRUE. + +CONTAINS + subroutine CheckPaths() + ! Check existance of DLL input files. The DLL does not check this, and will + ! catastrophically fail if they are not found. + if ( PathIsRelative( dll_data%PROPSfile ) ) then + PropsLoc = trim(CwdPath)//trim(dll_data%PROPSfile(3:len_trim(dll_data%PROPSfile))) ! remove the leading ./ + else + PropsLoc = trim(dll_data%PROPSfile) + endif + if ( PathIsRelative( dll_data%LDISPfile ) ) then + LDispLoc = trim(CwdPath)//trim(dll_data%LDISPfile(3:len_trim(dll_data%LDISPfile))) ! remove the leading ./ + else + LDispLoc = trim(dll_data%LDISPfile) + endif + inquire( file=trim(PropsLoc), exist=FileExist ) + if ( .not. FileExist ) call SetErrStat(ErrID_Fatal, 'PropsFile '//trim(dll_data%PROPSfile)// & + ' not found (path must be relative to the working directory, or absolute)', ErrStat, ErrMsg, RoutineName) + inquire( file=trim(LDispLoc), exist=FileExist ) + if ( .not. FileExist ) call SetErrStat(ErrID_Fatal, 'LDispFile '//trim(dll_data%LDISPFile)// & + ' not found (path must be relative to the working direcotry, or absolute)', ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) UseREDWINinterface = .FALSE. + end subroutine CheckPaths + + logical function Failed() + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Failed = ErrStat >= AbortErrLev + if ( ErrStat >= AbortErrLev ) UseREDWINinterface = .FALSE. + end function Failed +end subroutine REDWINinterface_Init + + +!================================================================================================================================== +!> This routine would call the DLL a final time, but there appears to be no end routine for the DLL, +!! so we don't need to make a last call. It also frees the dynamic library (doesn't do anything on +!! static linked). +subroutine REDWINinterface_End( DLL_Trgt, ErrStat, ErrMsg ) + + type(DLL_Type), intent(inout) :: DLL_Trgt ! The DLL to be called. + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables: + INTEGER(IntKi) :: ErrStat2 ! The error status code + CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred + character(*), parameter :: RoutineName = 'REDWINinterface_End' + + ErrStat = ErrID_None + ErrMsg= '' + + ! Free the library (note: this doesn't do anything #ifdef STATIC_DLL_LOAD because DLL_Trgt is 0 (NULL)) + CALL FreeDynamicLib( DLL_Trgt, ErrStat, ErrMsg ) + +end subroutine REDWINinterface_End + + +!================================================================================================================================== +!> This routine sets the AVRswap array, calls the routine from the REDWIN DLL, and sets the outputs from the call to be used as +!! necessary in the main ServoDyn CalcOutput routine. +subroutine REDWINinterface_CalcOutput( DLL_Trgt, DLL_Model, Displacement, Force, dll_data, ErrStat, ErrMsg ) + + type(DLL_Type), intent(in ) :: DLL_Trgt !< The DLL to be called. + integer(IntKi), intent(in ) :: DLL_Model !< Model type of the DLL + real(R8Ki), intent(in ) :: Displacement(6) !< OpenFAST global coordinate frame + real(R8Ki), intent( out) :: Force(6) !< OpenFAST global coordinate frame + type(REDWINdllType), intent(inout) :: dll_data !< DLL coordinate frame arrays in here + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables: + integer(IntKi) :: ErrStat2 ! The error status code + character(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred + character(*), parameter :: RoutineName = 'REDWINinterface_CalcOutput' + + ! Initialize error values: + ErrStat = ErrID_None + ErrMsg= '' + + + ! Copy data over + dll_data%Disp = Displacement + +#ifdef DEBUG_REDWIN_INTERFACE +!CALL WrNumAryFileNR ( 58, m%dll_data%avrSWAP,'1x,ES15.6E2', ErrStat, ErrMsg ) +!write(58,'()') +#endif + + ! Call the REDWIN-style DLL: + dll_data%IDtask = IDtask_calc + CALL CallREDWINdll( DLL_Trgt, DLL_Model, dll_data, ErrStat2, ErrMsg2); if(Failed()) return; + + ! Coordinate transform from REDWIN frame + Force = dll_data%Force + + ! Call routine for error trapping the returned ErrorCodes + call CheckREDWINerrors( dll_data, DLL_Model, dll_data%SuppressWarn, ErrStat2, ErrMsg2 ); if(Failed()) return; + + +#ifdef DEBUG_REDWIN_INTERFACE +!CALL WrNumAryFileNR ( 59, m%dll_data%avrSWAP,'1x,ES15.6E2', ErrStat, ErrMsg ) +!write(59,'()') +#endif + +contains + logical function Failed() + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine REDWINinterface_CalcOutput + + +!================================================================================================================================== +!> This routine sets the AVRswap array, calls the routine from the REDWIN DLL, and sets the outputs from the call to be used as +!! necessary in the main ServoDyn CalcOutput routine. +subroutine REDWINinterface_GetStiffMatrix( DLL_Trgt, DLL_Model, Displacement, Force, StiffMatrix, dll_data, ErrStat, ErrMsg ) + + type(DLL_Type), intent(in ) :: DLL_Trgt !< The DLL to be called. + integer(IntKi), intent(in ) :: DLL_Model !< Model type of the DLL + real(R8Ki), intent(in ) :: Displacement(6) !< Displacement (OpenFAST global coords) + real(R8Ki), intent( out) :: Force(6) !< Resulting force (OpenFAST global coords) + real(R8Ki), intent( out) :: StiffMatrix(6,6) !< Returned stiffness (OpenFAST global coords) + type(REDWINdllType), intent(inout) :: dll_data + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables: + integer(IntKi) :: ErrStat2 ! The error status code + character(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred + character(*), parameter :: RoutineName = 'REDWINinterface_GetStiffMatrix' + + ! Initialize error values: + ErrStat = ErrID_None + ErrMsg= '' + + ! Coordinate transform to REDWIN frame + dll_data%Disp = Displacement + + ! Call the REDWIN-style DLL: + dll_data%IDtask = IDtask_stiff + CALL CallREDWINdll( DLL_Trgt, DLL_Model, dll_data, ErrStat2, ErrMsg2); if(Failed()) return; + + ! Coordinate transformation + Force = dll_data%Force + StiffMatrix = dll_data%D + +#ifdef DEBUG_REDWIN_INTERFACE +!CALL WrNumAryFileNR ( 59, m%dll_data%avrSWAP,'1x,ES15.6E2', ErrStat, ErrMsg ) +!write(59,'()') +#endif + +contains + logical function Failed() + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine REDWINinterface_GetStiffMatrix + + +!================================================================================================================================== +!> Check errors from REDWIN +!! Error values taken from "20150014-11-R_Rev0_3D_Foundation Model Library.pdf" +!! +!! NOTE: the DLL does not at present return any error codes. Instead when it hits an error +!! it simply aborts the whole program without returning. So this routine will never +!! actually catch any errors... :( +subroutine CheckREDWINerrors( dll_data, DLL_Model, SuppressWarn, ErrStat, ErrMsg ) + type(REDWINdllType), intent(in ) :: dll_data ! data type + integer(IntKi), intent(in ) :: DLL_Model ! Model type of the DLL + logical, intent(inout) :: SuppressWarn ! from dll_data%SupressWarn + integer(IntKi), intent( out) :: ErrStat ! Error status of the operation + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None + integer(IntKi) :: i + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + ErrStat = ErrID_none + ErrMsg = '' + + select case (DLL_Model) + case(1) + do i=1,dll_data%nErrorCode + call CheckErrorsModel1(dll_data%ErrorCode(i),ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'REDWIN DLL error') + enddo + case(2) + do i=1,dll_data%nErrorCode + call CheckErrorsModel2(dll_data%ErrorCode(i),ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'REDWIN DLL error') + enddo + case(3) + do i=1,dll_data%nErrorCode + call CheckErrorsModel3(dll_data%ErrorCode(i),ErrStat2,ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'REDWIN DLL error') + enddo + case default + end select + + ! Check if this is only a warning, and if we should supress further warnings (only one warning exists in each DLL model, rest are errors + if (ErrStat == ErrID_Warn) then + if ( SuppressWarn ) then + ErrStat = ErrID_None + ErrMsg = '' + else + SuppressWarn = .TRUE. + endif + endif + +CONTAINS + + !> Check error codes from DLL model 1 + subroutine CheckErrorsModel1(ErrVal,ErrStat,ErrMsg) + ! 1 Warning: The number of rows in LDISDPFILE exceed the maximum number supported (200). The calibration will proceed using the first 200 values. + ! Reduce the number of data points in the input file. + ! 2 Error in the interpolation tool used in the model calibration. The value you are trying to interpolate is outside the interpolation curve. + ! Please inspect LDISPFILE to make sure that it covers a wide enough range and that all values are positive. + ! Try to extend the input load-displacement curves in LDISPFILE. + integer(IntKi), intent(in ) :: ErrVal + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen), intent( out) :: ErrMSg + integer(IntKi), parameter :: MaxErr=2 + + if ( (ErrVal > MaxErr) .or. (ErrVal < 0) ) then + ErrStat = ErrID_Fatal + ErrMSg = 'Unknown error from REDWIN DLL: '//trim(num2lstr(ErrVal))//'. Only '//trim(num2lstr(MaxErr))//' values are known.' & + //NewLine//' --> Check that the correct REDWIN DLL model is specified and used.' + return + endif + + select case(ErrVal) + case(0) + ErrStat = ErrID_None + ErrMsg = '' + case(1) + ErrStat = ErrID_Warn + ErrMsg = 'The number of rows in LDISDPFILE exceed the maximum number supported (200). The calibration will proceed using the first 200 values.' & + //NewLine//' --> Reduce the number of data points in the input file.' + case(2) + ErrStat = ErrID_Fatal + ErrMsg = 'Error in the interpolation tool used in the model calibration. The value you are trying to interpolate is outside the interpolation curve.' & + //NewLine//' --> Please inspect LDISPFILE to make sure that it covers a wide enough range and that all values are positive. ' & + //'Try to extend the input load-displacement curves in LDISPFILE.' + end select + end subroutine CheckErrorsModel1 + + !> Check error codes from DLL model 2 + subroutine CheckErrorsModel2(ErrVal,ErrStat,ErrMsg) + ! 1 Warning: The plastic force- displacement calibration curve has several zero-rows. The solution does not stop, but the results may be inaccurate or erroneous. + ! Check that the provided coefficients of the elastic stiffness matrix are consistent with the load-displacement input curves. + ! 2 Error. The iteration to find the plastic rotation increment and the plastic displacement increment did not converge. + ! The force you are trying to apply might be outside the calibrated range. Please extend the input load-displacement curves in LDISPFILE. + ! Alternatively, increase the number of iterations in PROPSFILE. + ! 3 Error in the interpolation tool used in the model calibration. The value you are trying to interpolate is outside the interpolation curve. + ! Please inspect LDISPFILE to make sure that it covers a wide enough range and that all values are positive. Try to extend the input load-displacement curves in LDISPFILE. + ! 4 Error in the calibration tool. The contours of plastic horizontal displacement and the contours of plastic rotation are parallel. + ! The input might be non-physical. Please check that LDISPFILE is in the correct format and that the units are consistent. + ! 5 Error in the calibration tool. The calculation of the orientation of the yield surfaces might be wrong. + ! The input might be non-physical. Please check that LDISPFILE is in the correct format and that the units are consistent. + ! 6 Error in the calibration tool. The contours of plastic horizontal displacement are steeper than the contours of plastic rotation. + ! The input might be non-physical. Please check that LDISPFILE is in the correct format and that the units are consistent. + integer(IntKi), intent(in ) :: ErrVal + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen), intent( out) :: ErrMSg + integer(IntKi), parameter :: MaxErr=6 + + if ( (ErrVal > MaxErr) .or. (ErrVal < 0) ) then + ErrStat = ErrID_Fatal + ErrMSg = 'Unknown error from REDWIN DLL: '//trim(num2lstr(ErrVal))//'. Only '//trim(num2lstr(MaxErr))//' values are known.' + return + endif + + select case(ErrVal) + case(0) + ErrStat = ErrID_None + ErrMsg = '' + case(1) + ErrStat = ErrID_Warn + ErrMsg = 'The plastic force- displacement calibration curve has several zero-rows. The solution does not stop, but the results may be inaccurate or erroneous.' & + //NewLine//' --> Check that the provided coefficients of the elastic stiffness matrix are consistent with the load-displacement input curves.' + case(2) + ErrStat = ErrID_Fatal + ErrMsg = 'The iteration to find the plastic rotation increment and the plastic displacement increment did not converge.' & + //NewLine//' --> The force you are trying to apply might be outside the calibrated range. Please extend the input load-displacement curves ' & + //'in LDISPFILE. Alternatively, increase the number of iterations in PROPSFILE.' + case(3) + ErrStat = ErrID_Fatal + ErrMsg = 'Error in the interpolation tool used in the model calibration. The value you are trying to interpolate is outside the interpolation curve.' & + //NewLine//' --> Please inspect LDISPFILE to make sure that it covers a wide enough range and that all values are positive. ' & + //'Try to extend the input load-displacement curves in LDISPFILE.' + case(4) + ErrStat = ErrID_Fatal + ErrMsg = 'Error in the calibration tool. The contours of plastic horizontal displacement and the contours of plastic rotation are parallel. ' & + //NewLine//' --> The input might be non-physical. Please check that LDISPFILE is in the correct format and that the units are consistent.' + case(5) + ErrStat = ErrID_Fatal + ErrMsg = 'Error in the calibration tool. The calculation of the orientation of the yield surfaces might be wrong.' & + //NewLine//' --> The input might be non-physical. Please check that LDISPFILE is in the correct format and that the units are consistent.' + case(6) + ErrStat = ErrID_Fatal + ErrMsg = 'Error in the calibration tool. The contours of plastic horizontal displacement are steeper than the contours of plastic rotation.' & + //NewLine//' --> The input might be non-physical. Please check that LDISPFILE is in the correct format and that the units are consistent.' + end select + end subroutine CheckErrorsModel2 + + !> Check error codes from DLL model 3 + subroutine CheckErrorsModel3(ErrVal,ErrStat,ErrMsg) + ! 1 Warning. The solution in the current sub-step seems to be diverging. Will attempt to reduce the step size. + ! The step size may be too large for convergence to be reached. The model will attempt to try again with a smaller step size. + ! 2 Error. The sub-stepping algorithm in the multi-surface plasticity model did not converge. + ! The cause of divergence is usually that the applied loads exceed the calibration range, or that there are several identical spring stiffness for low load levels. + ! Possible solutions are: reduce the number of yield surfaces (Ns), increase the number of substeps (nsub), increase the range of the input load-displacement files. + ! 3 Error in the calibration tool. The input file cannot be found. + ! Check that the file name and path of the input files PROPSFILE and LDISPFILE are correctly specified. + ! 4 Error in the calibration tool during read of PROPSFILE or LDISPFILE. + ! Check that the format of the input files are correct. + integer(IntKi), intent(in ) :: ErrVal + integer(IntKi), intent( out) :: ErrStat + character(ErrMsgLen), intent( out) :: ErrMSg + integer(IntKi), parameter :: MaxErr=4 + + if ( (ErrVal > MaxErr) .or. (ErrVal < 0) ) then + ErrStat = ErrID_Fatal + ErrMSg = 'Unknown error from REDWIN DLL: '//trim(num2lstr(ErrVal))//'. Only '//trim(num2lstr(MaxErr))//' values are known.' + return + endif + + select case(ErrVal) + case(0) + ErrStat = ErrID_None + ErrMsg = '' + case(1) + ErrStat = ErrID_Warn + ErrMsg = 'The solution in the current sub-step seems to be diverging. Will attempt to reduce the step size.' & + //NewLine//' --> The step size may be too large for convergence to be reached.' & + //' The model will attempt to try again with a smaller step size.' + case(2) + ErrMsg = 'The sub-stepping algorithm in the multi-surface plasticity model did not converge.' & + //NewLine//' --> The cause of divergence is usually that the applied loads exceed the calibration range, or that there' & + //' are several identical spring stiffness for low load levels. Possible solutions are: reduce the number of yield surfaces' & + //'(Ns), increase the number of substeps (nsub), increase the range of the input load-displacement files.' + case(3) + ErrMsg = 'Error in the calibration tool. The input file cannot be found.' & + //NewLine//' --> Check that the file name and path of the input files PROPSFILE and LDISPFILE are correctly specified.' + case(4) + ErrMsg = 'Error in the calibration tool during read of PROPSFILE or LDISPFILE.' & + //NewLine//' --> Check that the format of the input files are correct.' + end select + end subroutine CheckErrorsModel3 +end subroutine CheckREDWINerrors + + + + +end module REDWINinterface diff --git a/modules/soildyn/src/SoilDyn.f90 b/modules/soildyn/src/SoilDyn.f90 new file mode 100644 index 0000000000..622cf8bd39 --- /dev/null +++ b/modules/soildyn/src/SoilDyn.f90 @@ -0,0 +1,609 @@ +!********************************************************************************************************************************** +!> ## SoilDyn +!! The SoilDyn and SoilDyn_Types modules make up a template for creating user-defined calculations in the FAST Modularization +!! Framework. SoilDyn_Types will be auto-generated by the FAST registry program, based on the variables specified in the +!! SoilDyn_Registry.txt file. +!! +!! This template file contains comments in the style required for Doxygen, and it contains methods for handling errors. +!! +!! "SoilDyn" should be replaced with the name of your module. Example: ElastoDyn \n +!! "SoilDyn" (in SoilDyn_*) should be replaced with the module name or an abbreviation of it. Example: ED +! .................................................................................................................................. +!! ## LICENSING +!! Copyright (C) 2012-2013, 2015-2016 National Renewable Energy Laboratory +!! +!! This file is part of SoilDyn. +!! +!! 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 SoilDyn + + USE SoilDyn_Types + USE SoilDyn_IO + USE NWTC_Library + USE REDWINinterface + + IMPLICIT NONE + + PRIVATE + + TYPE(ProgDesc), PARAMETER :: SlD_Ver = ProgDesc( 'SoilDyn', 'v0.01.00', '24-Aug-2022' ) !< module date/version information + + ! ..... Public Subroutines ................................................................................................... + PUBLIC :: SlD_Init ! Initialization routine + PUBLIC :: SlD_End ! Ending routine (includes clean up) + PUBLIC :: SlD_UpdateStates ! Loose coupling routine for solving for constraint states, integrating + PUBLIC :: SlD_CalcOutput ! Routine for computing outputs + +!NOTE: these are placeholders for now. +!!! PUBLIC :: SlD_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual +!!! PUBLIC :: SlD_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states +!!! PUBLIC :: SlD_UpdateDiscState ! Tight coupling routine for updating discrete states +!!! PUBLIC :: SlD_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) +!!! PUBLIC :: SlD_JacobianPContState ! Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions all with respect to the continuous states (x) +!!! PUBLIC :: SlD_JacobianPDiscState ! Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions all with respect to the discrete states (xd) +!!! PUBLIC :: SlD_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 :: SlD_GetOP ! Routine to get the operating-point values for linearization (from data structures to arrays) + +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. +!! The initial states and initial guess for the input are defined. +subroutine SlD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) + + type(SlD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine + type(SlD_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined + type(SlD_ParameterType), intent( out) :: p !< Parameters + type(SlD_ContinuousStateType), intent( out) :: x !< Initial continuous states + type(SlD_DiscreteStateType), intent( out) :: xd !< Initial discrete states + type(SlD_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states + type(SlD_OtherStateType), intent( out) :: OtherState !< Initial other states (logical, etc) + type(SlD_OutputType), intent( out) :: y !< Initial system outputs + type(SlD_MiscVarType), intent( out) :: m !< Misc variables for optimization (not copied in glue code) + real(DbKi), intent(inout) :: Interval !< Coupling interval in seconds + type(SlD_InitOutputType), intent( out) :: 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) :: j !< generic counter + integer(IntKi) :: ErrStat2 !< local error status + character(ErrMsgLen) :: ErrMsg2 !< local error message + character(*), parameter :: RoutineName = 'SlD_Init' + type(SlD_InputFile) :: InputFileData !< Data stored in the module's input file + + ! Initialize variables + ErrStat = ErrID_None + ErrMsg = "" + + ! Initialize the NWTC Subroutine Library + call NWTC_Init( ) + + ! Display the module information + call DispNVD( SlD_Ver ) + + ! Set some names + call GetRoot( InitInp%InputFile, p%RootFileName ) + p%EchoFileName = TRIM(p%RootFileName)//".ech" + p%SumFileName = TRIM(p%RootFileName)//"SlD.sum" + + + call SlD_ReadInput( InitInp%InputFile, p%EchoFileName, InputFileData, ErrStat2, ErrMsg2 ); if (Failed()) return; + call SlD_ValidateInput( InitInp, InputFileData, ErrStat2, ErrMsg2 ); if (Failed()) return; + + ! Define parameters here: + p%DT = Interval + p%DLL_Model = InputFileData%DLL_Model + p%DLL_OnlyStiff = InputFileData%DLL_OnlyStiff + p%CalcOption = InputFileData%CalcOption + + p%UseREDWINinterface = .FALSE. ! Initially set to false in case DLL not used. + + ! Define initial system states here: + x%DummyContState = 0.0_ReKi + z%DummyConstrState = 0.0_ReKi + OtherState%DummyOtherState = 0.0_ReKi + + ! are the returned reaction forces only the non-linear portion (used when SubDyn is calculating the linear portion) + p%SlDNonLinearForcePortionOnly = InitInp%SlDNonLinearForcePortionOnly + if (p%SlDNonLinearForcePortionOnly) call WrScr(' SoilDyn returning only non-linear portion of reaction forces') + + + if (InitInp%Linearize) then + + ! If the module does not implement the four Jacobian routines at the end of this template, or the module cannot + ! linearize with the features that are enabled, stop the simulation if InitInp%Linearize is true. + + CALL SetErrStat( ErrID_Fatal, 'SoilDyn cannot perform linearization analysis.', ErrStat, ErrMsg, RoutineName) + return + + ! Otherwise, if the module does allow linearization, return the appropriate Jacobian row/column names and rotating-frame flags here: + ! Allocate and set these variables: InitOut%LinNames_y, InitOut%LinNames_x, InitOut%LinNames_xd, InitOut%LinNames_z, InitOut%LinNames_u + ! Allocate and set these variables: InitOut%RotFrame_y, InitOut%RotFrame_x, InitOut%RotFrame_xd, InitOut%RotFrame_z, InitOut%RotFrame_u + + end if + + call SlD_InitMeshes( InputFileData, u, y, p, m, ErrStat2,ErrMsg2); if (Failed()) return; + + + ! Set miscvars: including dll_data arrays and checking for input files. + call SlD_InitStatesMisc( InputFileData, m, xd, ErrStat2,ErrMsg2); if (Failed()) return; + + + ! Setup and initialize the Calc Options + select case(p%CalcOption) + case (Calc_StiffDamp) + call move_alloc(InputFileData%Stiffness,p%Stiffness) + !call move_alloc(InputFileData%Damping,p%Damping) + case (Calc_PYcurve) + case (Calc_REDWIN) + call SlD_REDWINsetup( InputFileData,p, m, xd, ErrStat, ErrMsg ) + end select + + ! set paramaters for I/O data + InitOut%Ver = SlD_Ver + p%NumOuts = InputFileData%NumOuts + call AllocAry( InitOut%WriteOutputHdr, p%NumOuts, 'WriteOutputHdr', errStat2, errMsg2 ); if (Failed()) return; + call AllocAry( InitOut%WriteOutputUnt, p%NumOuts, 'WriteOutputUnt', errStat2, errMsg2 ); if (Failed()) return; + call AllocAry( y%WriteOutput, p%NumOuts, 'WriteOutput', ErrStat2, ErrMsg2 ); if (Failed()) return; + y%WriteOutput = 0 + + call SetOutParam(InputFileData%OutList, p, ErrStat2, ErrMsg2); if (Failed()) return; + do j=1,p%NumOuts + InitOut%WriteOutputHdr(j) = p%OutParam(j)%Name + InitOut%WriteOutputUnt(j) = p%OutParam(j)%Units + end do + +contains + logical function Failed() + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed + + subroutine SlD_REDWINsetup( InputFileData,p, m, xd, ErrStat, ErrMsg ) + type(SlD_InputFile), intent(in ) :: InputFileData !< Data stored in the module's input file + type(SlD_ParameterType), intent(inout) :: p !< Parameters + type(SlD_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(SlD_DiscreteStateType), intent(inout) :: xd !< Initial discrete states + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i ! Generic counter + integer(IntKi) :: ErrStat2 !< local error status + character(ErrMsgLen) :: ErrMsg2 !< local error message + real(R8Ki) :: NullDispl(6) !< ignored + real(R8Ki) :: NullForce(6) !< ignored + + ErrStat = ErrID_None + ErrMsg = "" + + ! set placeholder for DLL stifness matrices + call AllocAry( p%Stiffness, 6, 6, size(m%dll_data), 'DLL stiffness matrices', ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! Initialize the dll + do i=1,size(m%dll_data) + call REDWINinterface_Init( InputFileData%DLL_FileName, InputFileData%DLL_ProcName, p%DLL_Trgt, p%DLL_Model, & + m%dll_data(i), p%UseREDWINinterface, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName); if (ErrStat >= AbortErrLev) return + NullDispl = 0.0_R8Ki + NullForce = 0.0_ReKi + call REDWINinterface_GetStiffMatrix( p%DLL_Trgt, p%DLL_Model, NullDispl, NullForce, p%StiffNess(1:6,1:6,i), m%dll_data(i), ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! now initialize the states info from the miscvar + xd%dll_states(i)%Props = m%dll_data(i)%Props + xd%dll_states(i)%StVar = m%dll_data(i)%StVar + enddo + end subroutine SlD_REDWINsetup + + !> Allocate arrays for storing the DLL input file names, and check that they exist. The DLL has no error checking (as of 2020.02.10) + !! and will create empty input files before segfaulting. + subroutine SlD_InitStatesMisc( InputFileData, m, xd, ErrStat, ErrMsg ) + type(SlD_InputFile), intent(in ) :: InputFileData !< Data stored in the module's input file + type(SlD_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(SlD_DiscreteStateType), intent( out) :: xd !< Initial discrete states + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i ! Generic counter + integer(IntKi) :: ErrStat2 !< local error status + character(ErrMsgLen) :: ErrMsg2 !< local error message + + ErrStat = ErrID_None + ErrMsg = '' + + call AllocAry(m%ForceTotal,6,p%NumPoints,'ForceTotal array for output', ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + select case(p%CalcOption) + case (Calc_StiffDamp) + allocate( xd%dll_states(1), STAT=ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Could not allocate xd%dll_states', ErrStat, ErrMsg, RoutineName) + return + endif + + case (Calc_PYcurve) + allocate( xd%dll_states(1), STAT=ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Could not allocate xd%dll_states', ErrStat, ErrMsg, RoutineName) + return + endif + + case (Calc_REDWIN) + !------------------- + ! Set DLL data + allocate( m%dll_data(InputFileData%DLL_NumPoints), STAT=ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Could not allocate m%dll_data', ErrStat, ErrMsg, RoutineName) + return + endif + + allocate( xd%dll_states(InputFileData%DLL_NumPoints), STAT=ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Could not allocate xd%dll_states', ErrStat, ErrMsg, RoutineName) + return + endif + + ! Set the input file names and check they are not too long. Existance checks done in the interface routine. + do i=1,InputFileData%DLL_NumPoints + m%dll_data(i)%PROPSfile = trim(InputFileData%DLL_PropsFile(i)) + if ( len(m%dll_data(i)%PROPSfile) < len_trim(InputFileData%DLL_PropsFile(i)) ) then + call SetErrStat(ErrID_Fatal, 'PropsFile #'//trim(Num2LStr(i))//' name is longer than '//trim(Num2LStr(len(m%dll_data(i)%PROPSfile)))// & + ' characters (DLL limititation)', ErrStat, ErrMsg, '') + endif + m%dll_data(i)%LDISPfile = trim(InputFileData%DLL_LDispFile(i)) + if ( len(m%dll_data(i)%LDISPfile) < len_trim(InputFileData%DLL_LDispFile(i)) ) then + call SetErrStat(ErrID_Fatal, 'LDispFile #'//trim(Num2LStr(i))//' name is longer than '//trim(Num2LStr(len(m%dll_data(i)%LDISPfile)))// & + ' characters (DLL limititation)', ErrStat, ErrMsg, '') + endif + enddo + + end select + if (ErrStat >= AbortErrLev) return + end subroutine SlD_InitStatesMisc + + subroutine SlD_InitMeshes( InputFileData, u, y, p, m, ErrStat, ErrMsg ) + type(SlD_InputFile), intent(in ) :: InputFileData !< Data stored in the module's input file + type(SlD_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(SlD_OutputType), intent(inout) :: y !< Initial system outputs + type(SlD_ParameterType), intent(inout) :: p !< Parameters + type(SlD_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: i ! Generic counter + integer(IntKi) :: ErrStat2 !< local error status + character(ErrMsgLen) :: ErrMsg2 !< local error message + + real(R8Ki) :: DCM(3,3) + real(ReKi), allocatable :: MeshLocations(:,:) + + select case(p%CalcOption) + case (Calc_StiffDamp) + p%NumPoints = 1_IntKi +!FIXME: update to allow more than one set of points +! NumPoints = InputFileData%StiffDamp_NumPoints + p%NumPoints = 1 + call AllocAry(MeshLocations,3,p%NumPoints,'Mesh locations',ErrStat,ErrMsg); + do i=1,size(MeshLocations,2) + MeshLocations(1:3,i) = InputFileData%SD_locations(1:3,i) + enddo + case (Calc_PYcurve) + p%NumPoints = InputFileData%PY_NumPoints + call AllocAry(MeshLocations,3,p%NumPoints,'Mesh locations',ErrStat,ErrMsg); + do i=1,size(MeshLocations,2) + MeshLocations(1:3,i) = InputFileData%PY_locations(1:3,i) + enddo + case (Calc_REDWIN) + p%NumPoints = InputFileData%DLL_NumPoints + call AllocAry(MeshLocations,3,p%NumPoints,'Mesh locations',ErrStat,ErrMsg); + do i=1,size(MeshLocations,2) + MeshLocations(1:3,i) = InputFileData%DLL_locations(1:3,i) + enddo + case default + ErrStat = ErrID_Fatal + ErrMsg = ' Programming error. Unknown calculation type '//trim(Num2LStr(p%CalcOption))//' detected.' + return + end select + + !................................. + ! u%SoilMesh (for coupling with external codes) + !................................. + + CALL MeshCreate( BlankMesh = u%SoilMesh & + , IOS = COMPONENT_INPUT & + , NNodes = p%NumPoints & + , TranslationDisp = .TRUE. & + , TranslationVel = .FALSE. & + , TranslationAcc = .FALSE. & + , Orientation = .TRUE. & + , RotationVel = .FALSE. & + , RotationAcc = .FALSE. & + , ErrStat = ErrStat2 & + , ErrMess = ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat>=AbortErrLev) return + + ! Assuming zero orientation displacement for start + DCM = 0.0_DbKi + DCM(1,1) = 1.0_DbKi + DCM(2,2) = 1.0_DbKi + DCM(3,3) = 1.0_DbKi + + do i=1,p%NumPoints + CALL MeshPositionNode( Mesh = u%SoilMesh & + , INode = i & + , Pos = MeshLocations(1:3,i) & + , ErrStat = ErrStat2 & + , ErrMess = ErrMsg2 & + , Orient = DCM ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MeshConstructElement ( Mesh = u%SoilMesh & + , Xelement = ELEMENT_POINT & + , P1 = i & + , ErrStat = ErrStat2 & + , ErrMess = ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + enddo + + CALL MeshCommit ( Mesh = u%SoilMesh, ErrStat = ErrStat2, ErrMess = ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat>=AbortErrLev) return + + + !................................. + ! y%SoilMesh (for coupling with external codes) + !................................. + + CALL MeshCopy( SrcMesh = u%SoilMesh & + , DestMesh = y%SoilMesh & + , CtrlCode = MESH_SIBLING & + , IOS = COMPONENT_OUTPUT & + , Force = .TRUE. & + , Moment = .TRUE. & + , ErrStat = ErrStat2 & + , ErrMess = ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat>=AbortErrLev) RETURN + + + end subroutine SlD_InitMeshes +end subroutine SlD_Init + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the end of the simulation. +subroutine SlD_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) + + type(SlD_InputType), intent(inout) :: u !< System inputs + type(SlD_ParameterType), intent(inout) :: p !< Parameters + type(SlD_ContinuousStateType), intent(inout) :: x !< Continuous states + type(SlD_DiscreteStateType), intent(inout) :: xd !< Discrete states + type(SlD_ConstraintStateType), intent(inout) :: z !< Constraint states + type(SlD_OtherStateType), intent(inout) :: OtherState !< Other states + type(SlD_OutputType), intent(inout) :: y !< System outputs + type(SlD_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + integer(IntKi) :: ErrStat2 ! local error status + character(ErrMsgLen) :: ErrMsg2 ! local error message + character(*), parameter :: RoutineName = 'SlD_End' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + !! Place any last minute operations or calculations here: + if (p%UseREDWINinterface) then + call REDWINinterface_End( p%DLL_Trgt, ErrStat, ErrMsg ) + endif + + !! Close files here (but because of checkpoint-restart capability, it is not recommended to have files open during the simulation): + + !! Destroy the input data: + call SlD_DestroyInput( u, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + !! Destroy the parameter data: We won't keep warnings from p since it will complain about FreeDynamicLib when not compiled with it + call SlD_DestroyParam( p, ErrStat2,ErrMsg2) !; call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + !! Destroy the state data: + call SlD_DestroyContState( x, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call SlD_DestroyDiscState( xd, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call SlD_DestroyConstrState( z, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call SlD_DestroyOtherState( OtherState, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + !! Destroy the output data: + call SlD_DestroyOutput( y, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + !! Destroy the misc data: + call SlD_DestroyMisc( m, ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + +end subroutine SlD_End + + +!==================================================================================================== +! The following routines were added to satisfy the framework, but do nothing useful. +!==================================================================================================== +!> This is a loose coupling routine for solving constraint states, integrating continuous states, and updating discrete and other +!! states. Continuous, constraint, discrete, and other states are updated to values at t + Interval. +subroutine SlD_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + integer(IntKi), intent(in ) :: n !< Current step of the simulation: t = n*Interval + type(SlD_InputType), intent(inout) :: Inputs(:) !< Inputs at InputTimes (output from this routine only + !! because of record keeping in routines that copy meshes) + real(DbKi), intent(in ) :: InputTimes(:) !< Times in seconds associated with Inputs + type(SlD_ParameterType), intent(in ) :: p !< Parameters + type(SlD_ContinuousStateType), intent(inout) :: x !< Input: Continuous states at t; + !! Output: Continuous states at t + Interval + type(SlD_DiscreteStateType), intent(inout) :: xd !< Input: Discrete states at t; + !! Output: Discrete states at t + Interval + type(SlD_ConstraintStateType), intent(inout) :: z !< Input: Constraint states at t; + !! Output: Constraint states at t + Interval + type(SlD_OtherStateType), intent(inout) :: OtherState !< Other states: Other states at t; + !! Output: Other states at t + Interval + type(SlD_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + integer(IntKi) :: i !< Generic counter + + ! Initialize variables + ErrStat = ErrID_None ! no error has occurred + ErrMsg = "" + + x%DummyContState = 0.0_ReKi + z%DummyConstrState = 0.0_ReKi + + ! The DLL states are copied over from misc var (ideally the DLL would have an update states + ! routine, but it doesn't so we have to work around that to satisfy the framework requirements) + if (p%CalcOption == Calc_REDWIN) then + do i=1,size(xd%dll_states) + xd%dll_states(i)%Props = m%dll_data(i)%Props + xd%dll_states(i)%StVar = m%dll_data(i)%StVar + enddo + else + do i=1,size(xd%dll_states) + xd%dll_states(i)%Props = 0.0_R8Ki + xd%dll_states(i)%StVar = 0.0_R8Ki + enddo + endif + +end subroutine SlD_UpdateStates + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This is a routine for computing outputs, used in both loose and tight coupling. +subroutine SlD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) + + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + type(SlD_InputType), intent(in ) :: u !< Inputs at t + type(SlD_ParameterType), intent(in ) :: p !< Parameters + type(SlD_ContinuousStateType), intent(in ) :: x !< Continuous states at t + type(SlD_DiscreteStateType), intent(in ) :: xd !< Discrete states at t + type(SlD_ConstraintStateType), intent(in ) :: z !< Constraint states at t + type(SlD_OtherStateType), intent(in ) :: OtherState !< Other states at t + type(SlD_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(SlD_OutputType), intent(inout) :: y !< Outputs computed at t (Input only so that mesh con- + !! nectivity information does not have to be recalculated) + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + integer(IntKi) :: ErrStat2 ! local error status + character(ErrMsgLen) :: ErrMsg2 ! local error message + character(*), parameter :: RoutineName = 'SlD_CalcOutput' + + real(ReKi) :: AllOuts(0:MaxOutPts) + real(R8Ki) :: Displacement(6) + real(R8Ki) :: ForceLinear(6) + integer(IntKi) :: i !< generic counter + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + select case(p%CalcOption) + case (Calc_StiffDamp) + +!TODO: add ability to do more than one point + do i=1,1 + ! Copy displacement from point mesh (angles in radians -- REDWIN dll also uses rad) + Displacement(1:3) = u%SoilMesh%TranslationDisp(1:3,i) ! Translations -- This is R8Ki in the mesh + Displacement(4:6) = GetSmllRotAngs(u%SoilMesh%Orientation(1:3,1:3,i), ErrStat2, ErrMsg2); if (Failed()) return; + + ! Calculate reaction with F = k*dX + m%ForceTotal(1:6,i) = matmul(p%Stiffness(1:6,1:6,i), Displacement) + if (p%SlDNonLinearForcePortionOnly) then + ForceLinear = matmul(p%Stiffness(1:6,1:6,i), Displacement) + endif + + ! TODO: add damping term effects here + + ! Return reaction force onto the resulting point mesh + y%SoilMesh%Force (1:3,i) = -real(m%ForceTotal(1:3,i),ReKi) + y%SoilMesh%Moment(1:3,i) = -real(m%ForceTotal(4:6,i),ReKi) + + ! Subrtract out the linear piece here + if (p%SlDNonLinearForcePortionOnly) then + y%SoilMesh%Force (1:3,i) = y%SoilMesh%Force (1:3,i) + real(ForceLinear(1:3),ReKi) + y%SoilMesh%Moment(1:3,i) = y%SoilMesh%Moment(1:3,i) + real(ForceLinear(4:6),ReKi) + endif + enddo + + case (Calc_PYcurve) + call SetErrStat(ErrID_Fatal,' SoilDyn does not support P-Y curve calculations yet.',ErrStat,ErrMsg,RoutineName) + + case (Calc_REDWIN) + ! call the dll + do i=1,size(m%dll_data) + + ! copy the state info over to miscvar for passing to dll (we are separating states out to better match the framework) + m%dll_data(i)%Props = xd%dll_states(i)%Props + m%dll_data(i)%StVar = xd%dll_states(i)%StVar + + ! Copy displacement from point mesh (angles in radians -- REDWIN dll also uses rad) + Displacement(1:3) = u%SoilMesh%TranslationDisp(1:3,i) ! Translations -- This is R8Ki in the mesh + Displacement(4:6) = GetSmllRotAngs(u%SoilMesh%Orientation(1:3,1:3,i), ErrStat2, ErrMsg2); if (Failed()) return; ! Small angle assumption should be valid here -- Note we are assuming reforientation is identity + + ! Linear portion of the stiffness reaction (NOTE: the DLL stiffness info is stored in parameters + if (p%SlDNonLinearForcePortionOnly) then + ForceLinear = matmul(p%Stiffness(1:6,1:6,i), Displacement) + endif + + call REDWINinterface_CalcOutput( p%DLL_Trgt, p%DLL_Model, Displacement, m%ForceTotal(1:6,i), m%dll_data(i), ErrStat2, ErrMsg2 ); if (Failed()) return; + + ! Return reaction force onto the resulting point mesh + y%SoilMesh%Force (1:3,i) = -real(m%ForceTotal(1:3,i),ReKi) + y%SoilMesh%Moment(1:3,i) = -real(m%ForceTotal(4:6,i),ReKi) + + ! Subrtract out the linear piece here + if (p%SlDNonLinearForcePortionOnly) then + y%SoilMesh%Force (1:3,i) = y%SoilMesh%Force (1:3,i) + real(ForceLinear(1:3),ReKi) + y%SoilMesh%Moment(1:3,i) = y%SoilMesh%Moment(1:3,i) + real(ForceLinear(4:6),ReKi) + endif + enddo + end select + + ! Outputs + call SlD_WriteOutput( p, AllOuts, u, y, m, ErrStat2, ErrMsg2 ); if (Failed()) return; + + do i=1,p%NumOuts + y%WriteOutput(i) = p%OutParam(i)%SignM * Allouts( p%OutParam(i)%Indx ) + enddo + + return + +contains + logical function Failed() + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine SlD_CalcOutput + + +END MODULE SoilDyn + +!********************************************************************************************************************************** +!NOTE: the following have been omitted. When we add the other methods for calculating (6x6 Stiffness/Damping) and the P-Y curve, then +! some of these will need to be added. Leaving this as a placeholder for the moment. +!SUBROUTINE SlD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) +!SUBROUTINE SlD_UpdateDiscState( t, n, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) +!SUBROUTINE SlD_CalcConstrStateResidual( t, u, p, x, xd, z, OtherState, m, Z_residual, ErrStat, ErrMsg ) +!SUBROUTINE SlD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +!SUBROUTINE SlD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) +!SUBROUTINE SlD_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) +!SUBROUTINE SlD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) +!SUBROUTINE SlD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) diff --git a/modules/soildyn/src/SoilDyn_IO.f90 b/modules/soildyn/src/SoilDyn_IO.f90 new file mode 100644 index 0000000000..4dcf966ce4 --- /dev/null +++ b/modules/soildyn/src/SoilDyn_IO.f90 @@ -0,0 +1,857 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2020 National Renewable Energy Laboratory +! +! This file is part of SoilDyn. +! +! 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 SoilDyn_IO + + USE SoilDyn_Types + USE NWTC_Library + + IMPLICIT NONE + + + +! =================================================================================================== +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +! =================================================================================================== +! This code was generated by Write_ChckOutLst.m at 12-Mar-2020 13:30:14. + + + ! Parameters related to output length (number of characters allowed in the output data headers): + + INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 + + + ! Indices for computing output channels: + ! NOTES: + ! (1) These parameters are in the order stored in "OutListParameters.xlsx" + ! (2) Array AllOuts() must be dimensioned to the value of the largest output parameter + + ! Time: + + INTEGER(IntKi), PARAMETER :: Time = 0 + + + ! Forces: + + INTEGER(IntKi), PARAMETER :: Sld1Fxg = 1 + INTEGER(IntKi), PARAMETER :: Sld1Fyg = 2 + INTEGER(IntKi), PARAMETER :: Sld1Fzg = 3 + INTEGER(IntKi), PARAMETER :: Sld1Mxg = 4 + INTEGER(IntKi), PARAMETER :: Sld1Myg = 5 + INTEGER(IntKi), PARAMETER :: Sld1Mzg = 6 + INTEGER(IntKi), PARAMETER :: Sld2Fxg = 7 + INTEGER(IntKi), PARAMETER :: Sld2Fyg = 8 + INTEGER(IntKi), PARAMETER :: Sld2Fzg = 9 + INTEGER(IntKi), PARAMETER :: Sld2Mxg = 10 + INTEGER(IntKi), PARAMETER :: Sld2Myg = 11 + INTEGER(IntKi), PARAMETER :: Sld2Mzg = 12 + INTEGER(IntKi), PARAMETER :: Sld3Fxg = 13 + INTEGER(IntKi), PARAMETER :: Sld3Fyg = 14 + INTEGER(IntKi), PARAMETER :: Sld3Fzg = 15 + INTEGER(IntKi), PARAMETER :: Sld3Mxg = 16 + INTEGER(IntKi), PARAMETER :: Sld3Myg = 17 + INTEGER(IntKi), PARAMETER :: Sld3Mzg = 18 + INTEGER(IntKi), PARAMETER :: Sld4Fxg = 19 + INTEGER(IntKi), PARAMETER :: Sld4Fyg = 20 + INTEGER(IntKi), PARAMETER :: Sld4Fzg = 21 + INTEGER(IntKi), PARAMETER :: Sld4Mxg = 22 + INTEGER(IntKi), PARAMETER :: Sld4Myg = 23 + INTEGER(IntKi), PARAMETER :: Sld4Mzg = 24 + INTEGER(IntKi), PARAMETER :: Sld5Fxg = 25 + INTEGER(IntKi), PARAMETER :: Sld5Fyg = 26 + INTEGER(IntKi), PARAMETER :: Sld5Fzg = 27 + INTEGER(IntKi), PARAMETER :: Sld5Mxg = 28 + INTEGER(IntKi), PARAMETER :: Sld5Myg = 29 + INTEGER(IntKi), PARAMETER :: Sld5Mzg = 30 + INTEGER(IntKi), PARAMETER :: Sld6Fxg = 31 + INTEGER(IntKi), PARAMETER :: Sld6Fyg = 32 + INTEGER(IntKi), PARAMETER :: Sld6Fzg = 33 + INTEGER(IntKi), PARAMETER :: Sld6Mxg = 34 + INTEGER(IntKi), PARAMETER :: Sld6Myg = 35 + INTEGER(IntKi), PARAMETER :: Sld6Mzg = 36 + INTEGER(IntKi), PARAMETER :: Sld7Fxg = 37 + INTEGER(IntKi), PARAMETER :: Sld7Fyg = 38 + INTEGER(IntKi), PARAMETER :: Sld7Fzg = 39 + INTEGER(IntKi), PARAMETER :: Sld7Mxg = 40 + INTEGER(IntKi), PARAMETER :: Sld7Myg = 41 + INTEGER(IntKi), PARAMETER :: Sld7Mzg = 42 + INTEGER(IntKi), PARAMETER :: Sld8Fxg = 43 + INTEGER(IntKi), PARAMETER :: Sld8Fyg = 44 + INTEGER(IntKi), PARAMETER :: Sld8Fzg = 45 + INTEGER(IntKi), PARAMETER :: Sld8Mxg = 46 + INTEGER(IntKi), PARAMETER :: Sld8Myg = 47 + INTEGER(IntKi), PARAMETER :: Sld8Mzg = 48 + INTEGER(IntKi), PARAMETER :: Sld9Fxg = 49 + INTEGER(IntKi), PARAMETER :: Sld9Fyg = 50 + INTEGER(IntKi), PARAMETER :: Sld9Fzg = 51 + INTEGER(IntKi), PARAMETER :: Sld9Mxg = 52 + INTEGER(IntKi), PARAMETER :: Sld9Myg = 53 + INTEGER(IntKi), PARAMETER :: Sld9Mzg = 54 + + + ! Displacements: + + INTEGER(IntKi), PARAMETER :: Sld1TDxg = 55 + INTEGER(IntKi), PARAMETER :: Sld1TDyg = 56 + INTEGER(IntKi), PARAMETER :: Sld1TDzg = 57 + INTEGER(IntKi), PARAMETER :: Sld1RDxg = 58 + INTEGER(IntKi), PARAMETER :: Sld1RDyg = 59 + INTEGER(IntKi), PARAMETER :: Sld1RDzg = 60 + INTEGER(IntKi), PARAMETER :: Sld2TDxg = 61 + INTEGER(IntKi), PARAMETER :: Sld2TDyg = 62 + INTEGER(IntKi), PARAMETER :: Sld2TDzg = 63 + INTEGER(IntKi), PARAMETER :: Sld2RDxg = 64 + INTEGER(IntKi), PARAMETER :: Sld2RDyg = 65 + INTEGER(IntKi), PARAMETER :: Sld2RDzg = 66 + INTEGER(IntKi), PARAMETER :: Sld3TDxg = 67 + INTEGER(IntKi), PARAMETER :: Sld3TDyg = 68 + INTEGER(IntKi), PARAMETER :: Sld3TDzg = 69 + INTEGER(IntKi), PARAMETER :: Sld3RDxg = 70 + INTEGER(IntKi), PARAMETER :: Sld3RDyg = 71 + INTEGER(IntKi), PARAMETER :: Sld3RDzg = 72 + INTEGER(IntKi), PARAMETER :: Sld4TDxg = 73 + INTEGER(IntKi), PARAMETER :: Sld4TDyg = 74 + INTEGER(IntKi), PARAMETER :: Sld4TDzg = 75 + INTEGER(IntKi), PARAMETER :: Sld4RDxg = 76 + INTEGER(IntKi), PARAMETER :: Sld4RDyg = 77 + INTEGER(IntKi), PARAMETER :: Sld4RDzg = 78 + INTEGER(IntKi), PARAMETER :: Sld5TDxg = 79 + INTEGER(IntKi), PARAMETER :: Sld5TDyg = 80 + INTEGER(IntKi), PARAMETER :: Sld5TDzg = 81 + INTEGER(IntKi), PARAMETER :: Sld5RDxg = 82 + INTEGER(IntKi), PARAMETER :: Sld5RDyg = 83 + INTEGER(IntKi), PARAMETER :: Sld5RDzg = 84 + INTEGER(IntKi), PARAMETER :: Sld6TDxg = 85 + INTEGER(IntKi), PARAMETER :: Sld6TDyg = 86 + INTEGER(IntKi), PARAMETER :: Sld6TDzg = 87 + INTEGER(IntKi), PARAMETER :: Sld6RDxg = 88 + INTEGER(IntKi), PARAMETER :: Sld6RDyg = 89 + INTEGER(IntKi), PARAMETER :: Sld6RDzg = 90 + INTEGER(IntKi), PARAMETER :: Sld7TDxg = 91 + INTEGER(IntKi), PARAMETER :: Sld7TDyg = 92 + INTEGER(IntKi), PARAMETER :: Sld7TDzg = 93 + INTEGER(IntKi), PARAMETER :: Sld7RDxg = 94 + INTEGER(IntKi), PARAMETER :: Sld7RDyg = 95 + INTEGER(IntKi), PARAMETER :: Sld7RDzg = 96 + INTEGER(IntKi), PARAMETER :: Sld8TDxg = 97 + INTEGER(IntKi), PARAMETER :: Sld8TDyg = 98 + INTEGER(IntKi), PARAMETER :: Sld8TDzg = 99 + INTEGER(IntKi), PARAMETER :: Sld8RDxg = 100 + INTEGER(IntKi), PARAMETER :: Sld8RDyg = 101 + INTEGER(IntKi), PARAMETER :: Sld8RDzg = 102 + INTEGER(IntKi), PARAMETER :: Sld9TDxg = 103 + INTEGER(IntKi), PARAMETER :: Sld9TDyg = 104 + INTEGER(IntKi), PARAMETER :: Sld9TDzg = 105 + INTEGER(IntKi), PARAMETER :: Sld9RDxg = 106 + INTEGER(IntKi), PARAMETER :: Sld9RDyg = 107 + INTEGER(IntKi), PARAMETER :: Sld9RDzg = 108 + + + ! The maximum number of output channels which can be output by the code. + INTEGER(IntKi), PARAMETER :: MaxOutPts = 108 + +!End of code generated by Matlab script +! =================================================================================================== + ! The following simplify my output assigning later in the WriteOutput routine + integer(IntKi), parameter :: MaxNumberOfOutputLocations = 9 ! This is based on our coding of 1 digit on output point number + integer(IntKi), parameter :: SoilPtF(6,MaxNumberOfOutputLocations) = reshape( (/ & ! Forces and moments indices + SlD1Fxg, SlD1Fyg, SlD1Fzg, SlD1Mxg, SlD1Myg, SlD1Mzg, & ! SoilPt 1 + SlD2Fxg, SlD2Fyg, SlD2Fzg, SlD2Mxg, SlD2Myg, SlD2Mzg, & ! SoilPt 2 + SlD3Fxg, SlD3Fyg, SlD3Fzg, SlD3Mxg, SlD3Myg, SlD3Mzg, & ! SoilPt 3 + SlD4Fxg, SlD4Fyg, SlD4Fzg, SlD4Mxg, SlD4Myg, SlD4Mzg, & ! SoilPt 4 + SlD5Fxg, SlD5Fyg, SlD5Fzg, SlD5Mxg, SlD5Myg, SlD5Mzg, & ! SoilPt 5 + SlD6Fxg, SlD6Fyg, SlD6Fzg, SlD6Mxg, SlD6Myg, SlD6Mzg, & ! SoilPt 6 + SlD7Fxg, SlD7Fyg, SlD7Fzg, SlD7Mxg, SlD7Myg, SlD7Mzg, & ! SoilPt 7 + SlD8Fxg, SlD8Fyg, SlD8Fzg, SlD8Mxg, SlD8Myg, SlD8Mzg, & ! SoilPt 8 + SlD9Fxg, SlD9Fyg, SlD9Fzg, SlD9Mxg, SlD9Myg, SlD9Mzg & ! SoilPt 9 + /), (/6,MaxNumberOfOutputLocations/) ) + integer(IntKi), parameter :: SoilPtD(6,MaxNumberOfOutputLocations) = reshape( (/ & ! Soil point displacements indices + SlD1TDxg,SlD1TDyg,SlD1TDzg,SlD1RDxg,SlD1RDyg,SlD1RDzg, & ! SoilPt 1 + SlD2TDxg,SlD2TDyg,SlD2TDzg,SlD2RDxg,SlD2RDyg,SlD2RDzg, & ! SoilPt 2 + SlD3TDxg,SlD3TDyg,SlD3TDzg,SlD3RDxg,SlD3RDyg,SlD3RDzg, & ! SoilPt 3 + SlD4TDxg,SlD4TDyg,SlD4TDzg,SlD4RDxg,SlD4RDyg,SlD4RDzg, & ! SoilPt 4 + SlD5TDxg,SlD5TDyg,SlD5TDzg,SlD5RDxg,SlD5RDyg,SlD5RDzg, & ! SoilPt 5 + SlD6TDxg,SlD6TDyg,SlD6TDzg,SlD6RDxg,SlD6RDyg,SlD6RDzg, & ! SoilPt 6 + SlD7TDxg,SlD7TDyg,SlD7TDzg,SlD7RDxg,SlD7RDyg,SlD7RDzg, & ! SoilPt 7 + SlD8TDxg,SlD8TDyg,SlD8TDzg,SlD8RDxg,SlD8RDyg,SlD8RDzg, & ! SoilPt 8 + SlD9TDxg,SlD9TDyg,SlD9TDzg,SlD9RDxg,SlD9RDyg,SlD9RDzg & ! SoilPt 9 + /), (/6,MaxNumberOfOutputLocations/) ) +! =================================================================================================== + +CONTAINS + + +!==================================================================================================== +!> This public subroutine reads the input required for SoilDyn from the file whose name is an +!! input parameter. +subroutine SlD_ReadInput( InputFileName, EchoFileName, InputFileData, ErrStat, ErrMsg ) + + character(*), intent(in ) :: InputFileName !< name of the input file + character(*), intent(in ) :: EchoFileName !< name of the echo file + type(SlD_InputFile), intent(inout) :: InputFileData !< The data for initialization + integer(IntKi), intent( out) :: ErrStat !< Returned error status from this subroutine + character(*), intent( out) :: ErrMsg !< Returned error message from this subroutine + + integer(IntKi) :: UnitInput !< Unit number for the input file + integer(IntKi) :: UnitEcho !< The local unit number for this module's echo file + character(35) :: Frmt !< Output format for logical parameters. (matches NWTC Subroutine Library format) + character(200) :: Line !< Temporary storage of a line from the input file (to compare with "default") + integer(IntKi) :: LineLen !< Length of the line read + integer(IntKi) :: i !< Generic counter + + integer(IntKi) :: TmpErrStat !< Temporary error status + integer(IntKi) :: IOS !< Temporary error status + character(ErrMsgLen) :: TmpErrMsg !< Temporary error message + character(1024) :: PriPath !< Path name of the primary file + character(*), PARAMETER :: RoutineName="SlD_ReadInput" + + + ! Initialize local data + + UnitEcho = -1 + Frmt = "( 2X, L11, 2X, A, T30, ' - ', A )" + ErrStat = ErrID_None + ErrMsg = "" + InputFileData%EchoFlag = .FALSE. ! initialize for error handling (cleanup() routine) + CALL GetPath( InputFileName, PriPath ) ! Input files will be relative to the path where the primary input file is located. + + + ! allocate the array for the OutList + CALL AllocAry( InputFileData%OutList, MaxOutPts, "SoilDyn Input File's OutList", TmpErrStat, TmpErrMsg ); if (Failed()) return; + + !------------------------------------------------------------------------------------------------- + ! Open the file + !------------------------------------------------------------------------------------------------- + + CALL GetNewUnit( UnitInput, TmpErrStat, TmpErrMsg ); if (Failed()) return; + CALL OpenFInpFile( UnitInput, TRIM(InputFileName), TmpErrStat, TmpErrMsg ); if (Failed()) return; + + + !------------------------------------------------------------------------------------------------- + ! File header + !------------------------------------------------------------------------------------------------- + + call ReadCom( UnitInput, InputFileName, 'SoilDyn input file header line 1', TmpErrStat, TmpErrMsg ); if (Failed()) return; + call ReadCom( UnitInput, InputFileName, 'SoilDyn input file header line 2', TmpErrStat, TmpErrMsg ); if (Failed()) return; + call ReadCom( UnitInput, InputFileName, 'SoilDyn input file separator line', TmpErrStat, TmpErrMsg ); if (Failed()) return; + + ! Echo Input Files. + call ReadVar ( UnitInput, InputFileName, InputFileData%EchoFlag, 'Echo', 'Echo Input', TmpErrStat, TmpErrMsg ); if (Failed()) return; + + ! If we are Echoing the input then we should re-read the first three lines so that we can echo them + ! using the NWTC_Library routines. The echoing is done inside those routines via a global variable + ! which we must store, set, and then replace on error or completion. + IF ( InputFileData%EchoFlag ) THEN + call OpenEcho ( UnitEcho, TRIM(EchoFileName), TmpErrStat, TmpErrMsg ); if (Failed()) return; + rewind(UnitInput) + + call ReadCom( UnitInput, InputFileName, 'SoilDyn input file header line 1', TmpErrStat, TmpErrMsg, UnitEcho ); if (Failed()) return; + call ReadCom( UnitInput, InputFileName, 'SoilDyn input file header line 2', TmpErrStat, TmpErrMsg, UnitEcho ); if (Failed()) return; + call ReadCom( UnitInput, InputFileName, 'SoilDyn input file separator line', TmpErrStat, TmpErrMsg, UnitEcho ); if (Failed()) return; + + ! Echo Input Files. + call ReadVar ( UnitInput, InputFileName, InputFileData%EchoFlag, 'Echo', 'Echo the input file data', TmpErrStat, TmpErrMsg, UnitEcho ); if (Failed()) return; + end if + + ! DT - Time interval for SoilDyn calculations {or default} (s): + CALL ReadVar( UnitInput, InputFileName, Line, "DT", "Time interval for soil calculations {or default} (s)", TmpErrStat, TmpErrMsg, UnitEcho); if (Failed()) return; + CALL Conv2UC( Line ) + IF ( INDEX(Line, "DEFAULT" ) /= 1 ) THEN ! If it's not "default", read this variable; otherwise use the value already stored in InputFileData%DTAero + READ( Line, *, IOSTAT=IOS) InputFileData%DT + CALL CheckIOS ( IOS, InputFileName, 'DT', NumType, TmpErrStat, TmpErrMsg ); if (Failed()) return; + END IF + + ! CalcOption -- option on which calculation methodology to use {1: Stiffness / Damping matrices, 2: P-Y curves [unavailable], 3: coupled REDWIN DLL} + call ReadVar( UnitInput, InputFileName, InputFileData%CalcOption, "CalcOption", "Calculation methodology to use", TmpErrStat, TmpErrMsg, UnitEcho); if (Failed()) return; + + + !------------------------------------------------------------------------------------------------- + !> Read Stiffness / Damping section [ CalcOption == 1 only ] Calc_StiffDamp + !------------------------------------------------------------------------------------------------- + + call ReadCom( UnitInput, InputFileName, 'SoilDyn input file separator line', TmpErrStat, TmpErrMsg, UnitEcho ); if (Failed()) return; + + ! In general, the stiffness and damping matrices will have the following symetries: + ! K11 = K22 + ! K15 = -K24 + ! K51 = -K42 + ! K55 = K44 + + ! Location + !NOTE: only 1 SD_location allowed at present. TODO allow multiple SD_locations + allocate( InputFileData%SD_locations(3,1), STAT=TmpErrStat ) ! InputFileData%SD_NumPoints + if (TmpErrStat /= 0) call SetErrStat(ErrID_Fatal, 'Could not allocate SD_locations', ErrStat, ErrMsg, RoutineName) + call ReadAry( UnitInput, InputFileName, InputFileData%SD_locations(1:3,1), 3, 'SD_locations', 'Stiffness Damping location', TmpErrStat, TmpErrMsg, UnitEcho); if (Failed()) return; + + ! Stiffness + call ReadCom( UnitInput, InputFileName, 'SoilDyn input file separator line', TmpErrStat, TmpErrMsg, UnitEcho ); if (Failed()) return; + call AllocAry( InputFileData%Stiffness, 6, 6, 1, 'Stiffness matrices', TmpErrStat, TmpErrMsg ); if (Failed()) return; + do i=1,6 + call ReadAry( UnitInput, InputFileName, InputFileData%Stiffness(i,:,1), 6, 'Stiffness', 'Elastic stiffness matrix', TmpErrStat, TmpErrMsg, UnitEcho); if (Failed()) return; + enddo + + ! Damping + call ReadCom( UnitInput, InputFileName, 'SoilDyn input file separator line', TmpErrStat, TmpErrMsg, UnitEcho ); if (Failed()) return; + call AllocAry( InputFileData%Damping, 6, 6, 1, 'Damping matrices', TmpErrStat, TmpErrMsg ); if (Failed()) return; + do i=1,6 + call ReadAry( UnitInput, InputFileName, InputFileData%Damping(i,:,1), 6, 'Damping', 'Elastic damping ratio (-)', TmpErrStat, TmpErrMsg, UnitEcho); if (Failed()) return; + enddo + + !------------------------------------------------------------------------------------------------- + !> Read P-Y curve section [ CalcOption == 2 only ] Calc_PYcurve + !------------------------------------------------------------------------------------------------- + + call ReadCom( UnitInput, InputFileName, 'SoilDyn input file separator line', TmpErrStat, TmpErrMsg, UnitEcho ); if (Failed()) return; + call ReadVar( UnitInput, InputFileName, InputFileData%PY_NumPoints, "PY_NumPoints", "Number of PY curve points", TmpErrStat, TmpErrMsg, UnitEcho ); if (Failed()) return; + + ! Allocate arrays to hold the information that will be read in next + allocate( InputFileData%PY_locations(3,InputFileData%PY_NumPoints), STAT=TmpErrStat ) + if (TmpErrStat /= 0) call SetErrStat(ErrID_Fatal, 'Could not allocate PY_locations', ErrStat, ErrMsg, RoutineName) + allocate( InputFileData%PY_inputFile(InputFileData%PY_NumPoints), STAT=TmpErrStat ) + if (TmpErrStat /= 0) call SetErrStat(ErrID_Fatal, 'Could not allocate PY_inputFile', ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) then + call CleanUp() + return + endif + + ! Now read in the set of PY curves + call ReadCom( UnitInput, InputFileName, 'SoilDyn input file separator line in PY curve data', TmpErrStat, TmpErrMsg, UnitEcho ); if (Failed()) return; + + ! Read in each line of location and input file ( ---- Location (x,y,z) ------- Point InputFile ------------- ) + do i=1,InputFileData%PY_NumPoints + call ReadLine( UnitInput, '', Line, LineLen, TmpErrStat ) + if (TmpErrStat /= 0) then + call SetErrStat( ErrID_Fatal, 'Error reading PY_curve line '//trim(Num2LStr(i))//' from '//InputFileName//'.', ErrStat, ErrMsg, RoutineName) + return + endif + READ( Line, *, IOSTAT=IOS) InputFileData%PY_locations(1:3,i), InputFileData%PY_inputFile(i) + CALL CheckIOS ( IOS, InputFileName, 'DT', NumType, TmpErrStat, TmpErrMsg ); if (Failed()) return; ! NOTE: unclear if the message returned will match what was misread. + + ! Check for relative paths in the file names + if ( PathIsRelative( InputFileData%PY_inputFile(i) ) ) InputFileData%PY_inputFile(i) = TRIM(PriPath)//TRIM(InputFileData%PY_inputFile(i)) + + ! Add stuff to echo file if it is used + if ( InputFileData%EchoFlag ) then + write(UnitEcho,*) ' Location ('//trim(Num2LStr(i))//')' + write(UnitEcho,*) InputFileData%PY_locations(1:3,i), trim(InputFileData%PY_inputFile(i)) + endif + enddo + + + !------------------------------------------------------------------------------------------------- + !> Read REDWIN interface for DLL section [ CalcOption == 3 only ] Calc_REDWIN + !------------------------------------------------------------------------------------------------- + + + call ReadCom( UnitInput, InputFileName, 'SoilDyn input file separator line', TmpErrStat, TmpErrMsg, UnitEcho ); if (Failed()) return; + +!FIXME: parse out the 's' option. + ! DLL model, and optionally only use stiffness matrix in response calcs + call ReadVar( UnitInput, InputFileName, InputFileData%DLL_modelChr, "DLL_Model", "REDWIN DLL model to use", TmpErrStat, TmpErrMsg, UnitEcho ); if (Failed()) return; + call Conv2UC( InputFileData%DLL_modelChr ) ! Convert Line to upper case. + + call ReadVar( UnitInput, InputFileName, InputFileData%DLL_FileName, "DLL_FileName", "REDWIN DLL model used", TmpErrStat, TmpErrMsg, UnitEcho ); if (Failed()) return; + call ReadVar( UnitInput, InputFileName, InputFileData%DLL_NumPoints, "DLL_NumPoints", "Number of DLL interfaces", TmpErrStat, TmpErrMsg, UnitEcho ); if (Failed()) return; + + ! Allocate arrays to hold the information that will be read in next + allocate( InputFileData%DLL_locations(3,InputFileData%DLL_NumPoints), STAT=TmpErrStat ) + if (TmpErrStat /= 0) call SetErrStat(ErrID_Fatal, 'Could not allocate DLL_locations', ErrStat, ErrMsg, RoutineName) + allocate( InputFileData%DLL_PropsFile(InputFileData%DLL_NumPoints), STAT=TmpErrStat ) + if (TmpErrStat /= 0) call SetErrStat(ErrID_Fatal, 'Could not allocate DLL_PropsFile', ErrStat, ErrMsg, RoutineName) + allocate( InputFileData%DLL_LDispFile(InputFileData%DLL_NumPoints), STAT=TmpErrStat ) + if (TmpErrStat /= 0) call SetErrStat(ErrID_Fatal, 'Could not allocate DLL_LDispFile', ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) then + call CleanUp() + return + endif + + ! Now read in the set of DLL connections + call ReadCom( UnitInput, InputFileName, 'SoilDyn input file separator line in DLL data', TmpErrStat, TmpErrMsg, UnitEcho ); if (Failed()) return; + + ! Read in each line of location and input file ( ---- Location (x,y,z) ------- Point InputFile ------------- ) + do i=1,InputFileData%DLL_NumPoints + call ReadLine( UnitInput, '', Line, LineLen, TmpErrStat ) + if (TmpErrStat /= 0) then + call SetErrStat( ErrID_Fatal, 'Error reading DLL_curve line '//trim(Num2LStr(i))//' from '//InputFileName//'.', ErrStat, ErrMsg, RoutineName) + return + endif + READ( Line, *, IOSTAT=IOS) InputFileData%DLL_locations(1:3,i), InputFileData%DLL_PropsFile(i), InputFileData%DLL_LDispFile(i) + CALL CheckIOS ( IOS, InputFileName, 'DLL info', NumType, TmpErrStat, TmpErrMsg ); if (Failed()) return; ! NOTE: unclear if the message returned will match what was misread. + + ! Check for relative paths in the file names + if ( PathIsRelative( InputFileData%DLL_PropsFile(i) ) ) InputFileData%DLL_PropsFile(i) = TRIM(PriPath)//TRIM(InputFileData%DLL_PropsFile(i)) + if ( PathIsRelative( InputFileData%DLL_LDispFile(i) ) ) InputFileData%DLL_LDispFile(i) = TRIM(PriPath)//TRIM(InputFileData%DLL_LDispFile(i)) + + ! Add stuff to echo file if it is used + if ( InputFileData%EchoFlag ) then + write(UnitEcho,*) ' Location ('//trim(Num2LStr(i))//')' + write(UnitEcho,*) InputFileData%DLL_locations(1:3,i), trim(InputFileData%DLL_PropsFile(i)), ' ',trim(InputFileData%DLL_LDispFile(i)), ' ',trim(InputFileData%DLL_FileName) + endif + enddo + + InputFileData%DLL_ProcName = 'INTERFACEFOUNDATION' ! This is hard coded for now + + !---------------------- OUTPUT -------------------------------------------------- + CALL ReadCom( UnitInput, InputFileName, 'Section Header: Output', TmpErrStat, TmpErrMsg, UnitEcho ); if (Failed()) return; + CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) + + ! SumPrint - Print summary data to .IfW.sum (flag): + CALL ReadVar( UnitInput, InputFileName, InputFileData%SumPrint, "SumPrint", "Print summary data to .SlD.sum (flag)", TmpErrStat, TmpErrMsg, UnitEcho ); if (Failed()) return; + CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) + + + !---------------------- OUTLIST -------------------------------------------- + CALL ReadCom( UnitInput, InputFileName, 'Section Header: OutList', TmpErrStat, TmpErrMsg, UnitEcho ); if (Failed()) return; + CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) + + ! OutList - List of user-requested output channels (-): -- uses routine from the NWTC_Library + CALL ReadOutputList ( UnitInput, InputFileName, InputFileData%OutList, InputFileData%NumOuts, 'OutList', & + "List of user-requested output channels", TmpErrStat, TmpErrMsg, UnitEcho ); if (Failed()) return; + + + + !------------------------------------------------------------------------------------------------- + ! This is the end of the input file + !------------------------------------------------------------------------------------------------- + + call Cleanup() + return + + CONTAINS + logical function Failed() + call SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (ErrStat >= AbortErrLev) call CleanUp() + end function Failed + subroutine Cleanup() + ! Close input file + close ( UnitInput ) + ! Cleanup the Echo file and global variables + if ( InputFileData%EchoFlag ) then + close(UnitEcho) + end if + end subroutine Cleanup + +END SUBROUTINE SlD_ReadInput + + +!==================================================================================================== +!> This private subroutine verifies the input required for SoilDyn is correctly specified. This +!! routine checkes all the parameters that are common with all the wind types, then calls subroutines +!! that check the parameters specific to each wind type. Only the parameters corresponding to the +!! desired wind type are evaluated; the rest are ignored. Additional checks will be performed after +!! the respective wind file has been read in, but these checks will be performed within the respective +!! wind module. +! +! The reason for structuring it this way is to allow for relocating the validation routines for the +! wind type into their respective modules. It might also prove useful later if we change languages +! but retain the fortran wind modules. +SUBROUTINE SlD_ValidateInput( InitInp, InputFileData, ErrStat, ErrMsg ) + TYPE(SlD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization + TYPE(SlD_InputFile), INTENT(INOUT) :: InputFileData !< The data for initialization + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status from this subroutine + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message from this subroutine + INTEGER(IntKi) :: ErrStat2 !< Temporary error status for subroutine and function calls + CHARACTER(ErrMsgLen) :: ErrMsg2 !< Temporary error message for subroutine and function calls + INTEGER(IntKi) :: I !< Generic counter + CHARACTER(*), PARAMETER :: RoutineName="SlD_ValidateInput" + integer(IntKi) :: IOS !< Temporary error status + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + select case(InputFileData%CalcOption) + case (Calc_StiffDamp) + call ValidateStiffnessMatrix() + case (Calc_PYcurve) + call ValidatePYcurves() + case (Calc_REDWIN) + call ValidateDLL() + end select + + +CONTAINS + subroutine ValidateStiffnessMatrix() + call CheckWtrDepth( InputFileData%SD_locations, 'SD locations', ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ! Notify user that damping does not yet work + if (maxval(abs(InputFileData%Damping)) > epsilon(1.0_ReKi)) then + call SetErrStat( ErrID_Severe, 'Damping matrix not supported yet with CalcOption==1 in SoilDyn. Ignoring values entered.', ErrStat, ErrMsg, RoutineName) + endif + end subroutine ValidateStiffnessMatrix + + subroutine ValidatePYcurves() + call CheckWtrDepth( InputFileData%PY_locations, 'PY locations', ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ! Placeholder + end subroutine ValidatePYcurves + + subroutine ValidateDLL() + call CheckWtrDepth( InputFileData%DLL_locations, 'DLL locations', ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + + ! Check the model + read( InputFileData%DLL_modelChr(1:1), *, IOSTAT=IOS ) InputFileData%DLL_model + call CheckIOS ( IOS, "", 'DLL_model', NumType, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + if ( ErrStat >= AbortErrLev ) return + if ( InputFileData%DLL_model > 3_IntKi .or. InputFileData%DLL_model < 1_IntKi ) then + call SetErrStat( ErrID_Fatal,' DLL_Model must be 1, 2, or 3', ErrStat,ErrMsg,RoutineName) + endif + ! Disable option 1 and 3 + if ( InputFileData%DLL_model /= 2_IntKi ) then + call SetErrStat( ErrID_Fatal,' Only DLL_Model 2 is currently supported and validated.', ErrStat,ErrMsg,RoutineName) + return + endif + InputFileData%DLL_OnlyStiff = .false. + if (LEN_TRIM(InputFileData%DLL_modelChr) > 1_IntKi ) then + if ( InputFileData%DLL_modelChr(2:2) == 'S' ) then + InputFileData%DLL_OnlyStiff = .true. + call SetErrStat( ErrID_Info, ' Using only the stiffness matrices from the REDWIN DLL', ErrStat,ErrMsg,RoutineName ) + else + call SetErrStat( ErrID_Fatal, ' Unknown option '''//InputFileData%DLL_modelChr(2:2)//''' on the DLL_model', ErrStat,ErrMsg,RoutineName) + endif + endif + + end subroutine ValidateDLL + + subroutine CheckWtrDepth(Depths,InfoDesc,ErrStat3,ErrMsg3) + real(ReKi), intent(in ) :: Depths(:,:) + character(*), intent(in ) :: InfoDesc + integer(IntKi), intent( out) :: ErrStat3 + character(ErrMsgLen), intent( out) :: ErrMsg3 + ErrStat3 = ErrID_None + ErrMsg3 = '' + do i = 1,size(Depths,dim=2) + if (Depths(3,i) > -abs(InitInp%WtrDpth)) then + call SetErrStat( ErrID_Fatal, ' Soil location '//trim(Num2LStr(i))//' ('//trim(Num2LStr(Depths(3,i)))// & + ' m) for '//trim(InfoDesc)//' is above mudline',ErrStat3,ErrMsg3,'') + endif + enddo + if (ErrStat3 /= ErrID_None) ErrMsg3=trim(ErrMsg3)//NewLine//'Water depth passed to SoilDyn = '//trim(Num2LStr(InitInp%WtrDpth))//' m' + return + end subroutine CheckWtrDepth + +END SUBROUTINE SlD_ValidateInput + + + +!********************************************************************************************************************************** +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine checks to see if any requested output channel names (stored in the OutList(:)) are invalid. It returns a +!! warning if any of the channels are not available outputs from the module. +!! It assigns the settings for OutParam(:) (i.e, the index, name, and units of the output channels, WriteOutput(:)). +!! the sign is set to 0 if the channel is invalid. +!! It sets assumes the value p%NumOuts has been set before this routine has been called, and it sets the values of p%OutParam here. +!! +!! This routine was generated by Write_ChckOutLst.m using the parameters listed in OutListParameters.xlsx at 12-Mar-2020 13:30:14. +SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) +!.................................................................................................................................. + + IMPLICIT NONE + + ! Passed variables + + CHARACTER(ChanLen), INTENT(IN ) :: OutList(:) !< The list out user-requested outputs + TYPE(SlD_ParameterType), INTENT(INOUT) :: p !< The module parameters + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< The error status code + CHARACTER(*), INTENT( OUT) :: ErrMsg !< The error message, if an error occurred + + ! Local variables + + INTEGER :: ErrStat2 ! temporary (local) error status + INTEGER :: I ! Generic loop-counting index + INTEGER :: J ! Generic loop-counting index + INTEGER :: INDX ! Index for valid arrays + + LOGICAL :: CheckOutListAgain ! Flag used to determine if output parameter starting with "M" is valid (or the negative of another parameter) + LOGICAL :: InvalidOutput(0:MaxOutPts) ! This array determines if the output channel is valid for this configuration + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I) + CHARACTER(*), PARAMETER :: RoutineName = "SetOutParam" + + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(108) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + "SLD1FXG ","SLD1FYG ","SLD1FZG ","SLD1MXG ","SLD1MYG ","SLD1MZG ","SLD1RDXG ", & + "SLD1RDYG ","SLD1RDZG ","SLD1TDXG ","SLD1TDYG ","SLD1TDZG ","SLD2FXG ","SLD2FYG ", & + "SLD2FZG ","SLD2MXG ","SLD2MYG ","SLD2MZG ","SLD2RDXG ","SLD2RDYG ","SLD2RDZG ", & + "SLD2TDXG ","SLD2TDYG ","SLD2TDZG ","SLD3FXG ","SLD3FYG ","SLD3FZG ","SLD3MXG ", & + "SLD3MYG ","SLD3MZG ","SLD3RDXG ","SLD3RDYG ","SLD3RDZG ","SLD3TDXG ","SLD3TDYG ", & + "SLD3TDZG ","SLD4FXG ","SLD4FYG ","SLD4FZG ","SLD4MXG ","SLD4MYG ","SLD4MZG ", & + "SLD4RDXG ","SLD4RDYG ","SLD4RDZG ","SLD4TDXG ","SLD4TDYG ","SLD4TDZG ","SLD5FXG ", & + "SLD5FYG ","SLD5FZG ","SLD5MXG ","SLD5MYG ","SLD5MZG ","SLD5RDXG ","SLD5RDYG ", & + "SLD5RDZG ","SLD5TDXG ","SLD5TDYG ","SLD5TDZG ","SLD6FXG ","SLD6FYG ","SLD6FZG ", & + "SLD6MXG ","SLD6MYG ","SLD6MZG ","SLD6RDXG ","SLD6RDYG ","SLD6RDZG ","SLD6TDXG ", & + "SLD6TDYG ","SLD6TDZG ","SLD7FXG ","SLD7FYG ","SLD7FZG ","SLD7MXG ","SLD7MYG ", & + "SLD7MZG ","SLD7RDXG ","SLD7RDYG ","SLD7RDZG ","SLD7TDXG ","SLD7TDYG ","SLD7TDZG ", & + "SLD8FXG ","SLD8FYG ","SLD8FZG ","SLD8MXG ","SLD8MYG ","SLD8MZG ","SLD8RDXG ", & + "SLD8RDYG ","SLD8RDZG ","SLD8TDXG ","SLD8TDYG ","SLD8TDZG ","SLD9FXG ","SLD9FYG ", & + "SLD9FZG ","SLD9MXG ","SLD9MYG ","SLD9MZG ","SLD9RDXG ","SLD9RDYG ","SLD9RDZG ", & + "SLD9TDXG ","SLD9TDYG ","SLD9TDZG "/) + INTEGER(IntKi), PARAMETER :: ParamIndxAry(108) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + Sld1Fxg , Sld1Fyg , Sld1Fzg , Sld1Mxg , Sld1Myg , Sld1Mzg , Sld1RDxg , & + Sld1RDyg , Sld1RDzg , Sld1TDxg , Sld1TDyg , Sld1TDzg , Sld2Fxg , Sld2Fyg , & + Sld2Fzg , Sld2Mxg , Sld2Myg , Sld2Mzg , Sld2RDxg , Sld2RDyg , Sld2RDzg , & + Sld2TDxg , Sld2TDyg , Sld2TDzg , Sld3Fxg , Sld3Fyg , Sld3Fzg , Sld3Mxg , & + Sld3Myg , Sld3Mzg , Sld3RDxg , Sld3RDyg , Sld3RDzg , Sld3TDxg , Sld3TDyg , & + Sld3TDzg , Sld4Fxg , Sld4Fyg , Sld4Fzg , Sld4Mxg , Sld4Myg , Sld4Mzg , & + Sld4RDxg , Sld4RDyg , Sld4RDzg , Sld4TDxg , Sld4TDyg , Sld4TDzg , Sld5Fxg , & + Sld5Fyg , Sld5Fzg , Sld5Mxg , Sld5Myg , Sld5Mzg , Sld5RDxg , Sld5RDyg , & + Sld5RDzg , Sld5TDxg , Sld5TDyg , Sld5TDzg , Sld6Fxg , Sld6Fyg , Sld6Fzg , & + Sld6Mxg , Sld6Myg , Sld6Mzg , Sld6RDxg , Sld6RDyg , Sld6RDzg , Sld6TDxg , & + Sld6TDyg , Sld6TDzg , Sld7Fxg , Sld7Fyg , Sld7Fzg , Sld7Mxg , Sld7Myg , & + Sld7Mzg , Sld7RDxg , Sld7RDyg , Sld7RDzg , Sld7TDxg , Sld7TDyg , Sld7TDzg , & + Sld8Fxg , Sld8Fyg , Sld8Fzg , Sld8Mxg , Sld8Myg , Sld8Mzg , Sld8RDxg , & + Sld8RDyg , Sld8RDzg , Sld8TDxg , Sld8TDyg , Sld8TDzg , Sld9Fxg , Sld9Fyg , & + Sld9Fzg , Sld9Mxg , Sld9Myg , Sld9Mzg , Sld9RDxg , Sld9RDyg , Sld9RDzg , & + Sld9TDxg , Sld9TDyg , Sld9TDzg /) + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(108) = (/ & ! This lists the units corresponding to the allowed parameters + "(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ", & + "(deg) ","(deg) ","(m) ","(m) ","(m) ","(kN) ","(kN) ", & + "(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ", & + "(m) ","(m) ","(m) ","(kN) ","(kN) ","(kN) ","(kN-m) ", & + "(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ","(m) ","(m) ", & + "(m) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(deg) ","(deg) ","(deg) ","(m) ","(m) ","(m) ","(kN) ", & + "(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ", & + "(deg) ","(m) ","(m) ","(m) ","(kN) ","(kN) ","(kN) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ","(m) ", & + "(m) ","(m) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(deg) ","(deg) ","(deg) ","(m) ","(m) ","(m) ", & + "(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ", & + "(deg) ","(deg) ","(m) ","(m) ","(m) ","(kN) ","(kN) ", & + "(kN) ","(kN-m) ","(kN-m) ","(kN-m) ","(deg) ","(deg) ","(deg) ", & + "(m) ","(m) ","(m) "/) + + character(4) :: TmpPrefix + + ! Initialize values + ErrStat = ErrID_None + ErrMsg = "" + InvalidOutput = .FALSE. + + +! ..... Developer must add checking for invalid inputs here: ..... + ! Check outputs based on how many points (p%NumPoints) we are interfacing with soil + ! --> Loop through possible output names and check leading prefix. + ! If it is above the number of points interfacing to soil, mark invalid. + do I=p%NumPoints+1,MaxNumberOfOutputLocations + TmpPrefix='SLD'//trim(Num2LStr(I)) + do J=1,MaxOutPts + if ( INDEX(TmpPrefix, ValidParamAry(J)(1:len(TmpPrefix))) == 1 ) InvalidOutput( ParamIndxAry(J) ) = .TRUE. + enddo + enddo +! ................. End of validity checking ................. + + + !------------------------------------------------------------------------------------------------- + ! Allocate and set index, name, and units for the output channels + ! If a selected output channel is not available in this module, set error flag. + !------------------------------------------------------------------------------------------------- + + ALLOCATE ( p%OutParam(0:p%NumOuts) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the SoilDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + ! Set index, name, and units for the time output channel: + + p%OutParam(0)%Indx = Time + p%OutParam(0)%Name = "Time" ! OutParam(0) is the time channel by default. + p%OutParam(0)%Units = "(s)" + p%OutParam(0)%SignM = 1 + + + ! Set index, name, and units for all of the output channels. + ! If a selected output channel is not available by this module set ErrStat = ErrID_Warn. + + DO I = 1,p%NumOuts + + p%OutParam(I)%Name = OutList(I) + OutListTmp = OutList(I) + + ! Reverse the sign (+/-) of the output channel if the user prefixed the + ! channel name with a "-", "_", "m", or "M" character indicating "minus". + + + CheckOutListAgain = .FALSE. + + IF ( INDEX( "-_", OutListTmp(1:1) ) > 0 ) THEN + p%OutParam(I)%SignM = -1 ! ex, "-TipDxc1" causes the sign of TipDxc1 to be switched. + OutListTmp = OutListTmp(2:) + ELSE IF ( INDEX( "mM", OutListTmp(1:1) ) > 0 ) THEN ! We'll assume this is a variable name for now, (if not, we will check later if OutListTmp(2:) is also a variable name) + CheckOutListAgain = .TRUE. + p%OutParam(I)%SignM = 1 + ELSE + p%OutParam(I)%SignM = 1 + END IF + + CALL Conv2UC( OutListTmp ) ! Convert OutListTmp to upper case + + + Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) + + + ! If it started with an "M" (CheckOutListAgain) we didn't find the value in our list (Indx < 1) + + IF ( CheckOutListAgain .AND. Indx < 1 ) THEN ! Let's assume that "M" really meant "minus" and then test again + p%OutParam(I)%SignM = -1 ! ex, "MTipDxc1" causes the sign of TipDxc1 to be switched. + OutListTmp = OutListTmp(2:) + + Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) + END IF + + + IF ( Indx > 0 ) THEN ! we found the channel name + p%OutParam(I)%Indx = ParamIndxAry(Indx) + IF ( InvalidOutput( ParamIndxAry(Indx) ) ) THEN ! but, it isn't valid for these settings + p%OutParam(I)%Units = "INVALID" + p%OutParam(I)%SignM = 0 + ELSE + p%OutParam(I)%Units = ParamUnitsAry(Indx) ! it's a valid output + END IF + ELSE ! this channel isn't valid + p%OutParam(I)%Indx = Time ! pick any valid channel (I just picked "Time" here because it's universal) + p%OutParam(I)%Units = "INVALID" + p%OutParam(I)%SignM = 0 ! multiply all results by zero + + CALL SetErrStat(ErrID_Fatal, TRIM(p%OutParam(I)%Name)//" is not an available output channel.",ErrStat,ErrMsg,RoutineName) + END IF + + END DO + + RETURN +END SUBROUTINE SetOutParam +!---------------------------------------------------------------------------------------------------------------------------------- +!End of code generated by Matlab script +!********************************************************************************************************************************** + + +!==================================================================================================== +SUBROUTINE SlD_OpenSumFile( SumFileUnit, SummaryName, IfW_Prog, WindType, ErrStat, ErrMsg ) + INTEGER(IntKi), INTENT( OUT) :: SumFileUnit !< the unit number for the SoilDynsummary file + CHARACTER(*), INTENT(IN ) :: SummaryName !< the name of the SoilDyn summary file + TYPE(ProgDesc), INTENT(IN ) :: IfW_Prog !< the name/version/date of the SoilDyn program + INTEGER(IntKi), INTENT(IN ) :: WindType !< type identifying what wind we are using + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< returns a non-zero value when an error occurs + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi) :: TmpErrStat !< Temporary error status for checking how the WRITE worked + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + SumFileUnit = -1 + CALL GetNewUnit( SumFileUnit ) + CALL OpenFOutFile ( SumFileUnit, SummaryName, ErrStat, ErrMsg ) + IF (ErrStat >=AbortErrLev) RETURN + + ! Write the summary file header + WRITE(SumFileUnit,'(/,A/)',IOSTAT=TmpErrStat) 'This summary file was generated by '//TRIM( IfW_Prog%Name )//& + ' '//TRIM( IfW_Prog%Ver )//' on '//CurDate()//' at '//CurTime()//'.' + WRITE(SumFileUnit,'(A14,I1)',IOSTAT=TmpErrStat) ' WindType: ',WindType + IF ( TmpErrStat /= 0 ) THEN + CALL SetErrStat(ErrID_Fatal,'Error writing to summary file.',ErrStat,ErrMsg,'') + RETURN + END IF +END SUBROUTINE SlD_OpenSumFile +!==================================================================================================== +SUBROUTINE SlD_CloseSumFile( SumFileUnit, ErrStat, ErrMsg ) + INTEGER(IntKi), INTENT(INOUT) :: SumFileUnit !< the unit number for the SoilDynsummary file + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< returns a non-zero value when an error occurs + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi) :: TmpErrStat + CHARACTER(1024) :: TmpErrMsg + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + TmpErrStat = ErrID_None + TmpErrMsg = '' + + ! Write any closing information in the summary file + IF ( SumFileUnit > 0_IntKi ) THEN + WRITE (SumFileUnit,'(/,A/)', IOSTAT=TmpErrStat) 'This summary file was closed on '//CurDate()//' at '//CurTime()//'.' + IF (TmpErrStat /= 0_IntKi) CALL SetErrStat( ErrID_Fatal, 'Problem writing to the SoilDyn summary file.', ErrStat, ErrMsg, '' ) + + ! Close the file + CLOSE( SumFileUnit, IOSTAT=TmpErrStat ) + IF (TmpErrStat /= 0_IntKi) CALL SetErrStat( ErrID_Fatal, 'Problem closing the SoilDyn summary file.', ErrStat, ErrMsg, '' ) + END IF +END SUBROUTINE SlD_CloseSumFile +!==================================================================================================== + +!> Set the output channels +!! Note: there is an assumption here that only small angle deflections will occur +subroutine SlD_WriteOutput(p, AllOuts, u, y, m, ErrStat, ErrMsg ) + + type(SlD_ParameterType), intent(in ) :: p !< The module parameters + real(ReKi), intent(inout) :: AllOuts(0:) !< array of values to potentially write to file + type(SlD_InputType), intent(in ) :: u !< inputs + type(SlD_OutputType), intent(in ) :: y !< outputs + type(SlD_MiscVarType), intent(inout) :: m !< misc/optimization variables (for computing mesh transfers) + integer(IntKi), intent( out) :: ErrStat !< The error status code + character(*), intent( out) :: ErrMsg !< The error message, if an error occurred + + ! local variables + character(*), parameter :: RoutineName = 'SlD_WriteOutput' + integer(IntKi) :: i,j ! generic counters + real(ReKi) :: Theta(3) ! euler angle extraction (small angle assumption required for this module anyhow) + + ErrStat = ErrID_None + ErrMsg = '' + AllOuts = 0.0_ReKi + if (p%NumOuts < 1) return + + ! Cycle through the soil interaction points only (all the others are marked invalid anyhow) + do i=1,p%NumPoints + ! Forces + do j=1,3 + AllOuts( SoilPtF(j,i) ) = real( -m%ForceTotal(j,i) / 1000.0_ReKi, SiKi ) + enddo + + ! Moments + do j=4,6 + AllOuts( SoilPtF(j,i) ) = real( -m%ForceTotal(j,i) / 1000.0_ReKi, SiKi ) + enddo + + ! Translation displacement + do j=1,3 + AllOuts( SoilPtD(j ,i) ) = real( u%SoilMesh%TranslationDisp(j,i), SiKi ) + enddo + + ! We have defined the referene orientatation aligned with XYZ, so we don't need as much math here. + ! Small angle assumption must be valid for computations in this module, so GetSmllRotAngs extract is sufficient + Theta = real( GetSmllRotAngs(u%SoilMesh%Orientation(1:3,1:3,i), ErrStat, ErrMsg), ReKi) ! orientations are double + do j=1,3 + AllOuts( SoilPtD(j+3,i) ) = Theta(j)*R2D + enddo + enddo + + + + +end subroutine SlD_WriteOutput +!********************************************************************************************************************************** +END MODULE SoilDyn_IO diff --git a/modules/soildyn/src/SoilDyn_Registry.txt b/modules/soildyn/src/SoilDyn_Registry.txt new file mode 100644 index 0000000000..2bea3410dd --- /dev/null +++ b/modules/soildyn/src/SoilDyn_Registry.txt @@ -0,0 +1,144 @@ +################################################################################################################################### +# Registry for SoilDyn in the FAST Modularization Framework +# This Registry file is used to create MODULE SoilDyn_Types, which contains all of the user-defined types needed in SoilDyn. +# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. +# +# Entries are of the form +# keyword +# +# Use ^ as a shortcut for the value from the previous line. +# See NWTC Programmer's Handbook for further information on the format/contents of this file. +################################################################################################################################### + +# ...... Include files (definitions from NWTC Library) ............................................................................ +include Registry_NWTC_Library.txt + +#Parameters CalcOptions: {1: Stiffness / Damping matrices [unavailable], 2: P-Y curves [unavailable], 3: coupled REDWIN DLL} +param SoilDyn/SlD - IntKi Calc_StiffDamp - 1 - "Stiffness / Damping calculations (currently unavailable)" - +param SoilDyn/SlD - IntKi Calc_PYcurve - 2 - "P-Y curve calculations (currently unavailable)" - +param SoilDyn/SlD - IntKi Calc_REDWIN - 3 - "Coupled to REDWIN dll for soil reaction forces" - + + + +# REDWIN interface DLL type +# ..... Data for using REDWIN DLLs ....................................................................................................... +# Values set to type R8Ki are defined in the REDWIN fortran code as kind=selected_real_kind(p=15) +typedef SoilDyn/SlD REDWINdllType character(45) PROPSFILE - - - "" - +typedef SoilDyn/SlD REDWINdllType character(45) LDISPFILE - - - "" - +typedef SoilDyn/SlD REDWINdllType IntKi IDtask - - - "Task identifier for what DLL should do: IDTask = 1: Read input properties, initialize and calibrate model IDTask = 2: Calculate forces based on displacement at end of step IDTask = 3: Calculate elastic macro-element stiffness matrix" - +typedef ^ REDWINdllType IntKi nErrorCode - - - "number of returned error codes" - +typedef ^ REDWINdllType IntKi ErrorCode {100} - - "Array containing one or more error codes. These are specific to each model." - +typedef ^ REDWINdllType R8Ki Props {100}{200} - - "Array containing foundation model properties (used internally by the REDWIN models). Specific to each model." - +typedef ^ REDWINdllType R8Ki StVar {12}{100} - - "Array containing the state variables at the end of the step (used internally by the REDWIN models). Specific to each model." - +typedef ^ REDWINdllType IntKi StVarPrint {12}{100} - - "Array indicating which state variables should be printed to the screen. This feature is currently not supported." - +typedef ^ REDWINdllType R8Ki Disp {6} - - "Displacements. Follows convention of REDWIN orientation." '(m, rad)' +typedef ^ REDWINdllType R8Ki Force {6} - - "Forces. Follows convention of REDWIN orientations." '(N)' +typedef ^ REDWINdllType R8Ki D {6}{6} - - "The 6 x 6 elastic macro-element stiffness matrix at the SFI." - +typedef ^ REDWINdllType LOGICAL SuppressWarn - .FALSE. - "Supress further warnings." - +typedef ^ REDWINdllType IntKi RunMode - 0 - "RunMode of DLL (read from Props(1,1) in Model 1 during initialization" - + + +typedef SoilDyn/SlD REDWINdllStates R8Ki Props {100}{200} - - "Array containing foundation model properties (used internally by the REDWIN models). Specific to each model." - +typedef ^ REDWINdllStates R8Ki StVar {12}{100} - - "Array containing the state variables at the end of the step (used internally by the REDWIN models). Specific to each model." - + + +# SoilDyn input file +typedef ^ SlD_InputFile LOGICAL EchoFlag - - - "Echo the input file" - +typedef ^ SlD_InputFile CHARACTER(ChanLen) OutList : - - "List of user-requested output channels" - +typedef ^ SlD_InputFile R8Ki DT - - - "Timestep requested" '(s)' +typedef ^ SlD_InputFile IntKi CalcOption - - - "Calculation methodology to use" - +typedef ^ SlD_InputFile ReKi SD_locations :: - - "Location of the Stiffness damping point" '(m)' +typedef ^ SlD_InputFile R8Ki Stiffness ::: - - "Stiffness matrix 6x6" '(N/m, N-m/rad)' +typedef ^ SlD_InputFile R8Ki Damping ::: - - "Damping ratio matrix 6x6" - +typedef ^ SlD_InputFile IntKi PY_numpoints - - - "Number of P-Y curve mesh points" - +typedef ^ SlD_InputFile ReKi PY_locations :: - - "P-Y curve location points for mesh" '(m)' +typedef ^ SlD_InputFile character(1024) PY_inputFile : - - "Input file with P-Y curve data" - +typedef ^ SlD_InputFile IntKi DLL_model - - - "REDWIN DLL model type to use" - +typedef ^ SlD_InputFile CHARACTER(2) DLL_modelChr - - - "REDWIN DLL model type to use - character string" - +typedef ^ SlD_InputFile CHARACTER(1024) DLL_FileName - - - "Name of the DLL file including the full path" - +typedef ^ SlD_InputFile CHARACTER(1024) DLL_ProcName - - - "Name of the procedure in the DLL that will be called" - +typedef ^ SlD_InputFile IntKi DLL_numpoints - - - "Number of points to interface to DLL" - +typedef ^ SlD_InputFile ReKi DLL_locations :: - - "DLL location points for mesh" '(m)' +typedef ^ SlD_InputFile CHARACTER(1024) DLL_PROPSFILE : - - "Name of PROPSFILE input file used in DLL" - +typedef ^ SlD_InputFile CHARACTER(1024) DLL_LDISPFILE : - - "Name of LDISPFILE input file used in DLL" - +typedef ^ SlD_InputFile LOGICAL SumPrint - - - "Print summary information to file (.SlD.sum)" - +typedef ^ SlD_InputFile IntKi NumOuts - - - "Number of outputs requested" - +typedef ^ SlD_InputFile logical DLL_OnlyStiff - - - "use only the DLL stiffness matrices in calculating response" - + +# ..... Initialization data ....................................................................................................... +# Define inputs that the initialization routine may need here: +# e.g., the name of the input file, the file root name, etc. +typedef ^ InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - +typedef ^ InitInputType CHARACTER(1024) RootName - - - "Root name of the input file" - +typedef ^ InitInputType LOGICAL Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - +typedef ^ InitInputType ReKi WtrDpth - - - "Water depth to mudline (global coordinates)" '(m)' +typedef ^ InitInputType logical SlDNonLinearForcePortionOnly - .FALSE. - "Only the non-linear portion of the reaction forces is returned" - + +# Define outputs from the initialization routine here: +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 SoilStiffness {:}{:}{:} - - "Soil stiffness at each mesh point (in order)" '(N/m, N-m/rad)' +# if this module has implemented linearization, return the names of the rows/columns of the Jacobian matrices: +#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - +#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - +#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_xd {:} - - "Names of the discrete states used in linearization" - +#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_z {:} - - "Names of the constraint states used in linearization" - +#typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - +#typedef ^ InitOutputType LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - +#typedef ^ InitOutputType LOGICAL RotFrame_x {:} - - "Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame" - +#typedef ^ InitOutputType LOGICAL RotFrame_xd {:} - - "Flag that tells FAST if the discrete states used in linearization are in the rotating frame" - +#typedef ^ InitOutputType LOGICAL RotFrame_z {:} - - "Flag that tells FAST if the constraint states used in linearization are in the rotating frame" - +#typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - + + +# ..... States .................................................................................................................... +# Define continuous (differentiable) states here: +typedef ^ ContinuousStateType ReKi DummyContState - - - "Remove this variable if you have continuous states" - + +# Define discrete (nondifferentiable) states here: +typedef ^ DiscreteStateType REDWINdllStates dll_states : - - "state data used for REDWIN DLL (we think)" - + +# Define constraint states here: +typedef ^ ConstraintStateType ReKi DummyConstrState - - - "Remove this variable if you have constraint states" - + +# Define any other states, including integer or logical states here: +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 REDWINdllType dll_data : - - "data used for REDWIN DLL" - +typedef ^ MiscVarType R8Ki ForceTotal :: - - "Total reaction force at each node" - + + +# ..... Parameters ................................................................................................................ +# Define parameters here: +# 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 cont. state integration & disc. state update" seconds +typedef ^ ParameterType DLL_Type DLL_Trgt - - - "The addresses and names of the Bladed DLL and its procedure" - +typedef ^ ParameterType DbKi DLL_DT - - - "Time step for DLL" seconds +typedef ^ ParameterType CHARACTER(1024) RootName - - - "RootName for writing output files" - +typedef ^ ParameterType LOGICAL UseREDWINinterface - .FALSE. - "True if interface successfully initialized" - +typedef ^ ParameterType CHARACTER(1024) RootFileName - - - "Root file name" - +typedef ^ ParameterType CHARACTER(1024) EchoFileName - - - "Name of echo file" - +typedef ^ ParameterType CHARACTER(1024) SumFileName - - - "Name of summary file" - +typedef ^ ParameterType IntKi DLL_model - - - "REDWIN DLL model type to use" - +typedef ^ ParameterType IntKi CalcOption - - - "Calculation methodology to use" - +typedef ^ ParameterType OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - +typedef ^ ParameterType IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - +typedef ^ ParameterType IntKi NumPoints - - - "Number of points interfacing soil with" - +typedef ^ ParameterType ReKi WtrDepth - - - "Water depth to mudline (global coordinates)" '(m)' +typedef ^ ParameterType R8Ki Stiffness ::: - - "Stiffness matrix" '(N/m, N-m/rad)' +#typedef ^ ParameterType R8Ki Damping ::: - - "Damping matrix" '(N/m, N-m/rad)' +typedef ^ ParameterType logical DLL_OnlyStiff - - - "Use only the stiffness matrix in calculating the restoring forces" - +typedef ^ ParameterType logical SlDNonLinearForcePortionOnly - .FALSE. - "Only the non-linear portion of the reaction forces is returned" - +# ..... Inputs .................................................................................................................... +typedef ^ InputType MeshType SoilMesh - - - "Mesh of soil contact points" - + +# ..... Outputs ................................................................................................................... +typedef ^ OutputType ReKi DummyOutput - - - "Remove this variable if you have output data" - +typedef ^ OutputType ReKi WriteOutput {:} - - "Example of data to be written to an output file" "s,-" +typedef ^ OutputType MeshType SoilMesh - - - "reaction forces and moments point mesh (may be multiple points)" - + diff --git a/modules/soildyn/src/SoilDyn_Types.f90 b/modules/soildyn/src/SoilDyn_Types.f90 new file mode 100644 index 0000000000..8baef4b1e1 --- /dev/null +++ b/modules/soildyn/src/SoilDyn_Types.f90 @@ -0,0 +1,4261 @@ +!STARTOFREGISTRYGENERATEDFILE 'SoilDyn_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 +!********************************************************************************************************************************* +! SoilDyn_Types +!................................................................................................................................. +! This file is part of SoilDyn. +! +! 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 SoilDyn. 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 SoilDyn_Types +!--------------------------------------------------------------------------------------------------------------------------------- +USE NWTC_Library +IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: Calc_StiffDamp = 1 ! Stiffness / Damping calculations (currently unavailable) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Calc_PYcurve = 2 ! P-Y curve calculations (currently unavailable) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Calc_REDWIN = 3 ! Coupled to REDWIN dll for soil reaction forces [-] +! ========= REDWINdllType ======= + TYPE, PUBLIC :: REDWINdllType + character(45) :: PROPSFILE !< [-] + character(45) :: LDISPFILE !< [-] + INTEGER(IntKi) :: IDtask !< Task identifier for what DLL should do: IDTask = 1: Read input properties, initialize and calibrate model IDTask = 2: Calculate forces based on displacement at end of step IDTask = 3: Calculate elastic macro-element stiffness matrix [-] + INTEGER(IntKi) :: nErrorCode !< number of returned error codes [-] + INTEGER(IntKi) , DIMENSION(1:100) :: ErrorCode !< Array containing one or more error codes. These are specific to each model. [-] + REAL(R8Ki) , DIMENSION(1:100,1:200) :: Props !< Array containing foundation model properties (used internally by the REDWIN models). Specific to each model. [-] + REAL(R8Ki) , DIMENSION(1:12,1:100) :: StVar !< Array containing the state variables at the end of the step (used internally by the REDWIN models). Specific to each model. [-] + INTEGER(IntKi) , DIMENSION(1:12,1:100) :: StVarPrint !< Array indicating which state variables should be printed to the screen. This feature is currently not supported. [-] + REAL(R8Ki) , DIMENSION(1:6) :: Disp !< Displacements. Follows convention of REDWIN orientation. ['(m,] + REAL(R8Ki) , DIMENSION(1:6) :: Force !< Forces. Follows convention of REDWIN orientations. ['(N)'] + REAL(R8Ki) , DIMENSION(1:6,1:6) :: D !< The 6 x 6 elastic macro-element stiffness matrix at the SFI. [-] + LOGICAL :: SuppressWarn = .FALSE. !< Supress further warnings. [-] + INTEGER(IntKi) :: RunMode = 0 !< RunMode of DLL (read from Props(1,1) in Model 1 during initialization [-] + END TYPE REDWINdllType +! ======================= +! ========= REDWINdllStates ======= + TYPE, PUBLIC :: REDWINdllStates + REAL(R8Ki) , DIMENSION(1:100,1:200) :: Props !< Array containing foundation model properties (used internally by the REDWIN models). Specific to each model. [-] + REAL(R8Ki) , DIMENSION(1:12,1:100) :: StVar !< Array containing the state variables at the end of the step (used internally by the REDWIN models). Specific to each model. [-] + END TYPE REDWINdllStates +! ======================= +! ========= SlD_InputFile ======= + TYPE, PUBLIC :: SlD_InputFile + LOGICAL :: EchoFlag !< Echo the input file [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] + REAL(R8Ki) :: DT !< Timestep requested ['(s)'] + INTEGER(IntKi) :: CalcOption !< Calculation methodology to use [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SD_locations !< Location of the Stiffness damping point ['(m)'] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Stiffness !< Stiffness matrix 6x6 ['(N/m,] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Damping !< Damping ratio matrix 6x6 [-] + INTEGER(IntKi) :: PY_numpoints !< Number of P-Y curve mesh points [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PY_locations !< P-Y curve location points for mesh ['(m)'] + character(1024) , DIMENSION(:), ALLOCATABLE :: PY_inputFile !< Input file with P-Y curve data [-] + INTEGER(IntKi) :: DLL_model !< REDWIN DLL model type to use [-] + CHARACTER(2) :: DLL_modelChr !< REDWIN DLL model type to use - character string [-] + CHARACTER(1024) :: DLL_FileName !< Name of the DLL file including the full path [-] + CHARACTER(1024) :: DLL_ProcName !< Name of the procedure in the DLL that will be called [-] + INTEGER(IntKi) :: DLL_numpoints !< Number of points to interface to DLL [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: DLL_locations !< DLL location points for mesh ['(m)'] + CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: DLL_PROPSFILE !< Name of PROPSFILE input file used in DLL [-] + CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: DLL_LDISPFILE !< Name of LDISPFILE input file used in DLL [-] + LOGICAL :: SumPrint !< Print summary information to file (.SlD.sum) [-] + INTEGER(IntKi) :: NumOuts !< Number of outputs requested [-] + LOGICAL :: DLL_OnlyStiff !< use only the DLL stiffness matrices in calculating response [-] + END TYPE SlD_InputFile +! ======================= +! ========= SlD_InitInputType ======= + TYPE, PUBLIC :: SlD_InitInputType + CHARACTER(1024) :: InputFile !< Name of the input file [-] + CHARACTER(1024) :: RootName !< Root name of the input file [-] + LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] + REAL(ReKi) :: WtrDpth !< Water depth to mudline (global coordinates) ['(m)'] + LOGICAL :: SlDNonLinearForcePortionOnly = .FALSE. !< Only the non-linear portion of the reaction forces is returned [-] + END TYPE SlD_InitInputType +! ======================= +! ========= SlD_InitOutputType ======= + TYPE, PUBLIC :: SlD_InitOutputType + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] + TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SoilStiffness !< Soil stiffness at each mesh point (in order) ['(N/m,] + END TYPE SlD_InitOutputType +! ======================= +! ========= SlD_ContinuousStateType ======= + TYPE, PUBLIC :: SlD_ContinuousStateType + REAL(ReKi) :: DummyContState !< Remove this variable if you have continuous states [-] + END TYPE SlD_ContinuousStateType +! ======================= +! ========= SlD_DiscreteStateType ======= + TYPE, PUBLIC :: SlD_DiscreteStateType + TYPE(REDWINdllStates) , DIMENSION(:), ALLOCATABLE :: dll_states !< state data used for REDWIN DLL (we think) [-] + END TYPE SlD_DiscreteStateType +! ======================= +! ========= SlD_ConstraintStateType ======= + TYPE, PUBLIC :: SlD_ConstraintStateType + REAL(ReKi) :: DummyConstrState !< Remove this variable if you have constraint states [-] + END TYPE SlD_ConstraintStateType +! ======================= +! ========= SlD_OtherStateType ======= + TYPE, PUBLIC :: SlD_OtherStateType + INTEGER(IntKi) :: DummyOtherState !< Remove this variable if you have other states [-] + END TYPE SlD_OtherStateType +! ======================= +! ========= SlD_MiscVarType ======= + TYPE, PUBLIC :: SlD_MiscVarType + TYPE(REDWINdllType) , DIMENSION(:), ALLOCATABLE :: dll_data !< data used for REDWIN DLL [-] + REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: ForceTotal !< Total reaction force at each node [-] + END TYPE SlD_MiscVarType +! ======================= +! ========= SlD_ParameterType ======= + TYPE, PUBLIC :: SlD_ParameterType + REAL(DbKi) :: DT !< Time step for cont. state integration & disc. state update [seconds] + TYPE(DLL_Type) :: DLL_Trgt !< The addresses and names of the Bladed DLL and its procedure [-] + REAL(DbKi) :: DLL_DT !< Time step for DLL [seconds] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] + LOGICAL :: UseREDWINinterface = .FALSE. !< True if interface successfully initialized [-] + CHARACTER(1024) :: RootFileName !< Root file name [-] + CHARACTER(1024) :: EchoFileName !< Name of echo file [-] + CHARACTER(1024) :: SumFileName !< Name of summary file [-] + INTEGER(IntKi) :: DLL_model !< REDWIN DLL model type to use [-] + INTEGER(IntKi) :: CalcOption !< Calculation methodology to use [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] + INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumPoints !< Number of points interfacing soil with [-] + REAL(ReKi) :: WtrDepth !< Water depth to mudline (global coordinates) ['(m)'] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Stiffness !< Stiffness matrix ['(N/m,] + LOGICAL :: DLL_OnlyStiff !< Use only the stiffness matrix in calculating the restoring forces [-] + LOGICAL :: SlDNonLinearForcePortionOnly = .FALSE. !< Only the non-linear portion of the reaction forces is returned [-] + END TYPE SlD_ParameterType +! ======================= +! ========= SlD_InputType ======= + TYPE, PUBLIC :: SlD_InputType + TYPE(MeshType) :: SoilMesh !< Mesh of soil contact points [-] + END TYPE SlD_InputType +! ======================= +! ========= SlD_OutputType ======= + TYPE, PUBLIC :: SlD_OutputType + REAL(ReKi) :: DummyOutput !< Remove this variable if you have output data [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Example of data to be written to an output file [s,-] + TYPE(MeshType) :: SoilMesh !< reaction forces and moments point mesh (may be multiple points) [-] + END TYPE SlD_OutputType +! ======================= +CONTAINS + SUBROUTINE SlD_CopyREDWINdllType( SrcREDWINdllTypeData, DstREDWINdllTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(REDWINdllType), INTENT(IN) :: SrcREDWINdllTypeData + TYPE(REDWINdllType), INTENT(INOUT) :: DstREDWINdllTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_CopyREDWINdllType' +! + ErrStat = ErrID_None + ErrMsg = "" + DstREDWINdllTypeData%PROPSFILE = SrcREDWINdllTypeData%PROPSFILE + DstREDWINdllTypeData%LDISPFILE = SrcREDWINdllTypeData%LDISPFILE + DstREDWINdllTypeData%IDtask = SrcREDWINdllTypeData%IDtask + DstREDWINdllTypeData%nErrorCode = SrcREDWINdllTypeData%nErrorCode + DstREDWINdllTypeData%ErrorCode = SrcREDWINdllTypeData%ErrorCode + DstREDWINdllTypeData%Props = SrcREDWINdllTypeData%Props + DstREDWINdllTypeData%StVar = SrcREDWINdllTypeData%StVar + DstREDWINdllTypeData%StVarPrint = SrcREDWINdllTypeData%StVarPrint + DstREDWINdllTypeData%Disp = SrcREDWINdllTypeData%Disp + DstREDWINdllTypeData%Force = SrcREDWINdllTypeData%Force + DstREDWINdllTypeData%D = SrcREDWINdllTypeData%D + DstREDWINdllTypeData%SuppressWarn = SrcREDWINdllTypeData%SuppressWarn + DstREDWINdllTypeData%RunMode = SrcREDWINdllTypeData%RunMode + END SUBROUTINE SlD_CopyREDWINdllType + + SUBROUTINE SlD_DestroyREDWINdllType( REDWINdllTypeData, ErrStat, ErrMsg ) + TYPE(REDWINdllType), INTENT(INOUT) :: REDWINdllTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_DestroyREDWINdllType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE SlD_DestroyREDWINdllType + + SUBROUTINE SlD_PackREDWINdllType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(REDWINdllType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_PackREDWINdllType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1*LEN(InData%PROPSFILE) ! PROPSFILE + Int_BufSz = Int_BufSz + 1*LEN(InData%LDISPFILE) ! LDISPFILE + Int_BufSz = Int_BufSz + 1 ! IDtask + Int_BufSz = Int_BufSz + 1 ! nErrorCode + Int_BufSz = Int_BufSz + SIZE(InData%ErrorCode) ! ErrorCode + Db_BufSz = Db_BufSz + SIZE(InData%Props) ! Props + Db_BufSz = Db_BufSz + SIZE(InData%StVar) ! StVar + Int_BufSz = Int_BufSz + SIZE(InData%StVarPrint) ! StVarPrint + Db_BufSz = Db_BufSz + SIZE(InData%Disp) ! Disp + Db_BufSz = Db_BufSz + SIZE(InData%Force) ! Force + Db_BufSz = Db_BufSz + SIZE(InData%D) ! D + Int_BufSz = Int_BufSz + 1 ! SuppressWarn + Int_BufSz = Int_BufSz + 1 ! RunMode + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO I = 1, LEN(InData%PROPSFILE) + IntKiBuf(Int_Xferred) = ICHAR(InData%PROPSFILE(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%LDISPFILE) + IntKiBuf(Int_Xferred) = ICHAR(InData%LDISPFILE(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%IDtask + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nErrorCode + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%ErrorCode,1), UBOUND(InData%ErrorCode,1) + IntKiBuf(Int_Xferred) = InData%ErrorCode(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i2 = LBOUND(InData%Props,2), UBOUND(InData%Props,2) + DO i1 = LBOUND(InData%Props,1), UBOUND(InData%Props,1) + DbKiBuf(Db_Xferred) = InData%Props(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%StVar,2), UBOUND(InData%StVar,2) + DO i1 = LBOUND(InData%StVar,1), UBOUND(InData%StVar,1) + DbKiBuf(Db_Xferred) = InData%StVar(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%StVarPrint,2), UBOUND(InData%StVarPrint,2) + DO i1 = LBOUND(InData%StVarPrint,1), UBOUND(InData%StVarPrint,1) + IntKiBuf(Int_Xferred) = InData%StVarPrint(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%Disp,1), UBOUND(InData%Disp,1) + DbKiBuf(Db_Xferred) = InData%Disp(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%Force,1), UBOUND(InData%Force,1) + DbKiBuf(Db_Xferred) = InData%Force(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i2 = LBOUND(InData%D,2), UBOUND(InData%D,2) + DO i1 = LBOUND(InData%D,1), UBOUND(InData%D,1) + DbKiBuf(Db_Xferred) = InData%D(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%SuppressWarn, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%RunMode + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SlD_PackREDWINdllType + + SUBROUTINE SlD_UnPackREDWINdllType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(REDWINdllType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_UnPackREDWINdllType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + DO I = 1, LEN(OutData%PROPSFILE) + OutData%PROPSFILE(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%LDISPFILE) + OutData%LDISPFILE(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%IDtask = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nErrorCode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%ErrorCode,1) + i1_u = UBOUND(OutData%ErrorCode,1) + DO i1 = LBOUND(OutData%ErrorCode,1), UBOUND(OutData%ErrorCode,1) + OutData%ErrorCode(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + i1_l = LBOUND(OutData%Props,1) + i1_u = UBOUND(OutData%Props,1) + i2_l = LBOUND(OutData%Props,2) + i2_u = UBOUND(OutData%Props,2) + DO i2 = LBOUND(OutData%Props,2), UBOUND(OutData%Props,2) + DO i1 = LBOUND(OutData%Props,1), UBOUND(OutData%Props,1) + OutData%Props(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + i1_l = LBOUND(OutData%StVar,1) + i1_u = UBOUND(OutData%StVar,1) + i2_l = LBOUND(OutData%StVar,2) + i2_u = UBOUND(OutData%StVar,2) + DO i2 = LBOUND(OutData%StVar,2), UBOUND(OutData%StVar,2) + DO i1 = LBOUND(OutData%StVar,1), UBOUND(OutData%StVar,1) + OutData%StVar(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + i1_l = LBOUND(OutData%StVarPrint,1) + i1_u = UBOUND(OutData%StVarPrint,1) + i2_l = LBOUND(OutData%StVarPrint,2) + i2_u = UBOUND(OutData%StVarPrint,2) + DO i2 = LBOUND(OutData%StVarPrint,2), UBOUND(OutData%StVarPrint,2) + DO i1 = LBOUND(OutData%StVarPrint,1), UBOUND(OutData%StVarPrint,1) + OutData%StVarPrint(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + i1_l = LBOUND(OutData%Disp,1) + i1_u = UBOUND(OutData%Disp,1) + DO i1 = LBOUND(OutData%Disp,1), UBOUND(OutData%Disp,1) + OutData%Disp(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%Force,1) + i1_u = UBOUND(OutData%Force,1) + DO i1 = LBOUND(OutData%Force,1), UBOUND(OutData%Force,1) + OutData%Force(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%D,1) + i1_u = UBOUND(OutData%D,1) + i2_l = LBOUND(OutData%D,2) + i2_u = UBOUND(OutData%D,2) + DO i2 = LBOUND(OutData%D,2), UBOUND(OutData%D,2) + DO i1 = LBOUND(OutData%D,1), UBOUND(OutData%D,1) + OutData%D(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + OutData%SuppressWarn = TRANSFER(IntKiBuf(Int_Xferred), OutData%SuppressWarn) + Int_Xferred = Int_Xferred + 1 + OutData%RunMode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SlD_UnPackREDWINdllType + + SUBROUTINE SlD_CopyREDWINdllStates( SrcREDWINdllStatesData, DstREDWINdllStatesData, CtrlCode, ErrStat, ErrMsg ) + TYPE(REDWINdllStates), INTENT(IN) :: SrcREDWINdllStatesData + TYPE(REDWINdllStates), INTENT(INOUT) :: DstREDWINdllStatesData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_CopyREDWINdllStates' +! + ErrStat = ErrID_None + ErrMsg = "" + DstREDWINdllStatesData%Props = SrcREDWINdllStatesData%Props + DstREDWINdllStatesData%StVar = SrcREDWINdllStatesData%StVar + END SUBROUTINE SlD_CopyREDWINdllStates + + SUBROUTINE SlD_DestroyREDWINdllStates( REDWINdllStatesData, ErrStat, ErrMsg ) + TYPE(REDWINdllStates), INTENT(INOUT) :: REDWINdllStatesData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_DestroyREDWINdllStates' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE SlD_DestroyREDWINdllStates + + SUBROUTINE SlD_PackREDWINdllStates( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(REDWINdllStates), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_PackREDWINdllStates' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Db_BufSz = Db_BufSz + SIZE(InData%Props) ! Props + Db_BufSz = Db_BufSz + SIZE(InData%StVar) ! StVar + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i2 = LBOUND(InData%Props,2), UBOUND(InData%Props,2) + DO i1 = LBOUND(InData%Props,1), UBOUND(InData%Props,1) + DbKiBuf(Db_Xferred) = InData%Props(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%StVar,2), UBOUND(InData%StVar,2) + DO i1 = LBOUND(InData%StVar,1), UBOUND(InData%StVar,1) + DbKiBuf(Db_Xferred) = InData%StVar(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END SUBROUTINE SlD_PackREDWINdllStates + + SUBROUTINE SlD_UnPackREDWINdllStates( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(REDWINdllStates), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_UnPackREDWINdllStates' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%Props,1) + i1_u = UBOUND(OutData%Props,1) + i2_l = LBOUND(OutData%Props,2) + i2_u = UBOUND(OutData%Props,2) + DO i2 = LBOUND(OutData%Props,2), UBOUND(OutData%Props,2) + DO i1 = LBOUND(OutData%Props,1), UBOUND(OutData%Props,1) + OutData%Props(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + i1_l = LBOUND(OutData%StVar,1) + i1_u = UBOUND(OutData%StVar,1) + i2_l = LBOUND(OutData%StVar,2) + i2_u = UBOUND(OutData%StVar,2) + DO i2 = LBOUND(OutData%StVar,2), UBOUND(OutData%StVar,2) + DO i1 = LBOUND(OutData%StVar,1), UBOUND(OutData%StVar,1) + OutData%StVar(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END SUBROUTINE SlD_UnPackREDWINdllStates + + SUBROUTINE SlD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SlD_InputFile), INTENT(IN) :: SrcInputFileData + TYPE(SlD_InputFile), INTENT(INOUT) :: DstInputFileData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_CopyInputFile' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag +IF (ALLOCATED(SrcInputFileData%OutList)) THEN + i1_l = LBOUND(SrcInputFileData%OutList,1) + i1_u = UBOUND(SrcInputFileData%OutList,1) + IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN + ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%OutList = SrcInputFileData%OutList +ENDIF + DstInputFileData%DT = SrcInputFileData%DT + DstInputFileData%CalcOption = SrcInputFileData%CalcOption +IF (ALLOCATED(SrcInputFileData%SD_locations)) THEN + i1_l = LBOUND(SrcInputFileData%SD_locations,1) + i1_u = UBOUND(SrcInputFileData%SD_locations,1) + i2_l = LBOUND(SrcInputFileData%SD_locations,2) + i2_u = UBOUND(SrcInputFileData%SD_locations,2) + IF (.NOT. ALLOCATED(DstInputFileData%SD_locations)) THEN + ALLOCATE(DstInputFileData%SD_locations(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%SD_locations.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%SD_locations = SrcInputFileData%SD_locations +ENDIF +IF (ALLOCATED(SrcInputFileData%Stiffness)) THEN + i1_l = LBOUND(SrcInputFileData%Stiffness,1) + i1_u = UBOUND(SrcInputFileData%Stiffness,1) + i2_l = LBOUND(SrcInputFileData%Stiffness,2) + i2_u = UBOUND(SrcInputFileData%Stiffness,2) + i3_l = LBOUND(SrcInputFileData%Stiffness,3) + i3_u = UBOUND(SrcInputFileData%Stiffness,3) + IF (.NOT. ALLOCATED(DstInputFileData%Stiffness)) THEN + ALLOCATE(DstInputFileData%Stiffness(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Stiffness.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%Stiffness = SrcInputFileData%Stiffness +ENDIF +IF (ALLOCATED(SrcInputFileData%Damping)) THEN + i1_l = LBOUND(SrcInputFileData%Damping,1) + i1_u = UBOUND(SrcInputFileData%Damping,1) + i2_l = LBOUND(SrcInputFileData%Damping,2) + i2_u = UBOUND(SrcInputFileData%Damping,2) + i3_l = LBOUND(SrcInputFileData%Damping,3) + i3_u = UBOUND(SrcInputFileData%Damping,3) + IF (.NOT. ALLOCATED(DstInputFileData%Damping)) THEN + ALLOCATE(DstInputFileData%Damping(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%Damping.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%Damping = SrcInputFileData%Damping +ENDIF + DstInputFileData%PY_numpoints = SrcInputFileData%PY_numpoints +IF (ALLOCATED(SrcInputFileData%PY_locations)) THEN + i1_l = LBOUND(SrcInputFileData%PY_locations,1) + i1_u = UBOUND(SrcInputFileData%PY_locations,1) + i2_l = LBOUND(SrcInputFileData%PY_locations,2) + i2_u = UBOUND(SrcInputFileData%PY_locations,2) + IF (.NOT. ALLOCATED(DstInputFileData%PY_locations)) THEN + ALLOCATE(DstInputFileData%PY_locations(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PY_locations.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%PY_locations = SrcInputFileData%PY_locations +ENDIF +IF (ALLOCATED(SrcInputFileData%PY_inputFile)) THEN + i1_l = LBOUND(SrcInputFileData%PY_inputFile,1) + i1_u = UBOUND(SrcInputFileData%PY_inputFile,1) + IF (.NOT. ALLOCATED(DstInputFileData%PY_inputFile)) THEN + ALLOCATE(DstInputFileData%PY_inputFile(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%PY_inputFile.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%PY_inputFile = SrcInputFileData%PY_inputFile +ENDIF + DstInputFileData%DLL_model = SrcInputFileData%DLL_model + DstInputFileData%DLL_modelChr = SrcInputFileData%DLL_modelChr + DstInputFileData%DLL_FileName = SrcInputFileData%DLL_FileName + DstInputFileData%DLL_ProcName = SrcInputFileData%DLL_ProcName + DstInputFileData%DLL_numpoints = SrcInputFileData%DLL_numpoints +IF (ALLOCATED(SrcInputFileData%DLL_locations)) THEN + i1_l = LBOUND(SrcInputFileData%DLL_locations,1) + i1_u = UBOUND(SrcInputFileData%DLL_locations,1) + i2_l = LBOUND(SrcInputFileData%DLL_locations,2) + i2_u = UBOUND(SrcInputFileData%DLL_locations,2) + IF (.NOT. ALLOCATED(DstInputFileData%DLL_locations)) THEN + ALLOCATE(DstInputFileData%DLL_locations(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%DLL_locations.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%DLL_locations = SrcInputFileData%DLL_locations +ENDIF +IF (ALLOCATED(SrcInputFileData%DLL_PROPSFILE)) THEN + i1_l = LBOUND(SrcInputFileData%DLL_PROPSFILE,1) + i1_u = UBOUND(SrcInputFileData%DLL_PROPSFILE,1) + IF (.NOT. ALLOCATED(DstInputFileData%DLL_PROPSFILE)) THEN + ALLOCATE(DstInputFileData%DLL_PROPSFILE(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%DLL_PROPSFILE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%DLL_PROPSFILE = SrcInputFileData%DLL_PROPSFILE +ENDIF +IF (ALLOCATED(SrcInputFileData%DLL_LDISPFILE)) THEN + i1_l = LBOUND(SrcInputFileData%DLL_LDISPFILE,1) + i1_u = UBOUND(SrcInputFileData%DLL_LDISPFILE,1) + IF (.NOT. ALLOCATED(DstInputFileData%DLL_LDISPFILE)) THEN + ALLOCATE(DstInputFileData%DLL_LDISPFILE(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%DLL_LDISPFILE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%DLL_LDISPFILE = SrcInputFileData%DLL_LDISPFILE +ENDIF + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + DstInputFileData%DLL_OnlyStiff = SrcInputFileData%DLL_OnlyStiff + END SUBROUTINE SlD_CopyInputFile + + SUBROUTINE SlD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) + TYPE(SlD_InputFile), INTENT(INOUT) :: InputFileData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_DestroyInputFile' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(InputFileData%OutList)) THEN + DEALLOCATE(InputFileData%OutList) +ENDIF +IF (ALLOCATED(InputFileData%SD_locations)) THEN + DEALLOCATE(InputFileData%SD_locations) +ENDIF +IF (ALLOCATED(InputFileData%Stiffness)) THEN + DEALLOCATE(InputFileData%Stiffness) +ENDIF +IF (ALLOCATED(InputFileData%Damping)) THEN + DEALLOCATE(InputFileData%Damping) +ENDIF +IF (ALLOCATED(InputFileData%PY_locations)) THEN + DEALLOCATE(InputFileData%PY_locations) +ENDIF +IF (ALLOCATED(InputFileData%PY_inputFile)) THEN + DEALLOCATE(InputFileData%PY_inputFile) +ENDIF +IF (ALLOCATED(InputFileData%DLL_locations)) THEN + DEALLOCATE(InputFileData%DLL_locations) +ENDIF +IF (ALLOCATED(InputFileData%DLL_PROPSFILE)) THEN + DEALLOCATE(InputFileData%DLL_PROPSFILE) +ENDIF +IF (ALLOCATED(InputFileData%DLL_LDISPFILE)) THEN + DEALLOCATE(InputFileData%DLL_LDISPFILE) +ENDIF + END SUBROUTINE SlD_DestroyInputFile + + SUBROUTINE SlD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SlD_InputFile), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_PackInputFile' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! EchoFlag + Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no + IF ( ALLOCATED(InData%OutList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList + END IF + Db_BufSz = Db_BufSz + 1 ! DT + Int_BufSz = Int_BufSz + 1 ! CalcOption + Int_BufSz = Int_BufSz + 1 ! SD_locations allocated yes/no + IF ( ALLOCATED(InData%SD_locations) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! SD_locations upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SD_locations) ! SD_locations + END IF + Int_BufSz = Int_BufSz + 1 ! Stiffness allocated yes/no + IF ( ALLOCATED(InData%Stiffness) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Stiffness upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Stiffness) ! Stiffness + END IF + Int_BufSz = Int_BufSz + 1 ! Damping allocated yes/no + IF ( ALLOCATED(InData%Damping) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Damping upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Damping) ! Damping + END IF + Int_BufSz = Int_BufSz + 1 ! PY_numpoints + Int_BufSz = Int_BufSz + 1 ! PY_locations allocated yes/no + IF ( ALLOCATED(InData%PY_locations) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PY_locations upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PY_locations) ! PY_locations + END IF + Int_BufSz = Int_BufSz + 1 ! PY_inputFile allocated yes/no + IF ( ALLOCATED(InData%PY_inputFile) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! PY_inputFile upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%PY_inputFile)*LEN(InData%PY_inputFile) ! PY_inputFile + END IF + Int_BufSz = Int_BufSz + 1 ! DLL_model + Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_modelChr) ! DLL_modelChr + Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_FileName) ! DLL_FileName + Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_ProcName) ! DLL_ProcName + Int_BufSz = Int_BufSz + 1 ! DLL_numpoints + Int_BufSz = Int_BufSz + 1 ! DLL_locations allocated yes/no + IF ( ALLOCATED(InData%DLL_locations) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! DLL_locations upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%DLL_locations) ! DLL_locations + END IF + Int_BufSz = Int_BufSz + 1 ! DLL_PROPSFILE allocated yes/no + IF ( ALLOCATED(InData%DLL_PROPSFILE) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! DLL_PROPSFILE upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%DLL_PROPSFILE)*LEN(InData%DLL_PROPSFILE) ! DLL_PROPSFILE + END IF + Int_BufSz = Int_BufSz + 1 ! DLL_LDISPFILE allocated yes/no + IF ( ALLOCATED(InData%DLL_LDISPFILE) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! DLL_LDISPFILE upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%DLL_LDISPFILE)*LEN(InData%DLL_LDISPFILE) ! DLL_LDISPFILE + END IF + Int_BufSz = Int_BufSz + 1 ! SumPrint + Int_BufSz = Int_BufSz + 1 ! NumOuts + Int_BufSz = Int_BufSz + 1 ! DLL_OnlyStiff + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = TRANSFER(InData%EchoFlag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%OutList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OutList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO I = 1, LEN(InData%OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CalcOption + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%SD_locations) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SD_locations,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SD_locations,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SD_locations,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SD_locations,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%SD_locations,2), UBOUND(InData%SD_locations,2) + DO i1 = LBOUND(InData%SD_locations,1), UBOUND(InData%SD_locations,1) + ReKiBuf(Re_Xferred) = InData%SD_locations(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Stiffness) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Stiffness,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stiffness,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Stiffness,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stiffness,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Stiffness,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stiffness,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Stiffness,3), UBOUND(InData%Stiffness,3) + DO i2 = LBOUND(InData%Stiffness,2), UBOUND(InData%Stiffness,2) + DO i1 = LBOUND(InData%Stiffness,1), UBOUND(InData%Stiffness,1) + DbKiBuf(Db_Xferred) = InData%Stiffness(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Damping) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Damping,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Damping,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Damping,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Damping,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Damping,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Damping,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Damping,3), UBOUND(InData%Damping,3) + DO i2 = LBOUND(InData%Damping,2), UBOUND(InData%Damping,2) + DO i1 = LBOUND(InData%Damping,1), UBOUND(InData%Damping,1) + DbKiBuf(Db_Xferred) = InData%Damping(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%PY_numpoints + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%PY_locations) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PY_locations,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PY_locations,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PY_locations,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PY_locations,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%PY_locations,2), UBOUND(InData%PY_locations,2) + DO i1 = LBOUND(InData%PY_locations,1), UBOUND(InData%PY_locations,1) + ReKiBuf(Re_Xferred) = InData%PY_locations(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PY_inputFile) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PY_inputFile,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PY_inputFile,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%PY_inputFile,1), UBOUND(InData%PY_inputFile,1) + DO I = 1, LEN(InData%PY_inputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%PY_inputFile(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IntKiBuf(Int_Xferred) = InData%DLL_model + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%DLL_modelChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_modelChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DLL_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DLL_ProcName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_ProcName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%DLL_numpoints + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%DLL_locations) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DLL_locations,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DLL_locations,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DLL_locations,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DLL_locations,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%DLL_locations,2), UBOUND(InData%DLL_locations,2) + DO i1 = LBOUND(InData%DLL_locations,1), UBOUND(InData%DLL_locations,1) + ReKiBuf(Re_Xferred) = InData%DLL_locations(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%DLL_PROPSFILE) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DLL_PROPSFILE,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DLL_PROPSFILE,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%DLL_PROPSFILE,1), UBOUND(InData%DLL_PROPSFILE,1) + DO I = 1, LEN(InData%DLL_PROPSFILE) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_PROPSFILE(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%DLL_LDISPFILE) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DLL_LDISPFILE,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DLL_LDISPFILE,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%DLL_LDISPFILE,1), UBOUND(InData%DLL_LDISPFILE,1) + DO I = 1, LEN(InData%DLL_LDISPFILE) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_LDISPFILE(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DLL_OnlyStiff, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SlD_PackInputFile + + SUBROUTINE SlD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SlD_InputFile), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_UnPackInputFile' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%EchoFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%EchoFlag) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OutList)) DEALLOCATE(OutData%OutList) + ALLOCATE(OutData%OutList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + OutData%DT = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CalcOption = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SD_locations not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SD_locations)) DEALLOCATE(OutData%SD_locations) + ALLOCATE(OutData%SD_locations(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SD_locations.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%SD_locations,2), UBOUND(OutData%SD_locations,2) + DO i1 = LBOUND(OutData%SD_locations,1), UBOUND(OutData%SD_locations,1) + OutData%SD_locations(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Stiffness not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Stiffness)) DEALLOCATE(OutData%Stiffness) + ALLOCATE(OutData%Stiffness(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stiffness.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Stiffness,3), UBOUND(OutData%Stiffness,3) + DO i2 = LBOUND(OutData%Stiffness,2), UBOUND(OutData%Stiffness,2) + DO i1 = LBOUND(OutData%Stiffness,1), UBOUND(OutData%Stiffness,1) + OutData%Stiffness(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Damping not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Damping)) DEALLOCATE(OutData%Damping) + ALLOCATE(OutData%Damping(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Damping.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Damping,3), UBOUND(OutData%Damping,3) + DO i2 = LBOUND(OutData%Damping,2), UBOUND(OutData%Damping,2) + DO i1 = LBOUND(OutData%Damping,1), UBOUND(OutData%Damping,1) + OutData%Damping(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + OutData%PY_numpoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PY_locations not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PY_locations)) DEALLOCATE(OutData%PY_locations) + ALLOCATE(OutData%PY_locations(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PY_locations.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PY_locations,2), UBOUND(OutData%PY_locations,2) + DO i1 = LBOUND(OutData%PY_locations,1), UBOUND(OutData%PY_locations,1) + OutData%PY_locations(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PY_inputFile not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PY_inputFile)) DEALLOCATE(OutData%PY_inputFile) + ALLOCATE(OutData%PY_inputFile(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PY_inputFile.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%PY_inputFile,1), UBOUND(OutData%PY_inputFile,1) + DO I = 1, LEN(OutData%PY_inputFile) + OutData%PY_inputFile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + OutData%DLL_model = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%DLL_modelChr) + OutData%DLL_modelChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DLL_FileName) + OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DLL_ProcName) + OutData%DLL_ProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%DLL_numpoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DLL_locations not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%DLL_locations)) DEALLOCATE(OutData%DLL_locations) + ALLOCATE(OutData%DLL_locations(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DLL_locations.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%DLL_locations,2), UBOUND(OutData%DLL_locations,2) + DO i1 = LBOUND(OutData%DLL_locations,1), UBOUND(OutData%DLL_locations,1) + OutData%DLL_locations(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DLL_PROPSFILE not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%DLL_PROPSFILE)) DEALLOCATE(OutData%DLL_PROPSFILE) + ALLOCATE(OutData%DLL_PROPSFILE(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DLL_PROPSFILE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%DLL_PROPSFILE,1), UBOUND(OutData%DLL_PROPSFILE,1) + DO I = 1, LEN(OutData%DLL_PROPSFILE) + OutData%DLL_PROPSFILE(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DLL_LDISPFILE not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%DLL_LDISPFILE)) DEALLOCATE(OutData%DLL_LDISPFILE) + ALLOCATE(OutData%DLL_LDISPFILE(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DLL_LDISPFILE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%DLL_LDISPFILE,1), UBOUND(OutData%DLL_LDISPFILE,1) + DO I = 1, LEN(OutData%DLL_LDISPFILE) + OutData%DLL_LDISPFILE(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DLL_OnlyStiff = TRANSFER(IntKiBuf(Int_Xferred), OutData%DLL_OnlyStiff) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SlD_UnPackInputFile + + SUBROUTINE SlD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SlD_InitInputType), INTENT(IN) :: SrcInitInputData + TYPE(SlD_InitInputType), INTENT(INOUT) :: DstInitInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_CopyInitInput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInitInputData%InputFile = SrcInitInputData%InputFile + DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%Linearize = SrcInitInputData%Linearize + DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth + DstInitInputData%SlDNonLinearForcePortionOnly = SrcInitInputData%SlDNonLinearForcePortionOnly + END SUBROUTINE SlD_CopyInitInput + + SUBROUTINE SlD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) + TYPE(SlD_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_DestroyInitInput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE SlD_DestroyInitInput + + SUBROUTINE SlD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SlD_InitInputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_PackInitInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile + Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName + Int_BufSz = Int_BufSz + 1 ! Linearize + Re_BufSz = Re_BufSz + 1 ! WtrDpth + Int_BufSz = Int_BufSz + 1 ! SlDNonLinearForcePortionOnly + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SlDNonLinearForcePortionOnly, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SlD_PackInitInput + + SUBROUTINE SlD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SlD_InitInputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_UnPackInitInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SlDNonLinearForcePortionOnly = TRANSFER(IntKiBuf(Int_Xferred), OutData%SlDNonLinearForcePortionOnly) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SlD_UnPackInitInput + + SUBROUTINE SlD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SlD_InitOutputType), INTENT(IN) :: SrcInitOutputData + TYPE(SlD_InitOutputType), INTENT(INOUT) :: DstInitOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_CopyInitOutput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN + i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) + i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN + ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr +ENDIF +IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN + i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) + i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN + ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt +ENDIF + CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcInitOutputData%SoilStiffness)) THEN + i1_l = LBOUND(SrcInitOutputData%SoilStiffness,1) + i1_u = UBOUND(SrcInitOutputData%SoilStiffness,1) + i2_l = LBOUND(SrcInitOutputData%SoilStiffness,2) + i2_u = UBOUND(SrcInitOutputData%SoilStiffness,2) + i3_l = LBOUND(SrcInitOutputData%SoilStiffness,3) + i3_u = UBOUND(SrcInitOutputData%SoilStiffness,3) + IF (.NOT. ALLOCATED(DstInitOutputData%SoilStiffness)) THEN + ALLOCATE(DstInitOutputData%SoilStiffness(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%SoilStiffness.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%SoilStiffness = SrcInitOutputData%SoilStiffness +ENDIF + END SUBROUTINE SlD_CopyInitOutput + + SUBROUTINE SlD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + TYPE(SlD_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_DestroyInitOutput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN + DEALLOCATE(InitOutputData%WriteOutputHdr) +ENDIF +IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN + DEALLOCATE(InitOutputData%WriteOutputUnt) +ENDIF + CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) +IF (ALLOCATED(InitOutputData%SoilStiffness)) THEN + DEALLOCATE(InitOutputData%SoilStiffness) +ENDIF + END SUBROUTINE SlD_DestroyInitOutput + + SUBROUTINE SlD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SlD_InitOutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_PackInitOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no + IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr + END IF + Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no + IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt + END IF + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype + CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Ver + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Ver + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Ver + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! SoilStiffness allocated yes/no + IF ( ALLOCATED(InData%SoilStiffness) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! SoilStiffness upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%SoilStiffness) ! SoilStiffness + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputHdr,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + DO I = 1, LEN(InData%WriteOutputHdr) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutputUnt,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + DO I = 1, LEN(InData%WriteOutputUnt) + IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%SoilStiffness) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SoilStiffness,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SoilStiffness,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%SoilStiffness,3), UBOUND(InData%SoilStiffness,3) + DO i2 = LBOUND(InData%SoilStiffness,2), UBOUND(InData%SoilStiffness,2) + DO i1 = LBOUND(InData%SoilStiffness,1), UBOUND(InData%SoilStiffness,1) + ReKiBuf(Re_Xferred) = InData%SoilStiffness(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + END SUBROUTINE SlD_PackInitOutput + + SUBROUTINE SlD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SlD_InitOutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_UnPackInitOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) + ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + DO I = 1, LEN(OutData%WriteOutputHdr) + OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) + ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + DO I = 1, LEN(OutData%WriteOutputUnt) + OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SoilStiffness not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SoilStiffness)) DEALLOCATE(OutData%SoilStiffness) + ALLOCATE(OutData%SoilStiffness(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SoilStiffness.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%SoilStiffness,3), UBOUND(OutData%SoilStiffness,3) + DO i2 = LBOUND(OutData%SoilStiffness,2), UBOUND(OutData%SoilStiffness,2) + DO i1 = LBOUND(OutData%SoilStiffness,1), UBOUND(OutData%SoilStiffness,1) + OutData%SoilStiffness(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + END SUBROUTINE SlD_UnPackInitOutput + + SUBROUTINE SlD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SlD_ContinuousStateType), INTENT(IN) :: SrcContStateData + TYPE(SlD_ContinuousStateType), INTENT(INOUT) :: DstContStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_CopyContState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstContStateData%DummyContState = SrcContStateData%DummyContState + END SUBROUTINE SlD_CopyContState + + SUBROUTINE SlD_DestroyContState( ContStateData, ErrStat, ErrMsg ) + TYPE(SlD_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_DestroyContState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE SlD_DestroyContState + + SUBROUTINE SlD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SlD_ContinuousStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_PackContState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyContState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE SlD_PackContState + + SUBROUTINE SlD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SlD_ContinuousStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_UnPackContState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE SlD_UnPackContState + + SUBROUTINE SlD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SlD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData + TYPE(SlD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_CopyDiscState' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcDiscStateData%dll_states)) THEN + i1_l = LBOUND(SrcDiscStateData%dll_states,1) + i1_u = UBOUND(SrcDiscStateData%dll_states,1) + IF (.NOT. ALLOCATED(DstDiscStateData%dll_states)) THEN + ALLOCATE(DstDiscStateData%dll_states(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%dll_states.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcDiscStateData%dll_states,1), UBOUND(SrcDiscStateData%dll_states,1) + CALL SlD_Copyredwindllstates( SrcDiscStateData%dll_states(i1), DstDiscStateData%dll_states(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + END SUBROUTINE SlD_CopyDiscState + + SUBROUTINE SlD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + TYPE(SlD_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_DestroyDiscState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(DiscStateData%dll_states)) THEN +DO i1 = LBOUND(DiscStateData%dll_states,1), UBOUND(DiscStateData%dll_states,1) + CALL SlD_Destroyredwindllstates( DiscStateData%dll_states(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(DiscStateData%dll_states) +ENDIF + END SUBROUTINE SlD_DestroyDiscState + + SUBROUTINE SlD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SlD_DiscreteStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_PackDiscState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! dll_states allocated yes/no + IF ( ALLOCATED(InData%dll_states) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! dll_states upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%dll_states,1), UBOUND(InData%dll_states,1) + Int_BufSz = Int_BufSz + 3 ! dll_states: size of buffers for each call to pack subtype + CALL SlD_Packredwindllstates( Re_Buf, Db_Buf, Int_Buf, InData%dll_states(i1), ErrStat2, ErrMsg2, .TRUE. ) ! dll_states + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! dll_states + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! dll_states + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! dll_states + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%dll_states) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dll_states,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dll_states,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%dll_states,1), UBOUND(InData%dll_states,1) + CALL SlD_Packredwindllstates( Re_Buf, Db_Buf, Int_Buf, InData%dll_states(i1), ErrStat2, ErrMsg2, OnlySize ) ! dll_states + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + END SUBROUTINE SlD_PackDiscState + + SUBROUTINE SlD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SlD_DiscreteStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_UnPackDiscState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dll_states not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%dll_states)) DEALLOCATE(OutData%dll_states) + ALLOCATE(OutData%dll_states(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dll_states.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%dll_states,1), UBOUND(OutData%dll_states,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SlD_Unpackredwindllstates( Re_Buf, Db_Buf, Int_Buf, OutData%dll_states(i1), ErrStat2, ErrMsg2 ) ! dll_states + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + END SUBROUTINE SlD_UnPackDiscState + + SUBROUTINE SlD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SlD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData + TYPE(SlD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_CopyConstrState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState + END SUBROUTINE SlD_CopyConstrState + + SUBROUTINE SlD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + TYPE(SlD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_DestroyConstrState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE SlD_DestroyConstrState + + SUBROUTINE SlD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SlD_ConstraintStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_PackConstrState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyConstrState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE SlD_PackConstrState + + SUBROUTINE SlD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SlD_ConstraintStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_UnPackConstrState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE SlD_UnPackConstrState + + SUBROUTINE SlD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SlD_OtherStateType), INTENT(IN) :: SrcOtherStateData + TYPE(SlD_OtherStateType), INTENT(INOUT) :: DstOtherStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_CopyOtherState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState + END SUBROUTINE SlD_CopyOtherState + + SUBROUTINE SlD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + TYPE(SlD_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_DestroyOtherState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE SlD_DestroyOtherState + + SUBROUTINE SlD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SlD_OtherStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_PackOtherState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! DummyOtherState + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SlD_PackOtherState + + SUBROUTINE SlD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SlD_OtherStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_UnPackOtherState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SlD_UnPackOtherState + + SUBROUTINE SlD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SlD_MiscVarType), INTENT(IN) :: SrcMiscData + TYPE(SlD_MiscVarType), INTENT(INOUT) :: DstMiscData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_CopyMisc' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcMiscData%dll_data)) THEN + i1_l = LBOUND(SrcMiscData%dll_data,1) + i1_u = UBOUND(SrcMiscData%dll_data,1) + IF (.NOT. ALLOCATED(DstMiscData%dll_data)) THEN + ALLOCATE(DstMiscData%dll_data(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dll_data.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMiscData%dll_data,1), UBOUND(SrcMiscData%dll_data,1) + CALL SlD_Copyredwindlltype( SrcMiscData%dll_data(i1), DstMiscData%dll_data(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcMiscData%ForceTotal)) THEN + i1_l = LBOUND(SrcMiscData%ForceTotal,1) + i1_u = UBOUND(SrcMiscData%ForceTotal,1) + i2_l = LBOUND(SrcMiscData%ForceTotal,2) + i2_u = UBOUND(SrcMiscData%ForceTotal,2) + IF (.NOT. ALLOCATED(DstMiscData%ForceTotal)) THEN + ALLOCATE(DstMiscData%ForceTotal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ForceTotal.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%ForceTotal = SrcMiscData%ForceTotal +ENDIF + END SUBROUTINE SlD_CopyMisc + + SUBROUTINE SlD_DestroyMisc( MiscData, ErrStat, ErrMsg ) + TYPE(SlD_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_DestroyMisc' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(MiscData%dll_data)) THEN +DO i1 = LBOUND(MiscData%dll_data,1), UBOUND(MiscData%dll_data,1) + CALL SlD_Destroyredwindlltype( MiscData%dll_data(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(MiscData%dll_data) +ENDIF +IF (ALLOCATED(MiscData%ForceTotal)) THEN + DEALLOCATE(MiscData%ForceTotal) +ENDIF + END SUBROUTINE SlD_DestroyMisc + + SUBROUTINE SlD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SlD_MiscVarType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_PackMisc' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! dll_data allocated yes/no + IF ( ALLOCATED(InData%dll_data) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! dll_data upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%dll_data,1), UBOUND(InData%dll_data,1) + Int_BufSz = Int_BufSz + 3 ! dll_data: size of buffers for each call to pack subtype + CALL SlD_Packredwindlltype( Re_Buf, Db_Buf, Int_Buf, InData%dll_data(i1), ErrStat2, ErrMsg2, .TRUE. ) ! dll_data + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! dll_data + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! dll_data + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! dll_data + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! ForceTotal allocated yes/no + IF ( ALLOCATED(InData%ForceTotal) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! ForceTotal upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%ForceTotal) ! ForceTotal + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%dll_data) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dll_data,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dll_data,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%dll_data,1), UBOUND(InData%dll_data,1) + CALL SlD_Packredwindlltype( Re_Buf, Db_Buf, Int_Buf, InData%dll_data(i1), ErrStat2, ErrMsg2, OnlySize ) ! dll_data + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ForceTotal) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ForceTotal,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ForceTotal,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ForceTotal,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ForceTotal,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%ForceTotal,2), UBOUND(InData%ForceTotal,2) + DO i1 = LBOUND(InData%ForceTotal,1), UBOUND(InData%ForceTotal,1) + DbKiBuf(Db_Xferred) = InData%ForceTotal(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE SlD_PackMisc + + SUBROUTINE SlD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SlD_MiscVarType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_UnPackMisc' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dll_data not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%dll_data)) DEALLOCATE(OutData%dll_data) + ALLOCATE(OutData%dll_data(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dll_data.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%dll_data,1), UBOUND(OutData%dll_data,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SlD_Unpackredwindlltype( Re_Buf, Db_Buf, Int_Buf, OutData%dll_data(i1), ErrStat2, ErrMsg2 ) ! dll_data + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ForceTotal not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ForceTotal)) DEALLOCATE(OutData%ForceTotal) + ALLOCATE(OutData%ForceTotal(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ForceTotal.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%ForceTotal,2), UBOUND(OutData%ForceTotal,2) + DO i1 = LBOUND(OutData%ForceTotal,1), UBOUND(OutData%ForceTotal,1) + OutData%ForceTotal(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE SlD_UnPackMisc + + SUBROUTINE SlD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SlD_ParameterType), INTENT(IN) :: SrcParamData + TYPE(SlD_ParameterType), INTENT(INOUT) :: DstParamData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_CopyParam' +! + ErrStat = ErrID_None + ErrMsg = "" + DstParamData%DT = SrcParamData%DT + DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt + DstParamData%DLL_DT = SrcParamData%DLL_DT + DstParamData%RootName = SrcParamData%RootName + DstParamData%UseREDWINinterface = SrcParamData%UseREDWINinterface + DstParamData%RootFileName = SrcParamData%RootFileName + DstParamData%EchoFileName = SrcParamData%EchoFileName + DstParamData%SumFileName = SrcParamData%SumFileName + DstParamData%DLL_model = SrcParamData%DLL_model + DstParamData%CalcOption = SrcParamData%CalcOption +IF (ALLOCATED(SrcParamData%OutParam)) THEN + i1_l = LBOUND(SrcParamData%OutParam,1) + i1_u = UBOUND(SrcParamData%OutParam,1) + IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN + ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumPoints = SrcParamData%NumPoints + DstParamData%WtrDepth = SrcParamData%WtrDepth +IF (ALLOCATED(SrcParamData%Stiffness)) THEN + i1_l = LBOUND(SrcParamData%Stiffness,1) + i1_u = UBOUND(SrcParamData%Stiffness,1) + i2_l = LBOUND(SrcParamData%Stiffness,2) + i2_u = UBOUND(SrcParamData%Stiffness,2) + i3_l = LBOUND(SrcParamData%Stiffness,3) + i3_u = UBOUND(SrcParamData%Stiffness,3) + IF (.NOT. ALLOCATED(DstParamData%Stiffness)) THEN + ALLOCATE(DstParamData%Stiffness(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Stiffness.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%Stiffness = SrcParamData%Stiffness +ENDIF + DstParamData%DLL_OnlyStiff = SrcParamData%DLL_OnlyStiff + DstParamData%SlDNonLinearForcePortionOnly = SrcParamData%SlDNonLinearForcePortionOnly + END SUBROUTINE SlD_CopyParam + + SUBROUTINE SlD_DestroyParam( ParamData, ErrStat, ErrMsg ) + TYPE(SlD_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_DestroyParam' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + CALL FreeDynamicLib( ParamData%DLL_Trgt, ErrStat, ErrMsg ) +IF (ALLOCATED(ParamData%OutParam)) THEN +DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) + CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ParamData%OutParam) +ENDIF +IF (ALLOCATED(ParamData%Stiffness)) THEN + DEALLOCATE(ParamData%Stiffness) +ENDIF + END SUBROUTINE SlD_DestroyParam + + SUBROUTINE SlD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SlD_ParameterType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_PackParam' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Db_BufSz = Db_BufSz + 1 ! DT + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! DLL_Trgt: size of buffers for each call to pack subtype + CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! DLL_Trgt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! DLL_Trgt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! DLL_Trgt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! DLL_Trgt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Db_BufSz = Db_BufSz + 1 ! DLL_DT + Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName + Int_BufSz = Int_BufSz + 1 ! UseREDWINinterface + Int_BufSz = Int_BufSz + 1*LEN(InData%RootFileName) ! RootFileName + Int_BufSz = Int_BufSz + 1*LEN(InData%EchoFileName) ! EchoFileName + Int_BufSz = Int_BufSz + 1*LEN(InData%SumFileName) ! SumFileName + Int_BufSz = Int_BufSz + 1 ! DLL_model + Int_BufSz = Int_BufSz + 1 ! CalcOption + Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no + IF ( ALLOCATED(InData%OutParam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) + Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutParam + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutParam + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutParam + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! NumOuts + Int_BufSz = Int_BufSz + 1 ! NumPoints + Re_BufSz = Re_BufSz + 1 ! WtrDepth + Int_BufSz = Int_BufSz + 1 ! Stiffness allocated yes/no + IF ( ALLOCATED(InData%Stiffness) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Stiffness upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Stiffness) ! Stiffness + END IF + Int_BufSz = Int_BufSz + 1 ! DLL_OnlyStiff + Int_BufSz = Int_BufSz + 1 ! SlDNonLinearForcePortionOnly + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DLL_Trgt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + DbKiBuf(Db_Xferred) = InData%DLL_DT + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseREDWINinterface, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%EchoFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%EchoFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%SumFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%SumFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%DLL_model + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CalcOption + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumPoints + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDepth + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%Stiffness) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Stiffness,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stiffness,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Stiffness,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stiffness,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Stiffness,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stiffness,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Stiffness,3), UBOUND(InData%Stiffness,3) + DO i2 = LBOUND(InData%Stiffness,2), UBOUND(InData%Stiffness,2) + DO i1 = LBOUND(InData%Stiffness,1), UBOUND(InData%Stiffness,1) + DbKiBuf(Db_Xferred) = InData%Stiffness(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%DLL_OnlyStiff, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SlDNonLinearForcePortionOnly, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SlD_PackParam + + SUBROUTINE SlD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SlD_ParameterType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_UnPackParam' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL DLLTypeUnpack( OutData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! DLL_Trgt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%DLL_DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UseREDWINinterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseREDWINinterface) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootFileName) + OutData%RootFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%EchoFileName) + OutData%EchoFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%SumFileName) + OutData%SumFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%DLL_model = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CalcOption = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) + ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumPoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WtrDepth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Stiffness not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Stiffness)) DEALLOCATE(OutData%Stiffness) + ALLOCATE(OutData%Stiffness(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stiffness.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Stiffness,3), UBOUND(OutData%Stiffness,3) + DO i2 = LBOUND(OutData%Stiffness,2), UBOUND(OutData%Stiffness,2) + DO i1 = LBOUND(OutData%Stiffness,1), UBOUND(OutData%Stiffness,1) + OutData%Stiffness(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + OutData%DLL_OnlyStiff = TRANSFER(IntKiBuf(Int_Xferred), OutData%DLL_OnlyStiff) + Int_Xferred = Int_Xferred + 1 + OutData%SlDNonLinearForcePortionOnly = TRANSFER(IntKiBuf(Int_Xferred), OutData%SlDNonLinearForcePortionOnly) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE SlD_UnPackParam + + SUBROUTINE SlD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SlD_InputType), INTENT(INOUT) :: SrcInputData + TYPE(SlD_InputType), INTENT(INOUT) :: DstInputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_CopyInput' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL MeshCopy( SrcInputData%SoilMesh, DstInputData%SoilMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE SlD_CopyInput + + SUBROUTINE SlD_DestroyInput( InputData, ErrStat, ErrMsg ) + TYPE(SlD_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_DestroyInput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + CALL MeshDestroy( InputData%SoilMesh, ErrStat, ErrMsg ) + END SUBROUTINE SlD_DestroyInput + + SUBROUTINE SlD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SlD_InputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_PackInput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! SoilMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! SoilMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SoilMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SoilMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SoilMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL MeshPack( InData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! SoilMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE SlD_PackInput + + SUBROUTINE SlD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SlD_InputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_UnPackInput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! SoilMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE SlD_UnPackInput + + SUBROUTINE SlD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SlD_OutputType), INTENT(INOUT) :: SrcOutputData + TYPE(SlD_OutputType), INTENT(INOUT) :: DstOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_CopyOutput' +! + ErrStat = ErrID_None + ErrMsg = "" + DstOutputData%DummyOutput = SrcOutputData%DummyOutput +IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN + i1_l = LBOUND(SrcOutputData%WriteOutput,1) + i1_u = UBOUND(SrcOutputData%WriteOutput,1) + IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN + ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%WriteOutput = SrcOutputData%WriteOutput +ENDIF + CALL MeshCopy( SrcOutputData%SoilMesh, DstOutputData%SoilMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE SlD_CopyOutput + + SUBROUTINE SlD_DestroyOutput( OutputData, ErrStat, ErrMsg ) + TYPE(SlD_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_DestroyOutput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(OutputData%WriteOutput)) THEN + DEALLOCATE(OutputData%WriteOutput) +ENDIF + CALL MeshDestroy( OutputData%SoilMesh, ErrStat, ErrMsg ) + END SUBROUTINE SlD_DestroyOutput + + SUBROUTINE SlD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SlD_OutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_PackOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! DummyOutput + Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no + IF ( ALLOCATED(InData%WriteOutput) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput + END IF + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! SoilMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! SoilMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SoilMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SoilMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SoilMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%DummyOutput + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WriteOutput,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + CALL MeshPack( InData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! SoilMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE SlD_PackOutput + + SUBROUTINE SlD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SlD_OutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_UnPackOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DummyOutput = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WriteOutput)) DEALLOCATE(OutData%WriteOutput) + ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%SoilMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! SoilMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE SlD_UnPackOutput + + + SUBROUTINE SlD_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(SlD_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs + TYPE(SlD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_Input_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .ne. size(u)) then + CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) + RETURN + endif + order = SIZE(u) - 1 + IF ( order .eq. 0 ) THEN + CALL SlD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL SlD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 2 ) THEN + CALL SlD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE + CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) + RETURN + ENDIF + END SUBROUTINE SlD_Input_ExtrapInterp + + + SUBROUTINE SlD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = u1, f(t2) = u2 +! +!.................................................................................................................................. + + TYPE(SlD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 + TYPE(SlD_InputType), INTENT(INOUT) :: u2 ! Input at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs + TYPE(SlD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_Input_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) + CALL MeshExtrapInterp1(u1%SoilMesh, u2%SoilMesh, tin, u_out%SoilMesh, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END SUBROUTINE SlD_Input_ExtrapInterp1 + + + SUBROUTINE SlD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time +! values of u (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = u1, f(t2) = u2, f(t3) = u3 +! +!.................................................................................................................................. + + TYPE(SlD_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 + TYPE(SlD_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 + TYPE(SlD_InputType), INTENT(INOUT) :: u3 ! Input at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs + TYPE(SlD_InputType), INTENT(INOUT) :: u_out ! Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_Input_ExtrapInterp2' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + CALL MeshExtrapInterp2(u1%SoilMesh, u2%SoilMesh, u3%SoilMesh, tin, u_out%SoilMesh, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END SUBROUTINE SlD_Input_ExtrapInterp2 + + + SUBROUTINE SlD_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y +! +! expressions below based on either +! +! f(t) = a +! f(t) = a + b * t, or +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) +! +!.................................................................................................................................. + + TYPE(SlD_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 + REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs + TYPE(SlD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_Output_ExtrapInterp' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + if ( size(t) .ne. size(y)) then + CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) + RETURN + endif + order = SIZE(y) - 1 + IF ( order .eq. 0 ) THEN + CALL SlD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 1 ) THEN + CALL SlD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE IF ( order .eq. 2 ) THEN + CALL SlD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ELSE + CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) + RETURN + ENDIF + END SUBROUTINE SlD_Output_ExtrapInterp + + + SUBROUTINE SlD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 1. +! +! f(t) = a + b * t, or +! +! where a and b are determined as the solution to +! f(t1) = y1, f(t2) = y2 +! +!.................................................................................................................................. + + TYPE(SlD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 + TYPE(SlD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 + REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs + TYPE(SlD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(2) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_Output_ExtrapInterp1' + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / t(2) + b = -(y1%DummyOutput - y2%DummyOutput) + y_out%DummyOutput = y1%DummyOutput + b * ScaleFactor +IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO +END IF ! check if allocated + CALL MeshExtrapInterp1(y1%SoilMesh, y2%SoilMesh, tin, y_out%SoilMesh, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END SUBROUTINE SlD_Output_ExtrapInterp1 + + + SUBROUTINE SlD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) +! +! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time +! values of y (which has values associated with times in t). Order of the interpolation is 2. +! +! expressions below based on either +! +! f(t) = a + b * t + c * t**2 +! +! where a, b and c are determined as the solution to +! f(t1) = y1, f(t2) = y2, f(t3) = y3 +! +!.................................................................................................................................. + + TYPE(SlD_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 + TYPE(SlD_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 + TYPE(SlD_OutputType), INTENT(INOUT) :: y3 ! Output at t3 + REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs + TYPE(SlD_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + ! local variables + REAL(DbKi) :: t(3) ! Times associated with the Outputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + INTEGER(IntKi) :: order ! order of polynomial fit (max 2) + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation + INTEGER(IntKi) :: ErrStat2 ! local errors + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + CHARACTER(*), PARAMETER :: RoutineName = 'SlD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + IF ( EqualRealNos( t(1), t(2) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN + CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))* scaleFactor + c = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) * scaleFactor + y_out%DummyOutput = y1%DummyOutput + b + c * t_out +IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO +END IF ! check if allocated + CALL MeshExtrapInterp2(y1%SoilMesh, y2%SoilMesh, y3%SoilMesh, tin, y_out%SoilMesh, tin_out, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + END SUBROUTINE SlD_Output_ExtrapInterp2 + +END MODULE SoilDyn_Types +!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/soildyn/src/driver/SoilDyn_Driver.f90 b/modules/soildyn/src/driver/SoilDyn_Driver.f90 new file mode 100644 index 0000000000..9f917c55b9 --- /dev/null +++ b/modules/soildyn/src/driver/SoilDyn_Driver.f90 @@ -0,0 +1,370 @@ +!********************************************************************************************************************************** +!> ## SoilDyn_DriverCode: This code tests the SoilDyn module +!!.................................................................................................................................. +!! LICENSING +!! Copyright (C) 2012, 2015 National Renewable Energy Laboratory +!! +!! This file is part of SoilDyn. +!! +!! 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. +!********************************************************************************************************************************** +PROGRAM SoilDyn_Driver + + USE NWTC_Library + USE VersionInfo + USE SoilDyn + USE SoilDyn_Types + USE SoilDyn_Driver_Subs + USE SoilDyn_Driver_Types + USE REDWINinterface, only: REDWINinterface_GetStiffMatrix + + IMPLICIT NONE + + TYPE( ProgDesc ), PARAMETER :: ProgInfo = ProgDesc("SlD_Driver","","") + INTEGER(IntKi) :: SlDDriver_Verbose = 5 ! Verbose level. 0 = none, 5 = some, 10 = lots + + + + integer(IntKi), parameter :: NumInp = 1 !< Number of inputs sent to SoilDyn_UpdateStates + + ! Program variables + real(DbKi) :: Time !< Variable for storing time, in seconds + real(DbKi) :: TimeInterval !< Interval between time steps, in seconds + real(DbKi) :: TStart !< Time to start + real(DbKi) :: TMax !< Maximum time if found by default + integer(IntKi) :: NumTSteps !< number of timesteps + logical :: TimeIntervalFound !< Interval between time steps, in seconds + real(DbKi) :: InputTime(NumInp) !< Variable for storing time associated with inputs, in seconds + real(R8Ki), allocatable :: DisplacementList(:,:) !< List of displacements and times to apply {idx 1 = time step, idx 2 = [T, dX, dY, dZ, dTheta_X, dTheta_Y, dTheta_Z]} + + type(SlD_InitInputType) :: InitInData !< Input data for initialization + type(SlD_InitOutputType) :: InitOutData !< Output data from initialization + + type(SlD_ContinuousStateType) :: x !< Continuous states + type(SlD_DiscreteStateType) :: xd !< Discrete states + type(SlD_ConstraintStateType) :: z !< Constraint states + type(SlD_ConstraintStateType) :: Z_residual !< Residual of the constraint state functions (Z) + type(SlD_OtherStateType) :: OtherState !< Other states + type(SlD_MiscVarType) :: misc !< Optimization variables + + type(SlD_ParameterType) :: p !< Parameters + type(SlD_InputType) :: u(NumInp) !< System inputs + type(SlD_OutputType) :: y !< System outputs + + ! Local variables for this code + TYPE(SlDDriver_Flags) :: CLSettingsFlags ! Flags indicating which command line arguments were specified + TYPE(SlDDriver_Settings) :: CLSettings ! Command line arguments passed in + TYPE(SlDDriver_Flags) :: SettingsFlags ! Flags indicating which settings were specified (includes CL and ipt file) + TYPE(SlDDriver_Settings) :: Settings ! Driver settings + REAL(DbKi) :: Timer(1:2) ! Keep track of how long this takes to run + + ! Data transfer + real(R8Ki) :: Force(6) + real(R8Ki) :: Displacement(6) + real(R8Ki) :: StiffMatrix(6,6) + real(R8Ki) :: Theta(3) + + INTEGER(IntKi) :: n !< Loop counter (for time step) + integer(IntKi) :: i !< generic loop counter + integer(IntKi) :: DimIdx !< Index of current dimension + integer(IntKi) :: TmpIdx(6) !< Index of last point accessed by dimension + INTEGER(IntKi) :: ErrStat !< Status of error message + CHARACTER(ErrMsgLen) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + CHARACTER(200) :: git_commit ! String containing the current git commit hash + TYPE(ProgDesc), PARAMETER :: version = ProgDesc( 'SoilDyn Driver', '', '' ) ! The version number of this program. + integer(IntKi) :: DvrOut + character(1024) :: OutputFileRootName + + + ! initialize library + call NWTC_Init + call DispNVD(ProgInfo) + DvrOut=-1 ! Set output unit to negative + + ! Display the copyright notice + CALL DispCopyrightLicense( version%Name ) + ! Obtain OpenFAST git commit hash + git_commit = QueryGitVersion() + ! Tell our users what they're running + CALL WrScr( ' Running '//GetNVD( version )//' a part of OpenFAST - '//TRIM(git_Commit)//NewLine//' linked with '//TRIM( GetNVD( NWTC_Ver ))//NewLine ) + + ! Start the timer + call CPU_TIME( Timer(1) ) + + ! Initialize the driver settings to their default values (same as the CL -- command line -- values) + call InitSettingsFlags( ProgInfo, CLSettings, CLSettingsFlags ) + Settings = CLSettings + SettingsFlags = CLSettingsFlags + + ! Parse the input line + call RetrieveArgs( CLSettings, CLSettingsFlags, ErrStat, ErrMsg ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL ProgAbort( ErrMsg ) + ELSEIF ( ErrStat /= 0 ) THEN + CALL WrScr( NewLine//ErrMsg ) + ErrStat = ErrID_None + ENDIF + + ! Check if we are doing verbose error reporting + IF ( CLSettingsFlags%VVerbose ) SlDDriver_Verbose = 10_IntKi + IF ( CLSettingsFlags%Verbose ) SlDDriver_Verbose = 7_IntKi + + ! Verbose error reporting + IF ( SlDDriver_Verbose >= 10_IntKi ) THEN + CALL WrScr('--- Settings from the command line: ---') + CALL printSettings( CLSettingsFlags, CLSettings ) + CALL WrSCr(NewLine) + ENDIF + + ! Verbose error reporting + IF ( SlDDriver_Verbose >= 10_IntKi ) THEN + CALL WrScr('--- Driver settings (before reading driver ipt file): ---') + CALL printSettings( SettingsFlags, Settings ) + CALL WrScr(NewLine) + ENDIF + + + ! Copy the input file information from the CLSettings to the Settings. + ! At this point only one input file type can be set. + IF ( CLSettingsFlags%DvrIptFile ) THEN + SettingsFlags%DvrIptFile = CLSettingsFlags%DvrIptFile + Settings%DvrIptFileName = CLSettings%DvrIptFileName + ELSE + SettingsFlags%SlDIptFile = CLSettingsFlags%SlDIptFile + Settings%SlDIptFileName = CLSettings%SlDIptFileName + ENDIF + + ! If the filename given was not the SlD input file (-ifw option), then it is treated + ! as the driver input file (flag should be set correctly by RetrieveArgs). So, we must + ! open this. + IF ( SettingsFlags%DvrIptFile ) THEN + + ! Read the driver input file + CALL ReadDvrIptFile( CLSettings%DvrIptFileName, SettingsFlags, Settings, ProgInfo, ErrStat, ErrMsg ) + call CheckErr('') + + ! VVerbose error reporting + IF ( SlDDriver_Verbose >= 10_IntKi ) THEN + CALL WrScr(NewLine//'--- Driver settings after reading the driver ipt file: ---') + CALL printSettings( SettingsFlags, Settings ) + CALL WrScr(NewLine) + ENDIF + + ! VVerbose error reporting + IF ( SlDDriver_Verbose >= 10_IntKi ) CALL WrScr('Updating driver settings with command line arguments') + + ELSE + + ! VVerbose error reporting + IF ( SlDDriver_Verbose >= 10_IntKi ) CALL WrScr('No driver input file used. Updating driver settings with command line arguments') + + ENDIF + + ! Since there were no settings picked up from the driver input file, we need to copy over all + ! the CLSettings into the regular Settings. The SettingsFlags%DvrIptFile is a flag indicating + ! if the driver input file read. + CALL UpdateSettingsWithCL( SettingsFlags, Settings, CLSettingsFlags, CLSettings, SettingsFlags%DvrIptFile, ErrStat, ErrMsg ) + call CheckErr('') + + ! Verbose error reporting + IF ( SlDDriver_Verbose >= 10_IntKi ) THEN + CALL WrScr(NewLine//'--- Driver settings after copying over CL settings: ---') + CALL printSettings( SettingsFlags, Settings ) + CALL WrScr(NewLine) + ENDIF + + + !------------------------------------------ + ! Read DisplacementList from InputDispFile + ! NOTE: DiplacementList is arranged for speed in interpolation + ! -- index 1 = time step + ! -- index 2 = [T, dX, dY, dZ, dTheta_X, dTheta_Y, dTheta_Z] + !------------------------------------------ + if ( SettingsFlags%InputDispFile ) then + call ReadInputDispFile( Settings%InputDispFile, DisplacementList, ErrStat, ErrMsg ) + call CheckErr('') + + if ( SlDDriver_Verbose >= 10_IntKi ) call WrScr('Input Displacements given for '//trim(Num2LStr(size(DisplacementList,1)))// & + ' time steps from T = '//trim(Num2LStr(DisplacementList(1,1)))//' to '//trim(Num2LStr(DisplacementList(size(DisplacementList,1),1)))//' seconds.') + endif + + + !------------------------------------------ + ! Logic for timestep and total time for sim. + !------------------------------------------ + if ( SettingsFlags%TStart ) then + TStart = Settings%TStart + else + TStart = 0.0_DbKi + ! TODO: if using the input file, could start at the initial time given there (set the TStart with a "default" input option) + endif + + + + TimeIntervalFound=.true. ! If specified or default value set + ! DT - timestep. If default was specified, then calculate default level. + if ( SettingsFlags%DTdefault ) then + if ( SettingsFlags%InputDispFile ) then + ! Set a value to start with (something larger than any expected DT). + TimeIntervalFound=.false. + TimeInterval=1000.0_DbKi + ! Step through all lines to get smallest DT + do n=min(2,size(DisplacementList,1)),size(DisplacementList,1) ! Start at 2nd point (min to avoid stepping over end for single line files) + TimeInterval=min(TimeInterval, real(DisplacementList(n,1)-DisplacementList(n-1,1), DbKi)) + TimeIntervalFound=.true. + enddo + if (TimeIntervalFound) then + call WrScr('Using smallest DT from data file: '//trim(Num2LStr(TimeInterval))//' seconds.') + else + call WrScr('No time timesteps found in input displacement file. Using only one timestep.') + endif + else + ! set default level. NOTE: the REDWIN dll does not use any form of timestep, so this is merely for bookkeeping. + TimeInterval = 0.01_DbKi + call WrScr('Setting default timestep to '//trim(Num2LStr(TimeInterval))//' seconds.') + endif + endif + + + ! TMax and NumTSteps from input file or from the value specified (specified overrides) + if ( SettingsFlags%NumTimeStepsDefault ) then + if ( SettingsFlags%InputDispFile ) then + TMax = real(DisplacementList(size(DisplacementList,1),1), DbKi) + NumTSteps = ceiling( TMax / TimeInterval ) + else ! Do one timestep + NumTSteps = 1_IntKi + TMax = TimeInterval * NumTSteps + endif + elseif ( SettingsFlags%NumTimeSteps ) then ! Override with number of timesteps + TMax = TimeInterval * Settings%NumTimeSteps + TStart + NumTSteps = Settings%NumTimeSteps + else + NumTSteps = 1_IntKi + TMax = TimeInterval * NumTSteps + endif + + + + ! Routines called in initialization + !............................................................................................................................... + + InitInData%InputFile = Settings%SldIptFileName + InitInData%SlDNonLinearForcePortionOnly = SettingsFlags%SlDNonLinearForcePortionOnly + + ! Initialize the module + CALL SlD_Init( InitInData, u(1), p, x, xd, z, OtherState, y, misc, TimeInterval, InitOutData, ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( 'After Init: '//ErrMsg ) + if ( ErrStat >= AbortErrLev ) call ProgEnd() + END IF + + ! Set the output file + call GetRoot(Settings%SlDIptFileName,OutputFileRootName) + call Dvr_InitializeOutputFile(DvrOut, InitOutData, OutputFileRootName, ErrStat, ErrMsg) + call CheckErr('Setting output file'); + + ! Destroy initialization data + CALL SlD_DestroyInitInput( InitInData, ErrStat, ErrMsg ) + CALL SlD_DestroyInitOutput( InitOutData, ErrStat, ErrMsg ) + + + ! If requested, get the stiffness matrix + if ( SettingsFlags%StiffMatOut .and. p%CalcOption==Calc_REDWIN ) then + do i=1,size(misc%dll_data) + call WrScr('Stiffness matrix for point '//trim(Num2LStr(i))//' at T = 0') + call WrMatrix( p%Stiffness(1:6,1:6,i), CU, '(ES12.4)', ' StiffMatrix' ) + enddo + endif + + + ! Routines called in loose coupling -- the glue code may implement this in various ways + !............................................................................................................................... + + + TmpIdx(1:6) = 0_IntKi + + DO n = 0,NumTSteps + Time = n*TimeInterval+TStart + InputTime(1) = Time + + ! interpolate into the input data to get the displacement. Set this as u then run + if ( SettingsFlags%InputDispFile ) then + do i=1,u(1)%SoilMesh%NNodes + ! InterpStpReal( X, Xary, Yary, indx, size) + do DimIdx=1,3 + u(1)%SoilMesh%TranslationDisp(DimIdx,i) = InterpStpReal8( real(Time,R8Ki), DisplacementList(:,1), DisplacementList(:,DimIdx+1), TmpIdx(DimIdx), size(DisplacementList,1) ) + enddo + do DimIdx=1,3 + Theta(DimIdx) = InterpStpReal8( real(Time,R8Ki), DisplacementList(:,1), DisplacementList(:,DimIdx+4), TmpIdx(DimIdx), size(DisplacementList,1) ) + enddo + u(1)%SoilMesh%Orientation(1:3,1:3,i) = EulerConstruct(Theta) + enddo + endif + + ! Calculate outputs at n + CALL SlD_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ); + call CheckErr('After CalcOutput: '); + + ! There are no states to update in SoilDyn, but for completeness we add this. + ! Get state variables at next step: INPUT at step n, OUTPUT at step n + 1 + CALL SlD_UpdateStates( Time, n, u, InputTime, p, x, xd, z, OtherState, misc, ErrStat, ErrMsg ); + call CheckErr(''); + + !call Dvr_WriteOutputLine(Time,DvrOut,p%OutFmt,y) + call Dvr_WriteOutputLine(Time,DvrOut,"ES20.12E2",y) + END DO + + + + ! If requested, get the stiffness matrix using whatever the last value of displacement was + if ( SettingsFlags%StiffMatOut .and. p%CalcOption==Calc_REDWIN ) then + do i=1,size(misc%dll_data) + ! Copy displacement from point mesh + Displacement(1:3) = u(1)%SoilMesh%TranslationDisp(1:3,i) ! Translations -- This is R8Ki in the mesh + Displacement(4:6) = EulerExtract(u(1)%SoilMesh%Orientation(1:3,1:3,i)) ! Small angle assumption should be valid here -- Note we are assuming reforientation is 0 + call REDWINinterface_GetStiffMatrix( p%DLL_Trgt, p%DLL_Model, Displacement, Force, StiffMatrix, misc%dll_data(i), ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( 'Get stiffness: '//ErrMsg ) + if ( ErrStat >= AbortErrLev ) call ProgEnd() + END IF + + call WrScr('Stiffness matrix for point '//trim(Num2LStr(i))//' at T = '//trim(Num2LStr(TMax))) + call WrMatrix( StiffMatrix, CU, '(ES12.4)', ' StiffMatrix' ) + enddo + endif + + + !............................................................................................................................... + ! Routine to terminate program execution + !............................................................................................................................... + if (DvrOut>0) close(DvrOut) + CALL SlD_End( u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ) + + IF ( ErrStat /= ErrID_None ) THEN + CALL WrScr( 'After End: '//ErrMsg ) + END IF + +CONTAINS + subroutine CheckErr(Text) + character(*), intent(in) :: Text + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( Text//ErrMsg ) + if ( ErrStat >= AbortErrLev ) call ProgEnd() + END IF + end subroutine CheckErr + subroutine ProgEnd() + ! Placeholder for moment + Call ProgAbort('Fatal error encountered. Ending.') + end subroutine ProgEnd +END PROGRAM SoilDyn_Driver diff --git a/modules/soildyn/src/driver/SoilDyn_Driver_Subs.f90 b/modules/soildyn/src/driver/SoilDyn_Driver_Subs.f90 new file mode 100644 index 0000000000..6b934fa6b9 --- /dev/null +++ b/modules/soildyn/src/driver/SoilDyn_Driver_Subs.f90 @@ -0,0 +1,1143 @@ +!********************************************************************************************************************************** +! +! MODULE: SoilDyn_Driver_Subs - This module contains subroutines used by the SoilDyn Driver program +! +!********************************************************************************************************************************** +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2020 National Renewable Energy Laboratory +! +! This file is part of SoilDyn. +! +! 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 SoilDyn_Driver_Subs + + USE NWTC_Library + USE SoilDyn_Driver_Types + IMPLICIT NONE + +! NOTE: This is loosely based on the InflowWind driver code. + +CONTAINS +!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +!> Print out help information +SUBROUTINE DispHelpText() + ! Statement about usage + CALL WrScr("") + CALL WrScr(" Syntax: SoilDyn_Driver [options]") + CALL WrScr("") + CALL WrScr(" where: -- Name of driver input file to use") + CALL WrScr(" options: "//SWChar//"sld -- treat as name of SoilDyn input file") + CALL WrScr(" (no driver input file)") + CALL WrScr("") + CALL WrScr(" The following options will overwrite values in the driver input file:") + CALL WrScr(" "//SwChar//"DT[#] -- timestep ") + CALL WrScr(" "//SwChar//"TStart[#] -- start time ") + CALL WrScr(" "//SwChar//"TSteps[#] -- number of timesteps ") + CALL WrScr(" "//SwChar//"v -- verbose output ") + CALL WrScr(" "//SwChar//"vv -- very verbose output ") + CALL WrScr(" "//SwChar//"NonLinear -- only return non-linear portion of reaction force") + CALL WrScr(" "//SwChar//"help -- print this help menu and exit") + CALL WrScr("") + CALL WrScr(" Notes:") + CALL WrScr(" -- Options are not case sensitive.") + CALL WrScr("") +!FIXME: update this +END SUBROUTINE DispHelpText + + +subroutine InitSettingsFlags( ProgInfo, CLSettings, CLFlags ) + implicit none + ! Storing the arguments + type( ProgDesc ), intent(in ) :: ProgInfo + type( SlDDriver_Settings ), intent( out) :: CLSettings !< Command line arguments passed in + type( SlDDriver_Flags ), intent( out) :: CLFlags !< Flags indicating which command line arguments were specified + + ! Set some CLSettings to null/default values + CLSettings%DvrIptFileName = "" ! No input name name until set + CLSettings%SlDIptFileName = "" ! No SlD input file name until set + CLSettings%InputDispFile = "" ! No SlD input displacement timeseries file name until set + CLSettings%NumTimeSteps = 0_IntKi + CLSettings%DT = 0.0_DbKi + CLSettings%TStart = 0.0_ReKi + CLSettings%ProgInfo = ProgInfo ! Driver info + + ! Set some CLFlags to null/default values + CLFlags%DvrIptFile = .FALSE. ! Driver input filename given as command line argument + CLFlags%SlDIptFile = .FALSE. ! SoilDyn input filename given as command line argument + CLFlags%InputDispFile = .FALSE. ! No SlD input displacement timeseries file name until set + CLFlags%TStart = .FALSE. ! specified time to start at + CLFlags%StiffMatOut = .FALSE. ! stiffness matrix output at start and end + CLFlags%NumTimeSteps = .FALSE. ! specified a number of timesteps + CLFlags%NumTimeStepsDefault = .FALSE. ! specified 'DEFAULT' for number of timesteps + CLFlags%DT = .FALSE. ! specified a resolution in time + CLFlags%DTDefault = .FALSE. ! specified 'DEFAULT' for resolution in time + CLFlags%Verbose = .FALSE. ! Turn on verbose error reporting? + CLFlags%VVerbose = .FALSE. ! Turn on very verbose error reporting? + CLFlags%SlDNonLinearForcePortionOnly = .FALSE. ! Report only non-linear portion of forces + +end subroutine InitSettingsFlags + +!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +!> This subroutine retrieves the command line arguments and passes them to the +!! SoilDyn_driver_subs::parsearg routine for processing. +SUBROUTINE RetrieveArgs( CLSettings, CLFlags, ErrStat, ErrMsg ) + ! Storing the arguments + type( SlDDriver_Flags ), intent( out) :: CLFlags !< Flags indicating which command line arguments were specified + type( SlDDriver_Settings ), intent( out) :: CLSettings !< Command line arguments passed in + integer(IntKi), intent( out) :: ErrStat + CHARACTER(*), intent( out) :: ErrMsg + + ! Local variable + integer(IntKi) :: i !< Generic counter + character(1024) :: Arg !< argument given + character(1024) :: ArgUC !< Upper case argument to check + integer(IntKi) :: NumInputArgs !< Number of argements passed in from command line + logical :: sldFlag !< The -sld flag was set + character(1024) :: FileName !< Filename from the command line. + logical :: FileNameGiven !< Flag indicating if a filename was given. + integer(IntKi) :: ErrStatTmp !< Temporary error status (for calls) + character(1024) :: ErrMsgTmp !< Temporary error message (for calls) + + ! initialize some things + CLFlags%DvrIptFile = .FALSE. + ErrStat = ErrID_None + ErrStatTmp = ErrID_None + ErrMsg = '' + ErrMsgTmp = '' + sldFlag = .FALSE. + FileNameGiven = .FALSE. + FileName = '' + + ! Check how many arguments are passed in + NumInputArgs = COMMAND_ARGUMENT_COUNT() + + ! exit if we don't have enough + IF (NumInputArgs == 0) THEN + CALL SetErrStat(ErrID_Fatal," Insufficient Arguments. Use option "//SwChar//"help for help menu.", & + ErrStat,ErrMsg,'RetrieveArgs') + RETURN + ENDIF + + + ! Loop through all the arguments, and store them + DO i=1,NumInputArgs + ! get the ith argument + CALL get_command_argument(i, Arg) + ArgUC = Arg + + ! convert to uppercase + CALL Conv2UC( ArgUC ) + + ! Check to see if it is a control parameter or the filename + IF ( INDEX( SwChar, ArgUC(1:1) ) > 0 ) THEN + + ! check to see if we asked for help + IF ( ArgUC(2:5) == "HELP" ) THEN + CALL DispHelpText() + CALL ProgExit(0) + ENDIF + + + ! Check the argument and put it where it belongs + ! chop the SwChar off before passing the argument + CALL ParseArg( CLSettings, CLFlags, ArgUC(2:), Arg(2:), sldFlag, ErrStatTmp, ErrMsgTmp ) + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'RetrieveArgs') + IF (ErrStat>AbortErrLev) RETURN + + ELSE + + ! since there is no switch character, assume it is the filename, unless we already set one + IF ( FileNameGiven ) THEN + CALL SetErrStat(ErrID_Fatal," Multiple driver input filenames given: "//TRIM(FileName)//", "//TRIM(Arg), & + ErrStat,ErrMsg,'RetrieveArgs') + RETURN + ELSE + FileName = TRIM(Arg) + FileNameGiven = .TRUE. + ENDIF + + ENDIF + END DO + + + ! Was a filename given? + IF ( .NOT. FileNameGiven ) THEN + CALL SetErrStat( ErrID_Fatal, " No filename given.", ErrStat, ErrMsg, 'RetrieveArgs' ) + RETURN + ENDIF + + ! Was the -sld flag set? If so, the filename is the SoilDyn input file. Otherwise + ! it is the driver input file. + IF ( sldFlag ) THEN + CLSettings%SlDIptFileName = TRIM(FileName) + CLFlags%SlDIptFile = .TRUE. + ELSE + CLSettings%DvrIptFileName = TRIM(FileName) + CLFlags%DvrIptFile = .TRUE. + ENDIF + + + + !------------------------------------------------------------------------------- + !------------------------------------------------------------------------------- + CONTAINS + + + !------------------------------------------------------------------------------- + !> Convert a string to a real number + FUNCTION StringToReal( StringIn, ErrStat ) + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT(IN ) :: StringIn + + REAL(ReKi) :: StringToReal + INTEGER(IntKi) :: ErrStatTmp ! Temporary variable to hold the error status + + read( StringIn, *, iostat=ErrStatTmp) StringToReal + + ! If that isn't a number, only warn since we can continue by skipping this value + IF ( ErrStatTmp .ne. 0 ) ErrStat = ErrID_Warn + + END FUNCTION StringToReal + + + + !------------------------------------------------------------------------------- + SUBROUTINE ParseArg( CLSettings, CLFlags, ThisArgUC, ThisArg, sldFlagSet, ErrStat, ErrMsg ) + !-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-! + ! Parse and store the input argument ! + !-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-! + + USE NWTC_Library + USE SoilDyn_Driver_Types + USE SoilDyn_Types + + IMPLICIT NONE + + ! Storing the arguments + TYPE( SlDDriver_Flags ), INTENT(INOUT) :: CLFlags ! Flags indicating which arguments were specified + TYPE( SlDDriver_Settings ), INTENT(INOUT) :: CLSettings ! Arguments passed in + + CHARACTER(*), INTENT(IN ) :: ThisArgUC ! The current argument (upper case for testing) + CHARACTER(*), INTENT(IN ) :: ThisArg ! The current argument (as passed in for error messages) + LOGICAL, INTENT(INOUT) :: sldFlagSet ! Was the -sld flag given? + + ! Error Handling + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + + ! local variables + INTEGER(IntKi) :: Delim1 ! where the [ is + INTEGER(IntKi) :: Delim2 ! where the ] is + INTEGER(IntKi) :: DelimSep ! where the : is + REAL(ReKi) :: TempReal ! temp variable to hold a real + + INTEGER(IntKi) :: ErrStatTmp ! Temporary error status for calls + + + + ! Initialize some things + ErrStat = ErrID_None + ErrStatTmp = ErrID_None + ErrMsg = '' + + ! Get the delimiters -- returns 0 if there isn't one + Delim1 = INDEX(ThisArgUC,'[') + Delim2 = INDEX(ThisArgUC,']') + DelimSep = INDEX(ThisArgUC,':') + + + ! check that if there is an opening bracket, then there is a closing one + IF ( (Delim1 > 0_IntKi ) .and. (Delim2 < Delim1) ) THEN + CALL SetErrStat(ErrID_Warn," Syntax error in option: '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & + ErrStat,ErrMsg,'ParseArg') + RETURN + ENDIF + + ! check that if there is a colon, then there are brackets + IF ( (DelimSep > 0_IntKi) .and. (Delim1 == 0_IntKi) ) THEN + CALL SetErrStat(ErrID_Warn," Syntax error in option: '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & + ErrStat,ErrMsg,'ParseArg') + RETURN + ENDIF + + + ! If no delimeters were given, than this option is simply a flag + IF ( Delim1 == 0_IntKi ) THEN + ! check to see if the filename is the name of the SlD input file + IF ( ThisArgUC(1:9) == "NONLINEAR" ) THEN + CLFlags%SlDNonLinearForcePortionOnly = .TRUE. + RETURN + ELSEIF ( ThisArgUC(1:3) == "SLD" ) THEN + sldFlagSet = .TRUE. ! More logic in the routine that calls this one to set things. + RETURN + ELSEIF ( ThisArgUC(1:2) == "VV" ) THEN + CLFlags%VVerbose = .TRUE. + RETURN + ELSEIF ( ThisArgUC(1:1) == "V" ) THEN + CLFlags%Verbose = .TRUE. + RETURN + ELSE + CALL SetErrStat( ErrID_Warn," Unrecognized option '"//SwChar//TRIM(ThisArg)//"'. Ignoring. Use option "//SwChar//"help for list of options.", & + ErrStat,ErrMsg,'ParseArg') + ENDIF + + ENDIF + + + ! "DT[#]" + IF( ThisArgUC(1:Delim1) == "DT[" ) THEN + TempReal = StringToReal( ThisArgUC(Delim1+1:Delim2-1), ErrStat ) + IF ( ErrStat == ErrID_None ) THEN + CLFlags%Dt = .TRUE. + CLSettings%DT = abs(TempReal) + ELSE + CLFlags%Dt = .FALSE. + IF ( ErrStat == ErrID_Warn ) THEN + CALL SetErrStat(ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & + ErrStat,ErrMsg,'ParseArgs') + ELSE + CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & + ErrStat, ErrMsg, 'ParseArg') + ENDIF + RETURN + ENDIF + + + ! "TSTEPS[#]" + ELSEIF( ThisArgUC(1:Delim1) == "TSTEPS[" ) THEN + TempReal = StringToReal( ThisArgUC(Delim1+1:Delim2-1), ErrStat ) + IF ( ErrStat == ErrID_None ) THEN + CLFlags%NumTimeSteps = .TRUE. + CLSettings%NumTimeSteps = nint(abs(TempReal)) + ELSE + CLFlags%NumTimeSteps = .FALSE. + CLSettings%NumTimeSteps = 1_IntKi + IF ( ErrStat == ErrID_Warn ) THEN + CALL SetErrStat(ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & + ErrStat,ErrMsg,'ParseArgs') + ELSE + CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & + ErrStat, ErrMsg, 'ParseArg') + ENDIF + RETURN + ENDIF + + + + ! "TSTART[#]" + ELSEIF( ThisArgUC(1:Delim1) == "TSTART[" ) THEN + TempReal = StringToReal( ThisArgUC(Delim1+1:Delim2-1), ErrStat ) + IF ( ErrStat == ErrID_None ) THEN + CLFlags%TStart = .TRUE. + CLSettings%TStart = abs(TempReal) + ELSE + CLFlags%TStart = .FALSE. + IF ( ErrStat == ErrID_Warn ) THEN + CALL SetErrStat(ErrStatTmp," Invalid number in option '"//SwChar//TRIM(ThisArg)//"'. Ignoring.", & + ErrStat,ErrMsg,'ParseArgs') + ELSE + CALL SetErrStat( ErrID_Fatal," Something failed in parsing option '"//SwChar//TRIM(ThisArg)//"'.", & + ErrStat, ErrMsg, 'ParseArg') + ENDIF + RETURN + ENDIF +!FIXME: add in the other inputs here. + + ELSE + ErrMsg = " Unrecognized option: '"//SwChar//TRIM(ThisArg)//"'. Ignoring. Use option "//SwChar//"help for list of options." + ErrStat = ErrID_Warn + ENDIF + + END SUBROUTINE ParseArg + !------------------------------------------------------------------------------- + +END SUBROUTINE RetrieveArgs + + +!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- +!> This subroutine reads the driver input file and sets up the flags and settings +!! for the driver code. Any settings from the command line options will override +!! this. +SUBROUTINE ReadDvrIptFile( DvrFileName, DvrFlags, DvrSettings, ProgInfo, ErrStat, ErrMsg ) + + CHARACTER(1024), INTENT(IN ) :: DvrFileName + TYPE(SlDDriver_Flags), INTENT(INOUT) :: DvrFlags + TYPE(SlDDriver_Settings), INTENT(INOUT) :: DvrSettings + TYPE(ProgDesc), INTENT(IN ) :: ProgInfo + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! returns a non-zero value when an error occurs + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Local variables + INTEGER(IntKi) :: UnIn ! Unit number for the driver input file + CHARACTER(1024) :: FileName ! Name of SoilDyn driver input file + + ! Input file echoing + LOGICAL :: EchoFileContents ! Do we echo the driver file out or not? + INTEGER(IntKi) :: UnEchoLocal ! The local unit number for this module's echo file + CHARACTER(1024) :: EchoFileName ! Name of SoilDyn driver echo file + + ! Time steps + CHARACTER(1024) :: InputChr ! Character string for timesteps and input file names (to handle DEFAULT or NONE value) + + ! Local error handling + INTEGER(IntKi) :: ios !< I/O status + INTEGER(IntKi) :: ErrStatTmp !< Temporary error status for calls + CHARACTER(1024) :: ErrMsgTmp !< Temporary error messages for calls + + + ! Initialize the echo file unit to -1 which is the default to prevent echoing, we will alter this based on user input + UnEchoLocal = -1 + + FileName = TRIM(DvrFileName) + + CALL GetNewUnit( UnIn ) + CALL OpenFInpFile( UnIn, FileName, ErrStatTmp, ErrMsgTmp ) + IF ( ErrStatTmp /= ErrID_None ) THEN + CALL SetErrStat(ErrID_Fatal,' Failed to open SoilDyn Driver input file: '//FileName, & + ErrStat,ErrMsg,'ReadDvrIptFile') + CLOSE( UnIn ) + RETURN + ENDIF + + + CALL WrScr( 'Opening SoilDyn Driver input file: '//trim(FileName) ) + + + !------------------------------------------------------------------------------------------------- + ! File header + !------------------------------------------------------------------------------------------------- + + CALL ReadCom( UnIn, FileName,' SoilDyn Driver input file header line 1', ErrStatTmp, ErrMsgTmp ) + if (Failed()) return + + CALL ReadCom( UnIn, FileName, 'SoilDyn Driver input file header line 2', ErrStatTmp, ErrMsgTmp ) + if (Failed()) return + + CALL ReadCom( UnIn, FileName, 'SoilDyn Driver input file seperator line', ErrStatTmp, ErrMsgTmp ) + if (Failed()) return + + ! Echo Input Files. + CALL ReadVar ( UnIn, FileName, EchoFileContents, 'Echo', 'Echo Input', ErrStatTmp, ErrMsgTmp ) + if (Failed()) return + + + ! If we are Echoing the input then we should re-read the first three lines so that we can echo them + ! using the NWTC_Library routines. The echoing is done inside those routines via a global variable + ! which we must store, set, and then replace on error or completion. + + IF ( EchoFileContents ) THEN + + EchoFileName = TRIM(FileName)//'.ech' + CALL GetNewUnit( UnEchoLocal ) + CALL OpenEcho ( UnEchoLocal, EchoFileName, ErrStatTmp, ErrMsgTmp, ProgInfo ) + if (Failed()) return + + REWIND(UnIn) + + ! Reread and echo + CALL ReadCom( UnIn, FileName,' SoilDyn Driver input file header line 1', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) + if (Failed()) return + + CALL ReadCom( UnIn, FileName, 'SoilDyn Driver input file header line 2', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) + if (Failed()) return + + CALL ReadCom( UnIn, FileName, 'SoilDyn Driver input file seperator line', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) + if (Failed()) return + + ! Echo Input Files. + CALL ReadVar ( UnIn, FileName, EchoFileContents, 'Echo', 'Echo Input', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) + if (Failed()) return + + ENDIF + + + !------------------------------------------------------------------------------------------------- + ! Driver setup section + !------------------------------------------------------------------------------------------------- + + ! Header + CALL ReadCom( UnIn, FileName,' Driver setup section, comment line', ErrStatTmp, ErrMsgTmp, UnEchoLocal ) + if (Failed()) return + + ! SoilDyn input file + CALL ReadVar( UnIn, FileName,DvrSettings%SlDIptFileName,'SlDIptFileName',' SoilDyn input filename', & + ErrStatTmp,ErrMsgTmp, UnEchoLocal ) + if (Failed()) then + return + else + DvrFlags%SlDIptFile = .TRUE. + endif + + + ! TStart -- start time + CALL ReadVar( UnIn, FileName,DvrSettings%TStart,'TStart',' Time in wind file to start parsing.', & + ErrStatTmp,ErrMsgTmp, UnEchoLocal ) + if (Failed()) then + return + else + DvrFlags%TStart = .TRUE. + endif + + + ! DT -- Timestep size for the driver to take (or DEFAULT for what the file contains) + CALL ReadVar( UnIn, FileName,InputChr,'InputChr',' Character string for Timestep size for the driver to take (or DEFAULT for what the file contains).', & + ErrStatTmp,ErrMsgTmp, UnEchoLocal ) + if (Failed()) return + + ! Check if we asked for the DEFAULT (use what is in the file) + CALL Conv2UC( InputChr ) + IF ( TRIM(InputChr) == 'DEFAULT' ) THEN ! we asked for the default value + DvrFlags%DT = .TRUE. + DvrFlags%DTDefault = .TRUE. ! This flag tells us to use the inflow wind file values + ELSE + ! We probably have a number if it isn't 'DEFAULT', so do an internal read and check to + ! make sure that it was appropriately interpretted. + READ (InputChr,*,IOSTAT=IOS) DvrSettings%DT + IF ( IOS /= 0 ) THEN ! problem in the read, so parse the error. + CALL CheckIOS ( IOS, '', 'DT',NumType, ErrStatTmp, ErrMsgTmp ) + if (Failed()) return + ELSE ! Was ok, so set the flags + DvrFlags%DT = .TRUE. + DvrFlags%DTDefault = .FALSE. + ENDIF + ENDIF + + + ! Number of timesteps + CALL ReadVar( UnIn, FileName,InputChr,'InputChr',' Character string for number of timesteps to read.', & + ErrStatTmp,ErrMsgTmp, UnEchoLocal ) + if (Failed()) return + + ! Check if we asked for the DEFAULT (use what is in the file) + CALL Conv2UC( InputChr ) + IF ( TRIM(InputChr) == 'DEFAULT' ) THEN ! we asked for the default value + DvrFlags%NumTimeSteps = .FALSE. + DvrFlags%NumTimeStepsDefault = .TRUE. ! This flag tells us to use the inflow wind file values + ELSE + ! We probably have a number if it isn't 'DEFAULT', so do an internal read and check to + ! make sure that it was appropriately interpretted. + READ (InputChr,*,IOSTAT=IOS) DvrSettings%NumTimeSteps + IF ( IOS /= 0 ) THEN ! problem in the read, so parse the error. + CALL CheckIOS ( IOS, '', 'NumTimeSteps',NumType, ErrStatTmp, ErrMsgTmp ) + if (Failed()) return + ELSE ! Was ok, so set the flags + DvrFlags%NumTimeSteps = .TRUE. + DvrFlags%NumTimeStepsDefault = .FALSE. + ENDIF + ENDIF + + + ! Stiffness matrix + CALL ReadVar( UnIn, FileName,DvrFlags%StiffMatOut,'StiffMatOut',' Output stiffness matrices at start and end', & + ErrStatTmp,ErrMsgTmp, UnEchoLocal ) + if (Failed()) return + + ! Non-linear reaction portion only + CALL ReadVar( UnIn, FileName,DvrFlags%SlDNonLinearForcePortionOnly,'SlDNonLinearForcePortionOnly',' Only report the non-linear portion of the reaction force.', & + ErrStatTmp,ErrMsgTmp, UnEchoLocal ) + if (Failed()) return + + + + !------------------------------------------------------------------------------------------------- + ! SoilDyn time series input -- this is read from a file of 7 columns (time and 6 dof) + !------------------------------------------------------------------------------------------------- + + ! InputDispFile input file + CALL ReadVar( UnIn, FileName,InputChr,'InputDispFile',' SoilDyn input displacements filename', & + ErrStatTmp,ErrMsgTmp, UnEchoLocal ) + if (Failed()) return + + DvrSettings%InputDispFile = InputChr + call Conv2UC( InputChr ) + if (trim(InputChr) == 'NONE') then + DvrSettings%InputDispFile = '' + DvrFlags%InputDispFile = .FALSE. + else + DvrFlags%InputDispFile = .TRUE. + endif + + + ! Close the echo and input file + CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) + CLOSE( UnIn ) + + +CONTAINS + + !> Set error status, close stuff, and return + logical function Failed() + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'ReadDvrIptFile') + if (ErrStat >= AbortErrLev) then + CALL CleanupEchoFile( EchoFileContents, UnEchoLocal ) + CLOSE( UnIn ) + endif + Failed = ErrStat >= AbortErrLev + end function Failed + + !> Clean up the module echo file + subroutine CleanupEchoFile( EchoFlag, UnEcho) + logical, intent(in ) :: EchoFlag ! local version of echo flag + integer(IntKi), intent(in ) :: UnEcho ! echo unit number + + ! Close this module's echo file + if ( EchoFlag ) then + close(UnEcho) + endif + END SUBROUTINE CleanupEchoFile + +END SUBROUTINE ReadDvrIptFile + + +!> This subroutine copies an command line (CL) settings over to the program settings. Warnings are +!! issued if anything is changed from what the driver input file requested. +SUBROUTINE UpdateSettingsWithCL( DvrFlags, DvrSettings, CLFlags, CLSettings, DVRIPT, ErrStat, ErrMsg ) + + TYPE(SlDDriver_Flags), INTENT(INOUT) :: DvrFlags + TYPE(SlDDriver_Settings), INTENT(INOUT) :: DvrSettings + TYPE(SlDDriver_Flags), INTENT(IN ) :: CLFlags + TYPE(SlDDriver_Settings), INTENT(IN ) :: CLSettings + LOGICAL, INTENT(IN ) :: DVRIPT + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + + ! Local variables + INTEGER(IntKi) :: ErrStatTmp !< Temporary error status for calls + CHARACTER(1024) :: ErrMsgTmp !< Temporary error status for calls + LOGICAL :: WindGridModify !< Did we modify any of the WindGrid related settings? + character(*), parameter :: RoutineName = 'UpdateSettingsWithCL' + + ! Initialization + WindGridModify = .FALSE. + + ! Initialize the error handling + ErrStat = ErrID_None + ErrMsg = '' + ErrStatTmp = ErrID_None + ErrMsgTmp = '' + + + !-------------------------------------------- + ! Did we change any time information? + !-------------------------------------------- + + ! Check TStart + IF ( CLFlags%TStart ) THEN + IF ( DvrFlags%TStart .AND. ( .NOT. EqualRealNos(DvrSettings%TStart, CLSettings%TStart) ) ) THEN + CALL SetErrStat( ErrID_Warn, ' Overriding driver input value for TStart with '//TRIM(Num2LStr(CLSettings%TStart))//'.', & + ErrStat,ErrMsg,RoutineName) + ELSE + DvrFlags%TStart = .TRUE. + ENDIF + DvrSettings%TStart = CLSettings%TStart + ENDIF + + ! Check DT + IF ( CLFlags%DT ) THEN + IF ( DvrFlags%DT .AND. ( .NOT. EqualRealNos(DvrSettings%DT, CLSettings%DT) ) ) THEN + CALL SetErrStat( ErrID_Warn, ' Overriding driver input value for DT with '//TRIM(Num2LStr(CLSettings%DT))//'.', & + ErrStat,ErrMsg,RoutineName) + ELSE + DvrFlags%DT = .TRUE. + ENDIF + DvrSettings%DT = CLSettings%DT + DvrFlags%DTDefault = .FALSE. + ENDIF + + ! Check NumTimeSteps + IF ( CLFlags%NumTimeSteps ) THEN + IF ( DvrFlags%NumTimeSteps .AND. ( DvrSettings%NumTimeSteps /= CLSettings%NumTimeSteps ) ) THEN + CALL SetErrStat( ErrID_Warn, ' Overriding driver input value for NumTimeSteps with '// & + TRIM(Num2LStr(CLSettings%NumTimeSteps))//'.',& + ErrStat,ErrMsg,RoutineName) + ELSE + DvrFlags%NumTimeSteps = .TRUE. + ENDIF + DvrSettings%NumTimeSteps = CLSettings%NumTimeSteps + DvrFlags%NumTimeStepsDefault = .FALSE. + ENDIF + + ! Make sure there is at least one timestep + DvrSettings%NumTimeSteps = MAX(DvrSettings%NumTimeSteps,1_IntKi) + + + !-------------------------------------------- + ! If there was no driver input file, we need to set a few things. + !-------------------------------------------- + + IF ( .NOT. DVRIPT ) THEN + + ! Do we need to set the NumTimeStepsDefault flag? + IF ( .NOT. DvrFlags%NumTimeSteps ) THEN + DvrFlags%NumTimeStepsDefault = .TRUE. + CALL SetErrStat( ErrID_Info,' The number of timesteps is not specified. Defaulting to what is in the input series file.', & + ErrStat,ErrMsg,RoutineName) + ENDIF + ENDIF + + +!FIXME: remove this after parsing rest of input file. + ! If no DT value has been set (DEFAULT requested), we need to set a default to pass into SlD + IF ( .NOT. DvrFlags%DT ) THEN + DvrSettings%DT = 0.025_DbKi ! This value gets passed into the SlD_Init routine, so something must be set. + ENDIF + + +END SUBROUTINE UpdateSettingsWithCL + + + +SUBROUTINE ReadInputDispFile( InputDispFile, DisplacementList, ErrStat, ErrMsg ) + CHARACTER(1024), INTENT(IN ) :: InputDispFile !< Name of the points file to read + REAL(R8Ki), ALLOCATABLE, INTENT( OUT) :: DisplacementList(:,:) !< The coordinates we read in: idx 1 = timestep, idx 2 = values + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< The error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< The message for the status + + ! Local variables + CHARACTER(1024) :: ErrMsgTmp !< Temporary error message for calls + INTEGER(IntKi) :: ErrStatTmp !< Temporary error status for calls + INTEGER(IntKi) :: FiUnitPoints !< Unit number for points file to open + + INTEGER(IntKi) :: NumDataColumns !< Number of data columns + INTEGER(IntKi) :: NumDataPoints !< Number of lines of data (one point per line) + INTEGER(IntKi) :: NumHeaderLines !< Number of header lines to ignore + + INTEGER(IntKi) :: I !< Generic counter + character(*), parameter :: RoutineName = 'ReadInputDispFile' + + ! Initialization of subroutine + ErrMsg = '' + ErrMsgTmp = '' + ErrStat = ErrID_None + ErrStatTmp = ErrID_None + + + ! Now open file + CALL GetNewUnit( FiUnitPoints, ErrStatTmp, ErrMsgTmp ); if (Failed()) return + CALL OpenFInpFile( FiUnitPoints, TRIM(InputDispFile), ErrStatTmp, ErrMsgTmp ) ! Unformatted input file + if (Failed()) return + + ! Find out how long the file is + CALL GetFileLength( FiUnitPoints, InputDispFile, NumDataColumns, NumDataPoints, NumHeaderLines, ErrMsgTmp, ErrStatTmp ) + if (Failed()) return + IF ( NumDataColumns /= 7 ) THEN + ErrStatTmp = ErrID_Fatal + ErrMsgTmp = ' Expecting seven columns in '//TRIM(InputDispFile)//' corresponding to '// & + 'time, dX, dY, dZ, dTheta_X, dTheta_Y, dTheta_Z coordinates. Instead found '//TRIM(Num2LStr(NumDataColumns))//' columns.' + if (Failed()) return + ENDIF + + + ! Allocate the storage for the data + CALL AllocAry( DisplacementList, NumDataPoints, 7, "Array of Points data", ErrStatTmp, ErrMsgTmp ) + if (Failed()) return + + + ! Read in the headers and throw them away + DO I=1,NumHeaderLines + CALL ReadCom( FiUnitPoints, InputDispFile,' Points file header line', ErrStatTmp, ErrMsgTmp ) + if (Failed()) return + ENDDO + + ! Read in the datapoints -- This is arranged with time in first index for speed in later interpolation operations + DO I=1,NumDataPoints + CALL ReadAry ( FiUnitPoints, InputDispFile, DisplacementList(I,:), 7, 'DisplacementList', & + 'Coordinate point from Points file', ErrStatTmp, ErrMsgTmp) + if (Failed()) return + ENDDO + + CLOSE( FiUnitPoints ) + +CONTAINS + !> Set error status, close stuff, and return + logical function Failed() + CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev .and. FiUnitPoints >0) close( FiUnitPoints ) + Failed = ErrStat >= AbortErrLev + end function Failed + + + !------------------------------------------------------------------------------------------------------------------------------- + !> This subroutine looks at a file that has been opened and finds out how many header lines there are, how many columns there + !! are, and how many lines of data there are in the file. + !! + !! A few things are assumed about the file: + !! 1. Any header lines are the first thing in the file. + !! 2. No text appears anyplace other than in first part of the file + !! 3. The datalines only contain numbers that can be read in as reals. + !! + !! Limitations: + !! 1. only handles up to 20 words (columns) on a line + !! 2. empty lines are considered text lines + !! 3. All data rows must contain the same number of columns + !! + !! + SUBROUTINE GetFileLength(UnitDataFile, DataFileName, NumDataColumns, NumDataLines, NumHeaderLines, ErrMsg, ErrStat) + + INTEGER(IntKi), INTENT(IN ) :: UnitDataFile !< Unit number of the file we are looking at. + CHARACTER(*), INTENT(IN ) :: DataFileName !< The name of the file we are looking at. + INTEGER(IntKi), INTENT( OUT) :: NumDataColumns !< The number of columns in the data file. + INTEGER(IntKi), INTENT( OUT) :: NumDataLines !< Number of lines containing data + INTEGER(IntKi), INTENT( OUT) :: NumHeaderLines !< Number of header lines at the start of the file + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error Message to return (empty if all good) + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Status flag if there were any problems (ErrID_None if all good) + + ! Local Variables + CHARACTER(2048) :: ErrMsgTmp !< Temporary message variable. Used in calls. + INTEGER(IntKi) :: ErrStatTmp !< Temporary error status. Used in calls. + INTEGER(IntKi) :: LclErrStat !< Temporary error status. Used locally to indicate when we have reached the end of the file. + INTEGER(IntKi) :: TmpIOErrStat !< Temporary error status for the internal read of the first word to a real number + LOGICAL :: IsRealNum !< Flag indicating if the first word on the line was a real number + + CHARACTER(1024) :: TextLine !< One line of text read from the file + INTEGER(IntKi) :: LineLen !< The length of the line read in + CHARACTER(1024) :: StrRead !< String containing the first word read in + REAL(R8Ki) :: RealRead !< Returns value of the number (if there was one), or NaN (as set by NWTC_Num) if there wasn't + CHARACTER(24) :: Words(20) !< Array of words we extract from a line. We shouldn't have more than 20. + INTEGER(IntKi) :: i !< simple integer counters + INTEGER(IntKi) :: LineNumber !< the line I am on + LOGICAL :: LineHasText !< Flag indicating if the line I just read has text. If so, it is a header line. + LOGICAL :: HaveReadData !< Flag indicating if I have started reading data. + INTEGER(IntKi) :: NumWords !< Number of words on a line + INTEGER(IntKi) :: FirstDataLineNum !< Line number of the first row of data in the file + + ! Initialize the error handling + ErrStat = ErrID_None + ErrStatTmp = ErrID_None + LclErrStat = ErrID_None + ErrMsg = '' + ErrMsgTmp = '' + + ! Set some of the flags and counters + HaveReadData = .FALSE. + NumDataColumns = 0 + NumHeaderLines = 0 + NumDataLines = 0 + LineNumber = 0 + + ! Just in case we were handed a file that we are part way through reading (should never be true), rewind to the start + + REWIND( UnitDataFile ) + + !------------------------------------ + !> The variable LclErrStat is used to indicate when we have reached the end of the file or had an error from + !! ReadLine. Until that occurs, we read each line, and decide if it contained any non-numeric data. The + !! first group of lines containing non-numeric data is considered the header. The first line of all numeric + !! data is considered the start of the data section. Any non-numeric containing found within the data section + !! will be considered as an invalid file format at which point we will return a fatal error from this routine. + + DO WHILE ( LclErrStat == ErrID_None ) + + !> Reset the indicator flag for the non-numeric content + LineHasText = .FALSE. + + !> Read in a single line from the file + CALL ReadLine( UnitDataFile, '', TextLine, LineLen, LclErrStat ) + + !> If there was an error in reading the file, then exit. + !! Possible causes: reading beyond end of file in which case we are done so don't process it. + IF ( LclErrStat /= ErrID_None ) EXIT + + !> Increment the line counter. + LineNumber = LineNumber + 1 + + !> Read all the words on the line into the array called 'Words'. Only the first words will be encountered + !! will be stored. The others are empty (i.e. only three words on the line, so the remaining 17 are empty). + CALL GetWords( TextLine, Words, 20 ) + + !> Cycle through and count how many are not empty. Once an empty value is encountered, all the rest should + !! be empty if GetWords worked correctly. The index of the last non-empty value is stored. + DO i=1,20 + IF (TRIM(Words(i)) .ne. '') NumWords=i + ENDDO + + + !> Now cycle through the first 'NumWords' of non-empty values stored in 'Words'. Words should contain + !! everything that is one the line. The subroutine ReadRealNumberFromString will set a flag 'IsRealNum' + !! when the value in Words(i) can be read as a real(R8Ki). 'StrRead' will contain the string equivalent. + DO i=1,NumWords + CALL ReadRealNumberFromString( Words(i), RealRead, StrRead, IsRealNum, ErrStatTmp, ErrMsgTmp, TmpIOErrStat ) + IF ( .NOT. IsRealNum) LineHasText = .TRUE. + ENDDO + + !> If all the words on that line had no text in them, then it must have been a line of data. + !! If not, then we have either a header line, which is ok, or a line containing text in the middle of the + !! the data section, which is not good (the flag HaveReadData tells us which case this is). + IF ( LineHasText ) THEN + IF ( HaveReadData ) THEN ! Uh oh, we have already read a line of data before now, so there is a problem + CALL SetErrStat( ErrID_Fatal, ' Found text on line '//TRIM(Num2LStr(LineNumber))//' of '//TRIM(DataFileName)// & + ' when real numbers were expected. There may be a problem with format of the file: '// & + TRIM(DataFileName)//'.', ErrStat, ErrMsg, RoutineName) + IF ( ErrStat >= AbortErrLev ) RETURN + ELSE + NumHeaderLines = NumHeaderLines + 1 + ENDIF + ELSE ! No text, must be data line + NumDataLines = NumDataLines + 1 + ! If this is the first row of data, then store the number of words that were on the line + IF ( .NOT. HaveReadData ) THEN + ! If this is the first line of data, keep some relevant info about it and the number of columns in it + HaveReadData = .TRUE. + FirstDataLineNum = LineNumber ! Keep the line number of the first row of data (for error reporting) + NumDataColumns = NumWords + ELSE + ! Make sure that the number columns on the row matches the number of columnns on the first row of data. + IF ( NumWords /= NumDataColumns ) THEN + CALL SetErrStat( ErrID_Fatal, ' Error in file: '//TRIM(DataFileName)//'.'// & + ' The number of data columns on line '//TRIM(Num2LStr(LineNumber))// & + '('//TRIM(Num2LStr(NumWords))//' columns) is different than the number of columns on first row of data '// & + ' (line: '//TRIM(Num2LStr(FirstDataLineNum))//', '//TRIM(Num2LStr(NumDataColumns))//' columns).', & + ErrStat, ErrMsg, RoutineName) + IF ( ErrStat >= AbortErrLev ) RETURN + ENDIF + ENDIF + ENDIF + + ENDDO + + REWIND( UnitDataFile ) + + END SUBROUTINE GetFileLength + + !------------------------------------------------------------------------------- + !> This subroutine takes a line of text that is passed in and reads the first + !! word to see if it is a number. An internal read is used to do this. If + !! it is a number, it is started in ValueRead and returned. The flag IsRealNum + !! is set to true. Otherwise, ValueRead is set to NaN (value from the NWTC_Num) + !! and the flag is set to false. + !! + !! The IsRealNum flag is set to indicate if we actually have a real number or + !! not. After calling this routine, a simple if statement can be used: + !! + !! @code + !! IF (IsRealNum) THEN + !! ! do something + !! ELSE + !! ! do something else + !! ENDIF + !! @endcode + !! + !------------------------------------------------------------------------------- + SUBROUTINE ReadRealNumberFromString(StringToParse, ValueRead, StrRead, IsRealNum, ErrStat, ErrMsg, IOErrStat) + CHARACTER(*), INTENT(IN ) :: StringToParse !< The string we were handed. + REAL(R8Ki), INTENT( OUT) :: ValueRead !< The variable being read. Returns as NaN (library defined) if not a Real. + CHARACTER(*), INTENT( OUT) :: StrRead !< A string containing what was read from the ReadNum routine. + LOGICAL, INTENT( OUT) :: IsRealNum !< Flag indicating if we successfully read a Real + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< ErrID level returned from ReadNum + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message including message from ReadNum + INTEGER(IntKi), INTENT( OUT) :: IOErrStat !< Error status from the internal read. Useful for diagnostics. + + ErrStat = ErrID_None + ErrMsg = '' + + ! ReadNum returns a string contained in StrRead. So, we now try to do an internal read to VarRead and then trap errors. + read(StringToParse,*,IOSTAT=IOErrStat) StrRead + read(StringToParse,*,IOSTAT=IOErrStat) ValueRead + + ! If IOErrStat==0, then we have a real number, anything else is a problem. + if (IOErrStat==0) then + IsRealNum = .TRUE. + else + IsRealNum = .FALSE. + ValueRead = NaN ! This is NaN as defined in the NWTC_Num. + ErrMsg = 'Not a real number. '//TRIM(ErrMsgTmp)//NewLine + ErrSTat = ErrID_Severe + endif + + RETURN + END SUBROUTINE ReadRealNumberFromString + + !------------------------------------------------------------------------------- + !> This subroutine works with the ReadNum routine from the library. ReadNum is + !! called to read a word from the input file. An internal read is then done to + !! convert the string to a number that is stored in VarRead and returned. + !! + !! The IsRealNum flag is set to indicate if we actually have a real number or + !! not. After calling this routine, a simple if statement can be used: + !! + !! @code + !! IF (ISRealNum) THEN + !! ! do something + !! ELSE + !! ! do something else + !! ENDIF + !! @endcode + !! + !------------------------------------------------------------------------------- + SUBROUTINE ReadRealNumber(UnitNum, FileName, VarName, VarRead, StrRead, IsRealNum, ErrStat, ErrMsg, IOErrStat) + INTEGER(IntKi), INTENT(IN ) :: UnitNum !< The unit number of the file being read + CHARACTER(*), INTENT(IN ) :: FileName !< The name of the file being read. Used in the ErrMsg from ReadNum (Library routine). + CHARACTER(*), INTENT(IN ) :: VarName !< The variable we are reading. Used in the ErrMsg from ReadNum (Library routine)'. + REAL(R8Ki), INTENT( OUT) :: VarRead !< The variable being read. Returns as NaN (library defined) if not a Real. + CHARACTER(*), INTENT( OUT) :: StrRead !< A string containing what was read from the ReadNum routine. + LOGICAL, INTENT( OUT) :: IsRealNum !< Flag indicating if we successfully read a Real + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< ErrID level returned from ReadNum + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message including message from ReadNum + INTEGER(IntKi), INTENT( OUT) :: IOErrStat !< Error status from the internal read. Useful for diagnostics. + + INTEGER(IntKi) :: ErrStatTmp + CHARACTER(2048) :: ErrMsgTmp + + ErrStat = ErrID_None + ErrMsg = '' + + ! Now call the ReadNum routine to get the number + ! If it is a word that does not start with T or F, then ReadNum won't give any errors. + CALL ReadNum( UnitNum, FileName, StrRead, VarName, ErrStatTmp, ErrMsgTmp) + + ! ReadNum returns a string contained in StrRead. So, we now try to do an internal read to VarRead and then trap errors. + read(StrRead,*,IOSTAT=IOErrStat) VarRead + + ! If IOErrStat==0, then we have a real number, anything else is a problem. + if (IOErrStat==0) then + IsRealNum = .TRUE. + else + IsRealNum = .FALSE. + VarRead = NaN ! This is NaN as defined in the NWTC_Num. + ErrMsg = 'Not a real number. '//TRIM(ErrMsgTmp)//NewLine + ErrStat = ErrStatTmp ! The ErrStatTmp returned by the ReadNum routine is an ErrID level. + endif + RETURN + END SUBROUTINE ReadRealNumber + +END SUBROUTINE ReadInputDispFile + + + + +!> This routine exists only to support the development of the module. It will not be needed after the module is complete. +SUBROUTINE printSettings( DvrFlags, DvrSettings ) + ! The arguments + TYPE( SlDDriver_Flags ), INTENT(IN ) :: DvrFlags !< Flags indicating which settings were set + TYPE( SlDDriver_Settings ), INTENT(IN ) :: DvrSettings !< Stored settings + + CALL WrsCr(TRIM(GetNVD(DvrSettings%ProgInfo))) + CALL WrScr(' DvrIptFile: '//FLAG(DvrFlags%DvrIptFile)// ' '//TRIM(DvrSettings%DvrIptFileName)) + CALL WrScr(' SlDIptFile: '//FLAG(DvrFlags%SlDIptFile)// ' '//TRIM(DvrSettings%SlDIptFileName)) + CALL WrScr(' TStart: '//FLAG(DvrFlags%TStart)// ' '//TRIM(Num2LStr(DvrSettings%TStart))) + IF ( DvrFlags%DTDefault) THEN + CALL WrScr(' DT: '//FLAG(DvrFlags%DT)// ' DEFAULT') + ELSE + CALL WrScr(' DT: '//FLAG(DvrFlags%DT)// ' '//TRIM(Num2LStr(DvrSettings%DT))) + ENDIF + IF ( DvrFlags%NumTimeStepsDefault) THEN + CALL WrScr(' NumTimeSteps: '//FLAG(DvrFlags%NumTimeSteps)// ' DEFAULT') + ELSE + CALL WrScr(' NumTimeSteps: '//FLAG(DvrFlags%NumTimeSteps)// ' '//TRIM(Num2LStr(DvrSettings%NumTimeSteps))) + ENDIF + CALL WrScr(' StiffMatOut: '//FLAG(DvrFlags%StiffMatOut)) + CALL WrScr(' Verbose: '//FLAG(DvrFlags%Verbose)) + CALL WrScr(' VVerbose: '//FLAG(DvrFlags%VVerbose)) + RETURN +END SUBROUTINE printSettings + + +!> This routine exists only to support the development of the module. It will not be kept after the module is complete. +!! This routine takes a flag setting (LOGICAL) and exports either 'T' or '-' for T/F (respectively) +FUNCTION FLAG(flagval) + LOGICAL, INTENT(IN ) :: flagval !< Value of the flag + CHARACTER(1) :: FLAG !< character interpretation (for prettiness when printing) + IF ( flagval ) THEN + FLAG = 'T' + ELSE + FLAG = '-' + ENDIF + RETURN +END FUNCTION FLAG + + +SUBROUTINE Dvr_InitializeOutputFile(OutUnit,IntOutput,RootName,ErrStat,ErrMsg) + integer(IntKi), intent( out):: OutUnit + type(SlD_InitOutputType), intent(in ):: IntOutput ! Output for initialization routine + integer(IntKi), intent( out):: ErrStat ! Error status of the operation + character(*), intent( out):: ErrMsg ! Error message if ErrStat /= ErrID_None + character(*), intent(in ):: RootName + integer(IntKi) :: i + integer(IntKi) :: numOuts + integer(IntKi) :: ErrStat2 ! Temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + character(*), parameter :: RoutineName = 'Dvr_InitializeOutputFile' + + ErrStat = ErrID_none + ErrMsg = "" + + CALL GetNewUnit(OutUnit,ErrStat2,ErrMsg2) + CALL OpenFOutFile ( OutUnit, trim(RootName)//'.out', ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + + write (OutUnit,'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using '//trim(GetNVD(IntOutput%Ver)) + write (OutUnit,'()' ) !print a blank line + + numOuts = size(IntOutput%WriteOutputHdr) + !...................................................... + ! Write the names of the output parameters on one line: + !...................................................... + + write (OutUnit,'()') + write (OutUnit,'()') + write (OutUnit,'()') + + call WrFileNR ( OutUnit, 'Time' ) + + do i=1,NumOuts + call WrFileNR ( OutUnit, tab//IntOutput%WriteOutputHdr(i) ) + end do ! i + + write (OutUnit,'()') + + !...................................................... + ! Write the units of the output parameters on one line: + !...................................................... + + call WrFileNR ( OutUnit, '(s)' ) + + do i=1,NumOuts + call WrFileNR ( Outunit, tab//trim(IntOutput%WriteOutputUnt(i)) ) + end do ! i + + write (OutUnit,'()') + + +END SUBROUTINE Dvr_InitializeOutputFile + +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE Dvr_WriteOutputLine(t,OutUnit, OutFmt, Output) + real(DbKi) , intent(in ) :: t ! simulation time (s) + integer(IntKi) , intent(in ) :: OutUnit ! Status of error message + character(*) , intent(in ) :: OutFmt + type(SlD_OutputType), intent(in ) :: Output + integer(IntKi) :: errStat ! Status of error message (we're going to ignore errors in writing to the file) + character(ErrMsgLen) :: errMsg ! Error message if ErrStat /= ErrID_None + character(200) :: frmt ! A string to hold a format specifier + character(15) :: tmpStr ! temporary string to print the time output as text + + frmt = '"'//tab//'"'//trim(OutFmt) ! format for array elements from individual modules + + ! time + write( tmpStr, '(F15.6)' ) t + call WrFileNR( OutUnit, tmpStr ) + call WrNumAryFileNR ( OutUnit, Output%WriteOutput, frmt, errStat, errMsg ) + + ! write a new line (advance to the next line) + write (OutUnit,'()') +end subroutine Dvr_WriteOutputLine + + +END MODULE SoilDyn_Driver_Subs diff --git a/modules/soildyn/src/driver/SoilDyn_Driver_Types.f90 b/modules/soildyn/src/driver/SoilDyn_Driver_Types.f90 new file mode 100644 index 0000000000..fe145586c4 --- /dev/null +++ b/modules/soildyn/src/driver/SoilDyn_Driver_Types.f90 @@ -0,0 +1,68 @@ +!********************************************************************************************************************************** +! +! MODULE: SlD_Driver_Types - This module contains types used by the SoilDyn Driver program to store arguments passed in +! +! The types listed here are used within the SoilDyn Driver program to store the settings. These settings are read in as +! command line arguments, then stored within these types. +! +!********************************************************************************************************************************** +! +!.................................................................................................................................. +! LICENSING +! Copyright (C) 2015 National Renewable Energy Laboratory +! +! This file is part of SoilDyn. +! +! SoilDyn is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as +! published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty +! of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License along with SoilDyn. +! If not, see . +! +!********************************************************************************************************************************** + +MODULE SoilDyn_Driver_Types + + USE NWTC_Library + USE SoilDyn_Types + + IMPLICIT NONE + + !> This contains flags to note if the settings were made. This same data structure is + !! used both during the driver input file and the command line options. + TYPE :: SlDDriver_Flags + LOGICAL :: DvrIptFile = .FALSE. !< Was an input file name given on the command line? + LOGICAL :: SlDIptFile = .FALSE. !< Was an SoilDyn input file requested? + LOGICAL :: InputDispFile = .FALSE. !< Input displacement time series + LOGICAL :: TStart = .FALSE. !< specified a start time + LOGICAL :: StiffMatOut = .FALSE. !< output stiffness matrices at start and finish + LOGICAL :: NumTimeSteps = .FALSE. !< specified a number of timesteps to process + LOGICAL :: NumTimeStepsDefault = .FALSE. !< specified a 'DEFAULT' for number of timesteps to process + LOGICAL :: DT = .FALSE. !< specified a resolution in time + LOGICAL :: DTDefault = .FALSE. !< specified a 'DEFAULT' for the time resolution + LOGICAL :: Verbose = .FALSE. !< Verbose error reporting + LOGICAL :: VVerbose = .FALSE. !< Very Verbose error reporting + LOGICAL :: SlDNonLinearForcePortionOnly = .FALSE. !< To only return the non-linear portion of the reaction force + END TYPE SlDDriver_Flags + + + ! This contains all the settings (possible passed in arguments). + TYPE :: SlDDriver_Settings + CHARACTER(1024) :: DvrIptFileName !< Driver input file name + CHARACTER(1024) :: SlDIptFileName !< Filename of SoilDyn input file to read (if no driver input file) + CHARACTER(1024) :: InputDispFile !< Filename of SoilDyn time series displacements + + INTEGER(IntKi) :: NumTimeSteps !< Number of timesteps + REAL(DbKi) :: DT !< resolution of time + REAL(DbKi) :: TStart !< Start time + + TYPE(ProgDesc) :: ProgInfo !< Program info + TYPE(ProgDesc) :: SlDProgInfo !< Program info for SoilDyn + + END TYPE SlDDriver_Settings + + +END MODULE SoilDyn_Driver_Types diff --git a/modules/subdyn/src/SD_FEM.f90 b/modules/subdyn/src/SD_FEM.f90 index bee8e4a9e7..f966c29501 100644 --- a/modules/subdyn/src/SD_FEM.f90 +++ b/modules/subdyn/src/SD_FEM.f90 @@ -2144,8 +2144,12 @@ logical function isFloating(Init, p) type(SD_InitType), intent(in ):: Init type(SD_ParameterType),intent(in ) :: p integer(IntKi) :: i - !isFloating=size(p%Nodes_C)>0 isFloating=.True. + ! If soil stiffness is provided by SoilDyn, return false + if (allocated(Init%Soil_K)) then + isFloating=.false. + return + end if do i =1,size(p%Nodes_C,1) if ((all(p%Nodes_C(I,2:7)==idBC_Internal)) .and. (Init%SSIfile(i)=='')) then continue diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index e9cc11d52e..dafd533fcf 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -242,6 +242,7 @@ of_regression("5MW_OC4Jckt_ExtPtfm" "openfast;elastodyn;extpt of_regression("HelicalWake_OLAF" "openfast;aerodyn15;olaf") of_regression("EllipticalWing_OLAF" "openfast;aerodyn15;olaf") of_regression("StC_test_OC4Semi" "openfast;servodyn;hydrodyn;moordyn;offshore;stc") +of_regression("OC6_phaseII" "openfast;soildyn;subdyn;hydrodyn;offshore;stc") # OpenFAST C++ API test if(BUILD_OPENFAST_CPP_API) diff --git a/reg_tests/r-test b/reg_tests/r-test index e8a144a39d..4cd7a251bf 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit e8a144a39d2301bd329e10ce927b5764b174e037 +Subproject commit 4cd7a251bf0ce130f566849cb3d53ccc3ca69a2a diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index 8b50656451..f8673450df 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -1734,6 +1734,15 @@ + + + + + + + + + diff --git a/vs-build/RunRegistry.bat b/vs-build/RunRegistry.bat index faf06756d7..79aa763b1e 100644 --- a/vs-build/RunRegistry.bat +++ b/vs-build/RunRegistry.bat @@ -41,6 +41,7 @@ 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 SlD_Loc=%Modules_Loc%\soildyn\src SET SC_Loc=%Modules_Loc%\supercontroller\src SET AWAE_Loc=%Modules_Loc%\awae\src @@ -48,7 +49,7 @@ 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 "%SrvD_Loc%" -I "%AD14_Loc%" -I^ - "%AD_Loc%" -I "%BD_Loc%" -I "%SC_Loc%" -I^ + "%AD_Loc%" -I "%BD_Loc%" -I "%SlD_Loc%" -I "%SC_Loc%" -I^ "%IfW_Loc%" -I "%SD_Loc%" -I "%HD_Loc%" -I "%MAP_Loc%" -I "%FEAM_Loc%" -I^ "%IceF_Loc%" -I "%IceD_Loc%" -I "%MD_Loc%" -I "%OpFM_Loc%" -I "%Orca_Loc%" -I "%ExtPtfm_Loc%" @@ -85,6 +86,12 @@ SET Output_Loc=%CURR_LOC% %REGISTRY% "%CURR_LOC%\Registry_BeamDyn.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" GOTO checkError +:SoilDyn +SET CURR_LOC=%SlD_Loc% +SET Output_Loc=%CURR_LOC% +%REGISTRY% "%CURR_LOC%\SoilDyn_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" +GOTO checkError + :SuperController SET CURR_LOC=%SC_Loc% SET Output_Loc=%CURR_LOC% diff --git a/vs-build/SoilDyn/SoilDyn-w-registry.sln b/vs-build/SoilDyn/SoilDyn-w-registry.sln new file mode 100644 index 0000000000..7b448a55d4 --- /dev/null +++ b/vs-build/SoilDyn/SoilDyn-w-registry.sln @@ -0,0 +1,64 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +# Visual Studio 15 +VisualStudioVersion = 15.0.28307.1022 +MinimumVisualStudioVersion = 10.0.40219.1 +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "SoilDyn", "SoilDyn.vfproj", "{815C302F-A93D-4C22-9329-7112345113C0}" + ProjectSection(ProjectDependencies) = postProject + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} = {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16} + EndProjectSection +EndProject +Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "FAST_Registry", "..\Registry\FAST_Registry.vcxproj", "{DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}" +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug_Double|Win32 = Debug_Double|Win32 + Debug_Double|x64 = Debug_Double|x64 + Debug|Win32 = Debug|Win32 + Debug|x64 = Debug|x64 + Release_Double|Win32 = Release_Double|Win32 + Release_Double|x64 = Release_Double|x64 + Release|Win32 = Release|Win32 + Release|x64 = Release|x64 + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {815C302F-A93D-4C22-9329-7112345113C0}.Debug_Double|Win32.ActiveCfg = Debug_Double|Win32 + {815C302F-A93D-4C22-9329-7112345113C0}.Debug_Double|Win32.Build.0 = Debug_Double|Win32 + {815C302F-A93D-4C22-9329-7112345113C0}.Debug_Double|x64.ActiveCfg = Debug_Double|x64 + {815C302F-A93D-4C22-9329-7112345113C0}.Debug_Double|x64.Build.0 = Debug_Double|x64 + {815C302F-A93D-4C22-9329-7112345113C0}.Debug|Win32.ActiveCfg = Debug|Win32 + {815C302F-A93D-4C22-9329-7112345113C0}.Debug|Win32.Build.0 = Debug|Win32 + {815C302F-A93D-4C22-9329-7112345113C0}.Debug|x64.ActiveCfg = Debug|x64 + {815C302F-A93D-4C22-9329-7112345113C0}.Debug|x64.Build.0 = Debug|x64 + {815C302F-A93D-4C22-9329-7112345113C0}.Release_Double|Win32.ActiveCfg = Release_Double|Win32 + {815C302F-A93D-4C22-9329-7112345113C0}.Release_Double|Win32.Build.0 = Release_Double|Win32 + {815C302F-A93D-4C22-9329-7112345113C0}.Release_Double|x64.ActiveCfg = Release_Double|x64 + {815C302F-A93D-4C22-9329-7112345113C0}.Release_Double|x64.Build.0 = Release_Double|x64 + {815C302F-A93D-4C22-9329-7112345113C0}.Release|Win32.ActiveCfg = Release|Win32 + {815C302F-A93D-4C22-9329-7112345113C0}.Release|Win32.Build.0 = Release|Win32 + {815C302F-A93D-4C22-9329-7112345113C0}.Release|x64.ActiveCfg = Release|x64 + {815C302F-A93D-4C22-9329-7112345113C0}.Release|x64.Build.0 = Release|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.ActiveCfg = Debug|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.Build.0 = Debug|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.ActiveCfg = Debug|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.Build.0 = Debug|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.ActiveCfg = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.Build.0 = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.ActiveCfg = Debug|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.Build.0 = Debug|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.ActiveCfg = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.Build.0 = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.ActiveCfg = Release|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.Build.0 = Release|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.ActiveCfg = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.Build.0 = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.ActiveCfg = Release|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.Build.0 = Release|x64 + EndGlobalSection + GlobalSection(SolutionProperties) = preSolution + HideSolutionNode = FALSE + EndGlobalSection + GlobalSection(ExtensibilityGlobals) = postSolution + SolutionGuid = {A0376D01-250D-4BCF-8D81-F82B933958E7} + EndGlobalSection +EndGlobal diff --git a/vs-build/SoilDyn/SoilDyn.vfproj b/vs-build/SoilDyn/SoilDyn.vfproj new file mode 100644 index 0000000000..53fa2e93e0 --- /dev/null +++ b/vs-build/SoilDyn/SoilDyn.vfproj @@ -0,0 +1,296 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +