diff --git a/CMakeLists.txt b/CMakeLists.txt index b7de977d57..a730094f27 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -42,6 +42,7 @@ 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_FASTFARM "Enable building FAST.Farm" off) option(BUILD_OPENFAST_CPP_API "Enable building OpenFAST - C++ API" off) option(BUILD_OPENFAST_CPP_DRIVER "Enable building OpenFAST C++ driver using C++ CFD API" off) @@ -192,6 +193,7 @@ set(OPENFAST_MODULES aerodyn aerodisk servodyn + soildyn elastodyn beamdyn subdyn diff --git a/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.tex b/docs/OtherSupporting/OpenFAST_Algorithms/OpenFAST_Algorithms.tex index c6817cef8d..30c6b27a0a 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 @@ -53,8 +53,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} @@ -125,6 +126,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 %%%% @@ -151,11 +156,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] @@ -170,6 +175,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}$} @@ -195,6 +201,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 \! @@ -206,6 +213,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 5dcccee42d..264300d190 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 315d86675e..39b82f766b 100644 --- a/docs/source/install/index.rst +++ b/docs/source/install/index.rst @@ -494,7 +494,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: ON) + 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) USE_LOCAL_STATIC_LAPACK - Enable downloading and building static LAPACK and BLAS libs (Default: OFF) VARIABLE_TRACKING - Enables variable tracking for better runtime debugging output. May increase compile time. Valid only for GNU. (Default: ON) diff --git a/docs/source/user/api_change.rst b/docs/source/user/api_change.rst index 80a973a4ec..27d9484379 100644 --- a/docs/source/user/api_change.rst +++ b/docs/source/user/api_change.rst @@ -35,8 +35,10 @@ Added in OpenFAST `dev` Module Line Flag Name Example Value ============================================= ======== ==================== ======================================================================================================================================================================================================== OpenFAST 8 ModCoupling 3 ModCoupling - Module coupling method (switch) {1=loose; 2=tight with fixed Jacobian updates (DT_UJac); 3=tight with automatic Jacobian updates} +OpenFAST 20 CompSoil 0 CompSoil - Compute soil-structural dynamics (switch) {0=None; 1=SoilDyn} OpenFAST 17 NRotors 2 NRotors - Number of rotors in turbine (-) OpenFAST 28 MirrorRotor F MirrorRotor - Flag to reverse rotor rotation direction [1 to NRotors] {F=Normal, T=Mirror} +OpenFAST 45 SoilFile "SoilDyn.dat" SoilFile - Name of the file containing the SoilDyn input parameters (quoted string) OpenFAST 52 ---------------------- INPUT FILES Rotor 2 ------------------------------------- OpenFAST 53 EDFile "ElastoDyn.dat" EDFile - Name of file containing ElastoDyn input parameters (quoted string) OpenFAST 54 BDBldFile(1) "BeamDyn.dat" BDBldFile(1) - Name of file containing BeamDyn input parameters for blade 1 (quoted string) diff --git a/glue-codes/simulink/CMakeLists.txt b/glue-codes/simulink/CMakeLists.txt index 58df8dc763..a19e992659 100644 --- a/glue-codes/simulink/CMakeLists.txt +++ b/glue-codes/simulink/CMakeLists.txt @@ -32,6 +32,7 @@ set(MEX_LIBS $ $ # MATLAB Specific $ + $ $ $ $ diff --git a/modules/aerodyn/src/FVW_BiotSavart.f90 b/modules/aerodyn/src/FVW_BiotSavart.f90 index 36c73d1dd9..fcc301511d 100644 --- a/modules/aerodyn/src/FVW_BiotSavart.f90 +++ b/modules/aerodyn/src/FVW_BiotSavart.f90 @@ -50,55 +50,61 @@ subroutine ui_seg_11(DeltaPa, DeltaPb, SegGamma, RegFunction, RegParam1, Uind) real(ReKi) :: xa, ya, za, xb, yb, zb !< Coordinates of X-Xa and X-Xb real(ReKi) :: exp_value !< ! - Uind(1:3)=0.0_ReKi + Uind(1:3) = 0.0_ReKi xa=DeltaPa(1); ya=DeltaPa(2); za=DeltaPa(3) xb=DeltaPb(1); yb=DeltaPb(2); zb=DeltaPb(3) norm_a = sqrt(xa*xa + ya*ya + za*za) norm_b = sqrt(xb*xb + yb*yb + zb*zb) denominator = norm_a*norm_b*(norm_a*norm_b + xa*xb+ya*yb+za*zb) ! |r1|*|r2|*(|r1|*|r2| + r1.r2) - if (denominator>PRECISION_UI) then - crossprod(1) = ya*zb-za*yb; crossprod(2) = za*xb-xa*zb; crossprod(3) = xa*yb-ya*xb - norm2_orth = crossprod(1)**2 + crossprod(2)**2 + crossprod(3)**2 - if (norm2_orth>PRECISION_UI) then ! On the singularity, Uind(1:3)=0.0_ReKi - norm2_r0 = (xa-xb)*(xa-xb) + (ya-yb)*(ya-yb) +(za-zb)*(za-zb) - if (norm2_r0>PRECISION_UI) then ! segment of zero length - ! --- Far field TODO - ! --- Regularization (close field) - norm2_orth = norm2_orth/norm2_r0 ! d = (r1xr2)/r0 - select case (RegFunction) ! - case ( idRegNone ) ! No vortex core model - Kv=1.0_ReKi - case ( idRegRankine ) ! Rankine - r_bar2 = norm2_orth/ RegParam1**2 - if (r_bar2<1) then - Kv=r_bar2 - else - Kv=1.0_ReKi - end if - case ( idRegLambOseen ) ! Lamb-Oseen - r_bar2 = norm2_orth/ RegParam1**2 - exp_value = -1.25643_ReKi*r_bar2 - if(exp_valuePRECISION_UI) then - crossprod(1) = ya*zb-za*yb; crossprod(2) = za*xb-xa*zb; crossprod(3) = xa*yb-ya*xb - norm2_orth = crossprod(1)**2 + crossprod(2)**2 + crossprod(3)**2 - if (norm2_orth>PRECISION_UI) then ! On the singularity, Uind(1:3)=0.0_ReKi - norm2_r0 = (xa-xb)*(xa-xb) + (ya-yb)*(ya-yb) +(za-zb)*(za-zb) - if (norm2_r0>PRECISION_UI) then - ! --- Far field TODO - ! --- Regularization (close field) --- Vatistas - norm2_orth = norm2_orth/norm2_r0 ! d = (r1xr2)/r0 - r_bar2 = norm2_orth/RegParam(is)**2 - Kv = r_bar2/sqrt(1+r_bar2**2) - Kv = SegGamma(is)*fourpi_inv*Kv*(norm_a+norm_b)/(denominator + MINDENOM) - Uind(1:3) = Kv*crossprod(1:3) - end if - end if ! denominator size or distances too small - end if ! - Uind_out(1:3,icp) = Uind_out(1:3,icp)+Uind(1:3) + ! denominator size or distances too small + if (denominator <= PRECISION_UI) cycle + crossprod(1) = ya*zb-za*yb; crossprod(2) = za*xb-xa*zb; crossprod(3) = xa*yb-ya*xb + norm2_orth = crossprod(1)**2 + crossprod(2)**2 + crossprod(3)**2 + ! On the singularity, cycle + if (norm2_orth <= PRECISION_UI) cycle + norm2_r0 = (xa-xb)*(xa-xb) + (ya-yb)*(ya-yb) +(za-zb)*(za-zb) + ! segment of zero length + if (norm2_r0 <= PRECISION_UI) cycle + ! --- Far field TODO + ! --- Regularization (close field) --- Vatistas + norm2_orth = norm2_orth/norm2_r0 ! d = (r1xr2)/r0 + r_bar2 = norm2_orth/RegParam(is)**2 + Kv = r_bar2/sqrt(1.0_ReKi+r_bar2**2) + Kv = SegGamma(is)*fourpi_inv*Kv*(norm_a+norm_b)/(denominator + MINDENOM) + Uind(1:3) = Uind(1:3) + Kv*crossprod(1:3) end do ! Loop on segments + Uind_out(1:3,icp) = Uind_out(1:3,icp) + Uind(1:3) enddo ! Loop on control points !$OMP END DO !$OMP END PARALLEL case ( idRegOffset ) ! Denominator offset !$OMP PARALLEL default(shared) - !$OMP do private(icp,is,Uind,P1,P2,crossprod,denominator,r_bar2,Kv,norm_a,norm_b,norm2_r0,norm2_orth,xa,ya,za,xb,yb,zb) schedule(runtime) + !$OMP do private(icp,is,CPs_icp,Uind,P1,P2,crossprod,denominator,r_bar2,Kv,norm_a,norm_b,norm2_r0,norm2_orth,xa,ya,za,xb,yb,zb) schedule(runtime) do icp=iCPStart,iCPEnd ! loop on CPs + Uind = 0.0_ReKi + CPs_icp = CPs(:,icp) do is=iSegStart,iSegEnd ! loop on selected segments - Uind = 0.0_ReKi P1 = SegPoints(1:3, SegConnct(1,is)) ! Segment extremity points P2 = SegPoints(1:3, SegConnct(2,is)) - xa=CPs(1,icp)-P1(1); ya=CPs(2,icp)-P1(2); za=CPs(3,icp)-P1(3); - xb=CPs(1,icp)-P2(1); yb=CPs(2,icp)-P2(2); zb=CPs(3,icp)-P2(3); + xa=CPs_icp(1)-P1(1); ya=CPs_icp(2)-P1(2); za=CPs_icp(3)-P1(3); + xb=CPs_icp(1)-P2(1); yb=CPs_icp(2)-P2(2); zb=CPs_icp(3)-P2(3); norm_a = sqrt(xa*xa + ya*ya + za*za) norm_b = sqrt(xb*xb + yb*yb + zb*zb) denominator = norm_a*norm_b*(norm_a*norm_b + xa*xb+ya*yb+za*zb) @@ -309,12 +321,12 @@ subroutine ui_seg(iCPStart, iCPEnd, CPs, & ! --- Regularization (close field) -- Offset denominator = denominator+RegParam(is)**2*norm2_r0 Kv = SegGamma(is)*fourpi_inv*(norm_a+norm_b)/(denominator + MINDENOM) - Uind(1:3) = Kv*crossprod(1:3) + Uind(1:3) = Uind(1:3) + Kv*crossprod(1:3) end if end if ! denominator size or distances too small end if ! - Uind_out(1:3,icp) = Uind_out(1:3,icp)+Uind(1:3) end do ! Loop on segments + Uind_out(1:3,icp) = Uind_out(1:3,icp)+Uind(1:3) enddo ! Loop on control points !$OMP END DO !$OMP END PARALLEL diff --git a/modules/aerodyn/src/FVW_Wings.f90 b/modules/aerodyn/src/FVW_Wings.f90 index 443653caac..4279d9d59c 100644 --- a/modules/aerodyn/src/FVW_Wings.f90 +++ b/modules/aerodyn/src/FVW_Wings.f90 @@ -281,23 +281,25 @@ subroutine Wings_ComputeCirculation(t, z, z_prev, p, x, m, AFInfo, ErrStat, ErrM GammaScale=1.0_ReKi endif - if (p%CircSolvMethod==idCircPrescribed) then + select case (p%CircSolvMethod) + ! Prescribed circulation + case (idCircPrescribed) do iW = 1, p%nWings !Loop over lifting lines z%W(iW)%Gamma_LL(1:p%W(iW)%nSpan) = p%W(iW)%PrescribedCirculation(1:p%W(iW)%nSpan) m%W(iW)%Vind_CP=-9999._ReKi !< Safety m%W(iW)%Vtot_CP=-9999._ReKi !< Safety enddo - else if (p%CircSolvMethod==idCircPolarData) then - ! --- Solve for circulation using polar data + ! Solve for circulation using polar data + case (idCircPolarData) CALL Wings_ComputeCirculationPolarData(z, z_prev, p, x, m, AFInfo, GammaScale, ErrStat, ErrMsg, iLabel) - else if (p%CircSolvMethod==idCircNoFlowThrough) then + case (idCircNoFlowThrough) ! --- Solve for circulation using the no-flow through condition ErrMsg='Circulation method nor implemented'; ErrStat=ErrID_Fatal; return ! should never happen - else + case default ErrMsg='Circulation method nor implemented'; ErrStat=ErrID_Fatal; return ! should never happen - endif + end select ! Scale circulation (for initial transient) do iW = 1, p%nWings !Loop over lifting lines @@ -428,9 +430,9 @@ subroutine Wings_ComputeCirculationPolarData(z, z_prev, p, x, m, AFInfo, GammaSc do iDepth=1,p%iNWStart ! Two first panels ! --- Defining a ring P1=x%W(iW)%r_NW(1:3,iSpan ,iDepth ) + P4=x%W(iW)%r_NW(1:3,iSpan ,iDepth+1) P2=x%W(iW)%r_NW(1:3,iSpan+1,iDepth ) P3=x%W(iW)%r_NW(1:3,iSpan+1,iDepth+1) - P4=x%W(iW)%r_NW(1:3,iSpan ,iDepth+1) ! --- Induced velocity from ring, on all other control points (have to loop on rotors and wings and span again) kCP2=1 do iWCP=1,p%nWings diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index e7825d4264..ff75e252af 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -1331,7 +1331,7 @@ END SUBROUTINE HydroDyn_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. -SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, calcMorisonHstLds ) REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds TYPE(HydroDyn_InputType), INTENT(INOUT) :: u !< Inputs at Time (note that this is intent out because we're copying the u%WAMITMesh into m%u_wamit%mesh) @@ -1345,6 +1345,8 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, TYPE(HydroDyn_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !! Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !! Error message if ErrStat /= ErrID_None + LOGICAL, OPTIONAL, INTENT(IN ) :: calcMorisonHstLds !< Flag to calculate the Morison hydrostatic loads (default: .true.) + !! Used to speed up Jacobian calculations when perturbing velocity/acceleration inputs INTEGER :: I, J ! Generic counters @@ -1367,11 +1369,18 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CalcOutput' REAL(ReKi), PARAMETER :: LrgAngle = 0.261799387799149 ! Threshold for platform roll and pitch rotation (15 deg). This is consistent with the ElastoDyn check. LOGICAL, SAVE :: FrstWarn_LrgY = .TRUE. + logical :: calcMorisonHstLdsLocal ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" + + if (present(calcMorisonHstLds)) then + calcMorisonHstLdsLocal = calcMorisonHstLds + else + calcMorisonHstLdsLocal = .true. + end if ! Write the Hydrodyn-level output file data FROM THE LAST COMPLETED TIME STEP if the user requested module-level output @@ -1567,7 +1576,8 @@ SUBROUTINE HydroDyn_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, IF ( u%Morison%Mesh%Committed ) THEN ! Make sure we are using Morison / there is a valid mesh u%Morison%PtfmRefY = PtfmRefY CALL Morison_CalcOutput( Time, u%Morison, p%Morison, x%Morison, xd%Morison, & - z%Morison, OtherState%Morison, y%Morison, m%Morison, ErrStat2, ErrMsg2 ) + z%Morison, OtherState%Morison, y%Morison, m%Morison, & + ErrStat2, ErrMsg2, calcMorisonHstLdsLocal ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -1774,6 +1784,7 @@ SUBROUTINE HD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, INTEGER(IntKi) :: i, j, k, col INTEGER(IntKi) :: startingI, startingJ, bOffset, offsetI integer(IntKi) :: iVarWaveElev0, iVarHWindSpeed, iVarPLexp, iVarPropagationDir + logical :: calcMorisonHstLds ErrStat = ErrID_None ErrMsg = '' @@ -1816,19 +1827,27 @@ SUBROUTINE HD_JacobianPInput(Vars, t, u, p, x, xd, z, OtherState, y, m, ErrStat, ! If variable is extended input, skip if (MV_HasFlagsAll(Vars%u(i), VF_ExtLin)) cycle + ! Calculate Morison hydrostatic loads when perturbing displacement/orientation inputs + select case (Vars%u(i)%Field) + case (FieldTransDisp, FieldOrientation) + calcMorisonHstLds = .true. + case default + calcMorisonHstLds = .false. + end select + ! Loop through number of linearization perturbations in variable do j = 1, Vars%u(i)%Num ! Calculate positive perturbation call MV_Perturb(Vars%u(i), j, 1, m%Jac%u, m%Jac%u_perturb) call HydroDyn_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) - call HydroDyn_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call HydroDyn_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, calcMorisonHstLds); if (Failed()) return call HydroDyn_VarsPackOutput(Vars, m%y_lin, m%Jac%y_pos) ! Calculate negative perturbation call MV_Perturb(Vars%u(i), j, -1, m%Jac%u, m%Jac%u_perturb) call HydroDyn_VarsUnpackInput(Vars, m%Jac%u_perturb, m%u_perturb) - call HydroDyn_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2); if (Failed()) return + call HydroDyn_CalcOutput(t, m%u_perturb, p, x, xd, z, OtherState, m%y_lin, m, ErrStat2, ErrMsg2, calcMorisonHstLds); if (Failed()) return call HydroDyn_VarsPackOutput(Vars, m%y_lin, m%Jac%y_neg) ! Calculate column index diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 0b3d688142..f7f1153241 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -3444,7 +3444,7 @@ SUBROUTINE AllocateNodeLoadVariables(InitInp, p, m, NNodes, errStat, errMsg ) END SUBROUTINE AllocateNodeLoadVariables !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. -SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, errMsg ) +SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, errMsg, calcHstLds ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds @@ -3459,6 +3459,8 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, TYPE(Morison_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: errMsg !< Error message if errStat /= ErrID_None + LOGICAL, OPTIONAL, INTENT(IN ) :: calcHstLds !< Flag to calculate the hydrostatic loads (default: .true.) + !! Used to speed up Jacobian calculations when perturbing velocity/acceleration inputs ! Local variables INTEGER(IntKi) :: errStat2 ! Error status of the operation (occurs after initial error) @@ -3538,12 +3540,20 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, INTEGER(IntKi) :: nodeInWater REAL(SiKi) :: WaveElev1, WaveElev2, WaveElev, FDynP, FV(3), FA(3), FAMCF(3) LOGICAL :: Is1stElement, Is1stFloodedMember + LOGICAL :: calcHstLdsLocal ! Initialize errStat errStat = ErrID_None errMsg = "" Imat = 0.0_ReKi g = p%Gravity + + ! Determine whether to calculate hydrostatic loads + if (present(calcHstLds)) then + calcHstLdsLocal = calcHstLds + else + calcHstLdsLocal = .true. + end if !=============================================================================================== ! Get displaced positions of the hydrodynamic nodes @@ -3570,7 +3580,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, DO j = 1,p%FilledGroups(i)%FillNumM im = p%FilledGroups(i)%FillMList(j) IF (p%Members(im)%memfloodstatus>0) THEN - CALL getMemBallastHiPt(p%Members(im),z_hi,ErrStat2,ErrMsg2); if (Failed()) return + CALL getMemBallastHiPt(p,m,u,p%Members(im),z_hi,ErrStat2,ErrMsg2); if (Failed()) return IF ( Is1stFloodedMember ) THEN m%zFillGroup(i) = z_hi Is1stFloodedMember = .false. @@ -3658,8 +3668,6 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! Note: CMatrix is element local to global displaced. CTrans is the opposite. ! save some commonly used variables dl = mem%dl - z1 = pos1(3) ! get node z locations from input mesh - z2 = pos2(3) a_s1 = u%Mesh%TranslationAcc(:, mem%NodeIndx(i )) alpha_s1 = u%Mesh%RotationAcc (:, mem%NodeIndx(i )) omega_s1 = u%Mesh%RotationVel (:, mem%NodeIndx(i )) @@ -3750,17 +3758,26 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, y%Mesh%Moment(:,mem%NodeIndx(i+1)) = y%Mesh%Moment(:,mem%NodeIndx(i+1)) + F_IMG(4:6) ! ------------------- buoyancy loads: sides: Sections 3.1 and 3.2 ------------------------ - IF (mem%MHstLMod == 1) THEN + + ! Skip hydrostatic load calculation if flag is false + if (.not. calcHstLdsLocal) cycle + + ! Select hydrostatic load calculation method + select case (mem%MHstLMod) + + ! Standard hydrostatic load calculation + case (1) + IF ( p%WaveField%WaveStMod > 0_IntKi ) THEN ! If wave stretching is enabled, compute buoyancy up to free surface - CALL GetTotalWaveElev( Time, pos1, Zeta1, ErrStat2, ErrMsg2 ) - CALL GetTotalWaveElev( Time, pos2, Zeta2, ErrStat2, ErrMsg2 ) + CALL GetTotalWaveElev(p, m, Time, pos1, Zeta1, ErrStat2, ErrMsg2 ) + CALL GetTotalWaveElev(p, m, Time, pos2, Zeta2, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE ! Without wave stretching, compute buoyancy based on SWL Zeta1 = 0.0_ReKi Zeta2 = 0.0_ReKi END IF Is1stElement = ( i .EQ. 1) - CALL getElementHstLds_Mod1(mem, Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1b, r2b, dl, mem%alpha(i), Is1stElement, F_B0, F_B1, F_B2, ErrStat2, ErrMsg2 ) + CALL getElementHstLds_Mod1(p, m, mem, Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1b, r2b, dl, mem%alpha(i), Is1stElement, F_B0, F_B1, F_B2, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Add nodal loads to mesh IF ( .NOT. Is1stElement ) THEN @@ -3774,19 +3791,24 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, y%Mesh%Moment(:,mem%NodeIndx(i )) = y%Mesh%Moment(:,mem%NodeIndx(i )) + F_B1(4:6) y%Mesh%Force (:,mem%NodeIndx(i+1)) = y%Mesh%Force (:,mem%NodeIndx(i+1)) + F_B2(1:3) y%Mesh%Moment(:,mem%NodeIndx(i+1)) = y%Mesh%Moment(:,mem%NodeIndx(i+1)) + F_B2(4:6) - ELSE IF (mem%MHstLMod == 2) THEN ! Alternative hydrostatic load calculation + + ! Alternative hydrostatic load calculation + case (2) + ! Get free surface elevation and normal at the element midpoint (both assumed constant over the element) posMid = 0.5 * (pos1+pos2) + ! rn is only used to estimate free surface normal numerically IF (mem%MSecGeom == MSecGeom_Cyl) THEN rn = 0.5 * (r1b +r2b ) ELSE IF (mem%MSecGeom == MSecGeom_Rec) THEN rn = MAX( 0.5*(Sa1b+Sa2b), 0.5*(Sb1b+Sb2b) ) END IF + IF (p%WaveField%WaveStMod > 0) THEN - CALL GetTotalWaveElev( Time, posMid, ZetaMid, ErrStat2, ErrMsg2 ) + CALL GetTotalWaveElev(p, m, Time, posMid, ZetaMid, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL GetFreeSurfaceNormal( Time, posMid, rn, n_hat, ErrStat2, ErrMsg2 ) + CALL GetFreeSurfaceNormal( p, m, Time, posMid, rn, n_hat, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FSPt = (/posMid(1),posMid(2),ZetaMid/) ! Reference point on the free surface ELSE @@ -3796,11 +3818,12 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, IF (mem%MSecGeom == MSecGeom_Cyl) THEN CALL GetSectionUnitVectors_Cyl( k_hat, y_hat, z_hat ) - CALL getElementHstLds_Mod2_Cyl( pos1, pos2, FSPt, k_hat, y_hat, z_hat, n_hat, r1b, r2b, dl, F_B1, F_B2, ErrStat2, ErrMsg2) + CALL getElementHstLds_Mod2_Cyl( p, pos1, pos2, FSPt, k_hat, y_hat, z_hat, n_hat, r1b, r2b, dl, F_B1, F_B2, ErrStat2, ErrMsg2) ELSE IF (mem%MSecGeom == MSecGeom_Rec) THEN CALL GetSectionUnitVectors_Rec( CMatrix, x_hat, y_hat ) - CALL getElementHstLds_Mod2_Rec( pos1, pos2, FSPt, k_hat, x_hat, y_hat, n_hat, Sa1b, Sa2b, Sb1b, Sb2b, dl, F_B1, F_B2, ErrStat2, ErrMsg2) + CALL getElementHstLds_Mod2_Rec( p, pos1, pos2, FSPt, k_hat, x_hat, y_hat, n_hat, Sa1b, Sa2b, Sb1b, Sb2b, dl, F_B1, F_B2, ErrStat2, ErrMsg2) END IF + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Add nodal loads to mesh @@ -3810,7 +3833,8 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, y%Mesh%Moment(:,mem%NodeIndx(i )) = y%Mesh%Moment(:,mem%NodeIndx(i )) + F_B1(4:6) y%Mesh%Force (:,mem%NodeIndx(i+1)) = y%Mesh%Force (:,mem%NodeIndx(i+1)) + F_B2(1:3) y%Mesh%Moment(:,mem%NodeIndx(i+1)) = y%Mesh%Moment(:,mem%NodeIndx(i+1)) + F_B2(4:6) - END IF ! MHstLMod + + end select ! MHstLMod END DO ! i = max(mem%i_floor,1), N ! loop through member elements that are not fully buried in the seabed END IF ! NOT Modeled with Potential flow theory @@ -4039,7 +4063,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, 0.5*mem%AxCd(i)*p%WaveField%WtrDens * pi*mem%RMG(i)*dRdl_p * & ! axial part abs(dot_product( mem%k, m%vrel(:,mem%NodeIndx(i)) )) * matmul( mem%kkt, m%vrel(:,mem%NodeIndx(i)) ) ! axial part cont'd ELSE IF (mem%MSecGeom==MSecGeom_Rec) THEN - Call GetDistDrag_Rec(Time,mem,i,dSadl_p,dSbdl_p,f_hydro,ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Call GetDistDrag_Rec(p, m, u, xd, Time,mem,i,dSadl_p,dSbdl_p,f_hydro,ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF CALL LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_D(:, i) ) y%Mesh%Force (:,mem%NodeIndx(i)) = y%Mesh%Force (:,mem%NodeIndx(i)) + m%memberLoads(im)%F_D(1:3, i) @@ -4194,7 +4218,8 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, CpFSInt = SubRatio * mem%Cp( FSElem+1) + (1.0-SubRatio) * mem%Cp( FSElem) AxCpFSInt = SubRatio * mem%AxCp(FSElem+1) + (1.0-SubRatio) * mem%AxCp(FSElem) - Call GetDistDrag_Rec(Time,mem,FSElem,dSadl_p,dSbdl_p,F_DS,ErrStat2,ErrMsg2,SubRatio,vrelFSInt); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Call GetDistDrag_Rec(p, m, u, xd, Time,mem,FSElem,dSadl_p,dSbdl_p,F_DS,ErrStat2,ErrMsg2,SubRatio,vrelFSInt) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! Hydrodynamic added mass and inertia loads IF ( .NOT. mem%PropPot ) THEN @@ -4405,7 +4430,8 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, 0.5*mem%AxCd(i)*p%WaveField%WtrDens*pi*mem%RMG(i)*dRdl_p * & ! axial part abs(dot_product( mem%k, m%vrel(:,mem%NodeIndx(i)) )) * matmul( mem%kkt, m%vrel(:,mem%NodeIndx(i)) ) ! axial part cont'd ELSE IF (mem%MSecGeom==MSecGeom_Rec) THEN - Call GetDistDrag_Rec(Time,mem,i,dSadl_p,dSbdl_p,f_hydro,ErrStat2,ErrMsg2); CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Call GetDistDrag_Rec(p, m, u, xd, Time,mem,i,dSadl_p,dSbdl_p,f_hydro,ErrStat2,ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF CALL LumpDistrHydroLoads( f_hydro, mem%k, deltal, h_c, m%memberLoads(im)%F_D(:, i) ) y%Mesh%Force (:,mem%NodeIndx(i)) = y%Mesh%Force (:,mem%NodeIndx(i)) + m%memberLoads(im)%F_D(1:3, i) @@ -4574,9 +4600,9 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, if (mem%i_floor == 0) then ! both ends above or at seabed ! Compute loads on the end plate of node 1 IF (p%WaveField%WaveStMod > 0) THEN - CALL GetTotalWaveElev( Time, pos1, Zeta1, ErrStat2, ErrMsg2 ) + CALL GetTotalWaveElev(p, m, Time, pos1, Zeta1, ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL GetFreeSurfaceNormal( Time, pos1, rn1, n_hat, ErrStat2, ErrMsg2 ) + CALL GetFreeSurfaceNormal(p, m, Time, pos1, rn1, n_hat, ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FSPt = (/pos1(1),pos1(2),Zeta1/) ! Reference point on the free surface ELSE @@ -4588,7 +4614,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, CALL GetSectionUnitVectors_Cyl( k_hat1, y_hat, z_hat ) CALL GetSectionFreeSurfaceIntersects_Cyl( REAL(pos1,DbKi), REAL(FSPt,DbKi), k_hat1, y_hat, z_hat, n_hat, REAL(r1,DbKi), theta1, theta2, secStat) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL GetEndPlateHstLds_Cyl(pos1, k_hat1, y_hat, z_hat, r1, theta1, theta2, F_B_End) + CALL GetEndPlateHstLds_Cyl(p, pos1, k_hat1, y_hat, z_hat, r1, theta1, theta2, F_B_End) IF (mem%MHstLMod == 1) THEN ! Check for partially wetted end plates IF ( .NOT.( EqualRealNos((theta2-theta1),0.0_DbKi) .OR. EqualRealNos((theta2-theta1),2.0_DbKi*PI_D) ) ) THEN CALL SetErrStat(ErrID_Warn, 'End plate is partially wetted with MHstLMod = 1. The buoyancy load and distribution potentially have large error. This has happened to the first node of Member ID ' //trim(num2lstr(mem%MemberID)), errStat, errMsg, RoutineName ) @@ -4596,15 +4622,15 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, END IF else if (mem%MSecGeom==MSecGeom_Rec) then CALL GetSectionUnitVectors_Rec( CMatrix1, x_hat, y_hat ) - CALL GetEndPlateHstLds_Rec(pos1, k_hat1, x_hat, y_hat, Sa1, Sb1, FSPt, n_hat, F_B_End) + CALL GetEndPlateHstLds_Rec(p, pos1, k_hat1, x_hat, y_hat, Sa1, Sb1, FSPt, n_hat, F_B_End) end if m%F_B_End(:, mem%NodeIndx( 1)) = m%F_B_End(:, mem%NodeIndx( 1)) + F_B_End ! Compute loads on the end plate of node N+1 IF (p%WaveField%WaveStMod > 0) THEN - CALL GetTotalWaveElev( Time, pos2, Zeta2, ErrStat2, ErrMsg2 ) + CALL GetTotalWaveElev(p, m, Time, pos2, Zeta2, ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL GetFreeSurfaceNormal( Time, pos2, rn2, n_hat, ErrStat2, ErrMsg2 ) + CALL GetFreeSurfaceNormal(p, m, Time, pos2, rn2, n_hat, ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FSPt = (/pos2(1),pos2(2),Zeta2/) ! Reference point on the free surface ELSE @@ -4616,7 +4642,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, CALL GetSectionUnitVectors_Cyl( k_hat2, y_hat, z_hat ) CALL GetSectionFreeSurfaceIntersects_Cyl( REAL(pos2,DbKi), REAL(FSPt,DbKi), k_hat2, y_hat, z_hat, n_hat, REAL(r2,DbKi), theta1, theta2, secStat) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL GetEndPlateHstLds_Cyl(pos2, k_hat2, y_hat, z_hat, r2, theta1, theta2, F_B_End) + CALL GetEndPlateHstLds_Cyl(p, pos2, k_hat2, y_hat, z_hat, r2, theta1, theta2, F_B_End) IF (mem%MHstLMod == 1) THEN ! Check for partially wetted end plates IF ( .NOT.( EqualRealNos((theta2-theta1),0.0_DbKi) .OR. EqualRealNos((theta2-theta1),2.0_DbKi*PI_D) ) ) THEN CALL SetErrStat(ErrID_Warn, 'End plate is partially wetted with MHstLMod = 1. The buoyancy load and distribution potentially have large error. This has happened to the last node of Member ID ' //trim(num2lstr(mem%MemberID)), errStat, errMsg, RoutineName ) @@ -4624,16 +4650,16 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, END IF else if (mem%MSecGeom==MSecGeom_Rec) then CALL GetSectionUnitVectors_Rec( CMatrix2, x_hat, y_hat ) - CALL GetEndPlateHstLds_Rec(pos2, k_hat2, x_hat, y_hat, Sa2, Sb2, FSPt, n_hat, F_B_End) + CALL GetEndPlateHstLds_Rec(p, pos2, k_hat2, x_hat, y_hat, Sa2, Sb2, FSPt, n_hat, F_B_End) end if m%F_B_End(:, mem%NodeIndx(N+1)) = m%F_B_End(:, mem%NodeIndx(N+1)) - F_B_End elseif ( mem%doEndBuoyancy ) then ! The member crosses the seabed line so only the upper end potentially have hydrostatic load ! Only compute the loads on the end plate of node N+1 IF (p%WaveField%WaveStMod > 0) THEN - CALL GetTotalWaveElev( Time, pos2, Zeta2, ErrStat2, ErrMsg2 ) + CALL GetTotalWaveElev(p, m, Time, pos2, Zeta2, ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL GetFreeSurfaceNormal( Time, pos2, rn2, n_hat, ErrStat2, ErrMsg2 ) + CALL GetFreeSurfaceNormal(p, m, Time, pos2, rn2, n_hat, ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) FSPt = (/pos2(1),pos2(2),Zeta2/) ! Reference point on the free surface ELSE @@ -4645,7 +4671,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, CALL GetSectionUnitVectors_Cyl( k_hat2, y_hat, z_hat ) CALL GetSectionFreeSurfaceIntersects_Cyl( REAL(pos2,DbKi), REAL(FSPt,DbKi), k_hat2, y_hat, z_hat, n_hat, REAL(r2,DbKi), theta1, theta2, secStat) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL GetEndPlateHstLds_Cyl(pos2, k_hat2, y_hat, z_hat, r2, theta1, theta2, F_B_End) + CALL GetEndPlateHstLds_Cyl(p, pos2, k_hat2, y_hat, z_hat, r2, theta1, theta2, F_B_End) IF (mem%MHstLMod == 1) THEN ! Check for partially wetted end plates IF ( .NOT.( EqualRealNos((theta2-theta1),0.0_DbKi) .OR. EqualRealNos((theta2-theta1),2.0_DbKi*PI_D) ) ) THEN CALL SetErrStat(ErrID_Warn, 'End plate is partially wetted with MHstLMod = 1. The buoyancy load and distribution potentially have large error. This has happened to the last node of Member ID ' //trim(num2lstr(mem%MemberID)), errStat, errMsg, RoutineName ) @@ -4653,7 +4679,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, END IF else if (mem%MSecGeom==MSecGeom_Rec) then CALL GetSectionUnitVectors_Rec( CMatrix2, x_hat, y_hat ) - CALL GetEndPlateHstLds_Rec(pos2, k_hat2, x_hat, y_hat, Sa2, Sb2, FSPt, n_hat, F_B_End) + CALL GetEndPlateHstLds_Rec(p, pos2, k_hat2, x_hat, y_hat, Sa2, Sb2, FSPt, n_hat, F_B_End) end if m%F_B_End(:, mem%NodeIndx(N+1)) = m%F_B_End(:, mem%NodeIndx(N+1)) - F_B_End @@ -4687,7 +4713,7 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, ! Effect of wave stretching already baked into m%FDynP, m%FA, and m%vrel. No additional modification needed. ! Joint yaw offset - call YawJoint(J,u%PtfmRefY,AM_End,An_End,DP_Const_End,I_MG_End,ErrStat2,ErrMsg2) + call YawJoint(p, J,u%PtfmRefY,AM_End,An_End,DP_Const_End,I_MG_End,ErrStat2,ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! Lumped added mass loads @@ -4750,7 +4776,19 @@ SUBROUTINE Morison_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, errStat, CONTAINS - SUBROUTINE GetTotalWaveElev( Time, pos, Zeta, ErrStat, ErrMsg ) + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + !if (Failed) then + ! call FailCleanup() + !endif + end function Failed + +END SUBROUTINE Morison_CalcOutput + + SUBROUTINE GetTotalWaveElev(p, m, Time, pos, Zeta, ErrStat, ErrMsg ) + TYPE(Morison_ParameterType), INTENT( IN ) :: p + TYPE(Morison_MiscVarType), INTENT( INOUT ) :: m REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos(*) ! Position at which free-surface elevation is to be calculated. Third entry ignored if present. REAL(ReKi), INTENT( OUT ) :: Zeta ! Total free-surface elevation with first- and second-order contribution (if present) @@ -4767,7 +4805,9 @@ SUBROUTINE GetTotalWaveElev( Time, pos, Zeta, ErrStat, ErrMsg ) END SUBROUTINE GetTotalWaveElev - SUBROUTINE GetFreeSurfaceNormal( Time, pos, r, n, ErrStat, ErrMsg) + SUBROUTINE GetFreeSurfaceNormal(p, m, Time, pos, r, n, ErrStat, ErrMsg) + TYPE(Morison_ParameterType), INTENT( IN ) :: p + TYPE(Morison_MiscVarType), INTENT( INOUT ) :: m REAL(DbKi), INTENT( In ) :: Time REAL(ReKi), INTENT( In ) :: pos(:) ! Position at which free-surface normal is to be calculated. Third entry ignored if present. REAL(ReKi), INTENT( In ) :: r ! Distance for central differencing @@ -4859,8 +4899,8 @@ SUBROUTINE GetSectionFreeSurfaceIntersects_Cyl( pos0, FSPt, k_hat, y_hat, z_hat, END SUBROUTINE GetSectionFreeSurfaceIntersects_Cyl - SUBROUTINE GetSectionHstLds_Cyl( origin, pos0, k_hat, y_hat, z_hat, R, dRdl, theta1, theta2, dFdl) - + SUBROUTINE GetSectionHstLds_Cyl(p, origin, pos0, k_hat, y_hat, z_hat, R, dRdl, theta1, theta2, dFdl) + TYPE(Morison_ParameterType), INTENT( IN ) :: p REAL(DbKi), INTENT( IN ) :: origin(3) REAL(DbKi), INTENT( IN ) :: pos0(3) REAL(DbKi), INTENT( IN ) :: k_hat(3) @@ -4888,12 +4928,12 @@ SUBROUTINE GetSectionHstLds_Cyl( origin, pos0, k_hat, y_hat, z_hat, R, dRdl, the dFdl(1:3) = -R *dRdl*C0*k_hat + R*C1*y_hat + R*C2*z_hat dFdl(4:6) = -R**2*dRdl*C2*y_hat + R**2*dRdl*C1*z_hat + CROSS_PRODUCT((pos0-origin),dFdl(1:3)) - dFdl = dFdl * p%WaveField%WtrDens * g + dFdl = dFdl * p%WaveField%WtrDens * p%Gravity END SUBROUTINE GetSectionHstLds_Cyl - SUBROUTINE GetSectionHstLds_Rec( origin, pos0, k_hat, x_hat, y_hat, Sa, Sb, dSadl, dSbdl, rFS, nFS, dFdl, secStat) - + SUBROUTINE GetSectionHstLds_Rec(p, origin, pos0, k_hat, x_hat, y_hat, Sa, Sb, dSadl, dSbdl, rFS, nFS, dFdl, secStat) + TYPE(Morison_ParameterType), INTENT( IN ) :: p REAL(DbKi), INTENT( IN ) :: origin(3) REAL(DbKi), INTENT( IN ) :: pos0(3) REAL(DbKi), INTENT( IN ) :: k_hat(3) @@ -4996,12 +5036,12 @@ SUBROUTINE GetSectionHstLds_Rec( origin, pos0, k_hat, x_hat, y_hat, Sa, Sb, dSad end do - dFdl = dFdl * p%WaveField%WtrDens * g + dFdl = dFdl * p%WaveField%WtrDens * p%Gravity END SUBROUTINE GetSectionHstLds_Rec - SUBROUTINE getElementHstLds_Mod2_Cyl( pos1In, pos2In, FSPtIn, k_hatIn, y_hatIn, z_hatIn, n_hatIn, r1In, r2In, dlIn, F_B1, F_B2, ErrStat, ErrMsg ) - + SUBROUTINE getElementHstLds_Mod2_Cyl(p, pos1In, pos2In, FSPtIn, k_hatIn, y_hatIn, z_hatIn, n_hatIn, r1In, r2In, dlIn, F_B1, F_B2, ErrStat, ErrMsg ) + TYPE(Morison_ParameterType), INTENT( IN ) :: p REAL(ReKi), INTENT( IN ) :: pos1In(3) REAL(ReKi), INTENT( IN ) :: pos2In(3) REAL(ReKi), INTENT( IN ) :: FSPtIn(3) @@ -5024,7 +5064,6 @@ SUBROUTINE getElementHstLds_Mod2_Cyl( pos1In, pos2In, FSPtIn, k_hatIn, y_hatIn, INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 ErrStat = ErrID_None - ErrMsg = "" pos1 = REAL(pos1In,DbKi) pos2 = REAL(pos2In,DbKi) @@ -5055,19 +5094,21 @@ SUBROUTINE getElementHstLds_Mod2_Cyl( pos1In, pos2In, FSPtIn, k_hatIn, y_hatIn, ! Section load at node 1 CALL GetSectionFreeSurfaceIntersects_Cyl( pos1, FSPt, REAL(k_hat,ReKi), REAL(y_hat,ReKi), REAL(z_hat,ReKi), REAL(n_hat,ReKi), r1, theta1, theta2, secStat1) - CALL GetSectionHstLds_Cyl( pos1, pos1, k_hat, y_hat, z_hat, r1, dRdl, theta1, theta2, dFdl1) + CALL GetSectionHstLds_Cyl(p, pos1, pos1, k_hat, y_hat, z_hat, r1, dRdl, theta1, theta2, dFdl1) ! Section load at midpoint CALL GetSectionFreeSurfaceIntersects_Cyl( posMid, FSPt, REAL(k_hat,ReKi), REAL(y_hat,ReKi), REAL(z_hat,ReKi), REAL(n_hat,ReKi), rMid, theta1, theta2, secStatMid) - CALL GetSectionHstLds_Cyl( pos1, posMid, k_hat, y_hat, z_hat, rMid, dRdl, theta1, theta2, dFdlMid) + CALL GetSectionHstLds_Cyl(p, pos1, posMid, k_hat, y_hat, z_hat, rMid, dRdl, theta1, theta2, dFdlMid) ! Section load at node 2 CALL GetSectionFreeSurfaceIntersects_Cyl( pos2, FSPt, REAL(k_hat,ReKi), REAL(y_hat,ReKi), REAL(z_hat,ReKi), REAL(n_hat,ReKi), r2, theta1, theta2, secStat2) - CALL GetSectionHstLds_Cyl( pos1, pos2, k_hat, y_hat, z_hat, r2, dRdl, theta1, theta2, dFdl2) + CALL GetSectionHstLds_Cyl(p, pos1, pos2, k_hat, y_hat, z_hat, r2, dRdl, theta1, theta2, dFdl2) ! Adaptively refine the load integration over the element - CALL RefineElementHstLds_Cyl(pos1,pos1,posMid,pos2,FSPt,r1,rMid,r2,dl,dRdl,secStat1,secStatMid,secStat2,k_hat,y_hat,z_hat,n_hat,dFdl1,dFdlMid,dFdl2,1,F_B,ErrStat2,ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL RefineElementHstLds_Cyl(p,pos1,pos1,posMid,pos2,FSPt,r1,rMid,r2,dl,dRdl,secStat1,secStatMid,secStat2,k_hat,y_hat,z_hat,n_hat,dFdl1,dFdlMid,dFdl2,1,F_B,ErrStat2) + if (ErrStat2 /= ErrID_None) then + CALL SetErrStat( ErrStat2, 'Tolerance for element hydrostatic load not met after the maximum allowed level of recursion is reached. Consider reducing MDivSize.', ErrStat, ErrMsg, RoutineName ) + end if ! Distribute the hydrostatic load to the two end nodes F_B1(1:3) = 0.5_DbKi * F_B(1:3) @@ -5078,8 +5119,8 @@ SUBROUTINE getElementHstLds_Mod2_Cyl( pos1In, pos2In, FSPtIn, k_hatIn, y_hatIn, END SUBROUTINE getElementHstLds_Mod2_Cyl - SUBROUTINE getElementHstLds_Mod2_Rec( pos1In, pos2In, FSPtIn, k_hatIn, x_hatIn, y_hatIn, n_hatIn, Sa1In, Sa2In, Sb1In, Sb2In, dlIn, F_B1, F_B2, ErrStat, ErrMsg ) - + SUBROUTINE getElementHstLds_Mod2_Rec(p, pos1In, pos2In, FSPtIn, k_hatIn, x_hatIn, y_hatIn, n_hatIn, Sa1In, Sa2In, Sb1In, Sb2In, dlIn, F_B1, F_B2, ErrStat, ErrMsg ) + TYPE(Morison_ParameterType), INTENT( IN ) :: p REAL(ReKi), INTENT( IN ) :: pos1In(3) REAL(ReKi), INTENT( IN ) :: pos2In(3) REAL(ReKi), INTENT( IN ) :: FSPtIn(3) @@ -5136,16 +5177,16 @@ SUBROUTINE getElementHstLds_Mod2_Rec( pos1In, pos2In, FSPtIn, k_hatIn, x_hatIn, END IF ! Section load at node 1 - CALL GetSectionHstLds_Rec( pos1, pos1, k_hat, x_hat, y_hat, Sa1, Sb1, dSadl, dSbdl, FSPt, n_hat, dFdl1, secStat1) + CALL GetSectionHstLds_Rec(p, pos1, pos1, k_hat, x_hat, y_hat, Sa1, Sb1, dSadl, dSbdl, FSPt, n_hat, dFdl1, secStat1) ! Section load at midpoint - CALL GetSectionHstLds_Rec( pos1, posMid, k_hat, x_hat, y_hat, SaMid, SbMid, dSadl, dSbdl, FSPt, n_hat, dFdlMid, secStatMid) + CALL GetSectionHstLds_Rec(p, pos1, posMid, k_hat, x_hat, y_hat, SaMid, SbMid, dSadl, dSbdl, FSPt, n_hat, dFdlMid, secStatMid) ! Section load at node 2 - CALL GetSectionHstLds_Rec( pos1, pos2, k_hat, x_hat, y_hat, Sa2, Sb2, dSadl, dSbdl, FSPt, n_hat, dFdl2, secStat2) + CALL GetSectionHstLds_Rec(p, pos1, pos2, k_hat, x_hat, y_hat, Sa2, Sb2, dSadl, dSbdl, FSPt, n_hat, dFdl2, secStat2) ! Adaptively refine the load integration over the element - CALL RefineElementHstLds_Rec(pos1,pos1,posMid,pos2,FSPt,Sa1,SaMid,Sa2,Sb1,SbMid,Sb2,dl,dSadl,dSbdl, & + CALL RefineElementHstLds_Rec(p,pos1,pos1,posMid,pos2,FSPt,Sa1,SaMid,Sa2,Sb1,SbMid,Sb2,dl,dSadl,dSbdl, & secStat1,secStatMid,secStat2,k_hat,x_hat,y_hat,n_hat,dFdl1,dFdlMid,dFdl2,1,F_B,ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5158,8 +5199,8 @@ SUBROUTINE getElementHstLds_Mod2_Rec( pos1In, pos2In, FSPtIn, k_hatIn, x_hatIn, END SUBROUTINE getElementHstLds_Mod2_Rec - RECURSIVE SUBROUTINE RefineElementHstLds_Cyl( origin, pos1, posMid, pos2, FSPt, r1, rMid, r2, dl, dRdl,secStat1,secStatMid,secStat2, k_hat, y_hat, z_hat, n_hat, dFdl1, dFdlMid, dFdl2, recurLvl, F_B_5pt, ErrStat, ErrMsg) - + SUBROUTINE RefineElementHstLds_Cyl(p, origin, pos1, posMid, pos2, FSPt, r1, rMid, r2, dl, dRdl,secStat1,secStatMid,secStat2, k_hat, y_hat, z_hat, n_hat, dFdl1, dFdlMid, dFdl2, recurLvl, F_B_5pt, ErrStat) + TYPE(Morison_ParameterType), INTENT( IN ) :: p REAL(DbKi), INTENT( IN ) :: origin(3) REAL(DbKi), INTENT( IN ) :: pos1(3) REAL(DbKi), INTENT( IN ) :: posMid(3) @@ -5182,84 +5223,175 @@ RECURSIVE SUBROUTINE RefineElementHstLds_Cyl( origin, pos1, posMid, pos2, FSPt, REAL(DbKi), INTENT( IN ) :: dFdl2(6) INTEGER(IntKi), INTENT( IN ) :: recurLvl REAL(DbKi), INTENT( OUT ) :: F_B_5pt(6) + INTEGER(IntKi), INTENT( OUT ) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if errStat /= ErrID_None REAL(DbKi) :: theta1,theta2 REAL(DbKi) :: posMidL(3), posMidR(3) REAL(DbKi) :: rMidL, rMidR - REAL(DbKi) :: dFdlMidL(6), dFdlMidR(6), F_B_3pt(6) + REAL(DbKi) :: dFdlMidL(6), dFdlMidR(6) + REAL(DbKi) :: F_B_3pt_sub(6), F_B_5pt_sub(6) REAL(DbKi) :: error(6), tmp(6) - LOGICAL :: refine, tolMet + LOGICAL :: tolMet INTEGER(IntKi) :: i INTEGER(IntKi) :: secStatMidL, secStatMidR + REAL(ReKi) :: k_hat_Re(3) + REAL(ReKi) :: y_hat_Re(3) + REAL(ReKi) :: z_hat_Re(3) + REAL(ReKi) :: n_hat_Re(3) REAL(DbKi), PARAMETER :: RelTol = 1.0E-6 REAL(DbKi), PARAMETER :: AbsTol = 1.0E-8 INTEGER(IntKi), PARAMETER :: maxRecurLvl = 50 CHARACTER(*), PARAMETER :: RoutineName = "RefineElementHstLds_Cyl" - + + type Stack + integer(IntKi) :: level + logical :: processed = .false. + real(DbKi) :: pos1(3), posMid(3), pos2(3) + real(DbKi) :: r1, rMid, r2 + real(DbKi) :: dl + integer(IntKi) :: secStat1, secStatMid, secStat2 + real(DbKi) :: dFdl1(6), dFdlMid(6), dFdl2(6) + end type + + type (Stack) :: SA(2*maxRecurLvl) ! Stack array + type (Stack) :: SE ! Stack element + ErrStat = ErrID_None - ErrMsg = "" - posMidL = 0.5_DbKi*(pos1+posMid) - posMidR = 0.5_DbKi*(posMid+pos2) - rMidL = 0.5_DbKi*(r1+rMid) - rMidR = 0.5_DbKi*(rMid+r2) + ! Convert unit vectors to ReKi for compatibility with GetSectionFreeSurfaceIntersects_Cyl + k_hat_Re = real(k_hat, ReKi) + y_hat_Re = real(y_hat, ReKi) + z_hat_Re = real(z_hat, ReKi) + n_hat_Re = real(n_hat, ReKi) + + ! Initialize first stack element + SA(1)%level = 1 + SA(1)%processed = .false. + SA(1)%pos1 = pos1 + SA(1)%posMid = posMid + SA(1)%pos2 = pos2 + SA(1)%r1 = r1 + SA(1)%rMid = rMid + SA(1)%r2 = r2 + SA(1)%dFdl1 = dFdl1 + SA(1)%dFdlMid = dFdlMid + SA(1)%dFdl2 = dFdl2 + SA(1)%dl = dl + SA(1)%secStat1 = secStat1 + SA(1)%secStatMid = secStatMid + SA(1)%secStat2 = secStat2 + + ! Initalize stack index + i = 1 + + ! Initialize output force + F_B_5pt = 0.0_DbKi + + ! Loop until all stack elements have been processed + do while (.true.) + + ! Find the next unprocessed stack element or exit if all processed + do while (SA(i)%processed) + i = i - 1 + if (i == 0) return ! All stack elements processed + end do - ! Avoid sections coincident with the SWL - IF ( ABS(k_hat(3)) > 0.999999_ReKi ) THEN ! Vertical member - IF ( EqualRealNos( posMidL(3), 0.0_DbKi ) ) THEN - posMidL(3) = posMidL(3) - 1.0E-6 * dl - END IF - IF ( EqualRealNos( posMidR(3), 0.0_DbKi ) ) THEN - posMidR(3) = posMidR(3) - 1.0E-6 * dl + ! Copy current stack element to local variable for processing + SE = SA(i) + + ! Compute mid points of left and right sub-elements + posMidL = 0.5_DbKi*(SE%pos1 + SE%posMid) + posMidR = 0.5_DbKi*(SE%posMid + SE%pos2) + rMidL = 0.5_DbKi*(SE%r1 + SE%rMid) + rMidR = 0.5_DbKi*(SE%rMid + SE%r2) + + ! Avoid sections coincident with the SWL + IF ( ABS(k_hat(3)) > 0.999999_ReKi ) THEN ! Vertical member + IF ( EqualRealNos( posMidL(3), 0.0_DbKi ) ) THEN + posMidL(3) = posMidL(3) - 1.0E-6 * SE%dl + END IF + IF ( EqualRealNos( posMidR(3), 0.0_DbKi ) ) THEN + posMidR(3) = posMidR(3) - 1.0E-6 * SE%dl + END IF END IF - END IF - ! Total hydrostatic load on the element (Simpsons Rule) - F_B_3pt = (dFdl1 + 4.0_DbKi*dFdlMid + dFdl2) * dl/6.0_DbKi + ! Total hydrostatic load on the element (3 point Simpsons Rule) + F_B_3pt_sub = (SE%dFdl1 + 4.0_DbKi*SE%dFdlMid + SE%dFdl2) * SE%dl/6.0_DbKi - ! Mid point of left section - CALL GetSectionFreeSurfaceIntersects_Cyl( posMidL, FSPt, REAL(k_hat,ReKi), REAL(y_hat,ReKi), REAL(z_hat,ReKi), REAL(n_hat,ReKi), rMidL, theta1, theta2, secStatMidL) - CALL GetSectionHstLds_Cyl( origin, posMidL, k_hat, y_hat, z_hat, rMidL, dRdl, theta1, theta2, dFdlMidL) + ! Mid point of left section + CALL GetSectionFreeSurfaceIntersects_Cyl( posMidL, FSPt, k_hat_Re, y_hat_Re, z_hat_Re, n_hat_Re, rMidL, theta1, theta2, secStatMidL) + CALL GetSectionHstLds_Cyl(p, origin, posMidL, k_hat, y_hat, z_hat, rMidL, dRdl, theta1, theta2, dFdlMidL) - ! Mid point of right section - CALL GetSectionFreeSurfaceIntersects_Cyl( posMidR, FSPt, REAL(k_hat,ReKi), REAL(y_hat,ReKi), REAL(z_hat,ReKi), REAL(n_hat,ReKi), rMidR, theta1, theta2, secStatMidR) - CALL GetSectionHstLds_Cyl( origin, posMidR, k_hat, y_hat, z_hat, rMidR, dRdl, theta1, theta2, dFdlMidR) - - F_B_5pt = (dFdl1 + 4.0_DbKi*dFdlMidL + 2.0_DbKi*dFdlMid + 4.0_DbKi*dFdlMidR + dFdl2) * dl/12.0_DbKi + ! Mid point of right section + CALL GetSectionFreeSurfaceIntersects_Cyl( posMidR, FSPt, k_hat_Re, y_hat_Re, z_hat_Re, n_hat_Re, rMidR, theta1, theta2, secStatMidR) + CALL GetSectionHstLds_Cyl(p, origin, posMidR, k_hat, y_hat, z_hat, rMidR, dRdl, theta1, theta2, dFdlMidR) + + ! Total hydrostatic load on the element (5 point Simpsons Rule) + F_B_5pt_sub = (SE%dFdl1 + 4.0_DbKi*dFdlMidL + 2.0_DbKi*SE%dFdlMid + 4.0_DbKi*dFdlMidR + SE%dFdl2) * SE%dl/12.0_DbKi - error = ABS(F_B_3pt - F_B_5pt) - tolMet = .TRUE. - DO i = 1,6 - IF ( error(i) > MAX(RelTol*ABS(F_B_5pt(i)),AbsTol) ) THEN - tolMet = .FALSE. - END IF - END DO - refine = .NOT. tolMet - IF (ABS(secStat1-secStat2)>1) THEN ! (Sub)element bounds the waterplane - refine = .TRUE. ! Keep refining irrespective of tolMet to avoid premature termination - END IF - IF ( recurLvl > maxRecurLvl ) THEN - refine = .FALSE. - IF (.NOT. tolMet) THEN - CALL SetErrStat(ErrID_Warn, 'Tolerance for element hydrostatic load not met after the maximum allowed level of recursion is reached. Consider reducing MDivSize.', ErrStat, ErrMsg, RoutineName ) - ! ELSE - ! Free surface is likely normal to the element. - END IF - END IF - - IF (refine) THEN ! Recursively refine the load integration if tolerance not met - CALL RefineElementHstLds_Cyl(origin,pos1,posMidL,posMid,FSPt,r1,rMidL,rMid,0.5_DbKi*dl,dRdl,secStat1,secStatMidL,secStatMid,k_hat,y_hat,z_hat,n_hat,dFdl1,dFdlMidL,dFdlMid, recurLvl+1, tmp, ErrStat, ErrMsg) - CALL RefineElementHstLds_Cyl(origin,posMid,posMidR,pos2,FSPt,rMid,rMidR,r2,0.5_DbKi*dl,dRdl,secStatMid,secStatMidR,secStat2,k_hat,y_hat,z_hat,n_hat,dFdlMid,dFdlMidR,dFdl2, recurLvl+1, F_B_5pt, ErrStat, ErrMsg) - F_B_5pt = F_B_5pt + tmp - END IF + ! Calculate error and check against tolerance + error = ABS(F_B_3pt_sub - F_B_5pt_sub) + tolMet = all(error <= MAX(RelTol*ABS(F_B_5pt_sub),AbsTol)) + + ! If tolerance was met and (sub)element does not bound the waterplane, + ! Set processed flag, sum force, and continue + if (tolMet .and. (ABS(SE%secStat1 - SE%secStat2) <= 1)) then + SA(i)%processed = .true. + F_B_5pt = F_B_5pt + F_B_5pt_sub + cycle + end if + + ! If recursion limit reached or stack full, + ! Set processed flag, set error flag, and continue + if ((SE%level + 1 > maxRecurLvl) .or. (i + 1 > size(SA))) then + SA(i)%processed = .true. + ErrStat = ErrID_Warn + cycle + end if + ! Push new branches onto stack + SA(i)%level = SE%level + 1 + SA(i)%processed = .false. + SA(i)%pos1 = SE%pos1 + SA(i)%posMid = posMidL + SA(i)%pos2 = SE%posMid + SA(i)%r1 = SE%r1 + SA(i)%rMid = rMidL + SA(i)%r2 = SE%rMid + SA(i)%dl = 0.5_DbKi * SE%dl + SA(i)%secStat1 = SE%secStat1 + SA(i)%secStatMid = secStatMidL + SA(i)%secStat2 = SE%secStatMid + SA(i)%dFdl1 = SE%dFdl1 + SA(i)%dFdlMid = dFdlMidL + SA(i)%dFdl2 = SE%dFdlMid + + SA(i+1)%level = SE%level + 1 + SA(i+1)%processed = .false. + SA(i+1)%pos1 = SE%posMid + SA(i+1)%posMid = posMidR + SA(i+1)%pos2 = SE%pos2 + SA(i+1)%r1 = SE%rMid + SA(i+1)%rMid = rMidR + SA(i+1)%r2 = SE%r2 + SA(i+1)%dl = 0.5_DbKi * SE%dl + SA(i+1)%secStat1 = SE%secStatMid + SA(i+1)%secStatMid = secStatMidR + SA(i+1)%secStat2 = SE%secStat2 + SA(i+1)%dFdl1 = SE%dFdlMid + SA(i+1)%dFdlMid = dFdlMidR + SA(i+1)%dFdl2 = SE%dFdl2 + + ! Increment stack index + i = i + 1 + end do + END SUBROUTINE RefineElementHstLds_Cyl - RECURSIVE SUBROUTINE RefineElementHstLds_Rec( origin, pos1, posMid, pos2, FSPt, Sa1, SaMid, Sa2, Sb1, SbMid, Sb2, dl, dSadl, dSbdl, & + RECURSIVE SUBROUTINE RefineElementHstLds_Rec(p, origin, pos1, posMid, pos2, FSPt, Sa1, SaMid, Sa2, Sb1, SbMid, Sb2, dl, dSadl, dSbdl, & secStat1, secStatMid, secStat2, k_hat, x_hat, y_hat, n_hat, dFdl1, dFdlMid, dFdl2, recurLvl, F_B_5pt, ErrStat, ErrMsg) - + TYPE(Morison_ParameterType), INTENT( IN ) :: p REAL(DbKi), INTENT( IN ) :: origin(3) REAL(DbKi), INTENT( IN ) :: pos1(3) REAL(DbKi), INTENT( IN ) :: posMid(3) @@ -5321,10 +5453,10 @@ RECURSIVE SUBROUTINE RefineElementHstLds_Rec( origin, pos1, posMid, pos2, FSPt, F_B_3pt = (dFdl1 + 4.0_DbKi*dFdlMid + dFdl2) * dl/6.0_DbKi ! Mid point of left section - CALL GetSectionHstLds_Rec( origin, posMidL, k_hat, x_hat, y_hat, SaMidL, SbMidL, dSadl, dSbdl, FSPt, n_hat, dFdlMidL, secStatMidL) + CALL GetSectionHstLds_Rec(p, origin, posMidL, k_hat, x_hat, y_hat, SaMidL, SbMidL, dSadl, dSbdl, FSPt, n_hat, dFdlMidL, secStatMidL) ! Mid point of right section - CALL GetSectionHstLds_Rec( origin, posMidR, k_hat, x_hat, y_hat, SaMidR, SbMidR, dSadl, dSbdl, FSPt, n_hat, dFdlMidR, secStatMidR) + CALL GetSectionHstLds_Rec(p, origin, posMidR, k_hat, x_hat, y_hat, SaMidR, SbMidR, dSadl, dSbdl, FSPt, n_hat, dFdlMidR, secStatMidR) F_B_5pt = (dFdl1 + 4.0_DbKi*dFdlMidL + 2.0_DbKi*dFdlMid + 4.0_DbKi*dFdlMidR + dFdl2) * dl/12.0_DbKi @@ -5349,17 +5481,17 @@ RECURSIVE SUBROUTINE RefineElementHstLds_Rec( origin, pos1, posMid, pos2, FSPt, END IF IF (refine) THEN ! Recursively refine the load integration if tolerance not met - CALL RefineElementHstLds_Rec(origin,pos1,posMidL,posMid,FSPt,Sa1,SaMidL,SaMid,Sb1,SbMidL,SbMid,0.5_DbKi*dl,dSadl,dSbdl, & + CALL RefineElementHstLds_Rec(p,origin,pos1,posMidL,posMid,FSPt,Sa1,SaMidL,SaMid,Sb1,SbMidL,SbMid,0.5_DbKi*dl,dSadl,dSbdl, & secStat1,secStatMidL,secStatMid,k_hat,x_hat,y_hat,n_hat,dFdl1,dFdlMidL,dFdlMid,recurLvl+1,tmp,ErrStat,ErrMsg) - CALL RefineElementHstLds_Rec(origin,posMid,posMidR,pos2,FSPt,SaMid,SaMidR,Sa2,SbMid,SbMidR,Sb2,0.5_DbKi*dl,dSadl,dSbdl, & + CALL RefineElementHstLds_Rec(p,origin,posMid,posMidR,pos2,FSPt,SaMid,SaMidR,Sa2,SbMid,SbMidR,Sb2,0.5_DbKi*dl,dSadl,dSbdl, & secStatMid,secStatMidR,secStat2,k_hat,x_hat,y_hat,n_hat,dFdlMid,dFdlMidR,dFdl2,recurLvl+1,F_B_5pt,ErrStat,ErrMsg) F_B_5pt = F_B_5pt + tmp END IF END SUBROUTINE RefineElementHstLds_Rec - SUBROUTINE GetEndPlateHstLds_Cyl(pos0, k_hat, y_hat, z_hat, R, theta1, theta2, F) - + SUBROUTINE GetEndPlateHstLds_Cyl(p, pos0, k_hat, y_hat, z_hat, R, theta1, theta2, F) + TYPE(Morison_ParameterType), INTENT( IN ) :: p REAL(ReKi), INTENT( IN ) :: pos0(3) REAL(ReKi), INTENT( IN ) :: k_hat(3) REAL(ReKi), INTENT( IN ) :: y_hat(3) @@ -5403,7 +5535,7 @@ SUBROUTINE GetEndPlateHstLds_Cyl(pos0, k_hat, y_hat, z_hat, R, theta1, theta2, F ! End plate force in the k_hat direction Fk = -0.5_DbKi*Z0*(R_2*dTheta-tmp1) + cosPhi/6.0_DbKi*( 2.0_DbKi*dy_3 - z1*z2*dy - z1_2*(y2+2.0_DbKi*y1) + z2_2*(y1+2.0_DbKi*y2) ) - F(1:3) = p%WaveField%WtrDens * g * Fk * k_hat + F(1:3) = p%WaveField%WtrDens * p%Gravity * Fk * k_hat ! End plate moment in the y_hat and z_hat direction My = Z0/6.0_DbKi*( 2.0_DbKi*dy_3 + 2.0_DbKi*dy*tmp2 + 3.0_DbKi*tmp1*sz ) & ! y_hat component @@ -5425,12 +5557,13 @@ SUBROUTINE GetEndPlateHstLds_Cyl(pos0, k_hat, y_hat, z_hat, R, theta1, theta2, F Mz = -Z0/ 6.0_DbKi*( dz*( y2*y2 + y2*y1 + y1*y1 + tmp2 - 3.0_DbKi*R_2 ) ) & -cosPhi/24.0_DbKi*( dz_2*(3.0_DbKi*z2_2+3.0_DbKi*z1_2+2.0_DbKi*y1*y2-6.0_DbKi*R_2) + dz*dz*(y1*y1-y2*y2) + 4.0_DbKi*dz*(y1*y1*z1+y2*y2*z2) ) - F(4:6) = p%WaveField%WtrDens * g * (My*y_hat + Mz*z_hat) + F(4:6) = p%WaveField%WtrDens * p%Gravity * (My*y_hat + Mz*z_hat) END SUBROUTINE GetEndPlateHstLds_Cyl - SUBROUTINE GetEndPlateHstLds_Rec(pos0, k_hat, x_hat, y_hat, Sa, Sb, rFS, nFS, F) + SUBROUTINE GetEndPlateHstLds_Rec(p, pos0, k_hat, x_hat, y_hat, Sa, Sb, rFS, nFS, F) + TYPE(Morison_ParameterType), INTENT( IN ) :: p REAL(ReKi), INTENT( IN ) :: pos0(3) REAL(ReKi), INTENT( IN ) :: k_hat(3) REAL(ReKi), INTENT( IN ) :: x_hat(3) @@ -5497,7 +5630,7 @@ SUBROUTINE GetEndPlateHstLds_Rec(pos0, k_hat, x_hat, y_hat, Sa, Sb, rFS, nFS, F) s1 = -0.5*Sa s2 = Sa * (0.5 - dot_product(rFS-rv(:,3),nFS)/dot_product(rv(:,4)-rv(:,3),nFS) ) end if - call GetHstLdsOnTrapezoid(REAL(pos0,DbKi),s1,s2,h1s1,h1s2,h2s1,h2s2,REAL(k_hat,DbKi),REAL(x_hat,DbKi),REAL(y_hat,DbKi),Ftmp1) + call GetHstLdsOnTrapezoid(p, REAL(pos0,DbKi),s1,s2,h1s1,h1s2,h2s1,h2s2,REAL(k_hat,DbKi),REAL(x_hat,DbKi),REAL(y_hat,DbKi),Ftmp1) F = Ftmp1 else if (numVInWtr == 2) then ! Two neighboring vertices in water if (vInWtr(1) .and. vInWtr(2)) then @@ -5520,7 +5653,7 @@ SUBROUTINE GetEndPlateHstLds_Rec(pos0, k_hat, x_hat, y_hat, Sa, Sb, rFS, nFS, F) h1s2 = -0.5*Sb s1 = Sa * (-0.5 + dot_product(rFS-rv(:,1),nFS)/dot_product(rv(:,2)-rv(:,1),nFS) ) s2 = Sa * (0.5 - dot_product(rFS-rv(:,3),nFS)/dot_product(rv(:,4)-rv(:,3),nFS) ) - call GetHstLdsOnTrapezoid(REAL(pos0,DbKi),s2,0.5_DbKi*Sa,-0.5_DbKi*Sb,-0.5_DbKi*Sb,0.5_DbKi*Sb,0.5_DbKi*Sb,REAL(k_hat,DbKi),REAL(x_hat,DbKi),REAL(y_hat,DbKi),Ftmp2) + call GetHstLdsOnTrapezoid(p, REAL(pos0,DbKi),s2,0.5_DbKi*Sa,-0.5_DbKi*Sb,-0.5_DbKi*Sb,0.5_DbKi*Sb,0.5_DbKi*Sb,REAL(k_hat,DbKi),REAL(x_hat,DbKi),REAL(y_hat,DbKi),Ftmp2) else if (vInWtr(3) .and. vInWtr(4)) then ! Sides 2 & 4 intersects the free surface ! Side 3 submerged and side 1 dry @@ -5541,9 +5674,9 @@ SUBROUTINE GetEndPlateHstLds_Rec(pos0, k_hat, x_hat, y_hat, Sa, Sb, rFS, nFS, F) h1s2 = -0.5*Sb s1 = Sa * ( 0.5 - dot_product(rFS-rv(:,3),nFS)/dot_product(rv(:,4)-rv(:,3),nFS) ) s2 = Sa * (-0.5 + dot_product(rFS-rv(:,1),nFS)/dot_product(rv(:,2)-rv(:,1),nFS) ) - call GetHstLdsOnTrapezoid(REAL(pos0,DbKi),-0.5_DbKi*Sa,s1,-0.5_DbKi*Sb,-0.5_DbKi*Sb,0.5_DbKi*Sb,0.5_DbKi*Sb,REAL(k_hat,DbKi),REAL(x_hat,DbKi),REAL(y_hat,DbKi),Ftmp2) + call GetHstLdsOnTrapezoid(p,REAL(pos0,DbKi),-0.5_DbKi*Sa,s1,-0.5_DbKi*Sb,-0.5_DbKi*Sb,0.5_DbKi*Sb,0.5_DbKi*Sb,REAL(k_hat,DbKi),REAL(x_hat,DbKi),REAL(y_hat,DbKi),Ftmp2) end if - call GetHstLdsOnTrapezoid(REAL(pos0,DbKi),s1,s2,h1s1,h1s2,h2s1,h2s2,REAL(k_hat,DbKi),REAL(x_hat,DbKi),REAL(y_hat,DbKi),Ftmp1) + call GetHstLdsOnTrapezoid(p,REAL(pos0,DbKi),s1,s2,h1s1,h1s2,h2s1,h2s2,REAL(k_hat,DbKi),REAL(x_hat,DbKi),REAL(y_hat,DbKi),Ftmp1) F = Ftmp1 + Ftmp2 else if (numVInWtr == 3) then ! Only one vertex out of water if (.not. vInWtr(1)) then @@ -5579,17 +5712,18 @@ SUBROUTINE GetEndPlateHstLds_Rec(pos0, k_hat, x_hat, y_hat, Sa, Sb, rFS, nFS, F) s1 = -0.5*Sa s2 = Sa * ( 0.5 - dot_product(rFS-rv(:,3),nFS)/dot_product(rv(:,4)-rv(:,3),nFS) ) end if - call GetHstLdsOnTrapezoid(REAL(pos0,DbKi),s1,s2,h1s1,h1s2,h2s1,h2s2,REAL(k_hat,DbKi),REAL(x_hat,DbKi),REAL(y_hat,DbKi),Ftmp1) - F(1:3) = -p%WaveField%WtrDens*g*z0*Sa*Sb*k_hat - Ftmp1(1:3) - F(4:6) = p%WaveField%WtrDens*g*(Sa**3*Sb*x_hat(3)*y_hat-Sa*Sb**3*y_hat(3)*x_hat)/12.0 - Ftmp1(4:6) + call GetHstLdsOnTrapezoid(p,REAL(pos0,DbKi),s1,s2,h1s1,h1s2,h2s1,h2s2,REAL(k_hat,DbKi),REAL(x_hat,DbKi),REAL(y_hat,DbKi),Ftmp1) + F(1:3) = -p%WaveField%WtrDens*p%Gravity*z0*Sa*Sb*k_hat - Ftmp1(1:3) + F(4:6) = p%WaveField%WtrDens*p%Gravity*(Sa**3*Sb*x_hat(3)*y_hat-Sa*Sb**3*y_hat(3)*x_hat)/12.0 - Ftmp1(4:6) else if (numVInWtr == 4) then ! Submerged endplate - F(1:3) = -p%WaveField%WtrDens*g*z0*Sa*Sb*k_hat - F(4:6) = p%WaveField%WtrDens*g*(Sa**3*Sb*x_hat(3)*y_hat-Sa*Sb**3*y_hat(3)*x_hat)/12.0 + F(1:3) = -p%WaveField%WtrDens*p%Gravity*z0*Sa*Sb*k_hat + F(4:6) = p%WaveField%WtrDens*p%Gravity*(Sa**3*Sb*x_hat(3)*y_hat-Sa*Sb**3*y_hat(3)*x_hat)/12.0 end if END SUBROUTINE GetEndPlateHstLds_Rec - SUBROUTINE GetHstLdsOnTrapezoid(pos0, s1, s2, h1s1, h1s2, h2s1, h2s2, k_hat, x_hat, y_hat, F) + SUBROUTINE GetHstLdsOnTrapezoid(p, pos0, s1, s2, h1s1, h1s2, h2s1, h2s2, k_hat, x_hat, y_hat, F) + TYPE(Morison_ParameterType), INTENT( IN ) :: p REAL(DbKi), INTENT( IN ) :: pos0(3) REAL(DbKi), INTENT( IN ) :: s1, s2, h1s1, h1s2, h2s1, h2s2 REAL(DbKi), INTENT( IN ) :: k_hat(3), x_hat(3), y_hat(3) @@ -5639,12 +5773,14 @@ SUBROUTINE GetHstLdsOnTrapezoid(pos0, s1, s2, h1s1, h1s2, h2s1, h2s2, k_hat, x_h +x_hat(3)/12.0*(3.0*dp*ds4+4.0*dq*ds3) & +y_hat(3)/24.0*tmp )*y_hat - F = p%WaveField%WtrDens * g * F + F = p%WaveField%WtrDens * p%Gravity * F END SUBROUTINE GetHstLdsOnTrapezoid - SUBROUTINE getElementHstLds_Mod1( mem, Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1, r2, dl, alphaIn, Is1stElement, F_B0, F_B1, F_B2, ErrStat, ErrMsg ) + SUBROUTINE getElementHstLds_Mod1(p, m, mem, Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1, r2, dl, alphaIn, Is1stElement, F_B0, F_B1, F_B2, ErrStat, ErrMsg ) + TYPE(Morison_ParameterType), INTENT( IN ) :: p + TYPE(Morison_MiscVarType), INTENT( INOUT ) :: m TYPE(Morison_MemberType), intent(in) :: mem REAL(DbKi), INTENT( IN ) :: Time REAL(ReKi), INTENT( IN ) :: pos1(3) @@ -5667,6 +5803,7 @@ SUBROUTINE getElementHstLds_Mod1( mem, Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1 REAL(ReKi) :: h0, rh, a0, b0, a0b0, s0, C_1, C_2, Z0 REAL(ReKi) :: sinGamma, cosGamma, tanGamma REAL(ReKi) :: FbVec(3), MbVec(3), FSInt(3), n_hat(3), t_hat(3), s_hat(3), r_hat(3) + REAL(ReKi) :: z1, z2 INTEGER(IntKi) :: errStat2 CHARACTER(ErrMsgLen) :: errMsg2 INTEGER(IntKi), PARAMETER :: pwr = 3 ! Exponent for buoyancy node distribution smoothing @@ -5678,6 +5815,9 @@ SUBROUTINE getElementHstLds_Mod1( mem, Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1 dRdl = (r2 - r1)/dl + z1 = pos1(3) + z2 = pos2(3) + IF ( (z1 < Zeta1) .AND. (z2 < Zeta2) ) THEN ! If element is fully submerged ! Compute the waterplane shape, the submerged volume, and it's geometric center ! No need to consider tapered and non-tapered elements separately @@ -5686,11 +5826,11 @@ SUBROUTINE getElementHstLds_Mod1( mem, Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1 ! Hydrostatic force on element FbVec = (/0.0_ReKi,0.0_ReKi,Vs/) - Pi*( r2*r2*z2 - r1*r1*z1) *k_hat - FbVec = p%WaveField%WtrDens * g * FbVec + FbVec = p%WaveField%WtrDens * p%Gravity * FbVec ! Hydrostatic moment on element about the lower node MbVec = (Vhc+0.25*Pi*(r2**4-r1**4)) * Cross_Product(k_hat,(/0.0_ReKi,0.0_ReKi,1.0_ReKi/)) - MbVec = p%WaveField%WtrDens * g * MbVec + MbVec = p%WaveField%WtrDens * p%Gravity * MbVec ! Distribute element load to nodes alpha = alphaIn*(z2-Zeta2)**pwr/(alphaIn*(z2-Zeta2)**pwr+(1.0_ReKi-alphaIn)*(z1-Zeta1)**pwr) @@ -5715,7 +5855,7 @@ SUBROUTINE getElementHstLds_Mod1( mem, Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1 rh = r1 + h0*dRdl ! Estimate the free-surface normal at the free-surface intersection, n_hat IF ( p%WaveField%WaveStMod > 0_IntKi ) THEN ! If wave stretching is enabled, compute free surface normal - CALL GetFreeSurfaceNormal( Time, FSInt, rh, n_hat, ErrStat2, ErrMsg2 ) + CALL GetFreeSurfaceNormal(p, m, Time, FSInt, rh, n_hat, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE ! Without wave stretching, use the normal of the SWL n_hat = (/0.0_ReKi,0.0_ReKi,1.0_ReKi/) @@ -5776,13 +5916,13 @@ SUBROUTINE getElementHstLds_Mod1( mem, Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1 ! Hydrostatic force on element FbVec = (/0.0_ReKi,0.0_ReKi,Vs/) - Pi*a0b0*Z0*n_hat + Pi*r1**2*z1*k_hat - FbVec = p%WaveField%WtrDens * g * FbVec + FbVec = p%WaveField%WtrDens * p%Gravity * FbVec ! Hydrostatic moment on element about the lower node MbVec = Cross_Product( Vrc*r_hat+Vhc*k_hat, (/0.0_ReKi,0.0_ReKi,1.0_ReKi/) ) & + 0.25*Pi*a0b0* ( ( s_hat(3)*a0*a0 + 4.0*(s0-h0*sinGamma)*Z0 )*t_hat - t_hat(3)*b0*b0*s_hat ) & - 0.25*Pi*r1**4*( r_hat(3) *t_hat - t_hat(3) * r_hat ) - MbVec = p%WaveField%WtrDens * g * MbVec + MbVec = p%WaveField%WtrDens * p%Gravity * MbVec IF ( Is1stElement ) THEN ! This is the 1st element of the member ! Assign the element load to the lower (1st) node of the member @@ -5802,7 +5942,8 @@ SUBROUTINE getElementHstLds_Mod1( mem, Time, pos1, pos2, Zeta1, Zeta2, k_hat, r1 END IF END SUBROUTINE getElementHstLds_Mod1 - SUBROUTINE YawJoint(JointNo,PtfmRefY,AM_End,An_End,DP_Const_End,I_MG_End,ErrStat,ErrMsg) + SUBROUTINE YawJoint(p, JointNo, PtfmRefY, AM_End, An_End, DP_Const_End, I_MG_End, ErrStat, ErrMsg) + TYPE(Morison_ParameterType), INTENT( IN ) :: p Integer(IntKi), intent(in ) :: JointNo Real(ReKi), intent(in ) :: PtfmRefY Real(ReKi), intent( out) :: AM_End(3,3) @@ -5831,8 +5972,11 @@ SUBROUTINE YawJoint(JointNo,PtfmRefY,AM_End,An_End,DP_Const_End,I_MG_End,ErrStat END SUBROUTINE YawJoint - SUBROUTINE getMemBallastHiPt(member,z_hi, ErrStat, ErrMsg) + SUBROUTINE getMemBallastHiPt(p, m, u, member, z_hi, ErrStat, ErrMsg) ! This subroutine returns the highest point of a member's internal ballast + Type(Morison_ParameterType), intent(in ) :: p + Type(Morison_MiscVarType), intent(in ) :: m + Type(Morison_InputType), intent(in ) :: u Type(Morison_MemberType), intent(in ) :: member Real(ReKi), intent( out) :: z_hi Integer(IntKi), intent( out) :: ErrStat @@ -5938,8 +6082,12 @@ SUBROUTINE getMemBallastHiPt(member,z_hi, ErrStat, ErrMsg) END SUBROUTINE getMemBallastHiPt - SUBROUTINE GetDistDrag_Rec(Time,mem,i,dSadl_p,dSbdl_p,f_hydro,ErrStat,ErrMsg,SubRatio,vrelFSInt) + SUBROUTINE GetDistDrag_Rec(p, m, u, xd, Time, mem, i, dSadl_p, dSbdl_p, f_hydro, ErrStat, ErrMsg, SubRatio, vrelFSInt) ! Compute the distributed (axial and transverse) drag per unit length for rectangular sections + TYPE(Morison_ParameterType), intent(in ) :: p !< Morison parameters + Type(Morison_MiscVarType),intent(inout) :: m !< Miscellaneous variables + Type(Morison_InputType) , intent(in ) :: u !< Morison inputs + Type(Morison_DiscreteStateType), intent(in ) :: xd !< Current discrete state Real(DbKi) , intent(in ) :: Time !< Current simulation time in seconds Type(Morison_MemberType), intent(in ) :: mem !< Current member Integer(IntKi) , intent(in ) :: i !< Node number within the member (not the global node index) @@ -6107,16 +6255,6 @@ SUBROUTINE GetDistDrag_Rec(Time,mem,i,dSadl_p,dSbdl_p,f_hydro,ErrStat,ErrMsg,Sub END SUBROUTINE GetDistDrag_Rec - - logical function Failed() - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - Failed = ErrStat >= AbortErrLev - !if (Failed) then - ! call FailCleanup() - !endif - end function Failed - -END SUBROUTINE Morison_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- subroutine LumpDistrHydroLoads( f_hydro, k_hat, dl, h_c, lumpedLoad ) real(ReKi), intent(in ) :: f_hydro(3) diff --git a/modules/inflowwind/src/IfW_FlowField.f90 b/modules/inflowwind/src/IfW_FlowField.f90 index 4b04737dc1..586452aa40 100644 --- a/modules/inflowwind/src/IfW_FlowField.f90 +++ b/modules/inflowwind/src/IfW_FlowField.f90 @@ -72,7 +72,6 @@ subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, A logical :: GridExceedAllow ! is this point allowed to exceed bounds of wind grid ErrStat = ErrID_None - ErrMsg = "" ! Get number of points to evaluate NumPoints = size(PositionXYZ, dim=2) @@ -737,7 +736,6 @@ subroutine Grid3DField_GetCell(G3D, Time, Position, CalcAccel, AllowExtrap, & logical :: InGrid ErrStat = ErrID_None - ErrMsg = "" ! Initialize to no extrapolation (modified in bounds routines) AllExtrap = ExtrapNone diff --git a/modules/moordyn/src/MoorDyn_Misc.f90 b/modules/moordyn/src/MoorDyn_Misc.f90 index 65fd5edddd..9ae7a4fb6b 100644 --- a/modules/moordyn/src/MoorDyn_Misc.f90 +++ b/modules/moordyn/src/MoorDyn_Misc.f90 @@ -948,28 +948,21 @@ SUBROUTINE getWaterKin(p, m, x, y, z, t, U, Ud, zeta, PDyn, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" - IF (p%WaterKin == 3 .AND. (.NOT. m%IC_gen)) THEN ! disable wavekin 3 during IC_gen, otherwise will never find steady state (becasue of waves) - - ! SeaState throws warning when queried location is out of bounds from the SeaState grid, so no need to handle here + ! Initialize outputs to zero + U = 0.0_DbKi + Ud = 0.0_DbKi + zeta = 0.0_DbKi + PDyn = 0.0_DbKi - ! Pack all MD inputs to WaveGrid input data types (double to single) - ! (only pos needed becasue time is double in wave field, all other are outputs that will be set by WaveField_GetNodeWaveKin) - xyz_sp = REAL((/ x, y, z /),SiKi) + select case (p%WaterKin) + ! no wave kinematics, do nothing (already initialized to zero above) + case (0) - ! for now we will force the node to be in the water (forceNodeInWater = True). Rods handle partial submergence seperately so they need to get information from SeaState - CALL WaveField_GetNodeWaveKin(p%WaveField, m%WaveField_m, t, xyz_sp, .TRUE., .TRUE., nodeInWater, WaveElev1, WaveElev2, zeta_sp, PDyn_sp, U_sp, Ud_sp, FAMCF, ErrStat2, ErrMsg2 ) ! outputs: nodeInWater, WaveElev1, WaveElev2, FAMCF all unused - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! Unpack all WaveGrid outputs to MD output data types (single to double) - U = REAL(U_sp,DbKi) - Ud = REAL(Ud_sp,DbKi) - zeta = REAL(zeta_sp,DbKi) - PDyn = REAL(PDyn_sp,DbKi) - - ELSEIF (p%WaterKin == 1 .OR. p%WaterKin == 2) THEN ! old or hybrid approach. SeaState contributions handeled in setupWaterKin, just proceed using old method + ! old or hybrid approach. SeaState contributions handeled in setupWaterKin, just proceed using old method + case (1,2) ! If wave kinematics enabled, get interpolated values from grid - IF (p%WaveKin > 0) THEN + if (p%WaveKin > 0) then ! find time interpolation indices and coefficients it = floor(t/ p%dtWave) + 1 ! add 1 because Fortran indexing starts at 1 @@ -977,59 +970,68 @@ SUBROUTINE getWaterKin(p, m, x, y, z, t, U, Ud, zeta, PDyn, ErrStat, ErrMsg) m%WaveTi = it ! find x-y interpolation indices and coefficients - CALL getInterpNumsSiKi(p%pxWave , REAL(x,SiKi), 1, ix, fx) ! wave grid - CALL getInterpNumsSiKi(p%pyWave , REAL(y,SiKi), 1, iy, fy) ! wave grid + CALL getInterpNumsSiKi(p%pxWave, REAL(x, SiKi), 1, ix, fx) ! wave grid + CALL getInterpNumsSiKi(p%pyWave, REAL(y, SiKi), 1, iy, fy) ! wave grid ! interpolate wave elevation CALL calculate3Dinterpolation(p%zeta, ix, iy, it, fx, fy, ft, zeta) ! compute modified z coordinate to be used for interpolating velocities and accelerations with Wheeler stretching - zp = ( z - zeta ) * p%WtrDpth/( p%WtrDpth + zeta ) + zp = (z - zeta) * p%WtrDpth/(p%WtrDpth + zeta) - CALL getInterpNumsSiKi(p%pzWave , REAL(zp,SiKi), 1, iz, fz) ! wave grid + CALL getInterpNumsSiKi(p%pzWave, REAL(zp, SiKi), 1, iz, fz) ! wave grid ! interpolate everything else CALL calculate4Dinterpolation(p%PDyn , ix, iy, iz, it, fx, fy, fz, ft, PDyn) - CALL calculate4Dinterpolation(p%uxWave, ix, iy, iz, it, fx, fy, fz, ft, U(1) ) - CALL calculate4Dinterpolation(p%uyWave, ix, iy, iz, it, fx, fy, fz, ft, U(2) ) - CALL calculate4Dinterpolation(p%uzWave, ix, iy, iz, it, fx, fy, fz, ft, U(3) ) - CALL calculate4Dinterpolation(p%axWave, ix, iy, iz, it, fx, fy, fz, ft, Ud(1) ) - CALL calculate4Dinterpolation(p%ayWave, ix, iy, iz, it, fx, fy, fz, ft, Ud(2) ) - CALL calculate4Dinterpolation(p%azWave, ix, iy, iz, it, fx, fy, fz, ft, Ud(3) ) - - ELSE ! set things to zero if wave kinematics not enabled - U = 0.0_DbKi - Ud = 0.0_DbKi - zeta = 0.0_DbKi - PDyn = 0.0_DbKi - - ENDIF + CALL calculate4Dinterpolation(p%uxWave, ix, iy, iz, it, fx, fy, fz, ft, U(1)) + CALL calculate4Dinterpolation(p%uyWave, ix, iy, iz, it, fx, fy, fz, ft, U(2)) + CALL calculate4Dinterpolation(p%uzWave, ix, iy, iz, it, fx, fy, fz, ft, U(3)) + CALL calculate4Dinterpolation(p%axWave, ix, iy, iz, it, fx, fy, fz, ft, Ud(1)) + CALL calculate4Dinterpolation(p%ayWave, ix, iy, iz, it, fx, fy, fz, ft, Ud(2)) + CALL calculate4Dinterpolation(p%azWave, ix, iy, iz, it, fx, fy, fz, ft, Ud(3)) + end if ! If current kinematics enabled, add interpolated current values from profile - IF (p%Current > 0) THEN + if (p%Current > 0) then - CALL getInterpNumsSiKi(p%pzCurrent, REAL(z,SiKi), 1, iz0, fz) + CALL getInterpNumsSiKi(p%pzCurrent, REAL(z, SiKi), 1, iz0, fz) - IF (fz == 0) THEN ! handle end case conditions + if (fz == 0) then ! handle end case conditions iz1 = iz0 - ELSE - iz1 = min(iz0+1,size(p%pzCurrent)) ! don't overstep bounds - END IF + else + iz1 = min(iz0+1, size(p%pzCurrent)) ! don't overstep bounds + end if ! Add the current velocities to the wave velocities (if any) U(1) = U(1) + (1.0-fz)*p%uxCurrent(iz0) + fz*p%uxCurrent(iz1) U(2) = U(2) + (1.0-fz)*p%uyCurrent(iz0) + fz*p%uyCurrent(iz1) - END IF + end if - ELSEIF (p%WaterKin > 3) THEN - CALL SetErrStat(ErrID_Fatal, "Invalid p%WaterKin value found in getWaterKin", ErrStat, ErrMsg, RoutineName) - - ELSE ! set things to zero if Water Kinematics not enabled - U = 0.0_DbKi - Ud = 0.0_DbKi - zeta = 0.0_DbKi - PDyn = 0.0_DbKi - ENDIF + ! SeaState wave kinematics + case (3) + + ! disable wavekin 3 during IC_gen, otherwise will never find steady state (because of waves) + if (m%IC_gen) return + + ! SeaState throws warning when queried location is out of bounds from the SeaState grid, so no need to handle here + + ! Pack all MD inputs to WaveGrid input data types (double to single) + ! (only pos needed because time is double in wave field, all other are outputs that will be set by WaveField_GetNodeWaveKin) + xyz_sp = REAL([x, y, z], SiKi) + + ! for now we will force the node to be in the water (forceNodeInWater = True). Rods handle partial submergence separately so they need to get information from SeaState + CALL WaveField_GetNodeWaveKin(p%WaveField, m%WaveField_m, t, xyz_sp, .true., .true., nodeInWater, WaveElev1, WaveElev2, zeta_sp, PDyn_sp, U_sp, Ud_sp, FAMCF, ErrStat2, ErrMsg2 ) ! outputs: nodeInWater, WaveElev1, WaveElev2, FAMCF all unused + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Unpack all WaveGrid outputs to MD output data types (single to double) + U = REAL(U_sp,DbKi) + Ud = REAL(Ud_sp,DbKi) + zeta = REAL(zeta_sp,DbKi) + PDyn = REAL(PDyn_sp,DbKi) + + case default + call SetErrStat(ErrID_Fatal, "Invalid value of p%WaterKin", ErrStat, ErrMsg, RoutineName) + end select END SUBROUTINE getWaterKin diff --git a/modules/nwtc-library/src/ModMesh.f90 b/modules/nwtc-library/src/ModMesh.f90 index 4844a765fb..5a9c834c0d 100644 --- a/modules/nwtc-library/src/ModMesh.f90 +++ b/modules/nwtc-library/src/ModMesh.f90 @@ -3205,18 +3205,10 @@ SUBROUTINE MeshExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) DO node=1,u_out%Nnodes Orient = u1%Orientation(:,:,node) - CALL DCM_logmap ( Orient, tensor(:,1), ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev ) THEN - ErrMsg = 'MeshExtrapInterp1:'//TRIM(ErrMsg) - RETURN - END IF + CALL DCM_logmap(Orient, tensor(:,1)) Orient = u2%Orientation(:,:,node) - CALL DCM_logmap ( Orient, tensor(:,2), ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev ) THEN - ErrMsg = 'MeshExtrapInterp1:'//TRIM(ErrMsg) - RETURN - END IF + CALL DCM_logmap(Orient, tensor(:,2)) CALL DCM_SetLogMapForInterp( tensor ) @@ -3347,25 +3339,13 @@ SUBROUTINE MeshExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) DO node=1,u_out%Nnodes Orient = u1%Orientation(:,:,node) - CALL DCM_logmap ( Orient, tensor(:,1), ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev ) THEN - ErrMsg = 'MeshExtrapInterp2:'//TRIM(ErrMsg) - RETURN - END IF + CALL DCM_logmap(Orient, tensor(:,1)) Orient = u2%Orientation(:,:,node) - CALL DCM_logmap ( Orient, tensor(:,2), ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev ) THEN - ErrMsg = 'MeshExtrapInterp2:'//TRIM(ErrMsg) - RETURN - END IF + CALL DCM_logmap(Orient, tensor(:,2)) Orient = u3%Orientation(:,:,node) - CALL DCM_logmap ( Orient, tensor(:,3), ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev ) THEN - ErrMsg = 'MeshExtrapInterp2:'//TRIM(ErrMsg) - RETURN - END IF + CALL DCM_logmap(Orient, tensor(:,3)) CALL DCM_SetLogMapForInterp( tensor ) diff --git a/modules/nwtc-library/src/ModMesh_Mapping.f90 b/modules/nwtc-library/src/ModMesh_Mapping.f90 index fd63f374f3..79f3fed31d 100644 --- a/modules/nwtc-library/src/ModMesh_Mapping.f90 +++ b/modules/nwtc-library/src/ModMesh_Mapping.f90 @@ -1333,15 +1333,13 @@ SUBROUTINE Transfer_Motions_Line2_to_Point( Src, Dest, MeshMap, ErrStat, ErrMsg RotationMatrixD = MATMUL( TRANSPOSE( Src%RefOrientation(:,:,n1) ), Src%Orientation(:,:,n1) ) RotationMatrixD = MATMUL( Dest%RefOrientation(:,:,i), RotationMatrixD ) - CALL DCM_logmap( RotationMatrixD, FieldValue(:,1), ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN + CALL DCM_logmap(RotationMatrixD, FieldValue(:,1)) ! calculate Rotation matrix for FieldValueN2 and convert to tensor: RotationMatrixD = MATMUL( TRANSPOSE( Src%RefOrientation(:,:,n2) ), Src%Orientation(:,:,n2) ) RotationMatrixD = MATMUL( Dest%RefOrientation(:,:,i), RotationMatrixD ) - CALL DCM_logmap( RotationMatrixD, FieldValue(:,2), ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN + CALL DCM_logmap(RotationMatrixD, FieldValue(:,2)) CALL DCM_SetLogMapForInterp( FieldValue ) ! make sure we don't cross a 2pi boundary @@ -4415,12 +4413,10 @@ SUBROUTINE Create_Augmented_Ln2_Src_Mesh(Src, Dest, MeshMap, Dest_TYPE, ErrStat, ! convert DCMs to tensors: RefOrientationD = Src%RefOrientation(:, :, n1) - CALL DCM_logmap( RefOrientationD, FieldValue(:,1), ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN + CALL DCM_logmap(RefOrientationD, FieldValue(:,1)) RefOrientationD = Src%RefOrientation(:, :, n2) - CALL DCM_logmap( RefOrientationD, FieldValue(:,2), ErrStat, ErrMsg ) - IF (ErrStat >= AbortErrLev) RETURN + CALL DCM_logmap(RefOrientationD, FieldValue(:,2)) CALL DCM_SetLogMapForInterp( FieldValue ) ! make sure we don't cross a 2pi boundary diff --git a/modules/nwtc-library/src/NWTC_Base.f90 b/modules/nwtc-library/src/NWTC_Base.f90 index d6b45cfe48..33235ec261 100644 --- a/modules/nwtc-library/src/NWTC_Base.f90 +++ b/modules/nwtc-library/src/NWTC_Base.f90 @@ -100,9 +100,12 @@ pure subroutine SetErrStat (ErrStatLcl, ErrMessLcl, ErrStat, ErrMess, RoutineNam CHARACTER(*), INTENT(IN ) :: RoutineName ! Name of the routine error occurred in IF ( ErrStatLcl /= ErrID_None ) THEN - IF (ErrStat /= ErrID_None) ErrMess = TRIM(ErrMess)//new_line('a') - ErrMess = TRIM(ErrMess)//TRIM(RoutineName)//':'//TRIM(ErrMessLcl) - ErrStat = MAX(ErrStat,ErrStatLcl) + IF (ErrStat /= ErrID_None) then + ErrMess = TRIM(ErrMess)//new_line('a')//TRIM(RoutineName)//':'//TRIM(ErrMessLcl) + else + ErrMess = TRIM(RoutineName)//':'//TRIM(ErrMessLcl) + END IF + ErrStat = MAX(ErrStat, ErrStatLcl) END IF end subroutine diff --git a/modules/nwtc-library/src/NWTC_Num.f90 b/modules/nwtc-library/src/NWTC_Num.f90 index d4f36542df..3b73b1865a 100644 --- a/modules/nwtc-library/src/NWTC_Num.f90 +++ b/modules/nwtc-library/src/NWTC_Num.f90 @@ -1258,26 +1258,18 @@ END FUNCTION DCM_expR !! !! This routine is the inverse of DCM_exp (nwtc_num::dcm_exp). \n !! Use DCM_logMap (nwtc_num::dcm_logmap) instead of directly calling a specific routine in the generic interface. - SUBROUTINE DCM_logMapD(DCM, logMap, ErrStat, ErrMsg, thetaOut) + SUBROUTINE DCM_logMapD(DCM, logMap, thetaOut) REAL(R8Ki), INTENT(IN) :: DCM(3,3) !< the direction cosine matrix, \f$\Lambda\f$ REAL(R8Ki), INTENT( OUT) :: logMap(3) !< vector containing \f$\lambda_1\f$, \f$\lambda_2\f$, and \f$\lambda_3\f$, the unique components of skew-symmetric matrix \f$\lambda\f$ REAL(R8Ki),OPTIONAL,INTENT( OUT) :: thetaOut !< the angle of rotation, \f$\theta\f$; output only for debugging - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ! local variables REAL(R8Ki) :: theta REAL(R8Ki) :: cosTheta REAL(R8Ki) :: TwoSinTheta REAL(R8Ki) :: v(3) REAL(R8Ki) :: divisor - INTEGER(IntKi) :: indx_max - - ! initialization - ErrStat = ErrID_None - ErrMsg = "" - + INTEGER(IntKi) :: indx_max cosTheta = 0.5_DbKi*( trace(DCM) - 1.0_R8Ki ) cosTheta = min( max(cosTheta,-1.0_R8Ki), 1.0_R8Ki ) !make sure it's in a valid range (to avoid cases where this is slightly outside the +/-1 range) @@ -1372,28 +1364,20 @@ SUBROUTINE DCM_logMapD(DCM, logMap, ErrStat, ErrMsg, thetaOut) END SUBROUTINE DCM_logMapD !======================================================================= !> \copydoc nwtc_num::dcm_logmapd - SUBROUTINE DCM_logMapR(DCM, logMap, ErrStat, ErrMsg, thetaOut) + SUBROUTINE DCM_logMapR(DCM, logMap, thetaOut) ! This function computes the logarithmic map for a direction cosine matrix. REAL(SiKi), INTENT(IN) :: DCM(3,3) REAL(SiKi), INTENT( OUT) :: logMap(3) REAL(SiKi),OPTIONAL,INTENT( OUT) :: thetaOut - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables REAL(SiKi) :: cosTheta REAL(SiKi) :: theta REAL(SiKi) :: TwoSinTheta REAL(SiKi) :: v(3) REAL(SiKi) :: divisor INTEGER(IntKi) :: indx_max - - ! initialization - ErrStat = ErrID_None - ErrMsg = "" - cosTheta = 0.5_SiKi*( trace(DCM) - 1.0_SiKi ) cosTheta = min( max(cosTheta,-1.0_SiKi), 1.0_SiKi ) !make sure it's in a valid range (to avoid cases where this is slightly outside the +/-1 range) diff --git a/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 b/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 index bf48d36268..2ee568ebb1 100644 --- a/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 +++ b/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 @@ -574,7 +574,6 @@ SUBROUTINE LAPACK_SGEMM( TRANSA, TRANSB, ALPHA, A, B, BETA, C, ErrStat, ErrMsg ) END IF ErrStat = ErrID_None - ErrMsg = "" IF ( K /= Kb ) THEN diff --git a/modules/openfast-library/CMakeLists.txt b/modules/openfast-library/CMakeLists.txt index f46baaf0f1..f5b000a3b2 100644 --- a/modules/openfast-library/CMakeLists.txt +++ b/modules/openfast-library/CMakeLists.txt @@ -64,6 +64,7 @@ target_link_libraries(openfast_prelib seastlib sedlib servodynlib + soildynlib subdynlib ) diff --git a/modules/openfast-library/src/FAST_AeroMap.f90 b/modules/openfast-library/src/FAST_AeroMap.f90 index ae66abca8f..ce7268c7ef 100644 --- a/modules/openfast-library/src/FAST_AeroMap.f90 +++ b/modules/openfast-library/src/FAST_AeroMap.f90 @@ -116,7 +116,7 @@ subroutine FAST_AeroMapDriver(AM, m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) T%ED, T%SED, T%BD, T%SrvD, T%AD, T%ADsk, & T%ExtLd, T%IfW, T%ExtInfw, & T%SeaSt, T%HD, T%SD, T%ExtPtfm, T%MAP, & - T%FEAM, T%MD, T%Orca, T%IceF, T%IceD, & + T%FEAM, T%MD, T%Orca, T%IceF, T%IceD, T%SlD, & CompAeroMaps, ErrStat2, ErrMsg2) if (Failed()) return @@ -305,7 +305,7 @@ subroutine FAST_AeroMapDriver(AM, m, p_FAST, m_FAST, y_FAST, T, ErrStat, ErrMsg) call WrOutputLine(n_global, p_FAST, y_FAST, UnusedAry, UnusedAry, T%ED%y, UnusedAry, & T%AD%y, UnusedAry, T%SrvD%y, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, & - UnusedAry, UnusedAry, UnusedAry, UnusedAry, T%IceD%y, T%BD%y, ErrStat2, ErrMsg2) + UnusedAry, UnusedAry, UnusedAry, UnusedAry, T%IceD%y, T%SlD%y%WriteOutput, T%BD%y, ErrStat2, ErrMsg2) if (Failed()) return !------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/FAST_Funcs.f90 b/modules/openfast-library/src/FAST_Funcs.f90 index fbaa168b6a..e43ec8e7af 100644 --- a/modules/openfast-library/src/FAST_Funcs.f90 +++ b/modules/openfast-library/src/FAST_Funcs.f90 @@ -137,6 +137,10 @@ module FAST_Funcs SD_CalcOutput, & SD_End +use SoilDyn, only: SlD_UpdateStates, & + SlD_CalcOutput, & + SlD_End + implicit none private @@ -289,6 +293,13 @@ subroutine FAST_ExtrapInterp(ModData, t_global_next, T, ErrStat, ErrMsg) end do call ShiftInputTimes(T%SD%InputTimes) + case (Module_SlD) + call SlD_Input_ExtrapInterp(T%SlD%Input(1:), T%SlD%InputTimes, T%SlD%Input(INPUT_TEMP), t_global_next, ErrStat2, ErrMsg2); if (Failed()) return + do j = T%p_FAST%InterpOrder, 0, -1 + call SlD_CopyInput(T%SlD%Input(j), T%SlD%Input(j + 1), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + end do + call ShiftInputTimes(T%SlD%InputTimes) + case (Module_SeaSt) ! call SeaSt_Input_ExtrapInterp(T%SeaSt%Input(1:), T%SeaSt%InputTimes, T%SeaSt%u, t_global_next, ErrStat2, ErrMsg2); if (Failed()) return ! do j = T%p_FAST%InterpOrder, 1, -1 @@ -403,6 +414,8 @@ subroutine FAST_InitInputStateArrays(ModAry, ThisTime, DT, T, ErrStat, ErrMsg) T%SD%InputTimes = InputTimes case (Module_SeaSt) T%SeaSt%InputTimes = InputTimes + case (Module_SlD) + T%SlD%InputTimes = InputTimes case (Module_SrvD) T%SrvD%InputTimes(:, ModData%Ins) = InputTimes case default @@ -669,6 +682,20 @@ subroutine FAST_UpdateStates(ModData, t_initial, n_t_global, T, ErrStat, ErrMsg) if (Failed()) return end do + case (Module_SlD) + call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + if (Failed()) return + + do j_ss = 1, ModData%SubSteps + n_t_module = n_t_global*ModData%SubSteps + j_ss - 1 + t_module = n_t_module*ModData%DT + t_initial + call SlD_UpdateStates(t_module, n_t_module, T%SlD%Input(1:), T%SlD%InputTimes, T%SlD%p, & + T%SlD%x(STATE_PRED), T%SlD%xd(STATE_PRED), & + T%SlD%z(STATE_PRED), T%SlD%OtherSt(STATE_PRED), & + T%SlD%m, ErrStat2, ErrMsg2) + if (Failed()) return + end do + case (Module_SrvD) call FAST_CopyStates(ModData, T, STATE_CURR, STATE_PRED, MESH_UPDATECOPY, ErrStat2, ErrMsg2) if (Failed()) return @@ -818,6 +845,11 @@ subroutine FAST_CalcOutput(ModData, Mappings, ThisTime, iInput, iState, T, ErrSt T%SeaSt%x(iState), T%SeaSt%xd(iState), T%SeaSt%z(iState), T%SeaSt%OtherSt(iState), & T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2) + case (Module_SlD) + call SlD_CalcOutput(ThisTime, T%SlD%Input(iInput), T%SlD%p, & + T%SlD%x(iState), T%SlD%xd(iState), T%SlD%z(iState), T%SlD%OtherSt(iState), & + T%SlD%y, T%SlD%m, ErrStat2, ErrMsg2) + case (Module_SrvD) call SrvD_CalcOutput(ThisTime, T%SrvD%Input(iInput,ModData%Ins), T%SrvD%p(ModData%Ins), & T%SrvD%x(ModData%Ins,iState), T%SrvD%xd(ModData%Ins,iState), T%SrvD%z(ModData%Ins,iState), T%SrvD%OtherSt(ModData%Ins,iState), & @@ -1707,6 +1739,13 @@ subroutine FAST_CopyStates(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) call SeaSt_CopyConstrState(T%SeaSt%z(iSrc), T%SeaSt%z(iDst), CtrlCode, ErrStat2, ErrMsg2); if (Failed()) return call SeaSt_CopyOtherState(T%SeaSt%OtherSt(iSrc), T%SeaSt%OtherSt(iDst), CtrlCode, ErrStat2, ErrMsg2); if (Failed()) return + case (Module_SlD) + + call SlD_CopyContState(T%SlD%x(iSrc), T%SlD%x(iDst), CtrlCode, ErrStat2, ErrMsg2); if (Failed()) return + call SlD_CopyDiscState(T%SlD%xd(iSrc), T%SlD%xd(iDst), CtrlCode, ErrStat2, ErrMsg2); if (Failed()) return + call SlD_CopyConstrState(T%SlD%z(iSrc), T%SlD%z(iDst), CtrlCode, ErrStat2, ErrMsg2); if (Failed()) return + call SlD_CopyOtherState(T%SlD%OtherSt(iSrc), T%SlD%OtherSt(iDst), CtrlCode, ErrStat2, ErrMsg2); if (Failed()) return + case (Module_SrvD) call SrvD_CopyContState(T%SrvD%x(ModData%Ins, iSrc), T%SrvD%x(ModData%Ins, iDst), CtrlCode, ErrStat2, ErrMsg2); if (Failed()) return @@ -1817,6 +1856,9 @@ subroutine FAST_CopyInput(ModData, T, iSrc, iDst, CtrlCode, ErrStat, ErrMsg) case (Module_SeaSt) call SeaSt_CopyInput(T%SeaSt%Input(iSrc), T%SeaSt%Input(iDst), CtrlCode, ErrStat2, ErrMsg2) + case (Module_SlD) + call SlD_CopyInput(T%SlD%Input(iSrc), T%SlD%Input(iDst), CtrlCode, ErrStat2, ErrMsg2) + case (Module_SrvD) call SrvD_CopyInput(T%SrvD%Input(iSrc, ModData%Ins), T%SrvD%Input(iDst, ModData%Ins), CtrlCode, ErrStat2, ErrMsg2) @@ -1979,6 +2021,11 @@ subroutine FAST_ModEnd(Mods, T, ErrStat, ErrMsg) T%SeaSt%z(STATE_CURR), T%SeaSt%OtherSt(STATE_CURR), & T%SeaSt%y, T%SeaSt%m, ErrStat2, ErrMsg2) + case (Module_SlD) + call SlD_End(T%SlD%Input(1), T%SlD%p, T%SlD%x(STATE_CURR), T%SlD%xd(STATE_CURR), & + T%SlD%z(STATE_CURR), T%SlD%OtherSt(STATE_CURR), & + T%SlD%y, T%SlD%m, ErrStat2, ErrMsg2) + case (Module_SrvD) call SrvD_End(T%SrvD%Input(1, ModData%Ins), T%SrvD%p(ModData%Ins), T%SrvD%x(ModData%Ins, STATE_CURR), T%SrvD%xd(ModData%Ins, STATE_CURR), & T%SrvD%z(ModData%Ins, STATE_CURR), T%SrvD%OtherSt(ModData%Ins, STATE_CURR), & diff --git a/modules/openfast-library/src/FAST_Mapping.f90 b/modules/openfast-library/src/FAST_Mapping.f90 index 5be279b88a..5d0386d654 100644 --- a/modules/openfast-library/src/FAST_Mapping.f90 +++ b/modules/openfast-library/src/FAST_Mapping.f90 @@ -120,6 +120,8 @@ subroutine FAST_InputMeshPointer(ModData, Turbine, MeshLoc, Mesh, iInput, ErrSta Mesh => SD_InputMeshPointer(Turbine%SD%Input(iInput), MeshLoc) case (Module_SeaSt) Mesh => SeaSt_InputMeshPointer(Turbine%SeaSt%Input(iInput), MeshLoc) + case (Module_SlD) + Mesh => SlD_InputMeshPointer(Turbine%SlD%Input(iInput), MeshLoc) case (Module_SrvD) Mesh => SrvD_InputMeshPointer(Turbine%SrvD%Input(iInput, ModData%Ins), MeshLoc) case default @@ -189,6 +191,8 @@ subroutine FAST_OutputMeshPointer(ModData, Turbine, MeshLoc, Mesh, ErrStat, ErrM Mesh => SD_OutputMeshPointer(Turbine%SD%y, MeshLoc) case (Module_SeaSt) Mesh => SeaSt_OutputMeshPointer(Turbine%SeaSt%y, MeshLoc) + case (Module_SlD) + Mesh => SlD_OutputMeshPointer(Turbine%SlD%y, MeshLoc) case (Module_SrvD) Mesh => SrvD_OutputMeshPointer(Turbine%SrvD%y(ModData%Ins), MeshLoc) case default @@ -490,6 +494,8 @@ subroutine FAST_InitMappings(Mappings, Mods, Turbine, ErrStat, ErrMsg) call InitMappings_SD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_SeaSt) call InitMappings_SeaSt(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) + case (Module_SlD) + call InitMappings_SlD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) case (Module_SrvD) call InitMappings_SrvD(MappingsTmp, Mods(iModSrc), Mods(iModDst), Turbine, ErrStat2, ErrMsg2) end select @@ -1914,6 +1920,15 @@ subroutine InitMappings_SD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) DstDispDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + case (Module_SlD) + + call MapLoadMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(SlD_y_SoilMesh), & ! SlD%y%SoilMesh + SrcDispDL=DatLoc(SlD_u_SoilMesh), & ! SlD%u%SoilMesh + DstDL=DatLoc(SD_u_LMesh), & ! SD%u%LMesh + DstDispDL=DatLoc(SD_y_y3Mesh), & ! SD%y%y3Mesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + case (Module_SrvD) call MapCustom(Mappings, Custom_SrvD_to_SD, SrcMod, DstMod) @@ -1965,6 +1980,38 @@ logical function Failed() end function end subroutine +subroutine InitMappings_SlD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) + type(MappingType), allocatable :: Mappings(:) + type(ModDataType), intent(inout) :: SrcMod, DstMod + type(FAST_TurbineType), intent(inout) :: Turbine !< Turbine type + integer(IntKi), intent(out) :: ErrStat + character(*), intent(out) :: ErrMsg + + character(*), parameter :: RoutineName = 'InitMappings_SlD' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + ErrStat = ErrID_None + ErrMsg = '' + + select case (SrcMod%ID) + + case (Module_SD) + + call MapMotionMesh(Turbine, Mappings, SrcMod=SrcMod, DstMod=DstMod, & + SrcDL=DatLoc(SD_y_Y3Mesh), & ! SD%y%y3Mesh + DstDL=DatLoc(SlD_u_SoilMesh), & ! SlD%u%SoilMesh + ErrStat=ErrStat2, ErrMsg=ErrMsg2); if(Failed()) return + + end select + +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function +end subroutine + subroutine InitMappings_SrvD(Mappings, SrcMod, DstMod, Turbine, ErrStat, ErrMsg) type(MappingType), allocatable :: Mappings(:) type(ModDataType), intent(inout) :: SrcMod, DstMod diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 365acfe768..5aa331a16b 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -21,6 +21,7 @@ usefrom AeroDisk_Registry.txt usefrom ExtLoads_Registry.txt usefrom SubDyn_Registry.txt usefrom SeaState.txt +usefrom SoilDyn_Registry.txt usefrom HydroDyn.txt usefrom IceFloe_FASTRegistry.inp usefrom InflowWind.txt @@ -63,7 +64,8 @@ param ^ - INTEGER Module_IceF - 18 - "IceFloe" - param ^ - INTEGER Module_IceD - 19 - "IceDyn" - param ^ - INTEGER Module_ADsk - 20 - "AeroDisk" - param ^ - INTEGER Module_SED - 21 - "Simplified-ElastoDyn" - -param ^ - INTEGER NumModules - 21 - "The number of modules available in FAST" - +param ^ - INTEGER Module_SlD - 22 - "SoilDyn" - +param ^ - INTEGER NumModules - 22 - "The number of modules available in FAST" - # Other Constants param ^ - INTEGER MaxBladesBD - 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" - @@ -140,9 +142,10 @@ typedef ^ FAST_ParameterType IntKi CompAero - - - "Compute aerodynamic loads (sw typedef ^ FAST_ParameterType IntKi CompServo - - - "Compute control and electrical-drive dynamics (switch) {Module_None; Module_SrvD}" - typedef ^ FAST_ParameterType IntKi CompSeaSt - - - "Compute sea states; wave kinematics (switch) {Module_None; Module_SeaSt}" - 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_SD, Module_ExtPtfm}" - +typedef ^ FAST_ParameterType IntKi CompSub - - - "Compute sub-structural dynamics (switch) {Module_None; Module_SD, Module_ExtPtfm, Module_SlD}" - 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)" - @@ -170,6 +173,7 @@ typedef ^ FAST_ParameterType CHARACTER(1024) HydroFile - - - "Hydrodynamic input typedef ^ FAST_ParameterType CHARACTER(1024) SubFile - - - "sub-structural input file path" - typedef ^ FAST_ParameterType CHARACTER(1024) MooringFile - - - "mooring system input file path" - typedef ^ FAST_ParameterType CHARACTER(1024) IceFile - - - "ice loading input file path" - +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 @@ -402,6 +406,19 @@ typedef ^ ^ SD_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ SD_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" +# ..... SoilDyn data ....................................................................................................... +typedef FAST SoilDyn_Data SlD_ContinuousStateType x {:} - - "Continuous states" +typedef ^ ^ SlD_ContinuousStateType dxdt - - - "Continuous state derivatives" +typedef ^ ^ SlD_DiscreteStateType xd {:} - - "Discrete states" +typedef ^ ^ SlD_ConstraintStateType z {:} - - "Constraint states" +typedef ^ ^ SlD_OtherStateType OtherSt {:} - - "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 {:} - - "Continuous states" typedef ^ ^ ExtPtfm_DiscreteStateType xd {:} - - "Discrete states" @@ -555,6 +572,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 ....................................................................................................... @@ -596,6 +615,7 @@ typedef ^ FAST_TurbineType ExternalInflow_Data ExtInfw - - - "Data for ExternalI typedef ^ FAST_TurbineType SeaState_Data SeaSt - - - "Data for the SeaState 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 29c8d8a818..fa5b395a21 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -139,7 +139,8 @@ subroutine FAST_SolverInit(p_FAST, p, m, GlueModData, GlueModMaps, Turbine, ErrS pack(modInds, ModIDs == Module_FEAM), & pack(modInds, ModIDs == Module_IceD), & pack(modInds, ModIDs == Module_IceF), & - pack(modInds, ModIDs == Module_MAP)] + pack(modInds, ModIDs == Module_MAP), & + pack(modInds, ModIDs == Module_SlD)] ! Indices of modules to perform InputSolves after the Option 1 solve p%iModPost = [pack(modInds, ModIDs == Module_SrvD), & diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 5102c20c0f..d3f6974156 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -45,6 +45,7 @@ MODULE FAST_Subs use IceFloe, only: IceFloe_Init use IceDyn, only: IceD_Init use SeaState, only: SeaSt_Init + use SoilDyn, only: SlD_Init use SubDyn, only: SD_Init use ServoDyn, only: SrvD_Init, & Cmpl4SFun, & @@ -76,7 +77,7 @@ SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, In CALL FAST_InitializeAll( t_initial, Turbine%m_Glue, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%SED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%ADsk, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, & Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, CompAeroMaps, ErrStat, ErrMsg, InFile, ExternInitData ) + Turbine%IceF, Turbine%IceD, Turbine%SlD, CompAeroMaps, ErrStat, ErrMsg, InFile, ExternInitData ) if(ErrStat >= AbortErrLev) return ! Initialize mappings between modules @@ -104,7 +105,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, m_Glue, p_FAST, y_FAST, m_FAST, ED, SED, BD, SrvD, AD, ADsk, ExtLd, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, CompAeroMaps, ErrStat, ErrMsg, InFile, ExternInitData ) + MAPp, FEAM, MD, Orca, IceF, IceD, SlD, CompAeroMaps, ErrStat, ErrMsg, InFile, ExternInitData ) use ElastoDyn_Parameters, only: Method_RK4 @@ -126,6 +127,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(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 @@ -866,7 +868,51 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE IF (p_FAST%CompAero == Module_AD) AD%p%FlowField => Init%OutData_ExtInfw%FlowField endif - !---------------------------------------------------------------------------- + !---------------------------------------------------------------------------- + ! CompSoil (SoilDyn) + !---------------------------------------------------------------------------- + + ! Allocate module data arrays + allocate(SlD%Input (InputAryLB:InputAryUB), stat=ErrStat2); if (FailedAlloc("SlD%Input")) return + allocate(SlD%InputTimes (InputAryUB ), stat=ErrStat2); if (FailedAlloc("SlD%InputTimes")) return + allocate(SlD%x (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SlD%x")) return + allocate(SlD%xd (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SlD%xd")) return + allocate(SlD%z (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SlD%z")) return + allocate(SlD%OtherSt (StateAryUB ), stat=ErrStat2); if (FailedAlloc("SlD%OtherSt")) return + + select case (p_FAST%CompSoil) + + ! SoilDyn + case (Module_SlD) + + ! SoilDyn requires SubDyn + if (p_FAST%CompSub /= Module_SD) then + call SetErrStat(ErrID_Fatal, "SoilDyn requires SubDyn (CompSub = 1)", ErrStat, ErrMsg, RoutineName) + return + end if + + ! Initialization input + 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 + Init%InData_SlD%WtrDpth = p_FAST%WtrDpth + + ! Initialize SoilDyn + dt_module = p_FAST%DT + 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, dt_module, Init%OutData_SlD, ErrStat2, ErrMsg2) + if (Failed()) return + + ! Add module to list of modules, return on error + CALL MV_AddModule(m_Glue%ModData, Module_SlD, 'SlD', 1, dt_module, p_FAST%DT, & + Init%OutData_SlD%Vars, p_FAST%Linearize, ErrStat2, ErrMsg2) + if (Failed()) return + + end select + + !---------------------------------------------------------------------------- ! CompSub (SubDyn or ExtPtfm) !---------------------------------------------------------------------------- @@ -895,6 +941,25 @@ SUBROUTINE FAST_InitializeAll( t_initial, m_Glue, p_FAST, y_FAST, m_FAST, ED, SE Init%InData_SD%SDInputFile = p_FAST%SubFile Init%InData_SD%RootName = p_FAST%OutFileRoot + ! If SoilDyn is enabled + if (p_FAST%CompSoil == Module_SlD) then + + ! Copy over the soil stiffness matrices + if (allocated(SlD%p%Stiffness)) then + Init%InData_SD%SoilStiffness = SlD%p%Stiffness + endif + + ! Make a copy of the SoilMesh to pass over + if (SlD%Input(INPUT_CURR)%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 + ! Set the water depth if (p_FAST%CompHydro == Module_HD) then Init%InData_SD%WtrDpth = Init%OutData_SeaSt%WaveField%WtrDpth @@ -1767,7 +1832,8 @@ 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' y_FAST%Module_Abrev( Module_ExtInfw) = 'ExtInfw' @@ -1788,7 +1854,8 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, 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_SlD ) = 'SlD' + p%BD_OutputSibling = .false. !............................................................................................................................... @@ -1944,12 +2011,14 @@ 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 ) ! NOTE: If future modules consume SeaState data, then their checks should be added to this routine. 12/1/21 GJH if (p%CompHydro == Module_HD .and. p%CompSeaSt == Module_None) then CALL SetErrStat( ErrID_Fatal, 'SeaState must be used when HydroDyn is used. Set CompSeaSt = 1 in the FAST input file.', ErrStat, ErrMsg, RoutineName ) end if + 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 ) @@ -1986,6 +2055,8 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) IF (p%CompElast == Module_BD .and. p%CompAero == Module_ADsk) CALL SetErrStat( ErrID_Fatal, 'AeroDisk 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. (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 ) + ! No method at the moment for getting disk average velocity from ExtInfw if (p%CompAero == Module_ADsk .and. p%CompInflow == MODULE_ExtInfw) call SetErrStat( ErrID_Fatal, 'AeroDisk cannot be used with ExtInflow or the library interface', ErrStat, ErrMsg, RoutineName ) @@ -2216,7 +2287,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 !...................................................... @@ -2258,6 +2334,7 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) 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_SlD%WriteOutputHdr)) y_FAST%numOuts(Module_SlD) = size(Init%OutData_SlD%WriteOutputHdr) !...................................................... ! Initialize the output channel names and units @@ -2363,11 +2440,8 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) do i = 1, Init%OutData_ED(iRot)%NumBl k = k + 1 if (.not. allocated(Init%OutData_BD(k)%WriteOutputHdr)) cycle - if (p_FAST%NRotors > 1) then - prefix = 'R'//trim(Num2LStr(iRot))//'B'//Num2LStr(i) - else - prefix = 'B'//Num2LStr(i) - end if + prefix = 'B'//Num2LStr(i) + if (p_FAST%NRotors > 1) prefix = 'R'//trim(Num2LStr(iRot))//prefix do j = 1, size(Init%OutData_BD(k)%WriteOutputHdr) y_FAST%ChannelNames(indxNext) = trim(prefix)//Init%OutData_BD(k)%WriteOutputHdr(j) y_FAST%ChannelUnits(indxNext) = Init%OutData_BD(k)%WriteOutputUnt(j) @@ -2486,6 +2560,13 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) end do end if + ! SoilDyn + do i=1,y_FAST%numOuts(Module_SlD) + y_FAST%ChannelNames(indxNext) = Init%OutData_SlD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_SlD%WriteOutputUnt(i) + indxNext = indxNext + 1 + end do + !...................................................... ! Open the text output file and print the headers !...................................................... @@ -2929,6 +3010,20 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS p%CompIce = Module_Unknown end select + ! 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) + if (Failed()) return + + ! immediately convert to values used inside the code: + select case (p%CompSoil) + case (0) + p%CompSoil = Module_NONE + case (1) + p%CompSoil = Module_SlD + case default + p%CompSoil = Module_Unknown + end select + ! 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) if (Failed()) return @@ -3045,6 +3140,11 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS if (Failed()) return 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) + if (Failed()) return + IF ( PathIsRelative( p%SoilFile ) ) p%SoilFile = TRIM(PriPath)//TRIM(p%SoilFile) + ! Read subsequent rotor input files do iRot = 2, p%NRotors @@ -4519,7 +4619,11 @@ SUBROUTINE FAST_WrSum( p_FAST, y_FAST, m_Glue, 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 @@ -4698,7 +4802,7 @@ SUBROUTINE FAST_Solution0_T(Turbine, ErrStat, ErrMsg) Turbine%SeaSt, Turbine%HD, Turbine%SD, & Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, & Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, & + Turbine%IceF, Turbine%IceD, Turbine%SlD, & ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4708,7 +4812,7 @@ SUBROUTINE FAST_Solution0_T(Turbine, ErrStat, ErrMsg) Turbine%ED, Turbine%SED, Turbine%BD, Turbine%AD, & Turbine%IfW, Turbine%ExtInfw, Turbine%SeaSt, Turbine%HD, & Turbine%SD, Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, & - Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD) + Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, Turbine%SlD) end if !---------------------------------------------------------------------------- @@ -5000,7 +5104,7 @@ SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) call WriteOutputToFile(n_t_global_next, t_global_next, Turbine%p_FAST, Turbine%y_FAST, Turbine%ED, Turbine%SED, Turbine%BD, & Turbine%AD, Turbine%ADsk, Turbine%IfW, Turbine%ExtInfw, Turbine%SeaSt, Turbine%HD, Turbine%SD, & Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2) + Turbine%IceF, Turbine%IceD, Turbine%SlD, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) !---------------------------------------------------------------------------- @@ -5180,7 +5284,7 @@ SUBROUTINE FAST_WriteOutput_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) Turbine%ED, Turbine%SED, Turbine%BD, Turbine%AD, Turbine%ADsk, Turbine%IfW, Turbine%ExtInfw, & Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, & Turbine%SrvD, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2) + Turbine%IceF, Turbine%IceD, Turbine%SlD, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) !---------------------------------------------------------------------------- @@ -5218,7 +5322,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, SED, BD, AD, ADsk, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & - SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg) + SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD, ErrStat, ErrMsg) !............................................................................................................................... INTEGER(IntKi), INTENT(IN ) :: n_t_global !< Current global time step REAL(DbKi), INTENT(IN ) :: t_global !< Current global time @@ -5243,6 +5347,7 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, SED, BD, 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), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -5263,13 +5368,13 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, SED, BD, ED%y, SED%y%WriteOutput, AD%y, ADsk%y%WriteOutput, SrvD%y, SeaSt%y%WriteOutput, & HD%y%WriteOutput, SD%y%WriteOutput, ExtPtfm%y%WriteOutput, MAPp%y%WriteOutput, & FEAM%y%WriteOutput, MD%y%WriteOutput, Orca%y%WriteOutput, IceF%y%WriteOutput, & - IceD%y, BD%y, ErrStat, ErrMsg ) + IceD%y, SlD%y%WriteOutput, 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, ED, SED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + call WriteVTK(t_global, p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD) END IF END IF @@ -5278,7 +5383,7 @@ END SUBROUTINE WriteOutputToFile !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes the module output to the primary output file(s). SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, ExtInfwOutput, y_ED, SEDOutput, y_AD, ADskOutput, y_SrvD, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput,& - MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, ErrStat, ErrMsg) + MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, SlDOutput, y_BD, ErrStat, ErrMsg) IMPLICIT NONE @@ -5305,6 +5410,7 @@ SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, ExtInfwOutput, y_ED, SEDO REAL(ReKi), ALLOCATABLE, INTENT(IN) :: OrcaOutput(:) !< OrcaFlex interface WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: IceFOutput(:) !< IceFloe WriteOutput values TYPE(IceD_OutputType), INTENT(IN) :: y_IceD(:) !< IceDyn outputs (WriteOutput values are subset) + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SlDOutput(:) !< SoilDyn WriteOutput values TYPE(BD_OutputType), INTENT(IN) :: y_BD(:) !< BeamDyn outputs (WriteOutput values are subset) INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status @@ -5321,7 +5427,7 @@ SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, ExtInfwOutput, y_ED, SEDO ErrMsg = '' CALL FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, y_ED, SEDOutput, y_AD, ADskOutput, y_SrvD, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput, & - MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, OutputAry) + MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, SlDOutput, y_BD, OutputAry) IF (p_FAST%WrTxtOutFile) THEN @@ -5396,15 +5502,16 @@ SUBROUTINE FillOutputAry_T(T, Outputs) T%Orca%y%WriteOutput, & T%IceF%y%WriteOutput, & T%IceD%y, & + T%SlD%y%WriteOutput, & T%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, ExtInfwOutput, y_ED, SEDOutput, y_AD, ADskOutput, y_SrvD, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput, & - MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, OutputAry) + MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, SlDOutput, 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 @@ -5426,6 +5533,7 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, y_ED, SEDOutp REAL(ReKi), ALLOCATABLE, INTENT(IN) :: OrcaOutput(:) !< OrcaFlex interface WriteOutput values REAL(ReKi), ALLOCATABLE, INTENT(IN) :: IceFOutput(:) !< IceFloe WriteOutput values TYPE(IceD_OutputType), INTENT(IN) :: y_IceD(:) !< IceDyn outputs (WriteOutput values are subset) + REAL(ReKi), ALLOCATABLE, INTENT(IN) :: SlDOutput (:) !< SoilDyn WriteOutput values TYPE(BD_OutputType), INTENT(IN) :: y_BD(:) !< BeamDyn outputs (WriteOutput values are subset) REAL(ReKi), INTENT(OUT) :: OutputAry(:) !< single array of output @@ -5569,9 +5677,15 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, y_ED, SEDOutp end do end if + if (y_FAST%numOuts(Module_SlD) > 0) then + IndexLast = IndexNext + size(SlDOutput) - 1 + OutputAry(IndexNext:IndexLast) = SlDOutput + IndexNext = IndexLast + 1 + end if + END SUBROUTINE FillOutputAry !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, SeaSt, 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) @@ -5593,6 +5707,7 @@ SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, Sea 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 @@ -5601,11 +5716,11 @@ SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, Sea IF ( p_FAST%VTK_Type == VTK_Surf ) THEN - CALL WrVTK_Surfaces(t_global, p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + CALL WrVTK_Surfaces(t_global, p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, SeaSt, 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, ED, SED, BD, AD, IfW, ExtInfw, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + CALL WrVTK_BasicMeshes(p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, 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, ED, SED, BD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + CALL WrVTK_AllMeshes(p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD) ELSE IF (p_FAST%VTK_Type==VTK_Old) THEN if (p_FAST%CompElast /= Module_SED) then !FIXME: SED is not included in these routines!!!! CALL WriteInputMeshesToFile( ED%Input(1,:), AD%Input(1), SD%Input(1), HD%Input(1), MAPp%Input(1), BD%Input(1,:), TRIM(p_FAST%OutFileRoot)//'.InputMeshes.bin', ErrStat2, ErrMsg2) @@ -5618,7 +5733,7 @@ SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, Sea 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, ED, SED, BD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, 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 @@ -5640,6 +5755,7 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, HD, SD 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) :: k, j, iRot, iBld @@ -5942,12 +6058,17 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, HD, SD END IF + ! SoilDyn + IF ( p_FAST%CompSoil == Module_SlD .and. allocated(SlD%Input)) THEN + 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 ) + ! 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 ) + 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, ED, SED, BD, AD, IfW, ExtInfw, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, 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 @@ -5967,6 +6088,7 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, HD, 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) :: i, j, k, iRot, iBld INTEGER(IntKi) :: ErrStat2 @@ -6080,12 +6202,18 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, HD, ! 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, ED, SED, BD, AD, IfW, ExtInfw, SeaSt, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, SeaSt, 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 @@ -6108,6 +6236,7 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInf 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 @@ -6191,6 +6320,11 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInf ! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y3Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y3Mesh_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 ! HydroDyn IF ( HD%y%Morison%VisMesh%Committed ) THEN @@ -6227,7 +6361,7 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInf ! END IF if (p_FAST%VTK_fields) then - call WrVTK_BasicMeshes(p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + call WrVTK_BasicMeshes(p_FAST, y_FAST, ED, SED, BD, AD, IfW, ExtInfw, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, SlD) end if END SUBROUTINE WrVTK_Surfaces @@ -6762,7 +6896,7 @@ SUBROUTINE ExitThisProgram_T( Turbine, ErrLevel_in, StopTheProgram, ErrLocMsg, S CALL WrVTK_AllMeshes(Turbine%p_FAST, Turbine%y_FAST, Turbine%ED, & Turbine%SED, Turbine%BD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%SrvD, Turbine%MAP, & - Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD) + Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, Turbine%SlD) end if ! If we are doing AeroMaps, there is leftover data in AD15 parameters @@ -7497,7 +7631,7 @@ subroutine CalcOutputModeShapeVTK(TimeVTK, Perturb) ! Write VTK output call WriteVTK(TimeVTK, T%p_FAST, T%y_FAST, & T%ED, T%SED, T%BD, T%AD, T%IfW, T%ExtInfw, T%SeaSt, T%HD, T%SD, & - T%ExtPtfm, T%SrvD, T%MAP, T%FEAM, T%MD, T%Orca, T%IceF, T%IceD) + T%ExtPtfm, T%SrvD, T%MAP, T%FEAM, T%MD, T%Orca, T%IceF, T%IceD, T%SlD) end subroutine diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 6b7d526605..ac56b2841a 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -41,6 +41,7 @@ MODULE FAST_Types USE ExtLoads_Types USE SubDyn_Types USE SeaState_Types +USE SoilDyn_Types USE HydroDyn_Types USE IceFloe_Types USE ExternalInflow_Types @@ -77,7 +78,8 @@ MODULE FAST_Types INTEGER(IntKi), PUBLIC, PARAMETER :: Module_IceD = 19 ! IceDyn [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_ADsk = 20 ! AeroDisk [-] INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SED = 21 ! Simplified-ElastoDyn [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 21 ! The number of modules available in FAST [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Module_SlD = 22 ! SoilDyn [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: NumModules = 22 ! The number of modules available in FAST [-] INTEGER(IntKi), PUBLIC, PARAMETER :: MaxBladesBD = 3 ! Maximum number of blades allowed on a turbine [-] INTEGER(IntKi), PUBLIC, PARAMETER :: IceD_MaxLegs = 4 ! because I don't know how many legs there are before calling IceD_Init and I don't want to copy the data because of sibling mesh issues, I'm going to allocate IceD based on this number [-] INTEGER(IntKi), PUBLIC, PARAMETER :: SS_Indx_Pitch = 1 ! pitch [-] @@ -154,9 +156,10 @@ MODULE FAST_Types INTEGER(IntKi) :: CompServo = 0_IntKi !< Compute control and electrical-drive dynamics (switch) {Module_None; Module_SrvD} [-] INTEGER(IntKi) :: CompSeaSt = 0_IntKi !< Compute sea states; wave kinematics (switch) {Module_None; Module_SeaSt} [-] INTEGER(IntKi) :: CompHydro = 0_IntKi !< Compute hydrodynamic loads (switch) {Module_None; Module_HD} [-] - INTEGER(IntKi) :: CompSub = 0_IntKi !< Compute sub-structural dynamics (switch) {Module_None; Module_SD, Module_ExtPtfm} [-] + INTEGER(IntKi) :: CompSub = 0_IntKi !< Compute sub-structural dynamics (switch) {Module_None; Module_SD, Module_ExtPtfm, Module_SlD} [-] INTEGER(IntKi) :: CompMooring = 0_IntKi !< Compute mooring system (switch) {Module_None; Module_MAP; Module_FEAM; Module_MD; Module_Orca} [-] INTEGER(IntKi) :: CompIce = 0_IntKi !< Compute ice loading (switch) {Module_None; Module_IceF, Module_IceD} [-] + INTEGER(IntKi) :: CompSoil = 0_IntKi !< Compute soil-structural dynamics (switch) {Module_None; Module_SlD} [-] INTEGER(IntKi) :: MHK = 0_IntKi !< MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine} [-] LOGICAL :: UseDWM = .false. !< Use the DWM module in AeroDyn [-] LOGICAL :: Linearize = .false. !< Linearization analysis (flag) [-] @@ -182,6 +185,7 @@ MODULE FAST_Types CHARACTER(1024) :: SubFile !< sub-structural input file path [-] CHARACTER(1024) :: MooringFile !< mooring system input file path [-] CHARACTER(1024) :: IceFile !< ice loading input file path [-] + CHARACTER(1024) :: SoilFile !< Name of file containing soil-structure input parameters [-] REAL(DbKi) :: TStart = 0.0_R8Ki !< Time to begin tabular output [s] REAL(DbKi) :: DT_Out = 0.0_R8Ki !< Time step for tabular output [s] LOGICAL :: WrSttsTime = .false. !< Whether we should write the status times to the screen [-] @@ -423,6 +427,21 @@ 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(:), ALLOCATABLE :: x !< Continuous states [-] + TYPE(SlD_ContinuousStateType) :: dxdt !< Continuous state derivatives [-] + TYPE(SlD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd !< Discrete states [-] + TYPE(SlD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z !< Constraint states [-] + TYPE(SlD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: 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(:), ALLOCATABLE :: x !< Continuous states [-] @@ -595,6 +614,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 ======= @@ -639,6 +660,7 @@ MODULE FAST_Types TYPE(SeaState_Data) :: SeaSt !< Data for the SeaState 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 [-] @@ -1154,6 +1176,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 @@ -1212,6 +1235,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 @@ -1381,6 +1405,7 @@ subroutine FAST_PackParam(RF, Indata) call RegPack(RF, InData%CompSub) call RegPack(RF, InData%CompMooring) call RegPack(RF, InData%CompIce) + call RegPack(RF, InData%CompSoil) call RegPack(RF, InData%MHK) call RegPack(RF, InData%UseDWM) call RegPack(RF, InData%Linearize) @@ -1406,6 +1431,7 @@ subroutine FAST_PackParam(RF, Indata) call RegPack(RF, InData%SubFile) call RegPack(RF, InData%MooringFile) call RegPack(RF, InData%IceFile) + call RegPack(RF, InData%SoilFile) call RegPack(RF, InData%TStart) call RegPack(RF, InData%DT_Out) call RegPack(RF, InData%WrSttsTime) @@ -1501,6 +1527,7 @@ subroutine FAST_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%CompSub); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%CompMooring); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%CompIce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CompSoil); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%MHK); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%UseDWM); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return @@ -1526,6 +1553,7 @@ subroutine FAST_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%SubFile); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%MooringFile); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%IceFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SoilFile); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%TStart); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DT_Out); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%WrSttsTime); if (RegCheckErr(RF, RoutineName)) return @@ -5772,6 +5800,342 @@ subroutine FAST_UnPackSubDyn_Data(RF, OutData) call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return end subroutine +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 + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_CopySoilDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcSoilDyn_DataData%x)) then + LB(1:1) = lbound(SrcSoilDyn_DataData%x) + UB(1:1) = ubound(SrcSoilDyn_DataData%x) + if (.not. allocated(DstSoilDyn_DataData%x)) then + allocate(DstSoilDyn_DataData%x(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSoilDyn_DataData%x.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(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 + end do + end if + call SlD_CopyContState(SrcSoilDyn_DataData%dxdt, DstSoilDyn_DataData%dxdt, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcSoilDyn_DataData%xd)) then + LB(1:1) = lbound(SrcSoilDyn_DataData%xd) + UB(1:1) = ubound(SrcSoilDyn_DataData%xd) + if (.not. allocated(DstSoilDyn_DataData%xd)) then + allocate(DstSoilDyn_DataData%xd(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSoilDyn_DataData%xd.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(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 + end do + end if + if (allocated(SrcSoilDyn_DataData%z)) then + LB(1:1) = lbound(SrcSoilDyn_DataData%z) + UB(1:1) = ubound(SrcSoilDyn_DataData%z) + if (.not. allocated(DstSoilDyn_DataData%z)) then + allocate(DstSoilDyn_DataData%z(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSoilDyn_DataData%z.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(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 + end do + end if + if (allocated(SrcSoilDyn_DataData%OtherSt)) then + LB(1:1) = lbound(SrcSoilDyn_DataData%OtherSt) + UB(1:1) = ubound(SrcSoilDyn_DataData%OtherSt) + if (.not. allocated(DstSoilDyn_DataData%OtherSt)) then + allocate(DstSoilDyn_DataData%OtherSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSoilDyn_DataData%OtherSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(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 + end do + end if + call SlD_CopyParam(SrcSoilDyn_DataData%p, DstSoilDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SlD_CopyInput(SrcSoilDyn_DataData%u, DstSoilDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SlD_CopyOutput(SrcSoilDyn_DataData%y, DstSoilDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + 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(SrcSoilDyn_DataData%Input)) then + LB(1:1) = lbound(SrcSoilDyn_DataData%Input) + UB(1:1) = ubound(SrcSoilDyn_DataData%Input) + if (.not. allocated(DstSoilDyn_DataData%Input)) then + allocate(DstSoilDyn_DataData%Input(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSoilDyn_DataData%Input.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(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 + end do + end if + if (allocated(SrcSoilDyn_DataData%InputTimes)) then + LB(1:1) = lbound(SrcSoilDyn_DataData%InputTimes) + UB(1:1) = ubound(SrcSoilDyn_DataData%InputTimes) + if (.not. allocated(DstSoilDyn_DataData%InputTimes)) then + allocate(DstSoilDyn_DataData%InputTimes(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstSoilDyn_DataData%InputTimes.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstSoilDyn_DataData%InputTimes = SrcSoilDyn_DataData%InputTimes + end if +end subroutine + +subroutine FAST_DestroySoilDyn_Data(SoilDyn_DataData, ErrStat, ErrMsg) + type(SoilDyn_Data), intent(inout) :: SoilDyn_DataData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FAST_DestroySoilDyn_Data' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SoilDyn_DataData%x)) then + LB(1:1) = lbound(SoilDyn_DataData%x) + UB(1:1) = ubound(SoilDyn_DataData%x) + do i1 = LB(1), UB(1) + call SlD_DestroyContState(SoilDyn_DataData%x(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SoilDyn_DataData%x) + end if + call SlD_DestroyContState(SoilDyn_DataData%dxdt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(SoilDyn_DataData%xd)) then + LB(1:1) = lbound(SoilDyn_DataData%xd) + UB(1:1) = ubound(SoilDyn_DataData%xd) + do i1 = LB(1), UB(1) + call SlD_DestroyDiscState(SoilDyn_DataData%xd(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SoilDyn_DataData%xd) + end if + if (allocated(SoilDyn_DataData%z)) then + LB(1:1) = lbound(SoilDyn_DataData%z) + UB(1:1) = ubound(SoilDyn_DataData%z) + do i1 = LB(1), UB(1) + call SlD_DestroyConstrState(SoilDyn_DataData%z(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SoilDyn_DataData%z) + end if + if (allocated(SoilDyn_DataData%OtherSt)) then + LB(1:1) = lbound(SoilDyn_DataData%OtherSt) + UB(1:1) = ubound(SoilDyn_DataData%OtherSt) + do i1 = LB(1), UB(1) + call SlD_DestroyOtherState(SoilDyn_DataData%OtherSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SoilDyn_DataData%OtherSt) + end if + call SlD_DestroyParam(SoilDyn_DataData%p, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SlD_DestroyInput(SoilDyn_DataData%u, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SlD_DestroyOutput(SoilDyn_DataData%y, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SlD_DestroyMisc(SoilDyn_DataData%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(SoilDyn_DataData%Input)) then + LB(1:1) = lbound(SoilDyn_DataData%Input) + UB(1:1) = ubound(SoilDyn_DataData%Input) + do i1 = LB(1), UB(1) + call SlD_DestroyInput(SoilDyn_DataData%Input(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(SoilDyn_DataData%Input) + end if + if (allocated(SoilDyn_DataData%InputTimes)) then + deallocate(SoilDyn_DataData%InputTimes) + end if +end subroutine + +subroutine FAST_PackSoilDyn_Data(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SoilDyn_Data), intent(in) :: InData + character(*), parameter :: RoutineName = 'FAST_PackSoilDyn_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%x)) + if (allocated(InData%x)) then + call RegPackBounds(RF, 1, lbound(InData%x), ubound(InData%x)) + LB(1:1) = lbound(InData%x) + UB(1:1) = ubound(InData%x) + do i1 = LB(1), UB(1) + call SlD_PackContState(RF, InData%x(i1)) + end do + end if + call SlD_PackContState(RF, InData%dxdt) + call RegPack(RF, allocated(InData%xd)) + if (allocated(InData%xd)) then + call RegPackBounds(RF, 1, lbound(InData%xd), ubound(InData%xd)) + LB(1:1) = lbound(InData%xd) + UB(1:1) = ubound(InData%xd) + do i1 = LB(1), UB(1) + call SlD_PackDiscState(RF, InData%xd(i1)) + end do + end if + call RegPack(RF, allocated(InData%z)) + if (allocated(InData%z)) then + call RegPackBounds(RF, 1, lbound(InData%z), ubound(InData%z)) + LB(1:1) = lbound(InData%z) + UB(1:1) = ubound(InData%z) + do i1 = LB(1), UB(1) + call SlD_PackConstrState(RF, InData%z(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt)) + if (allocated(InData%OtherSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt), ubound(InData%OtherSt)) + LB(1:1) = lbound(InData%OtherSt) + UB(1:1) = ubound(InData%OtherSt) + do i1 = LB(1), UB(1) + call SlD_PackOtherState(RF, InData%OtherSt(i1)) + end do + end if + call SlD_PackParam(RF, InData%p) + call SlD_PackInput(RF, InData%u) + call SlD_PackOutput(RF, InData%y) + call SlD_PackMisc(RF, InData%m) + call RegPack(RF, allocated(InData%Input)) + if (allocated(InData%Input)) then + call RegPackBounds(RF, 1, lbound(InData%Input), ubound(InData%Input)) + LB(1:1) = lbound(InData%Input) + UB(1:1) = ubound(InData%Input) + do i1 = LB(1), UB(1) + call SlD_PackInput(RF, InData%Input(i1)) + end do + end if + call RegPackAlloc(RF, InData%InputTimes) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine FAST_UnPackSoilDyn_Data(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SoilDyn_Data), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'FAST_UnPackSoilDyn_Data' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%x)) deallocate(OutData%x) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SlD_UnpackContState(RF, OutData%x(i1)) ! x + end do + end if + call SlD_UnpackContState(RF, OutData%dxdt) ! dxdt + if (allocated(OutData%xd)) deallocate(OutData%xd) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SlD_UnpackDiscState(RF, OutData%xd(i1)) ! xd + end do + end if + if (allocated(OutData%z)) deallocate(OutData%z) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SlD_UnpackConstrState(RF, OutData%z(i1)) ! z + end do + end if + if (allocated(OutData%OtherSt)) deallocate(OutData%OtherSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SlD_UnpackOtherState(RF, OutData%OtherSt(i1)) ! OtherSt + end do + end if + call SlD_UnpackParam(RF, OutData%p) ! p + call SlD_UnpackInput(RF, OutData%u) ! u + call SlD_UnpackOutput(RF, OutData%y) ! y + call SlD_UnpackMisc(RF, OutData%m) ! m + if (allocated(OutData%Input)) deallocate(OutData%Input) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%Input(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SlD_UnpackInput(RF, OutData%Input(i1)) ! Input + end do + end if + call RegUnpackAlloc(RF, OutData%InputTimes); if (RegCheckErr(RF, RoutineName)) return +end subroutine + subroutine FAST_CopyExtPtfm_Data(SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlCode, ErrStat, ErrMsg) type(ExtPtfm_Data), intent(inout) :: SrcExtPtfm_DataData type(ExtPtfm_Data), intent(inout) :: DstExtPtfm_DataData @@ -8624,6 +8988,12 @@ subroutine FAST_CopyInitData(SrcInitDataData, DstInitDataData, CtrlCode, ErrStat 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 subroutine FAST_DestroyInitData(InitDataData, ErrStat, ErrMsg) @@ -8734,6 +9104,10 @@ subroutine FAST_DestroyInitData(InitDataData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call IceD_DestroyInitOutput(InitDataData%OutData_IceD, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SlD_DestroyInitInput(InitDataData%InData_SlD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SlD_DestroyInitOutput(InitDataData%OutData_SlD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine FAST_PackInitData(RF, Indata) @@ -8805,6 +9179,8 @@ subroutine FAST_PackInitData(RF, Indata) call IceFloe_PackInitOutput(RF, InData%OutData_IceF) call IceD_PackInitInput(RF, InData%InData_IceD) call IceD_PackInitOutput(RF, InData%OutData_IceD) + call SlD_PackInitInput(RF, InData%InData_SlD) + call SlD_PackInitOutput(RF, InData%OutData_SlD) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -8891,6 +9267,8 @@ subroutine FAST_UnPackInitData(RF, OutData) call IceFloe_UnpackInitOutput(RF, OutData%OutData_IceF) ! OutData_IceF call IceD_UnpackInitInput(RF, OutData%InData_IceD) ! InData_IceD call IceD_UnpackInitOutput(RF, OutData%OutData_IceD) ! OutData_IceD + call SlD_UnpackInitInput(RF, OutData%InData_SlD) ! InData_SlD + call SlD_UnpackInitOutput(RF, OutData%OutData_SlD) ! OutData_SlD end subroutine subroutine FAST_CopyExternInitType(SrcExternInitTypeData, DstExternInitTypeData, CtrlCode, ErrStat, ErrMsg) @@ -9054,6 +9432,9 @@ subroutine FAST_CopyTurbineType(SrcTurbineTypeData, DstTurbineTypeData, CtrlCode 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 @@ -9122,6 +9503,8 @@ subroutine FAST_DestroyTurbineType(TurbineTypeData, ErrStat, ErrMsg) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroySubDyn_Data(TurbineTypeData%SD, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call FAST_DestroySoilDyn_Data(TurbineTypeData%SlD, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroyMAP_Data(TurbineTypeData%MAP, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) call FAST_DestroyFEAMooring_Data(TurbineTypeData%FEAM, ErrStat2, ErrMsg2) @@ -9162,6 +9545,7 @@ subroutine FAST_PackTurbineType(RF, Indata) call FAST_PackSeaState_Data(RF, InData%SeaSt) call FAST_PackHydroDyn_Data(RF, InData%HD) call FAST_PackSubDyn_Data(RF, InData%SD) + call FAST_PackSoilDyn_Data(RF, InData%SlD) call FAST_PackMAP_Data(RF, InData%MAP) call FAST_PackFEAMooring_Data(RF, InData%FEAM) call FAST_PackMoorDyn_Data(RF, InData%MD) @@ -9196,6 +9580,7 @@ subroutine FAST_UnPackTurbineType(RF, OutData) call FAST_UnpackSeaState_Data(RF, OutData%SeaSt) ! SeaSt call FAST_UnpackHydroDyn_Data(RF, OutData%HD) ! HD call FAST_UnpackSubDyn_Data(RF, OutData%SD) ! SD + call FAST_UnpackSoilDyn_Data(RF, OutData%SlD) ! SlD call FAST_UnpackMAP_Data(RF, OutData%MAP) ! MAP call FAST_UnpackFEAMooring_Data(RF, OutData%FEAM) ! FEAM call FAST_UnpackMoorDyn_Data(RF, OutData%MD) ! MD diff --git a/modules/orcaflex-interface/CMakeLists.txt b/modules/orcaflex-interface/CMakeLists.txt index 737f57be9a..e711ce0dad 100644 --- a/modules/orcaflex-interface/CMakeLists.txt +++ b/modules/orcaflex-interface/CMakeLists.txt @@ -18,6 +18,12 @@ if (GENERATE_TYPES) generate_f90_types(src/OrcaFlexInterface.txt ${CMAKE_CURRENT_LIST_DIR}/src/OrcaFlexInterface_Types.f90) endif() +if (WIN_DLL_LOAD) + add_definitions(-DLibLoad) +else (WIN_DLL_LOAD) + add_definitions(-DNO_LibLoad) +endif (WIN_DLL_LOAD) + add_library(orcaflexlib STATIC src/OrcaFlexInterface.f90 src/OrcaFlexInterface_Types.f90 diff --git a/modules/seastate/src/SeaSt_WaveField.f90 b/modules/seastate/src/SeaSt_WaveField.f90 index 6e48c1dea3..ad42da2264 100644 --- a/modules/seastate/src/SeaSt_WaveField.f90 +++ b/modules/seastate/src/SeaSt_WaveField.f90 @@ -39,7 +39,6 @@ FUNCTION WaveField_GetNodeTotalWaveElev( WaveField, WaveField_m, Time, pos, ErrS character(ErrMsgLen) :: errMsg2 ErrStat = ErrID_None - ErrMsg = "" IF (ALLOCATED(WaveField%WaveElev1) .or. ALLOCATED(WaveField%WaveElev2)) then CALL WaveField_Interp_Setup3D(Time, pos, WaveField%GridParams, WaveField_m, ErrStat2, ErrMsg2) @@ -84,7 +83,6 @@ SUBROUTINE WaveField_GetNodeWaveNormal( WaveField, WaveField_m, Time, pos, r, n, character(ErrMsgLen) :: errMsg2 ErrStat = ErrID_None - ErrMsg = "" r1 = MAX(r,real(1.0e-6,ReKi)) ! In case r is zero @@ -134,7 +132,6 @@ SUBROUTINE WaveField_GetNodeWaveKin( WaveField, WaveField_m, Time, pos, forceNod character(ErrMsgLen) :: errMsg2 ErrStat = ErrID_None - ErrMsg = "" posXY = pos(1:2) posXY0 = (/pos(1),pos(2),0.0_ReKi/) @@ -282,7 +279,6 @@ SUBROUTINE WaveField_GetNodeWaveVel( WaveField, WaveField_m, Time, pos, forceNod character(ErrMsgLen) :: errMsg2 ErrStat = ErrID_None - ErrMsg = "" posXY = pos(1:2) posXY0 = (/pos(1),pos(2),0.0_ReKi/) @@ -396,7 +392,6 @@ SUBROUTINE WaveField_GetNodeWaveVelAcc( WaveField, WaveField_m, Time, pos, force character(ErrMsgLen) :: errMsg2 ErrStat = ErrID_None - ErrMsg = "" posXY = pos(1:2) posXY0 = (/pos(1),pos(2),0.0_ReKi/) @@ -526,7 +521,6 @@ SUBROUTINE WaveField_GetWaveKin( WaveField, WaveField_m, Time, pos, forceNodeInW real(ReKi), allocatable :: FV_DC(:,:), FA_DC(:,:) ErrStat = ErrID_None - ErrMsg = "" NumPoints = size(pos, dim=2) DO i = 1, NumPoints @@ -561,9 +555,9 @@ logical function Failed() call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) Failed = ErrStat >= AbortErrLev end function - logical function FailedMsg(ErrMsg2) - character(*), intent(in ) :: ErrMsg2 - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + logical function FailedMsg(ErrMsgTmp) + character(*), intent(in ) :: ErrMsgTmp + call SetErrStat( ErrStat2, ErrMsgTmp, ErrStat, ErrMsg, RoutineName ) FailedMsg = ErrStat >= AbortErrLev end function end subroutine WaveField_GetWaveKin @@ -591,7 +585,6 @@ SUBROUTINE WaveField_GetWaveVelAcc_AD( WaveField, WaveField_m, StartNode, Time, character(ErrMsgLen) :: errMsg2 ErrStat = ErrID_None - ErrMsg = "" MSL2SWL = WaveField%MSL2SWL WtrDpth = WaveField%EffWtrDpth - MSL2SWL @@ -668,7 +661,6 @@ SUBROUTINE WaveField_GetMeanDynSurfCurr( WaveField, WaveTMax, WaveDT, CurrVxi0, character(ErrMsgLen) :: errMsg2 ErrStat = ErrID_None - ErrMsg = "" CurrVxi0 = 0.0_SiKi CurrVyi0 = 0.0_SiKi @@ -726,7 +718,6 @@ subroutine SetCartesianXYIndex(p, pZero, delta, nMax, Indx_Lo, Indx_Hi, isopc, F real(ReKi) :: Tmp ErrStat = ErrID_None - ErrMsg = "" isopc = -1.0 Indx_Lo = 0 @@ -792,7 +783,6 @@ subroutine SetCartesianZIndex(p, z_depth, delta, nMax, Indx_Lo, Indx_Hi, isopc, real(ReKi) :: Tmp ErrStat = ErrID_None - ErrMsg = "" isopc = -1.0 Indx_Lo = 0 @@ -849,7 +839,6 @@ subroutine SetTimeIndex(Time, deltaT, nMax, Indx_Lo, Indx_Hi, isopc, ErrStat, Er real(ReKi) :: Tmp ErrStat = ErrID_None - ErrMsg = "" isopc = -1.0 Indx_Lo = 0 @@ -905,7 +894,6 @@ subroutine WaveField_Interp_Setup4D( Time, Position, p, m, ErrStat, ErrMsg ) character(ErrMsgLen) :: ErrMsg2 ErrStat = ErrID_None - ErrMsg = "" ! Find the bounding indices for time call SetTimeIndex(Time, p%delta(1), p%n(1), m%Indx_Lo(1), m%Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) @@ -974,7 +962,6 @@ subroutine WaveField_Interp_Setup3D( Time, Position, p, m, ErrStat, ErrMsg ) character(ErrMsgLen) :: ErrMsg2 ErrStat = ErrID_None - ErrMsg = "" ! Find the bounding indices for time call SetTimeIndex(Time, p%delta(1), p%n(1), m%Indx_Lo(1), m%Indx_Hi(1), isopc(1), ErrStat2, ErrMsg2) diff --git a/modules/soildyn/CMakeLists.txt b/modules/soildyn/CMakeLists.txt new file mode 100644 index 0000000000..eca873d5a1 --- /dev/null +++ b/modules/soildyn/CMakeLists.txt @@ -0,0 +1,48 @@ +# +# 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() + +# SoilDyn Library +add_library(soildynlib STATIC + src/REDWINinterface.f90 + src/SoilDyn.f90 + src/SoilDyn_IO.f90 + src/SoilDyn_Types.f90) +target_link_libraries(soildynlib nwtclibs) +if (WIN_DLL_LOAD) + target_compile_definitions(soildynlib PRIVATE LibLoad) +else (WIN_DLL_LOAD) + target_compile_definitions(soildynlib PRIVATE NO_LibLoad) +endif (WIN_DLL_LOAD) + +# SoilDyn Driver +add_executable(soildyn_driver + src/driver/SoilDyn_Driver_Types.f90 + src/driver/SoilDyn_Driver_Subs.f90 + src/driver/SoilDyn_Driver.f90 +) +target_link_libraries(soildyn_driver soildynlib nwtclibs versioninfolib) + + +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..cc2326a966 --- /dev/null +++ b/modules/soildyn/src/REDWINinterface.f90 @@ -0,0 +1,522 @@ +!********************************************************************************************************************************** +! 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) + end if +#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 + end if + 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) + end if + 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) + end if + 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') + end do + 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') + end do + 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') + end do + 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. + end if + end if + +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 + end if + + 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 + end if + + 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 + end if + + 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..10de0275cc --- /dev/null +++ b/modules/soildyn/src/SoilDyn.f90 @@ -0,0 +1,665 @@ +!********************************************************************************************************************************** +!> ## 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. +! .................................................................................................................................. +!! ## 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 + + character(*), parameter :: RoutineName = 'SlD_Init' + integer(IntKi) :: ErrStat2 !< local error status + character(ErrMsgLen) :: ErrMsg2 !< local error message + type(SlD_InputFile) :: InputFileData !< Data stored in the module's input file + integer(IntKi) :: j + + ! 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 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. + if (InitInp%Linearize) then + call SetErrStat(ErrID_Fatal, 'SoilDyn cannot perform linearization analysis.', ErrStat, ErrMsg, RoutineName) + return + 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 parameters 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 + + call SlD_InitVars(u, p, x, y, m, InitOut%Vars, InitInp%Linearize, ErrStat2, ErrMsg2) + +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) :: ErrStat2 !< local error status + character(ErrMsgLen) :: ErrMsg2 !< local error message + real(R8Ki) :: NullDispl(6) !< ignored + real(R8Ki) :: NullForce(6) !< ignored + integer(IntKi) :: i ! Generic counter + + 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 + end do + 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) :: ErrStat2 !< local error status + character(ErrMsgLen) :: ErrMsg2 !< local error message + integer(IntKi) :: i ! Generic counter + + 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 + end if + + 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 + end if + + 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 + end if + + 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 + end if + + ! 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 limitation)', ErrStat, ErrMsg, '') + end if + 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 limitation)', ErrStat, ErrMsg, '') + end if + end do + + 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 + + character(ErrMsgLen) :: ErrMsg2 !< local error message + integer(IntKi) :: ErrStat2 !< local error status + real(R8Ki) :: DCM(3, 3) + real(ReKi), allocatable :: MeshLocations(:, :) + integer(IntKi) :: i + + 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) + end do + + 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) + end do + + 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) + end do + + case default + ErrStat = ErrID_Fatal + ErrMsg = ' Unknown calculation type '//trim(Num2LStr(p%CalcOption)) + 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 + call Eye2D(DCM, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + 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) + end do + + 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 + + +subroutine SlD_InitVars(u, p, x, y, m, Vars, Linearize, ErrStat, ErrMsg) + type(SlD_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(SlD_ParameterType), intent(inout) :: p !< Parameters + type(SlD_ContinuousStateType), intent(inout) :: x !< Continuous state + type(SlD_OutputType), intent(inout) :: y !< Initial system outputs (outputs are not calculated; + type(SlD_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) + type(ModVarsType), intent(inout) :: Vars !< Module variables + logical, intent(in) :: Linearize !< Flag to initialize linearization variables + integer(IntKi), intent(out) :: ErrStat !< Error status of the operation + character(*), intent(out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + character(*), parameter :: RoutineName = 'SlD_InitVars' + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: i + + ErrStat = ErrID_None + ErrMsg = "" + + ! Clear module variables type + call NWTC_Library_DestroyModVarsType(Vars, ErrStat2, ErrMsg2); if (Failed()) return + + !---------------------------------------------------------------------------- + ! Continuous State Variables + !---------------------------------------------------------------------------- + + ! SoilDyn has no continuous state variables + + !---------------------------------------------------------------------------- + ! Input variables + !---------------------------------------------------------------------------- + + ! Soil contact point motions + call MV_AddMeshVar(Vars%u, "SoilMesh", MotionFields, & + DL=DatLoc(SlD_u_SoilMesh), & + Mesh=u%SoilMesh) + + !---------------------------------------------------------------------------- + ! Output variables + !---------------------------------------------------------------------------- + + ! Reaction forces + call MV_AddMeshVar(Vars%y, 'SoilMesh', LoadFields, & + DL=DatLoc(SlD_y_SoilMesh), & + Mesh=y%SoilMesh) + + ! Write output variables + call MV_AddVar(Vars%y, "WriteOutput", FieldScalar, & + DL=DatLoc(SlD_y_WriteOutput), & + Num=p%NumOuts, & + Flags=VF_WriteOut, & + LinNames=[(WriteOutputLinName(i),i=1,p%NumOuts)]) + + !---------------------------------------------------------------------------- + ! Initialization dependent on linearization + !---------------------------------------------------------------------------- + + call MV_InitVarsJac(Vars, m%Jac, Linearize, ErrStat2, ErrMsg2); if (Failed()) return + + if (Linearize) then + call SlD_CopyContState(x, m%x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SlD_CopyContState(x, m%dxdt_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SlD_CopyInput(u, m%u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call SlD_CopyOutput(y, m%y_lin, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + end if + +contains + + function WriteOutputLinName(idx) result(LinName) + integer(IntKi), intent(in) :: idx + character(LinChanLen) :: LinName + LinName = trim(p%OutParam(idx)%Name)//', '//p%OutParam(idx)%Units + end function + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine is called at the end of the simulation. +subroutine 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 + + character(*), parameter :: RoutineName = 'SlD_End' + integer(IntKi) :: ErrStat2 ! local error status + character(ErrMsgLen) :: ErrMsg2 ! local error message + + ! 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) + end if + + !! 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 + end do + else + do i = 1, size(xd%dll_states) + xd%dll_states(i)%Props = 0.0_R8Ki + xd%dll_states(i)%StVar = 0.0_R8Ki + end do + end if + +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) + end if + + ! 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) + + ! Subtract 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) + end if + end do + + 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) + end if + + 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) + + ! Subtract 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) + end if + end do + 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) + end do + +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..eb0a60b30b --- /dev/null +++ b/modules/soildyn/src/SoilDyn_IO.f90 @@ -0,0 +1,849 @@ +!********************************************************************************************************************************** +! 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. + + ! 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) :: Fmt !< 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 + Fmt = "( 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 symmetries: + ! 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; + end do + + ! 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; + end do + + !------------------------------------------------------------------------------------------------- + !> 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 + end do + + + !------------------------------------------------------------------------------------------------- + !> 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 + end do + + 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 checks 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 + end do + 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. + end do + end do +! ................. 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 SoilDyn summary 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 SoilDyn summary 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 ) + end do + + ! Moments + do j=4,6 + AllOuts( SoilPtF(j,i) ) = real( -m%ForceTotal(j,i) / 1000.0_ReKi, SiKi ) + end do + + ! Translation displacement + do j=1,3 + AllOuts( SoilPtD(j ,i) ) = real( u%SoilMesh%TranslationDisp(j,i), SiKi ) + end do + + ! 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 + end do + end do + + + + +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..872133c97b --- /dev/null +++ b/modules/soildyn/src/SoilDyn_Registry.txt @@ -0,0 +1,132 @@ +################################################################################################################################### +# 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 ^ - IntKi Calc_PYcurve - 2 - "P-Y curve calculations (currently unavailable)" - +param ^ - 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 ^ REDWINdllType character(45) PROPSFILE - - - "" - +typedef ^ ^ character(45) LDISPFILE - - - "" - +typedef ^ ^ 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 ^ ^ IntKi nErrorCode - - - "number of returned error codes" - +typedef ^ ^ IntKi ErrorCode {100} - - "Array containing one or more error codes. These are specific to each model." - +typedef ^ ^ R8Ki Props {100}{200} - - "Array containing foundation model properties (used internally by the REDWIN models). Specific to each model." - +typedef ^ ^ 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 ^ ^ IntKi StVarPrint {12}{100} - - "Array indicating which state variables should be printed to the screen. This feature is currently not supported." - +typedef ^ ^ R8Ki Disp {6} - - "Displacements. Follows convention of REDWIN orientation." '(m, rad)' +typedef ^ ^ R8Ki Force {6} - - "Forces. Follows convention of REDWIN orientations." '(N)' +typedef ^ ^ R8Ki D {6}{6} - - "The 6 x 6 elastic macro-element stiffness matrix at the SFI." - +typedef ^ ^ LOGICAL SuppressWarn - .FALSE. - "Supress further warnings." - +typedef ^ ^ IntKi RunMode - 0 - "RunMode of DLL (read from Props(1,1) in Model 1 during initialization" - + + +typedef ^ REDWINdllStates R8Ki Props {100}{200} - - "Array containing foundation model properties (used internally by the REDWIN models). Specific to each model." - +typedef ^ ^ 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 ^ ^ CHARACTER(ChanLen) OutList : - - "List of user-requested output channels" - +typedef ^ ^ R8Ki DT - - - "Timestep requested" '(s)' +typedef ^ ^ IntKi CalcOption - - - "Calculation methodology to use" - +typedef ^ ^ ReKi SD_locations :: - - "Location of the Stiffness damping point" '(m)' +typedef ^ ^ R8Ki Stiffness ::: - - "Stiffness matrix 6x6" '(N/m, N-m/rad)' +typedef ^ ^ R8Ki Damping ::: - - "Damping ratio matrix 6x6" - +typedef ^ ^ IntKi PY_numpoints - - - "Number of P-Y curve mesh points" - +typedef ^ ^ ReKi PY_locations :: - - "P-Y curve location points for mesh" '(m)' +typedef ^ ^ character(1024) PY_inputFile : - - "Input file with P-Y curve data" - +typedef ^ ^ IntKi DLL_model - - - "REDWIN DLL model type to use" - +typedef ^ ^ CHARACTER(2) DLL_modelChr - - - "REDWIN DLL model type to use - character string" - +typedef ^ ^ CHARACTER(1024) DLL_FileName - - - "Name of the DLL file including the full path" - +typedef ^ ^ CHARACTER(1024) DLL_ProcName - - - "Name of the procedure in the DLL that will be called" - +typedef ^ ^ IntKi DLL_numpoints - - - "Number of points to interface to DLL" - +typedef ^ ^ ReKi DLL_locations :: - - "DLL location points for mesh" '(m)' +typedef ^ ^ CHARACTER(1024) DLL_PROPSFILE : - - "Name of PROPSFILE input file used in DLL" - +typedef ^ ^ CHARACTER(1024) DLL_LDISPFILE : - - "Name of LDISPFILE input file used in DLL" - +typedef ^ ^ LOGICAL SumPrint - - - "Print summary information to file (.SlD.sum)" - +typedef ^ ^ IntKi NumOuts - - - "Number of outputs requested" - +typedef ^ ^ 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 ^ ^ CHARACTER(1024) RootName - - - "Root name of the input file" - +typedef ^ ^ LOGICAL Linearize - F - "Flag that tells this module if the glue code wants to linearize." - +typedef ^ ^ ReKi WtrDpth - - - "Water depth to mudline (global coordinates)" '(m)' +typedef ^ ^ logical SlDNonLinearForcePortionOnly - F - "Only the non-linear portion of the reaction forces is returned" - + +# Define outputs from the initialization routine here: +typedef ^ InitOutputType ModVarsType Vars - - - "Module Variables" +typedef ^ ^ CHARACTER(ChanLen) WriteOutputHdr : - - "Names of the output-to-file channels" - +typedef ^ ^ CHARACTER(ChanLen) WriteOutputUnt : - - "Units of the output-to-file channels" - +typedef ^ ^ ProgDesc Ver - - - "This module's name, version, and date" - +typedef ^ ^ ReKi SoilStiffness ::: - - "Soil stiffness at each mesh point (in order)" '(N/m, N-m/rad)' + +# ..... 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" - + +# 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 ^ ^ DLL_Type DLL_Trgt - - - "The addresses and names of the Bladed DLL and its procedure" - +typedef ^ ^ DbKi DLL_DT - - - "Time step for DLL" seconds +typedef ^ ^ CHARACTER(1024) RootName - - - "RootName for writing output files" - +typedef ^ ^ LOGICAL UseREDWINinterface - F - "True if interface successfully initialized" - +typedef ^ ^ CHARACTER(1024) RootFileName - - - "Root file name" - +typedef ^ ^ CHARACTER(1024) EchoFileName - - - "Name of echo file" - +typedef ^ ^ CHARACTER(1024) SumFileName - - - "Name of summary file" - +typedef ^ ^ IntKi DLL_model - - - "REDWIN DLL model type to use" - +typedef ^ ^ IntKi CalcOption - - - "Calculation methodology to use" - +typedef ^ ^ OutParmType OutParam : - - "Names and units (and other characteristics) of all requested output parameters" - +typedef ^ ^ IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - +typedef ^ ^ IntKi NumPoints - - - "Number of points interfacing soil with" - +typedef ^ ^ ReKi WtrDepth - - - "Water depth to mudline (global coordinates)" '(m)' +typedef ^ ^ R8Ki Stiffness ::: - - "Stiffness matrix" '(N/m, N-m/rad)' +typedef ^ ^ logical DLL_OnlyStiff - - - "Use only the stiffness matrix in calculating the restoring forces" - +typedef ^ ^ logical SlDNonLinearForcePortionOnly - F - "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 WriteOutput : - - "Example of data to be written to an output file" "s,-" +typedef ^ ^ MeshType SoilMesh - - - "reaction forces and moments point mesh (may be multiple points)" - + +# 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 ^ ^ R8Ki ForceTotal :: - - "Total reaction force at each node" - +typedef ^ ^ ModJacType Jac - - - "Values corresponding to module variables" +typedef ^ ^ SlD_ContinuousStateType x_perturb - - - "Continuous state perturbation" - +typedef ^ ^ SlD_ContinuousStateType dxdt_lin - - - "Continuous state derivative" - +typedef ^ ^ SlD_InputType u_perturb - - - "Input perturbation" - +typedef ^ ^ SlD_OutputType y_lin - - - "Output" - diff --git a/modules/soildyn/src/SoilDyn_Types.f90 b/modules/soildyn/src/SoilDyn_Types.f90 new file mode 100644 index 0000000000..e5afda70e5 --- /dev/null +++ b/modules/soildyn/src/SoilDyn_Types.f90 @@ -0,0 +1,1855 @@ +!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 = 0_IntKi !< 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 = 0_IntKi !< number of returned error codes [-] + INTEGER(IntKi) , DIMENSION(1:100) :: ErrorCode = 0_IntKi !< Array containing one or more error codes. These are specific to each model. [-] + REAL(R8Ki) , DIMENSION(1:100,1:200) :: Props = 0.0_R8Ki !< Array containing foundation model properties (used internally by the REDWIN models). Specific to each model. [-] + REAL(R8Ki) , DIMENSION(1:12,1:100) :: StVar = 0.0_R8Ki !< 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 = 0_IntKi !< Array indicating which state variables should be printed to the screen. This feature is currently not supported. [-] + REAL(R8Ki) , DIMENSION(1:6) :: Disp = 0.0_R8Ki !< Displacements. Follows convention of REDWIN orientation. ['(m,] + REAL(R8Ki) , DIMENSION(1:6) :: Force = 0.0_R8Ki !< Forces. Follows convention of REDWIN orientations. ['(N)'] + REAL(R8Ki) , DIMENSION(1:6,1:6) :: D = 0.0_R8Ki !< 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 = 0.0_R8Ki !< Array containing foundation model properties (used internally by the REDWIN models). Specific to each model. [-] + REAL(R8Ki) , DIMENSION(1:12,1:100) :: StVar = 0.0_R8Ki !< 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 = .false. !< Echo the input file [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] + REAL(R8Ki) :: DT = 0.0_R8Ki !< Timestep requested ['(s)'] + INTEGER(IntKi) :: CalcOption = 0_IntKi !< 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 = 0_IntKi !< 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 = 0_IntKi !< 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 = 0_IntKi !< 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 = .false. !< Print summary information to file (.SlD.sum) [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of outputs requested [-] + LOGICAL :: DLL_OnlyStiff = .false. !< 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 = 0.0_ReKi !< 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 + TYPE(ModVarsType) :: Vars !< Module Variables [-] + 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 = 0.0_ReKi !< 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 = 0.0_ReKi !< Remove this variable if you have constraint states [-] + END TYPE SlD_ConstraintStateType +! ======================= +! ========= SlD_OtherStateType ======= + TYPE, PUBLIC :: SlD_OtherStateType + INTEGER(IntKi) :: DummyOtherState = 0_IntKi !< Remove this variable if you have other states [-] + END TYPE SlD_OtherStateType +! ======================= +! ========= SlD_ParameterType ======= + TYPE, PUBLIC :: SlD_ParameterType + REAL(DbKi) :: DT = 0.0_R8Ki !< 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 = 0.0_R8Ki !< 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 = 0_IntKi !< REDWIN DLL model type to use [-] + INTEGER(IntKi) :: CalcOption = 0_IntKi !< Calculation methodology to use [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] + INTEGER(IntKi) :: NumOuts = 0_IntKi !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumPoints = 0_IntKi !< Number of points interfacing soil with [-] + REAL(ReKi) :: WtrDepth = 0.0_ReKi !< Water depth to mudline (global coordinates) ['(m)'] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: Stiffness !< Stiffness matrix ['(N/m,] + LOGICAL :: DLL_OnlyStiff = .false. !< 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) , 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 +! ======================= +! ========= 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 [-] + TYPE(ModJacType) :: Jac !< Values corresponding to module variables [-] + TYPE(SlD_ContinuousStateType) :: x_perturb !< Continuous state perturbation [-] + TYPE(SlD_ContinuousStateType) :: dxdt_lin !< Continuous state derivative [-] + TYPE(SlD_InputType) :: u_perturb !< Input perturbation [-] + TYPE(SlD_OutputType) :: y_lin !< Output [-] + END TYPE SlD_MiscVarType +! ======================= + integer(IntKi), public, parameter :: SlD_x_DummyContState = 1 ! SlD%DummyContState + integer(IntKi), public, parameter :: SlD_u_SoilMesh = 2 ! SlD%SoilMesh + integer(IntKi), public, parameter :: SlD_y_WriteOutput = 3 ! SlD%WriteOutput + integer(IntKi), public, parameter :: SlD_y_SoilMesh = 4 ! SlD%SoilMesh + +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 + 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 + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SlD_PackREDWINdllType(RF, Indata) + type(RegFile), intent(inout) :: RF + type(REDWINdllType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SlD_PackREDWINdllType' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%PROPSFILE) + call RegPack(RF, InData%LDISPFILE) + call RegPack(RF, InData%IDtask) + call RegPack(RF, InData%nErrorCode) + call RegPack(RF, InData%ErrorCode) + call RegPack(RF, InData%Props) + call RegPack(RF, InData%StVar) + call RegPack(RF, InData%StVarPrint) + call RegPack(RF, InData%Disp) + call RegPack(RF, InData%Force) + call RegPack(RF, InData%D) + call RegPack(RF, InData%SuppressWarn) + call RegPack(RF, InData%RunMode) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SlD_UnPackREDWINdllType(RF, OutData) + type(RegFile), intent(inout) :: RF + type(REDWINdllType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SlD_UnPackREDWINdllType' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%PROPSFILE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%LDISPFILE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%IDtask); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%nErrorCode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%ErrorCode); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Props); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StVar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StVarPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Disp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Force); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%D); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SuppressWarn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RunMode); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + character(*), parameter :: RoutineName = 'SlD_CopyREDWINdllStates' + ErrStat = ErrID_None + ErrMsg = '' + DstREDWINdllStatesData%Props = SrcREDWINdllStatesData%Props + DstREDWINdllStatesData%StVar = SrcREDWINdllStatesData%StVar +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SlD_PackREDWINdllStates(RF, Indata) + type(RegFile), intent(inout) :: RF + type(REDWINdllStates), intent(in) :: InData + character(*), parameter :: RoutineName = 'SlD_PackREDWINdllStates' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Props) + call RegPack(RF, InData%StVar) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SlD_UnPackREDWINdllStates(RF, OutData) + type(RegFile), intent(inout) :: RF + type(REDWINdllStates), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SlD_UnPackREDWINdllStates' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Props); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%StVar); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(*), parameter :: RoutineName = 'SlD_CopyInputFile' + ErrStat = ErrID_None + ErrMsg = '' + DstInputFileData%EchoFlag = SrcInputFileData%EchoFlag + if (allocated(SrcInputFileData%OutList)) then + LB(1:1) = lbound(SrcInputFileData%OutList) + UB(1:1) = ubound(SrcInputFileData%OutList) + if (.not. allocated(DstInputFileData%OutList)) then + allocate(DstInputFileData%OutList(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputFileData%OutList = SrcInputFileData%OutList + end if + DstInputFileData%DT = SrcInputFileData%DT + DstInputFileData%CalcOption = SrcInputFileData%CalcOption + if (allocated(SrcInputFileData%SD_locations)) then + LB(1:2) = lbound(SrcInputFileData%SD_locations) + UB(1:2) = ubound(SrcInputFileData%SD_locations) + if (.not. allocated(DstInputFileData%SD_locations)) then + allocate(DstInputFileData%SD_locations(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInputFileData%Stiffness)) then + LB(1:3) = lbound(SrcInputFileData%Stiffness) + UB(1:3) = ubound(SrcInputFileData%Stiffness) + if (.not. allocated(DstInputFileData%Stiffness)) then + allocate(DstInputFileData%Stiffness(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), 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 + end if + if (allocated(SrcInputFileData%Damping)) then + LB(1:3) = lbound(SrcInputFileData%Damping) + UB(1:3) = ubound(SrcInputFileData%Damping) + if (.not. allocated(DstInputFileData%Damping)) then + allocate(DstInputFileData%Damping(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), 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 + end if + DstInputFileData%PY_numpoints = SrcInputFileData%PY_numpoints + if (allocated(SrcInputFileData%PY_locations)) then + LB(1:2) = lbound(SrcInputFileData%PY_locations) + UB(1:2) = ubound(SrcInputFileData%PY_locations) + if (.not. allocated(DstInputFileData%PY_locations)) then + allocate(DstInputFileData%PY_locations(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInputFileData%PY_inputFile)) then + LB(1:1) = lbound(SrcInputFileData%PY_inputFile) + UB(1:1) = ubound(SrcInputFileData%PY_inputFile) + if (.not. allocated(DstInputFileData%PY_inputFile)) then + allocate(DstInputFileData%PY_inputFile(LB(1):UB(1)), 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 + end if + 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 + LB(1:2) = lbound(SrcInputFileData%DLL_locations) + UB(1:2) = ubound(SrcInputFileData%DLL_locations) + if (.not. allocated(DstInputFileData%DLL_locations)) then + allocate(DstInputFileData%DLL_locations(LB(1):UB(1),LB(2):UB(2)), 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 + end if + if (allocated(SrcInputFileData%DLL_PROPSFILE)) then + LB(1:1) = lbound(SrcInputFileData%DLL_PROPSFILE) + UB(1:1) = ubound(SrcInputFileData%DLL_PROPSFILE) + if (.not. allocated(DstInputFileData%DLL_PROPSFILE)) then + allocate(DstInputFileData%DLL_PROPSFILE(LB(1):UB(1)), 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 + end if + if (allocated(SrcInputFileData%DLL_LDISPFILE)) then + LB(1:1) = lbound(SrcInputFileData%DLL_LDISPFILE) + UB(1:1) = ubound(SrcInputFileData%DLL_LDISPFILE) + if (.not. allocated(DstInputFileData%DLL_LDISPFILE)) then + allocate(DstInputFileData%DLL_LDISPFILE(LB(1):UB(1)), 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 + end if + DstInputFileData%SumPrint = SrcInputFileData%SumPrint + DstInputFileData%NumOuts = SrcInputFileData%NumOuts + DstInputFileData%DLL_OnlyStiff = SrcInputFileData%DLL_OnlyStiff +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(InputFileData%OutList)) then + deallocate(InputFileData%OutList) + end if + if (allocated(InputFileData%SD_locations)) then + deallocate(InputFileData%SD_locations) + end if + if (allocated(InputFileData%Stiffness)) then + deallocate(InputFileData%Stiffness) + end if + if (allocated(InputFileData%Damping)) then + deallocate(InputFileData%Damping) + end if + if (allocated(InputFileData%PY_locations)) then + deallocate(InputFileData%PY_locations) + end if + if (allocated(InputFileData%PY_inputFile)) then + deallocate(InputFileData%PY_inputFile) + end if + if (allocated(InputFileData%DLL_locations)) then + deallocate(InputFileData%DLL_locations) + end if + if (allocated(InputFileData%DLL_PROPSFILE)) then + deallocate(InputFileData%DLL_PROPSFILE) + end if + if (allocated(InputFileData%DLL_LDISPFILE)) then + deallocate(InputFileData%DLL_LDISPFILE) + end if +end subroutine + +subroutine SlD_PackInputFile(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SlD_InputFile), intent(in) :: InData + character(*), parameter :: RoutineName = 'SlD_PackInputFile' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%EchoFlag) + call RegPackAlloc(RF, InData%OutList) + call RegPack(RF, InData%DT) + call RegPack(RF, InData%CalcOption) + call RegPackAlloc(RF, InData%SD_locations) + call RegPackAlloc(RF, InData%Stiffness) + call RegPackAlloc(RF, InData%Damping) + call RegPack(RF, InData%PY_numpoints) + call RegPackAlloc(RF, InData%PY_locations) + call RegPackAlloc(RF, InData%PY_inputFile) + call RegPack(RF, InData%DLL_model) + call RegPack(RF, InData%DLL_modelChr) + call RegPack(RF, InData%DLL_FileName) + call RegPack(RF, InData%DLL_ProcName) + call RegPack(RF, InData%DLL_numpoints) + call RegPackAlloc(RF, InData%DLL_locations) + call RegPackAlloc(RF, InData%DLL_PROPSFILE) + call RegPackAlloc(RF, InData%DLL_LDISPFILE) + call RegPack(RF, InData%SumPrint) + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%DLL_OnlyStiff) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SlD_UnPackInputFile(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SlD_InputFile), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SlD_UnPackInputFile' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%EchoFlag); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%OutList); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CalcOption); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%SD_locations); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Stiffness); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Damping); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PY_numpoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PY_locations); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PY_inputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_model); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_modelChr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_FileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_ProcName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_numpoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DLL_locations); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DLL_PROPSFILE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%DLL_LDISPFILE); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumPrint); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_OnlyStiff); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + 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 + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SlD_PackInitInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SlD_InitInputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SlD_PackInitInput' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%InputFile) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%Linearize) + call RegPack(RF, InData%WtrDpth) + call RegPack(RF, InData%SlDNonLinearForcePortionOnly) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SlD_UnPackInitInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SlD_InitInputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SlD_UnPackInitInput' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%InputFile); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Linearize); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SlDNonLinearForcePortionOnly); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SlD_CopyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_CopyModVarsType(SrcInitOutputData%Vars, DstInitOutputData%Vars, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcInitOutputData%WriteOutputHdr)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputHdr) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputHdr) + if (.not. allocated(DstInitOutputData%WriteOutputHdr)) then + allocate(DstInitOutputData%WriteOutputHdr(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr + end if + if (allocated(SrcInitOutputData%WriteOutputUnt)) then + LB(1:1) = lbound(SrcInitOutputData%WriteOutputUnt) + UB(1:1) = ubound(SrcInitOutputData%WriteOutputUnt) + if (.not. allocated(DstInitOutputData%WriteOutputUnt)) then + allocate(DstInitOutputData%WriteOutputUnt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt + end if + 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 + LB(1:3) = lbound(SrcInitOutputData%SoilStiffness) + UB(1:3) = ubound(SrcInitOutputData%SoilStiffness) + if (.not. allocated(DstInitOutputData%SoilStiffness)) then + allocate(DstInitOutputData%SoilStiffness(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), 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 + end if +end subroutine + +subroutine SlD_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) + type(SlD_InitOutputType), intent(inout) :: InitOutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SlD_DestroyInitOutput' + ErrStat = ErrID_None + ErrMsg = '' + call NWTC_Library_DestroyModVarsType(InitOutputData%Vars, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%WriteOutputHdr)) then + deallocate(InitOutputData%WriteOutputHdr) + end if + if (allocated(InitOutputData%WriteOutputUnt)) then + deallocate(InitOutputData%WriteOutputUnt) + end if + call NWTC_Library_DestroyProgDesc(InitOutputData%Ver, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(InitOutputData%SoilStiffness)) then + deallocate(InitOutputData%SoilStiffness) + end if +end subroutine + +subroutine SlD_PackInitOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SlD_InitOutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SlD_PackInitOutput' + if (RF%ErrStat >= AbortErrLev) return + call NWTC_Library_PackModVarsType(RF, InData%Vars) + call RegPackAlloc(RF, InData%WriteOutputHdr) + call RegPackAlloc(RF, InData%WriteOutputUnt) + call NWTC_Library_PackProgDesc(RF, InData%Ver) + call RegPackAlloc(RF, InData%SoilStiffness) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SlD_UnPackInitOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SlD_InitOutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SlD_UnPackInitOutput' + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call NWTC_Library_UnpackModVarsType(RF, OutData%Vars) ! Vars + call RegUnpackAlloc(RF, OutData%WriteOutputHdr); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%WriteOutputUnt); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackProgDesc(RF, OutData%Ver) ! Ver + call RegUnpackAlloc(RF, OutData%SoilStiffness); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + character(*), parameter :: RoutineName = 'SlD_CopyContState' + ErrStat = ErrID_None + ErrMsg = '' + DstContStateData%DummyContState = SrcContStateData%DummyContState +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SlD_PackContState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SlD_ContinuousStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SlD_PackContState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyContState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SlD_UnPackContState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SlD_ContinuousStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SlD_UnPackContState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyContState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SlD_CopyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcDiscStateData%dll_states)) then + LB(1:1) = lbound(SrcDiscStateData%dll_states) + UB(1:1) = ubound(SrcDiscStateData%dll_states) + if (.not. allocated(DstDiscStateData%dll_states)) then + allocate(DstDiscStateData%dll_states(LB(1):UB(1)), 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 = LB(1), UB(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 + end do + end if +end subroutine + +subroutine SlD_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) + type(SlD_DiscreteStateType), intent(inout) :: DiscStateData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SlD_DestroyDiscState' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(DiscStateData%dll_states)) then + LB(1:1) = lbound(DiscStateData%dll_states) + UB(1:1) = ubound(DiscStateData%dll_states) + do i1 = LB(1), UB(1) + call SlD_DestroyREDWINdllStates(DiscStateData%dll_states(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(DiscStateData%dll_states) + end if +end subroutine + +subroutine SlD_PackDiscState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SlD_DiscreteStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SlD_PackDiscState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%dll_states)) + if (allocated(InData%dll_states)) then + call RegPackBounds(RF, 1, lbound(InData%dll_states), ubound(InData%dll_states)) + LB(1:1) = lbound(InData%dll_states) + UB(1:1) = ubound(InData%dll_states) + do i1 = LB(1), UB(1) + call SlD_PackREDWINdllStates(RF, InData%dll_states(i1)) + end do + end if + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SlD_UnPackDiscState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SlD_DiscreteStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SlD_UnPackDiscState' + integer(B4Ki) :: i1 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%dll_states)) deallocate(OutData%dll_states) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%dll_states(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dll_states.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SlD_UnpackREDWINdllStates(RF, OutData%dll_states(i1)) ! dll_states + end do + end if +end subroutine + +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 + character(*), parameter :: RoutineName = 'SlD_CopyConstrState' + ErrStat = ErrID_None + ErrMsg = '' + DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SlD_PackConstrState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SlD_ConstraintStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SlD_PackConstrState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyConstrState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SlD_UnPackConstrState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SlD_ConstraintStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SlD_UnPackConstrState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + character(*), parameter :: RoutineName = 'SlD_CopyOtherState' + ErrStat = ErrID_None + ErrMsg = '' + DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState +end subroutine + +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' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SlD_PackOtherState(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SlD_OtherStateType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SlD_PackOtherState' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DummyOtherState) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SlD_UnPackOtherState(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SlD_OtherStateType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SlD_UnPackOtherState' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DummyOtherState); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(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 + LB(1:1) = lbound(SrcParamData%OutParam) + UB(1:1) = ubound(SrcParamData%OutParam) + if (.not. allocated(DstParamData%OutParam)) then + allocate(DstParamData%OutParam(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call NWTC_Library_CopyOutParmType(SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumPoints = SrcParamData%NumPoints + DstParamData%WtrDepth = SrcParamData%WtrDepth + if (allocated(SrcParamData%Stiffness)) then + LB(1:3) = lbound(SrcParamData%Stiffness) + UB(1:3) = ubound(SrcParamData%Stiffness) + if (.not. allocated(DstParamData%Stiffness)) then + allocate(DstParamData%Stiffness(LB(1):UB(1),LB(2):UB(2),LB(3):UB(3)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Stiffness.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%Stiffness = SrcParamData%Stiffness + end if + DstParamData%DLL_OnlyStiff = SrcParamData%DLL_OnlyStiff + DstParamData%SlDNonLinearForcePortionOnly = SrcParamData%SlDNonLinearForcePortionOnly +end subroutine + +subroutine SlD_DestroyParam(ParamData, ErrStat, ErrMsg) + type(SlD_ParameterType), intent(inout) :: ParamData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SlD_DestroyParam' + ErrStat = ErrID_None + ErrMsg = '' + call FreeDynamicLib( ParamData%DLL_Trgt, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(ParamData%OutParam)) then + LB(1:1) = lbound(ParamData%OutParam) + UB(1:1) = ubound(ParamData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_DestroyOutParmType(ParamData%OutParam(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(ParamData%OutParam) + end if + if (allocated(ParamData%Stiffness)) then + deallocate(ParamData%Stiffness) + end if +end subroutine + +subroutine SlD_PackParam(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SlD_ParameterType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SlD_PackParam' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%DT) + call DLLTypePack(RF, InData%DLL_Trgt) + call RegPack(RF, InData%DLL_DT) + call RegPack(RF, InData%RootName) + call RegPack(RF, InData%UseREDWINinterface) + call RegPack(RF, InData%RootFileName) + call RegPack(RF, InData%EchoFileName) + call RegPack(RF, InData%SumFileName) + call RegPack(RF, InData%DLL_model) + call RegPack(RF, InData%CalcOption) + call RegPack(RF, allocated(InData%OutParam)) + if (allocated(InData%OutParam)) then + call RegPackBounds(RF, 1, lbound(InData%OutParam), ubound(InData%OutParam)) + LB(1:1) = lbound(InData%OutParam) + UB(1:1) = ubound(InData%OutParam) + do i1 = LB(1), UB(1) + call NWTC_Library_PackOutParmType(RF, InData%OutParam(i1)) + end do + end if + call RegPack(RF, InData%NumOuts) + call RegPack(RF, InData%NumPoints) + call RegPack(RF, InData%WtrDepth) + call RegPackAlloc(RF, InData%Stiffness) + call RegPack(RF, InData%DLL_OnlyStiff) + call RegPack(RF, InData%SlDNonLinearForcePortionOnly) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SlD_UnPackParam(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SlD_ParameterType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SlD_UnPackParam' + integer(B4Ki) :: i1, i2, i3 + integer(B4Ki) :: LB(3), UB(3) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%DT); if (RegCheckErr(RF, RoutineName)) return + call DLLTypeUnpack(RF, OutData%DLL_Trgt) ! DLL_Trgt + call RegUnpack(RF, OutData%DLL_DT); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UseREDWINinterface); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%RootFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EchoFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SumFileName); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_model); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CalcOption); if (RegCheckErr(RF, RoutineName)) return + if (allocated(OutData%OutParam)) deallocate(OutData%OutParam) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OutParam(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call NWTC_Library_UnpackOutParmType(RF, OutData%OutParam(i1)) ! OutParam + end do + end if + call RegUnpack(RF, OutData%NumOuts); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumPoints); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WtrDepth); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%Stiffness); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%DLL_OnlyStiff); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%SlDNonLinearForcePortionOnly); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +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 + 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 + +subroutine SlD_DestroyInput(InputData, ErrStat, ErrMsg) + type(SlD_InputType), intent(inout) :: InputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SlD_DestroyInput' + ErrStat = ErrID_None + ErrMsg = '' + call MeshDestroy( InputData%SoilMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SlD_PackInput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SlD_InputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SlD_PackInput' + if (RF%ErrStat >= AbortErrLev) return + call MeshPack(RF, InData%SoilMesh) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SlD_UnPackInput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SlD_InputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SlD_UnPackInput' + if (RF%ErrStat /= ErrID_None) return + call MeshUnpack(RF, OutData%SoilMesh) ! SoilMesh +end subroutine + +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 + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SlD_CopyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcOutputData%WriteOutput)) then + LB(1:1) = lbound(SrcOutputData%WriteOutput) + UB(1:1) = ubound(SrcOutputData%WriteOutput) + if (.not. allocated(DstOutputData%WriteOutput)) then + allocate(DstOutputData%WriteOutput(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstOutputData%WriteOutput = SrcOutputData%WriteOutput + end if + call MeshCopy(SrcOutputData%SoilMesh, DstOutputData%SoilMesh, CtrlCode, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine SlD_DestroyOutput(OutputData, ErrStat, ErrMsg) + type(SlD_OutputType), intent(inout) :: OutputData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SlD_DestroyOutput' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(OutputData%WriteOutput)) then + deallocate(OutputData%WriteOutput) + end if + call MeshDestroy( OutputData%SoilMesh, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SlD_PackOutput(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SlD_OutputType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SlD_PackOutput' + if (RF%ErrStat >= AbortErrLev) return + call RegPackAlloc(RF, InData%WriteOutput) + call MeshPack(RF, InData%SoilMesh) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SlD_UnPackOutput(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SlD_OutputType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SlD_UnPackOutput' + integer(B4Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpackAlloc(RF, OutData%WriteOutput); if (RegCheckErr(RF, RoutineName)) return + call MeshUnpack(RF, OutData%SoilMesh) ! SoilMesh +end subroutine + +subroutine SlD_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) + type(SlD_MiscVarType), intent(inout) :: SrcMiscData + type(SlD_MiscVarType), intent(inout) :: DstMiscData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SlD_CopyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(SrcMiscData%dll_data)) then + LB(1:1) = lbound(SrcMiscData%dll_data) + UB(1:1) = ubound(SrcMiscData%dll_data) + if (.not. allocated(DstMiscData%dll_data)) then + allocate(DstMiscData%dll_data(LB(1):UB(1)), 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 = LB(1), UB(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 + end do + end if + if (allocated(SrcMiscData%ForceTotal)) then + LB(1:2) = lbound(SrcMiscData%ForceTotal) + UB(1:2) = ubound(SrcMiscData%ForceTotal) + if (.not. allocated(DstMiscData%ForceTotal)) then + allocate(DstMiscData%ForceTotal(LB(1):UB(1),LB(2):UB(2)), 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 + end if + call NWTC_Library_CopyModJacType(SrcMiscData%Jac, DstMiscData%Jac, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SlD_CopyContState(SrcMiscData%x_perturb, DstMiscData%x_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SlD_CopyContState(SrcMiscData%dxdt_lin, DstMiscData%dxdt_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SlD_CopyInput(SrcMiscData%u_perturb, DstMiscData%u_perturb, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SlD_CopyOutput(SrcMiscData%y_lin, DstMiscData%y_lin, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return +end subroutine + +subroutine SlD_DestroyMisc(MiscData, ErrStat, ErrMsg) + type(SlD_MiscVarType), intent(inout) :: MiscData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SlD_DestroyMisc' + ErrStat = ErrID_None + ErrMsg = '' + if (allocated(MiscData%dll_data)) then + LB(1:1) = lbound(MiscData%dll_data) + UB(1:1) = ubound(MiscData%dll_data) + do i1 = LB(1), UB(1) + call SlD_DestroyREDWINdllType(MiscData%dll_data(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(MiscData%dll_data) + end if + if (allocated(MiscData%ForceTotal)) then + deallocate(MiscData%ForceTotal) + end if + call NWTC_Library_DestroyModJacType(MiscData%Jac, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SlD_DestroyContState(MiscData%x_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SlD_DestroyContState(MiscData%dxdt_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SlD_DestroyInput(MiscData%u_perturb, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SlD_DestroyOutput(MiscData%y_lin, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +end subroutine + +subroutine SlD_PackMisc(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SlD_MiscVarType), intent(in) :: InData + character(*), parameter :: RoutineName = 'SlD_PackMisc' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, allocated(InData%dll_data)) + if (allocated(InData%dll_data)) then + call RegPackBounds(RF, 1, lbound(InData%dll_data), ubound(InData%dll_data)) + LB(1:1) = lbound(InData%dll_data) + UB(1:1) = ubound(InData%dll_data) + do i1 = LB(1), UB(1) + call SlD_PackREDWINdllType(RF, InData%dll_data(i1)) + end do + end if + call RegPackAlloc(RF, InData%ForceTotal) + call NWTC_Library_PackModJacType(RF, InData%Jac) + call SlD_PackContState(RF, InData%x_perturb) + call SlD_PackContState(RF, InData%dxdt_lin) + call SlD_PackInput(RF, InData%u_perturb) + call SlD_PackOutput(RF, InData%y_lin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SlD_UnPackMisc(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SlD_MiscVarType), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SlD_UnPackMisc' + integer(B4Ki) :: i1, i2 + integer(B4Ki) :: LB(2), UB(2) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + if (allocated(OutData%dll_data)) deallocate(OutData%dll_data) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%dll_data(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%dll_data.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SlD_UnpackREDWINdllType(RF, OutData%dll_data(i1)) ! dll_data + end do + end if + call RegUnpackAlloc(RF, OutData%ForceTotal); if (RegCheckErr(RF, RoutineName)) return + call NWTC_Library_UnpackModJacType(RF, OutData%Jac) ! Jac + call SlD_UnpackContState(RF, OutData%x_perturb) ! x_perturb + call SlD_UnpackContState(RF, OutData%dxdt_lin) ! dxdt_lin + call SlD_UnpackInput(RF, OutData%u_perturb) ! u_perturb + call SlD_UnpackOutput(RF, OutData%y_lin) ! y_lin +end subroutine + +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) /= size(u)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(u)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(u) - 1 + select case (order) + case (0) + call SlD_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SlD_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SlD_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(u) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +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) :: a1, a2 ! 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = 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 + +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) :: a1,a2,a3 ! 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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + 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 + +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) /= size(y)) then + call SetErrStat(ErrID_Fatal, 'size(t) must equal size(y)', ErrStat, ErrMsg, RoutineName) + return + endif + order = size(y) - 1 + select case (order) + case (0) + call SlD_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (1) + call SlD_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case (2) + call SlD_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + case default + call SetErrStat(ErrID_Fatal, 'size(y) must be less than 4 (order must be less than 3).', ErrStat, ErrMsg, RoutineName) + return + end select +end subroutine + +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) :: a1, a2 ! 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 + + ! Calculate weighting factors from Lagrange polynomial + a1 = -(t_out - t(2))/t(2) + a2 = t_out/t(2) + + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + 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 + +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) :: a1,a2,a3 ! 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 + + ! Calculate Lagrange polynomial coefficients + a1 = (t_out - t(2))*(t_out - t(3))/((t(1) - t(2))*(t(1) - t(3))) + a2 = (t_out - t(1))*(t_out - t(3))/((t(2) - t(1))*(t(2) - t(3))) + a3 = (t_out - t(1))*(t_out - t(2))/((t(3) - t(1))*(t(3) - t(2))) + IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN + y_out%WriteOutput = a1*y1%WriteOutput + a2*y2%WriteOutput + a3*y3%WriteOutput + 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 + +function SlD_InputMeshPointer(u, DL) result(Mesh) + type(SlD_InputType), target, intent(in) :: u + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (SlD_u_SoilMesh) + Mesh => u%SoilMesh + end select +end function + +function SlD_OutputMeshPointer(y, DL) result(Mesh) + type(SlD_OutputType), target, intent(in) :: y + type(DatLoc), intent(in) :: DL + type(MeshType), pointer :: Mesh + nullify(Mesh) + select case (DL%Num) + case (SlD_y_SoilMesh) + Mesh => y%SoilMesh + end select +end function + +subroutine SlD_VarsPackContState(Vars, x, ValAry) + type(SlD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SlD_VarPackContState(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine SlD_VarPackContState(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SlD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SlD_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SlD_VarsUnpackContState(Vars, ValAry, x) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SlD_ContinuousStateType), intent(inout) :: x + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SlD_VarUnpackContState(Vars%x(i), ValAry, x) + end do +end subroutine + +subroutine SlD_VarUnpackContState(V, ValAry, x) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SlD_ContinuousStateType), intent(inout) :: x + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SlD_x_DummyContState) + x%DummyContState = VarVals(1) ! Scalar + end select + end associate +end subroutine + +function SlD_ContinuousStateFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SlD_x_DummyContState) + Name = "x%DummyContState" + case default + Name = "Unknown Field" + end select +end function + +subroutine SlD_VarsPackContStateDeriv(Vars, x, ValAry) + type(SlD_ContinuousStateType), intent(in) :: x + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%x) + call SlD_VarPackContStateDeriv(Vars%x(i), x, ValAry) + end do +end subroutine + +subroutine SlD_VarPackContStateDeriv(V, x, ValAry) + type(ModVarType), intent(in) :: V + type(SlD_ContinuousStateType), intent(in) :: x + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SlD_x_DummyContState) + VarVals(1) = x%DummyContState ! Scalar + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SlD_VarsPackInput(Vars, u, ValAry) + type(SlD_InputType), intent(in) :: u + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SlD_VarPackInput(Vars%u(i), u, ValAry) + end do +end subroutine + +subroutine SlD_VarPackInput(V, u, ValAry) + type(ModVarType), intent(in) :: V + type(SlD_InputType), intent(in) :: u + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SlD_u_SoilMesh) + call MV_PackMesh(V, u%SoilMesh, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SlD_VarsUnpackInput(Vars, ValAry, u) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SlD_InputType), intent(inout) :: u + integer(IntKi) :: i + do i = 1, size(Vars%u) + call SlD_VarUnpackInput(Vars%u(i), ValAry, u) + end do +end subroutine + +subroutine SlD_VarUnpackInput(V, ValAry, u) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SlD_InputType), intent(inout) :: u + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SlD_u_SoilMesh) + call MV_UnpackMesh(V, ValAry, u%SoilMesh) ! Mesh + end select + end associate +end subroutine + +function SlD_InputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SlD_u_SoilMesh) + Name = "u%SoilMesh" + case default + Name = "Unknown Field" + end select +end function + +subroutine SlD_VarsPackOutput(Vars, y, ValAry) + type(SlD_OutputType), intent(in) :: y + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(inout) :: ValAry(:) + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SlD_VarPackOutput(Vars%y(i), y, ValAry) + end do +end subroutine + +subroutine SlD_VarPackOutput(V, y, ValAry) + type(ModVarType), intent(in) :: V + type(SlD_OutputType), intent(in) :: y + real(R8Ki), intent(inout) :: ValAry(:) + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SlD_y_WriteOutput) + VarVals = y%WriteOutput(V%iLB:V%iUB) ! Rank 1 Array + case (SlD_y_SoilMesh) + call MV_PackMesh(V, y%SoilMesh, ValAry) ! Mesh + case default + VarVals = 0.0_R8Ki + end select + end associate +end subroutine + +subroutine SlD_VarsUnpackOutput(Vars, ValAry, y) + type(ModVarsType), intent(in) :: Vars + real(R8Ki), intent(in) :: ValAry(:) + type(SlD_OutputType), intent(inout) :: y + integer(IntKi) :: i + do i = 1, size(Vars%y) + call SlD_VarUnpackOutput(Vars%y(i), ValAry, y) + end do +end subroutine + +subroutine SlD_VarUnpackOutput(V, ValAry, y) + type(ModVarType), intent(in) :: V + real(R8Ki), intent(in) :: ValAry(:) + type(SlD_OutputType), intent(inout) :: y + associate (DL => V%DL, VarVals => ValAry(V%iLoc(1):V%iLoc(2))) + select case (DL%Num) + case (SlD_y_WriteOutput) + y%WriteOutput(V%iLB:V%iUB) = VarVals ! Rank 1 Array + case (SlD_y_SoilMesh) + call MV_UnpackMesh(V, ValAry, y%SoilMesh) ! Mesh + end select + end associate +end subroutine + +function SlD_OutputFieldName(DL) result(Name) + type(DatLoc), intent(in) :: DL + character(32) :: Name + select case (DL%Num) + case (SlD_y_WriteOutput) + Name = "y%WriteOutput" + case (SlD_y_SoilMesh) + Name = "y%SoilMesh" + case default + Name = "Unknown Field" + end select +end function + +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 5e54af502f..2b56d40019 100644 --- a/modules/subdyn/src/SD_FEM.f90 +++ b/modules/subdyn/src/SD_FEM.f90 @@ -2576,8 +2576,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/modules/wakedynamics/src/WakeDynamics.f90 b/modules/wakedynamics/src/WakeDynamics.f90 index 8ec6385b4d..dcf119c18a 100644 --- a/modules/wakedynamics/src/WakeDynamics.f90 +++ b/modules/wakedynamics/src/WakeDynamics.f90 @@ -1326,8 +1326,8 @@ subroutine filter_angles2(psi_filt, chi_filt, psi, chi, alpha, alpha_bar) DCM1 = EulerConstruct( (/ psi_filt, 0.0_ReKi, chi_filt /) ) DCM2 = EulerConstruct( (/ psi, 0.0_ReKi, chi /) ) ! Compute the logarithmic map of the DCMs: - CALL DCM_logMap( DCM1, lambda(:,1), errStat, errMsg) - CALL DCM_logMap( DCM2, lambda(:,2), errStat, errMsg) + CALL DCM_logMap(DCM1, lambda(:,1)) + CALL DCM_logMap(DCM2, lambda(:,2)) !Make sure we don't cross a 2pi boundary: CALL DCM_SetLogMapForInterp( lambda ) !Interpolate the logarithmic map: diff --git a/openfast_io/openfast_io/FAST_reader.py b/openfast_io/openfast_io/FAST_reader.py index c7b2eb6c48..55127ca4da 100644 --- a/openfast_io/openfast_io/FAST_reader.py +++ b/openfast_io/openfast_io/FAST_reader.py @@ -356,6 +356,7 @@ def read_MainInput(self): self.fst_vt['Fst']['CompSub'] = int(f.readline().split()[0]) self.fst_vt['Fst']['CompMooring'] = int(f.readline().split()[0]) self.fst_vt['Fst']['CompIce'] = int(f.readline().split()[0]) + self.fst_vt['Fst']['CompSoil'] = int(f.readline().split()[0]) self.fst_vt['Fst']['MHK'] = int(f.readline().split()[0]) self.fst_vt['Fst']['MirrorRotor'] = read_array(f, self.fst_vt['Fst']['NRotors'], array_type=bool) @@ -385,6 +386,7 @@ def read_MainInput(self): self.fst_vt['Fst']['SubFile'] = quoted_read(f.readline().split()[0]) self.fst_vt['Fst']['MooringFile'] = quoted_read(f.readline().split()[0]) self.fst_vt['Fst']['IceFile'] = quoted_read(f.readline().split()[0]) + self.fst_vt['Fst']['SoilFile'] = quoted_read(f.readline().split()[0]) # self.fst_vt['Fst']['EDFiles'] = [self.fst_vt['Fst']['EDFile']] # self.fst_vt['Fst']['BDBldFiles(1)'] = [self.fst_vt['Fst']['BDBldFile(1)']] # self.fst_vt['Fst']['BDBldFiles(2)'] = [self.fst_vt['Fst']['BDBldFile(2)']] diff --git a/openfast_io/openfast_io/FAST_writer.py b/openfast_io/openfast_io/FAST_writer.py index 9c3eb248df..68b115064b 100644 --- a/openfast_io/openfast_io/FAST_writer.py +++ b/openfast_io/openfast_io/FAST_writer.py @@ -307,6 +307,7 @@ def write_MainInput(self): f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['CompSub'], 'CompSub', '- Compute sub-structural dynamics (switch) {0=None; 1=SubDyn; 2=External Platform MCKF}\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['CompMooring'], 'CompMooring', '- Compute mooring system (switch) {0=None; 1=MAP++; 2=FEAMooring; 3=MoorDyn; 4=OrcaFlex}\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['CompIce'], 'CompIce', '- Compute ice loads (switch) {0=None; 1=IceFloe; 2=IceDyn}\n')) + f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['CompSoil'], 'CompSoil', '- Compute soil-structural dynamics (switch) {0=None; 1=SoilDyn}\n')) f.write('{:<22} {:<11} {:}'.format(self.fst_vt['Fst']['MHK'], 'MHK', '- MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine}\n')) f.write('{:<22} {:<11} {:}'.format(' '.join([str(b)[0] for b in np.array(self.fst_vt['Fst']['MirrorRotor'], dtype=bool)]), 'MirrorRotor', '- List of rotor rotation directions [1 to NRotors] {0=CCW, 1=CW}\n')) f.write('---------------------- ENVIRONMENTAL CONDITIONS --------------------------------\n') @@ -332,6 +333,7 @@ def write_MainInput(self): f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['Fst']['SubFile']+'"', 'SubFile', '- Name of file containing sub-structural input parameters (quoted string)\n')) f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['Fst']['MooringFile']+'"', 'MooringFile', '- Name of file containing mooring system input parameters (quoted string)\n')) f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['Fst']['IceFile']+'"', 'IceFile', '- Name of file containing ice input parameters (quoted string)\n')) + f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['Fst']['SoilFile']+'"', 'SoilFile', '- Name of file containing soil input parameters (quoted string)\n')) # for i in range(1, self.fst_vt['Fst']['NRotors']): # f.write('---------------------- INPUT FILES Rotor '+str(i+1)+' -------------------------------------\n') # f.write('{:<22} {:<11} {:}'.format('"'+self.fst_vt['Fst']['EDFiles'][i]+'"', 'EDFile', '- Name of file containing ElastoDyn input parameters (quoted string)\n')) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 05975d2a30..f7df881a5d 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -358,6 +358,7 @@ of_regression("Tailfin_FreeYaw1DOF_Unsteady" "openfast;elastodyn;aerod of_regression("5MW_Land_DLL_WTurb_ADsk" "openfast;elastodyn;aerodisk") of_regression("5MW_Land_DLL_WTurb_ADsk_SED" "openfast;simple-elastodyn;aerodisk") of_regression("5MW_Land_DLL_WTurb_SED" "openfast;simple-elastodyn;aerodyn") +of_regression("OC6_phaseII" "openfast;soildyn;subdyn;hydrodyn;offshore;stc") of_aeromap_regression("5MW_Land_AeroMap" "aeromap;elastodyn;aerodyn") diff --git a/reg_tests/r-test b/reg_tests/r-test index 7d49ab184b..b06fdd12ab 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 7d49ab184be35aabdbda4cbabe1d56b0fdc1e6a2 +Subproject commit b06fdd12ab7907d4d49d0f453da0d40d93b7c8c9 diff --git a/vs-build/RunRegistry.bat b/vs-build/RunRegistry.bat index 4e52e53343..d21db165b7 100644 --- a/vs-build/RunRegistry.bat +++ b/vs-build/RunRegistry.bat @@ -43,6 +43,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 ADsk_Loc=%Modules_Loc%\aerodisk\src @@ -53,7 +54,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 "%SED_Loc%" -I^ - "%SrvD_Loc%" -I "%AD_Loc%" -I "%ADsk_Loc%" -I "%BD_Loc%" -I "%SC_Loc%" -I^ + "%SrvD_Loc%" -I "%AD_Loc%" -I "%ADsk_Loc%" -I "%BD_Loc%" -I "%SlD_Loc%" -I "%SC_Loc%" -I^ "%IfW_Loc%" -I "%SD_Loc%" -I "%HD_Loc%" -I "%SEAST_Loc%" -I "%MAP_Loc%" -I "%FEAM_Loc%" -I^ "%IceF_Loc%" -I "%IceD_Loc%" -I "%MD_Loc%" -I "%ExtInfw_Loc%" -I "%Orca_Loc%" -I "%ExtPtfm_Loc%" -I "%ExtLoads_Loc%" @@ -98,7 +99,19 @@ GOTO checkError :BeamDyn SET CURR_LOC=%BD_Loc% SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\Registry_BeamDyn.txt" %ALL_FAST_Includes% -O "%Output_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% +%REGISTRY% "%CURR_LOC%\SuperController_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" -ccode GOTO checkError :SCDataEx: 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 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +