diff --git a/docs/source/user/api_change.rst b/docs/source/user/api_change.rst index 3592bbd5bf..e0a8f5e422 100644 --- a/docs/source/user/api_change.rst +++ b/docs/source/user/api_change.rst @@ -13,16 +13,57 @@ Thus, be sure to implement each in order so that subsequent line numbers are cor OpenFAST v3.2.0 to OpenFAST `dev` ---------------------------------- -============================================= ==== =============== ======================================================================================================================================================================================================== +============================================= ==== ================= ====================================================================================================================================================================================================== Added in OpenFAST dev --------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- Module Line Flag Name Example Value +============================================= ==== ================= ====================================================================================================================================================================================================== +AeroDyn driver 54\* WrVTK_Type 1 WrVTK_Type - VTK visualization data type: (switch) {1=surfaces; 2=lines; 3=both} +FAST.Farm 9 ModWaveField 2 Mod_WaveField Wave field handling (-) (switch) {1: use individual HydroDyn inputs without adjustment, 2: adjust wave phases based on turbine offsets from farm origin} +FAST.Farm 10 Mod_SharedMooring 0 Mod_SharedMooring Shared mooring system model (switch) {0: None, 3=MoorDyn}} +FAST.Farm 13 na ------ SHARED MOORING SYSTEM ------ [used only for Mod_SharedMoor>0] +FAST.Farm 14 SharedMoorFile "" SharedMoorFile Name of file containing shared mooring system input parameters (quoted string) [used only when Mod_SharedMooring > 0] +FAST.Farm 15 DT_Mooring 0.04 DT_Mooring Time step for farm-level mooring coupling with each turbine (s) [used only when Mod_SharedMooring > 0] +============================================= ==== ================= ====================================================================================================================================================================================================== + +\*Exact line number depends on number of entries in various preceeding tables. + + ============================================= ==== =============== ======================================================================================================================================================================================================== -AeroDyn driver 54\* WrVTK_Type 1 WrVTK_Type - VTK visualization data type: (switch) {1=surfaces; 2=lines; 3=both} +Modified in OpenFAST dev +--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- +Module Line Flag Name Example Value +============================================= ==== =============== ======================================================================================================================================================================================================== +MoorDyn\& 5 na Name Diam MassDen EA BA/-zeta EI Cd Ca CdAx CaAx +MoorDyn\& 6 na (-) (m) (kg/m) (N) (N-s/-) (-) (-) (-) (-) (-) +MoorDyn\& 7 na main 0.0766 113.35 7.536E8 -1.0 0 2.0 0.8 0.4 0.25 +MoorDyn\& 8\* na ---------------------- POINTS -------------------------------- +MoorDyn\& 9\* na ID Attachment X Y Z M V CdA CA +MoorDyn\& 10\* na (-) (-) (m) (m) (m) (kg) (m^3) (m^2) (-) +MoorDyn\& 11\* na 1 Fixed 418.8 725.383 -200.0 0 0 0 0 +MoorDyn\& 17\* na ---------------------- LINES -------------------------------------- +MoorDyn\& 18\* na ID LineType AttachA AttachB UnstrLen NumSegs Outputs +MoorDyn\& 19\* na (-) (-) (-) (-) (m) (-) (-) +MoorDyn\& 20\* na 1 main 1 4 835.35 20 - +============================================= ==== =============== ======================================================================================================================================================================================================== + +\&MoorDyn has undergone an extensive revision that leaves few lines unchanged. We recommend looking at a sample input file for the 5MW_OC4Semi_WSt_WavesWN regression test for reference rather than line by line changes in the above tables. + + +============================================= ==== =============== ======================================================================================================================================================================================================== +Removed in OpenFAST dev +--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- +Module Line Flag Name Example Value +============================================= ==== =============== ======================================================================================================================================================================================================== +MoorDyn\& 5 NTypes 1 NTypes - number of LineTypes +MoorDyn\& 10\* NConnects 6 NConnects - number of connections including anchors and fairleads +MoorDyn\& 20\* NLines 3 NLines - number of line objects ============================================= ==== =============== ======================================================================================================================================================================================================== \*Exact line number depends on number of entries in various preceeding tables. +\&MoorDyn has undergone an extensive revision that leaves few lines unchanged. We recommend looking at a sample input file for the 5MW_OC4Semi_WSt_WavesWN regression test for reference rather than line by line changes in the above tables. + OpenFAST v3.1.0 to OpenFAST v3.2.0 ---------------------------------- diff --git a/docs/source/user/fast.farm/InputFiles.rst b/docs/source/user/fast.farm/InputFiles.rst index 8b353e282d..8f66f507e5 100644 --- a/docs/source/user/fast.farm/InputFiles.rst +++ b/docs/source/user/fast.farm/InputFiles.rst @@ -34,6 +34,8 @@ sections: - Super Controller +- Shared Moorings + - Ambient Wind - Wind Turbines @@ -95,6 +97,15 @@ ambient wind data as defined by the FAST.Farm interface to the **[Mod_AmbWind=3]**. The distinct Ambient Wind subsections below pertain to each option. +**Mod_WaveField** [switch] indicates how the wave field should be treated. The +two options are: 1) use individual HydroDyn inputs at each turbine without +adjustment, 2) adjust wave phases based on turbine offsets from wind farm +origin. + +**Mod_SharedMooring** [switch] indicates if a farm level mooring line system +interconnects turbines. There are presently two options: 0) No shared moorings, +3) MoorDyn. + Super Controller ~~~~~~~~~~~~~~~~ @@ -108,6 +119,25 @@ turbine controllers defined in the style of the DISCON dynamic library of the DNV GL’s Bladed wind turbine software package, with minor modification. See :numref:`FF:sec:SupCon` for more information. +Shared Moorings +~~~~~~~~~~~~~~~ + +Shared mooring lines running between platforms introduce a coupling between the +platforms that operates on the same time scales as a platform's interaction with +a regular mooring system (typically resolved at a time step of 10--30 ms in +OpenFAST simulations). See :numref:`MoorDyn` for more information. + +**SharedMoorFile** [quoted string] sets the name and location of the MoorDyn +input file for the mooring lines in the wind farm. It is only used if +**Mod_SharedMooring** = 3. **The file name must be in quotations** and can +contain an absolute or a relative path. The mooring lines then connect to each +of the wind turbines in the farm. See `MoorDyn with FAST.Farm +`_ +documentation for details on the input file at the farm level. + +**DT_Mooring** (sec) sets the timestep for the shared mooring connections with +MoorDyn. + .. _FF:Input:VTK: Ambient Wind: Precursor in Visualization Toolkit Format diff --git a/docs/source/user/fast.farm/examples/FAST.Farm--input.dat b/docs/source/user/fast.farm/examples/FAST.Farm--input.dat index 35a5462439..c205f51084 100644 --- a/docs/source/user/fast.farm/examples/FAST.Farm--input.dat +++ b/docs/source/user/fast.farm/examples/FAST.Farm--input.dat @@ -6,8 +6,13 @@ FATAL AbortLevel Error level when simulation should abort (string) {"WAR 2000.0 TMax Total run time (s) [>=0.0] False UseSC Use a super controller? (flag) 1 Mod_AmbWind Ambient wind model (-) (switch) {1: high-fidelity precursor in VTK format, 2: one InflowWind module, 3: multiple instances of InflowWind module} +2 Mod_WaveField Wave field handling (-) (switch) {1: use individual HydroDyn inputs without adjustment, 2: adjust wave phases based on turbine offsets from farm origin} +0 Mod_SharedMooring Shared mooring system model (switch) {0: None, 3=MoorDyn}} --- SUPER CONTROLLER --- [used only for UseSC=True] "SC_DLL.dll" SC_FileName Name/location of the dynamic library {.dll [Windows] or .so [Linux]} containing the Super Controller algorithms (quoted string) +--- SHARED MOORING SYSTEM --- [used only for Mod_SharedMoor>0] +"" SharedMoorFile Name of file containing shared mooring system input parameters (quoted string) [used only when Mod_SharedMooring > 0] +0.04 DT_Mooring Time step for farm-level mooring coupling with each turbine (s) [used only when Mod_SharedMooring > 0] --- AMBIENT WIND: PRECURSOR IN VTK FORMAT --- [used only for Mod_AmbWind=1] 2.0 DT_Low-VTK Time step for low-resolution wind data input files; will be used as the global FAST.Farm time step (s) [>0.0] 0.5 DT_High-VTK Time step for high-resolution wind data input files (s) [>0.0] "/AmbWind/steady" WindFilePath Path name to wind data files from precursor (string) diff --git a/docs/source/user/index.rst b/docs/source/user/index.rst index 94436de674..41ec99f3fd 100644 --- a/docs/source/user/index.rst +++ b/docs/source/user/index.rst @@ -52,6 +52,7 @@ Documentation covers usage of models, underlying theory, and in some cases modul ElastoDyn HydroDyn InflowWind + MoorDyn ServoDyn Structural Control TurbSim diff --git a/docs/source/user/moordyn/index.rst b/docs/source/user/moordyn/index.rst new file mode 100644 index 0000000000..52730e521a --- /dev/null +++ b/docs/source/user/moordyn/index.rst @@ -0,0 +1,12 @@ +.. _MoorDyn: + +MoorDyn Users Guide +==================== + +A standalone C++ version of MoorDyn is also available outside the OpenFAST +repository. The documentation for the C++ version covers the input file format +(`MoorDyn usage `_, specifically the section for V2) +usage of MoorDyn at the FAST.Farm level +(`MoorDyn with FAST.Farm `_), +and links to publications with the relevant theory. + diff --git a/glue-codes/fast-farm/src/FASTWrapper.f90 b/glue-codes/fast-farm/src/FASTWrapper.f90 index 2a922ed675..9e14bdc971 100644 --- a/glue-codes/fast-farm/src/FASTWrapper.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper.f90 @@ -44,6 +44,8 @@ MODULE FASTWrapper PUBLIC :: FWrap_t0 ! call to compute outputs at t0 [and initialize some more variables] PUBLIC :: FWrap_Increment ! call to update states to n+1 and compute outputs at n+1 + PUBLIC :: FWrap_SetInputs + PUBLIC :: FWrap_CalcOutput CONTAINS @@ -140,6 +142,7 @@ SUBROUTINE FWrap_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init !.... multi-turbine options .... ExternInitData%TurbineID = InitInp%TurbNum ExternInitData%TurbinePos = InitInp%p_ref_Turbine + ExternInitData%WaveFieldMod = InitInp%WaveFieldMod ExternInitData%FarmIntegration = .true. ExternInitData%RootName = InitInp%RootName @@ -286,11 +289,11 @@ end subroutine cleanup END SUBROUTINE FWrap_Init !---------------------------------------------------------------------------------------------------------------------------------- ! this routine sets the parameters for the FAST Wrapper module. It does not set p%n_FAST_low because we need to initialize FAST first. -subroutine FWrap_SetParameters(InitInp, p, dt_FAST, InitInp_dt_low, ErrStat, ErrMsg) +subroutine FWrap_SetParameters(InitInp, p, dt_FAST, dt_caller, ErrStat, ErrMsg) TYPE(FWrap_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine TYPE(FWrap_ParameterType), INTENT(INOUT) :: p !< Parameters REAL(DbKi), INTENT(IN ) :: dt_FAST !< time step for FAST - REAL(DbKi), INTENT(IN ) :: InitInp_dt_low !< time step for FAST.Farm + REAL(DbKi), INTENT(IN ) :: dt_caller !< time step that FWrap will be called at by FAST.Farm (if MooringMod>0, this will be smaller than DT_low) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -317,22 +320,22 @@ subroutine FWrap_SetParameters(InitInp, p, dt_FAST, InitInp_dt_low, ErrStat, Err ! p%n_FAST_low has to be set AFTER we initialize FAST, because we need to know what the FAST time step is going to be. - IF ( EqualRealNos( dt_FAST, InitInp_dt_low ) ) THEN + IF ( EqualRealNos( dt_FAST, dt_caller ) ) THEN p%n_FAST_low = 1 ELSE - IF ( dt_FAST > InitInp_dt_low ) THEN + IF ( dt_FAST > dt_caller ) THEN ErrStat = ErrID_Fatal ErrMsg = "The FAST time step ("//TRIM(Num2LStr(dt_FAST))// & - " s) cannot be larger than FAST.Farm time step ("//TRIM(Num2LStr(InitInp_dt_low))//" s)." + " s) cannot be larger than FAST.Farm time step ("//TRIM(Num2LStr(dt_caller))//" s)." ELSE ! calculate the number of subcycles: - p%n_FAST_low = NINT( InitInp_dt_low / dt_FAST ) + p%n_FAST_low = NINT( dt_caller / dt_FAST ) ! let's make sure the FAST DT is an exact integer divisor of the global (FAST.Farm) time step: - IF ( .NOT. EqualRealNos( InitInp_dt_low, dt_FAST * p%n_FAST_low ) ) THEN + IF ( .NOT. EqualRealNos( dt_caller, dt_FAST * p%n_FAST_low ) ) THEN ErrStat = ErrID_Fatal ErrMsg = "The FASTWrapper module time step ("//TRIM(Num2LStr(dt_FAST))// & - " s) must be an integer divisor of the FAST.Farm time step ("//TRIM(Num2LStr(InitInp_dt_low))//" s)." + " s) must be an integer divisor of the FAST.Farm or farm-level mooring time step ("//TRIM(Num2LStr(dt_caller))//" s)." END IF END IF @@ -411,7 +414,7 @@ END SUBROUTINE FWrap_End SUBROUTINE FWrap_Increment( t, n, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !.................................................................................................................................. - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds (no longer used, since inputs are set elsewhere) INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval TYPE(FWrap_InputType), INTENT(INOUT) :: u !< Inputs at t (not changed, but possibly copied) TYPE(FWrap_ParameterType), INTENT(IN ) :: p !< Parameters @@ -451,11 +454,11 @@ SUBROUTINE FWrap_Increment( t, n, u, p, x, xd, z, OtherState, y, m, ErrStat, Err !ELSE ! ! set the inputs needed for FAST - call FWrap_SetInputs(u, m, t) + !call FWrap_SetInputs(u, m, t) <<< moved up into FAST.Farm FARM_UpdateStates - ! call FAST p%n_FAST_low times: - do n_ss = 1, p%n_FAST_low - n_FAST = n*p%n_FAST_low + n_ss - 1 + ! call FAST p%n_FAST_low times (p%n_FAST_low is simply the number of steps to make per wrapper call. It is affected by MooringMod) + do n_ss = 1, p%n_FAST_low + n_FAST = n*p%n_FAST_low + n_ss - 1 CALL FAST_Solution_T( t_initial, n_FAST, m%Turbine, ErrStat2, ErrMsg2 ) call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -463,8 +466,8 @@ SUBROUTINE FWrap_Increment( t, n, u, p, x, xd, z, OtherState, y, m, ErrStat, Err end do ! n_ss - call FWrap_CalcOutput(p, u, y, m, ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + !call FWrap_CalcOutput(p, u, y, m, ErrStat2, ErrMsg2) <<< moved up into FAST.Farm FARM_UpdateStates + ! call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !END IF diff --git a/glue-codes/fast-farm/src/FASTWrapper_Registry.txt b/glue-codes/fast-farm/src/FASTWrapper_Registry.txt index 7cf5303c5e..e494a34ea7 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Registry.txt +++ b/glue-codes/fast-farm/src/FASTWrapper_Registry.txt @@ -22,6 +22,7 @@ typedef ^ InitInputType CHARACTER(1024) FASTInFile typedef ^ InitInputType ReKi dr - - - "Radial increment of radial finite-difference grid" m typedef ^ InitInputType DbKi tmax - - - "Simulation length" s typedef ^ InitInputType ReKi p_ref_Turbine {3} - - "Undisplaced global coordinates of this turbine" m +typedef ^ InitInputType IntKi WaveFieldMod - - - "Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin" - typedef ^ InitInputType IntKi n_high_low - - - "Number of high-resolution time steps per low-resolution time step" - typedef ^ InitInputType DbKi dt_high - - - "High-resolution time step" s typedef ^ InitInputType ReKi p_ref_high {3} - - "Position of the origin of the high-resolution spatial domain for this turbine" m @@ -43,6 +44,7 @@ typedef ^ InitInputType SiKi fromSC # Define outputs from the initialization routine here: #typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - #typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - +typedef ^ InitOutputType DbKi PtfmInit {6} - - "Initial platform position/rotation vector - surge,sway,heave,roll,pitch,yaw - needed for mooring module initInp" - typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - diff --git a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 index 3e0fc25cc3..113967a4eb 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 @@ -41,6 +41,7 @@ MODULE FASTWrapper_Types REAL(ReKi) :: dr !< Radial increment of radial finite-difference grid [m] REAL(DbKi) :: tmax !< Simulation length [s] REAL(ReKi) , DIMENSION(1:3) :: p_ref_Turbine !< Undisplaced global coordinates of this turbine [m] + INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] INTEGER(IntKi) :: n_high_low !< Number of high-resolution time steps per low-resolution time step [-] REAL(DbKi) :: dt_high !< High-resolution time step [s] REAL(ReKi) , DIMENSION(1:3) :: p_ref_high !< Position of the origin of the high-resolution spatial domain for this turbine [m] @@ -62,6 +63,7 @@ MODULE FASTWrapper_Types ! ======================= ! ========= FWrap_InitOutputType ======= TYPE, PUBLIC :: FWrap_InitOutputType + REAL(DbKi) , DIMENSION(1:6) :: PtfmInit !< Initial platform position/rotation vector - surge,sway,heave,roll,pitch,yaw - needed for mooring module initInp [-] TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] END TYPE FWrap_InitOutputType ! ======================= @@ -145,6 +147,7 @@ SUBROUTINE FWrap_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er DstInitInputData%dr = SrcInitInputData%dr DstInitInputData%tmax = SrcInitInputData%tmax DstInitInputData%p_ref_Turbine = SrcInitInputData%p_ref_Turbine + DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod DstInitInputData%n_high_low = SrcInitInputData%n_high_low DstInitInputData%dt_high = SrcInitInputData%dt_high DstInitInputData%p_ref_high = SrcInitInputData%p_ref_high @@ -243,6 +246,7 @@ SUBROUTINE FWrap_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Re_BufSz = Re_BufSz + 1 ! dr Db_BufSz = Db_BufSz + 1 ! tmax Re_BufSz = Re_BufSz + SIZE(InData%p_ref_Turbine) ! p_ref_Turbine + Int_BufSz = Int_BufSz + 1 ! WaveFieldMod Int_BufSz = Int_BufSz + 1 ! n_high_low Db_BufSz = Db_BufSz + 1 ! dt_high Re_BufSz = Re_BufSz + SIZE(InData%p_ref_high) ! p_ref_high @@ -309,6 +313,8 @@ SUBROUTINE FWrap_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ReKiBuf(Re_Xferred) = InData%p_ref_Turbine(i1) Re_Xferred = Re_Xferred + 1 END DO + IntKiBuf(Int_Xferred) = InData%WaveFieldMod + Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%n_high_low Int_Xferred = Int_Xferred + 1 DbKiBuf(Db_Xferred) = InData%dt_high @@ -422,6 +428,8 @@ SUBROUTINE FWrap_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, OutData%p_ref_Turbine(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO + OutData%WaveFieldMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%n_high_low = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%dt_high = DbKiBuf(Db_Xferred) @@ -504,12 +512,14 @@ SUBROUTINE FWrap_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_CopyInitOutput' ! ErrStat = ErrID_None ErrMsg = "" + DstInitOutputData%PtfmInit = SrcInitOutputData%PtfmInit CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN @@ -562,6 +572,7 @@ SUBROUTINE FWrap_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 + Db_BufSz = Db_BufSz + SIZE(InData%PtfmInit) ! PtfmInit ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver @@ -607,6 +618,10 @@ SUBROUTINE FWrap_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 + DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) + DbKiBuf(Db_Xferred) = InData%PtfmInit(i1) + Db_Xferred = Db_Xferred + 1 + END DO CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -650,6 +665,7 @@ SUBROUTINE FWrap_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_UnPackInitOutput' @@ -663,6 +679,12 @@ SUBROUTINE FWrap_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 + i1_l = LBOUND(OutData%PtfmInit,1) + i1_u = UBOUND(OutData%PtfmInit,1) + DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) + OutData%PtfmInit(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN diff --git a/glue-codes/fast-farm/src/FAST_Farm_Registry.txt b/glue-codes/fast-farm/src/FAST_Farm_Registry.txt index 0f20a1d3fd..9f595b55c5 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Registry.txt +++ b/glue-codes/fast-farm/src/FAST_Farm_Registry.txt @@ -17,12 +17,13 @@ usefrom WakeDynamics_Registry.txt usefrom AWAE_Registry.txt usefrom SuperController_Registry.txt -param FAST_Farm/Farm - INTEGER NumFFModules - 4 - "The number of modules available in FAST.Farm" - +param FAST_Farm/Farm - INTEGER NumFFModules - 5 - "The number of modules available in FAST.Farm" - param ^ - INTEGER ModuleFF_None - 0 - "No module selected" - param ^ - INTEGER ModuleFF_SC - 1 - "Super Controller" - param ^ - INTEGER ModuleFF_FWrap - 2 - "FAST Wrapper" - param ^ - INTEGER ModuleFF_WD - 3 - "Wake Dynamics" - param ^ - INTEGER ModuleFF_AWAE - 4 - "Ambient Wind and Array Effects" - +param ^ - INTEGER ModuleFF_MD - 5 - "Farm-level MoorDyn" - # ..... Parameters ................................................................................................................ typedef FAST_Farm/Farm ParameterType DbKi DT_low - - - "Time step for low-resolution wind data input files; will be used as the global FAST.Farm time step" seconds typedef ^ ParameterType DbKi DT_high - - - "High-resolution time step" seconds @@ -31,8 +32,13 @@ typedef ^ ParameterType IntKi n_high_low - typedef ^ ParameterType IntKi NumTurbines - - - "Number of turbines in the simulation" - typedef ^ ParameterType CHARACTER(1024) WindFilePath - - - "Path name of wind data files from ABLSolver precursor" - typedef ^ ParameterType CHARACTER(1024) SC_FileName - - - "Name/location of the dynamic library {.dll [Windows] or .so [Linux]} containing the Super Controller algorithms" - -typedef ^ ParameterType LOGICAL UseSC - - - "Use a super controller?" - +typedef ^ ParameterType LOGICAL UseSC - - - "Use a super controller?" - typedef ^ ParameterType ReKi WT_Position {:}{:} - - "X-Y-Z position of each wind turbine; index 1 = XYZ; index 2 = turbine number" meters +typedef ^ ParameterType IntKi WaveFieldMod - - - "Wave field handling (-) (switch) {0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin}" - +typedef ^ ParameterType IntKi MooringMod - - - "Mod_SharedMooring is a flag for array-level mooring. (switch) {0: none, 3: yes/MoorDyn}" - +typedef ^ ParameterType CHARACTER(1024) MD_FileName - - - "Name/location of the farm-level MoorDyn input file" - +typedef ^ ParameterType DbKi DT_mooring - - - "Time step for farm-levem mooring coupling with each turbine [used only when Mod_SharedMooring > 0]" seconds +typedef ^ ParameterType IntKi n_mooring - - - "Number of FAST and MoorDyn time steps per FAST.Farm timestep when mooring > 0" - typedef ^ ParameterType CHARACTER(1024) WT_FASTInFile {:} - - "Name of input file for each turbine" - typedef ^ ParameterType CHARACTER(1024) FTitle - - - "The description line from the primary FAST.Farm input file" - typedef ^ ParameterType CHARACTER(1024) OutFileRoot - - - "The root name derived from the primary FAST.Farm input file" - @@ -79,6 +85,10 @@ typedef ^ ^ DbKi TimeData {:} - - "Array typedef ^ ^ ReKi AllOutData {:}{:} - - "Array to contain all the output data (time history of all outputs); Index 1 is NumOuts, Index 2 is Time step" typedef ^ ^ IntKi n_Out - - - "Time index into the AllOutData array" +typedef ^ MiscVarType MeshMapType FWrap_2_MD {:} - - "Map platform kinematics from each FAST instance to MD" +typedef ^ MiscVarType MeshMapType MD_2_FWrap {:} - - "Map MD loads at the array level to each FAST instance" + + # ..... FASTWrapper data ....................................................................................................... typedef ^ FASTWrapper_Data FWrap_ContinuousStateType x - - - "Continuous states" typedef ^ ^ FWrap_DiscreteStateType xd - - - "Discrete states" @@ -122,6 +132,18 @@ typedef ^ ^ DbKi utimes {1} - typedef ^ ^ SC_OutputType y - - - "System outputs" typedef ^ ^ SC_MiscVarType m - - - "Misc/optimization variables" typedef ^ ^ logical IsInitialized - .FALSE. - "Has SC_Init been called" +# ..... MD data ....................................................................................................... +typedef ^ MD_Data MD_ContinuousStateType x - - - "Continuous states" +typedef ^ ^ MD_DiscreteStateType xd - - - "Discrete states" +typedef ^ ^ MD_ConstraintStateType z - - - "Constraint states" +typedef ^ ^ MD_OtherStateType OtherSt - - - "Other states" +typedef ^ ^ MD_ParameterType p - - - "Parameters" +typedef ^ ^ MD_InputType u - - - "Extrapolated system inputs" +typedef ^ ^ MD_InputType Input {:} - - "System inputs" +typedef ^ ^ DbKi InputTimes {:} - - "Current time" s +typedef ^ ^ MD_OutputType y - - - "System outputs" +typedef ^ ^ MD_MiscVarType m - - - "Misc/optimization variables" +typedef ^ ^ logical IsInitialized - .FALSE. - "Has MD_Init been called" # ..... All submodules' variables................................................................................................. typedef ^ All_FastFarm_Data Farm_ParameterType p - - - "FAST.Farm parameter data" - typedef ^ All_FastFarm_Data Farm_MiscVarType m - - - "FAST.Farm misc var data" - @@ -129,5 +151,6 @@ typedef ^ All_FastFarm_Data FASTWrapper_Data FWrap {:} - - typedef ^ All_FastFarm_Data WakeDynamics_Data WD {:} - - "WakeDynamics (WD) data" - typedef ^ All_FastFarm_Data AWAE_Data AWAE - - - "Ambient Wind & Array Effects (AWAE) data" - typedef ^ All_FastFarm_Data SC_Data SC - - - "Super Controller (SC) data" - +typedef ^ All_FastFarm_Data MD_Data MD - - - "Farm-level MoorDyn model data" - # ..... FAST.Farm data ................................................................................................................ # diff --git a/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 b/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 index 6bcae36bee..7203c39134 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 @@ -319,6 +319,19 @@ SUBROUTINE Farm_Initialize( farm, InputFile, ErrStat, ErrMsg ) CALL Cleanup() RETURN END IF + + !............................................................................................................................... + ! step 4.5: initialize farm-level MoorDyn if applicable + !............................................................................................................................... + + if (farm%p%MooringMod == 3) then + CALL Farm_InitMD( farm, ErrStat2, ErrMsg2) ! FAST instances must be initialized first so that turbine initial positions are known + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + end if !............................................................................................................................... ! step 5: Open output file (or set up output file handling) @@ -537,6 +550,22 @@ SUBROUTINE Farm_ReadPrimaryFile( InputFile, p, WD_InitInp, AWAE_InitInp, SC_Init RETURN end if + ! Mod_WaveField - Wave field handling (-) (switch) {1: use individual HydroDyn inputs without adjustment, 2: adjust wave phases based on turbine offsets from farm origin} + CALL ReadVar( UnIn, InputFile, p%WaveFieldMod, "Mod_WaveField", "Wave field handling (-) (switch) {1: use individual HydroDyn inputs without adjustment, 2: adjust wave phases based on turbine offsets from farm origin}", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! Mod_SharedMooring - flag for array-level mooring. (switch) 0: none, 3: yes/MoorDyn + CALL ReadVar( UnIn, InputFile, p%MooringMod, "Mod_SharedMooring", "Array-level mooring handling (-) (switch) {0: none; 3: array-level MoorDyn model}", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + !---------------------- SUPER CONTROLLER ------------------------------------------------------------------ CALL ReadCom( UnIn, InputFile, 'Section Header: Super Controller', ErrStat2, ErrMsg2, UnEc ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -554,6 +583,31 @@ SUBROUTINE Farm_ReadPrimaryFile( InputFile, p, WD_InitInp, AWAE_InitInp, SC_Init end if IF ( PathIsRelative( p%SC_FileName ) ) p%SC_FileName = TRIM(PriPath)//TRIM(p%SC_FileName) SC_InitInp%DLL_FileName = p%SC_FileName + + !---------------------- SHARED MOORING SYSTEM ------------------------------------------------------------------ + CALL ReadCom( UnIn, InputFile, 'Section Header: SHARED MOORING SYSTEM', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! MD_FileName - Name/location of the farm-level MoorDyn input file (quoated string): + CALL ReadVar( UnIn, InputFile, p%MD_FileName, "MD_FileName", "Name/location of the dynamic library {.dll [Windows] or .so [Linux]} containing the Super Controller algorithms (quoated string)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + IF ( PathIsRelative( p%MD_FileName ) ) p%MD_FileName = TRIM(PriPath)//TRIM(p%MD_FileName) + + ! DT_Mooring - time step for farm-level mooring coupling with each turbine [used only when Mod_SharedMooring > 0] (s) [>0.0]: + CALL ReadVar( UnIn, InputFile, p%DT_mooring, "DT_Mooring", "Time step for farm-levem mooring coupling with each turbine [used only when Mod_SharedMooring > 0] (s) [>0.0]", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if !---------------------- AMBIENT WIND: PRECURSOR IN VTK FORMAT --------------------------------------------- CALL ReadCom( UnIn, InputFile, 'Section Header: Ambient Wind: Precursor in VTK Format', ErrStat2, ErrMsg2, UnEc ) @@ -1367,6 +1421,12 @@ SUBROUTINE Farm_ValidateInput( p, WD_InitInp, AWAE_InitInp, SC_InitInp, ErrStat, ErrStat = ErrID_None ErrMsg = "" + + ! --- SIMULATION CONTROL --- + IF ((p%WaveFieldMod .ne. 1) .and. (p%WaveFieldMod .ne. 2)) CALL SetErrStat(ErrID_Fatal,'WaveFieldMod must be 1 or 2.',ErrStat,ErrMsg,RoutineName) + IF ((p%MooringMod .ne. 0) .and. (p%MooringMod .ne. 3)) CALL SetErrStat(ErrID_Fatal,'MooringMod must be 0 or 3.',ErrStat,ErrMsg,RoutineName) + + IF (p%DT_low <= 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'DT_low must be positive.',ErrStat,ErrMsg,RoutineName) IF (p%DT_high <= 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'DT_high must be positive.',ErrStat,ErrMsg,RoutineName) IF (p%TMax < 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'TMax must not be negative.',ErrStat,ErrMsg,RoutineName) @@ -1375,7 +1435,10 @@ SUBROUTINE Farm_ValidateInput( p, WD_InitInp, AWAE_InitInp, SC_InitInp, ErrStat, ! --- SUPER CONTROLLER --- ! TODO : Verify that the DLL file exists - + ! --- SHARED MOORING SYSTEM --- + ! TODO : Verify that p%MD_FileName file exists + if ((p%DT_mooring <= 0.0_ReKi) .or. (p%DT_mooring > p%DT_high)) CALL SetErrStat(ErrID_Fatal,'DT_mooring must be greater than zero and no greater than dt_high.',ErrStat,ErrMsg,RoutineName) + ! --- WAKE DYNAMICS --- IF (WD_InitInp%dr <= 0.0_ReKi) CALL SetErrStat(ErrID_Fatal,'dr (radial increment) must be larger than 0.',ErrStat,ErrMsg,RoutineName) IF (WD_InitInp%NumRadii < 2) CALL SetErrStat(ErrID_Fatal,'NumRadii (number of radii) must be at least 2.',ErrStat,ErrMsg,RoutineName) @@ -1544,7 +1607,8 @@ SUBROUTINE Farm_InitFAST( farm, WD_InitInp, AWAE_InitOutput, SC_InitOutput, SC_y ! local variables type(FWrap_InitInputType) :: FWrap_InitInp - type(FWrap_InitOutputType) :: FWrap_InitOut + type(FWrap_InitOutputType) :: FWrap_InitOut + REAL(DbKi) :: FWrap_Interval !< Coupling interval that FWrap is called at (affected by MooringMod) INTEGER(IntKi) :: nt ! loop counter for rotor number INTEGER(IntKi) :: ErrStat2 ! Temporary Error status @@ -1582,6 +1646,11 @@ SUBROUTINE Farm_InitFAST( farm, WD_InitInp, AWAE_InitOutput, SC_InitOutput, SC_y allocate(FWrap_InitInp%fromSC(SC_InitOutput%NumSC2Ctrl)) + if (farm%p%MooringMod > 0) then + FWrap_Interval = farm%p%dt_mooring ! when there is a farm-level mooring model, FASTWrapper will be called at the mooring coupling time step + else + FWrap_Interval = farm%p%dt_low ! otherwise FASTWrapper will be called at the regular FAST.Farm time step + end if DO nt = 1,farm%p%NumTurbines !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ @@ -1590,6 +1659,7 @@ SUBROUTINE Farm_InitFAST( farm, WD_InitInp, AWAE_InitOutput, SC_InitOutput, SC_y FWrap_InitInp%FASTInFile = farm%p%WT_FASTInFile(nt) FWrap_InitInp%p_ref_Turbine = farm%p%WT_Position(:,nt) + FWrap_InitInp%WaveFieldMod = farm%p%WaveFieldMod FWrap_InitInp%TurbNum = nt FWrap_InitInp%RootName = trim(farm%p%OutFileRoot)//'.T'//num2lstr(nt) @@ -1606,7 +1676,7 @@ SUBROUTINE Farm_InitFAST( farm, WD_InitInp, AWAE_InitOutput, SC_InitOutput, SC_y end if ! note that FWrap_Init has Interval as INTENT(IN) so, we don't need to worry about overwriting farm%p%dt_low here: call FWrap_Init( FWrap_InitInp, farm%FWrap(nt)%u, farm%FWrap(nt)%p, farm%FWrap(nt)%x, farm%FWrap(nt)%xd, farm%FWrap(nt)%z, & - farm%FWrap(nt)%OtherSt, farm%FWrap(nt)%y, farm%FWrap(nt)%m, farm%p%dt_low, FWrap_InitOut, ErrStat2, ErrMsg2 ) + farm%FWrap(nt)%OtherSt, farm%FWrap(nt)%y, farm%FWrap(nt)%m, FWrap_Interval, FWrap_InitOut, ErrStat2, ErrMsg2 ) farm%FWrap(nt)%IsInitialized = .true. @@ -1629,6 +1699,268 @@ subroutine cleanup() end subroutine cleanup END SUBROUTINE Farm_InitFAST !---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes a farm-level instance of MoorDyn if applicable +SUBROUTINE Farm_InitMD( farm, ErrStat, ErrMsg ) + + ! Passed variables + type(All_FastFarm_Data), INTENT(INOUT) :: farm !< FAST.Farm data + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + ! local variables + type(MD_InitInputType) :: MD_InitInp + type(MD_InitOutputType) :: MD_InitOut + + INTEGER(IntKi) :: nt ! loop counter for rotor number + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + CHARACTER(*), PARAMETER :: RoutineName = 'Farm_InitMD' + + + ErrStat = ErrID_None + ErrMsg = "" + + CALL WrScr(" --------- in FARM_InitMD, to initiailze farm-level MoorDyn ------- ") + + + ! sort out how many times FASt and MoorDyn will be called per FAST.Farm time step based on DT_low and DT_mooring + IF ( EqualRealNos( farm%p%dt_mooring, farm%p%DT_low ) ) THEN + farm%p%n_mooring = 1 + ELSE + IF ( farm%p%dt_mooring > farm%p%DT_low ) THEN + ErrStat = ErrID_Fatal + ErrMsg = "The farm mooring coupling time step ("//TRIM(Num2LStr(farm%p%dt_mooring))// & + " s) cannot be larger than FAST.Farm time step ("//TRIM(Num2LStr(farm%p%DT_low))//" s)." + ELSE + ! calculate the number of FAST-MoorDyn subcycles: + farm%p%n_mooring = NINT( farm%p%DT_low / farm%p%dt_mooring ) + + ! let's make sure the FAST DT is an exact integer divisor of the global (FAST.Farm) time step: + IF ( .NOT. EqualRealNos( farm%p%DT_low, farm%p%dt_mooring * farm%p%n_mooring ) ) THEN + ErrStat = ErrID_Fatal + ErrMsg = "The MoorDyn coupling time step, DT_mooring ("//TRIM(Num2LStr(farm%p%dt_mooring))// & + " s) must be an integer divisor of the FAST.Farm time step ("//TRIM(Num2LStr(farm%p%DT_low))//" s)." + END IF + + END IF + END IF + + + !................. + ! MoorDyn initialization inputs... + !................ + !FWrap_InitInp%tmax = farm%p%TMax + !FWrap_InitInp%n_high_low = farm%p%n_high_low + 1 ! Add 1 because the FAST wrapper uses an index that starts at 1 + !FWrap_InitInp%dt_high = farm%p%dt_high + + + MD_InitInp%FileName = farm%p%MD_FileName ! input file name and path + MD_InitInp%RootName = trim(farm%p%OutFileRoot)//'.FarmMD' ! root of output files + MD_InitInp%FarmSize = farm%p%NumTurbines ! number of turbines in the array. >0 tells MoorDyn to operate in farm mode + + ALLOCATE( MD_InitInp%PtfmInit(6,farm%p%NumTurbines), MD_InitInp%TurbineRefPos(3,farm%p%NumTurbines), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating MoorDyn PtfmInit and TurbineRefPos initialization inputs in FAST.Farm.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + ! gather spatial initialization inputs for Farm-level MoorDyn + DO nt = 1,farm%p%NumTurbines + MD_InitInp%PtfmInit(:,nt) = farm%FWrap(nt)%m%Turbine%MD%m%PtfmInit ! turbine PRP initial positions and rotations in their respective coordinate systems from each FAST/MD instance + MD_InitInp%TurbineRefPos(:,nt) = farm%p%WT_Position(:,nt) ! reference positions of each turbine in the farm global coordinate system + END DO + + ! These aren't currently handled at the FAST.Farm level, so just give the farm's MoorDyn default values, which can be overwridden by its input file + MD_InitInp%g = 9.81 + MD_InitInp%rhoW = 1025.0 + MD_InitInp%WtrDepth = 0.0 !TODO: eventually connect this to a global depth input variable <<< + + + ! allocate MoorDyn inputs (assuming size 2 for linear interpolation/extrapolation... > + ALLOCATE( farm%MD%Input( 2 ), farm%MD%InputTimes( 2 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating MD%Input and MD%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + ! initialize MoorDyn + CALL MD_Init( MD_InitInp, farm%MD%Input(1), farm%MD%p, farm%MD%x, farm%MD%xd, farm%MD%z, & + farm%MD%OtherSt, farm%MD%y, farm%MD%m, farm%p%DT_mooring, MD_InitOut, ErrStat2, ErrMsg2 ) + + farm%MD%IsInitialized = .true. + + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) then + call cleanup() + return + end if + + + ! Copy MD inputs over into the 2nd entry of the input array, to allow the first extrapolation in FARM_MD_Increment + CALL MD_CopyInput (farm%MD%Input(1), farm%MD%Input(2), MESH_NEWCOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + farm%MD%InputTimes(2) = -0.1_DbKi + + CALL MD_CopyInput (farm%MD%Input(1), farm%MD%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + + ! Set up mesh maps between MoorDyn and floating platforms. + ! (for now assuming ElastoDyn - eventually could differentiate at the turbine level) + + ! allocate mesh mappings for coupling farm-level MoorDyn with OpenFAST instances + ALLOCATE( farm%m%MD_2_FWrap(farm%p%NumTurbines), farm%m%FWrap_2_MD(farm%p%NumTurbines), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating MD_2_FWrap and FWrap_2_MD.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + ! MoorDyn point mesh to/from ElastoDyn (or SubDyn) point mesh + do nt = 1,farm%p%NumTurbines + !if (farm%MD%p%NFairs(nt) > 0 ) then ! only set up a mesh map if MoorDyn has connections to this turbine + + ! loads + CALL MeshMapCreate( farm%MD%y%CoupledLoads(nt), & + farm%FWrap(nt)%m%Turbine%MeshMapData%u_ED_PlatformPtMesh_MDf, farm%m%MD_2_FWrap(nt), ErrStat2, ErrMsg2 ) + + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':MD_2_FWrap' ) + + ! kinematics + CALL MeshMapCreate( farm%FWrap(nt)%m%Turbine%ED%y%PlatformPtMesh, & + farm%MD%Input(1)%CoupledKinematics(nt), farm%m%FWrap_2_MD(nt), ErrStat2, ErrMsg2 ) + + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':FWrap_2_MD' ) + + ! Since SubDyn connections are not enabled yet, issue warning + if (allocated(farm%FWrap(nt)%m%Turbine%SD%Input)) then + call SetErrStat( ErrID_Warn, 'Turbine '//trim(Num2LStr(nt))//': Farm moorings connected to ElastoDyn platform reference instead of SubDyn', Errstat, ErrMsg, RoutineName//':MD_2_FWrap' ) + endif + + ! SubDyn alternative: + !CALL MeshMapCreate( farm%MD%y%CoupledLoads(nt), & + ! farm%FWrap(nt)%m%Turbine%SD%Input(1)%LMesh, farm%m%MD_2_FWrap, ErrStat2, ErrMsg2 ) + ! + !CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':MD_2_FWrap' ) + ! + !CALL MeshMapCreate( farm%FWrap(nt)%m%Turbine%SD%y%y2Mesh, & + ! farm%MD%Input(1)%CoupledKinematics(nt), farm%m%FWrap_2_MD, ErrStat2, ErrMsg2 ) + ! + !CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':FWrap_2_MD' ) + !end if + end do + + + farm%p%Module_Ver( ModuleFF_MD) = MD_InitOut%Ver + + call cleanup() + +contains + subroutine cleanup() + call MD_DestroyInitInput( MD_InitInp, ErrStat2, ErrMsg2 ) + call MD_DestroyInitOutput( MD_InitOut, ErrStat2, ErrMsg2 ) + end subroutine cleanup +END SUBROUTINE Farm_InitMD +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine moves a farm-level MoorDyn simulation one step forward, to catch up with FWrap_Increment +subroutine FARM_MD_Increment(t, n, farm, ErrStat, ErrMsg) + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation in FARM MoorDyn terms + type(All_FastFarm_Data), INTENT(INOUT) :: farm !< FAST.Farm data + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message + + INTEGER(IntKi) :: nt + INTEGER(IntKi) :: n_ss + INTEGER(IntKi) :: n_FMD + REAL(DbKi) :: t_next ! time at next step after this one (s) + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FARM_MD_Increment' + + ErrStat = ErrID_None + ErrMsg = "" + + ! ----- extrapolate MD inputs ----- + t_next = t + farm%p%DT_mooring + + ! Do a linear extrapolation to estimate MoorDyn inputs at time n_ss+1 + CALL MD_Input_ExtrapInterp(farm%MD%Input, farm%MD%InputTimes, farm%MD%u, t_next, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + ! Shift "window" of MD%Input: move values of Input and InputTimes from index 1 to index 2 + CALL MD_CopyInput (farm%MD%Input(1), farm%MD%Input(2), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + farm%MD%InputTimes(2) = farm%MD%InputTimes(1) + + ! update index 1 entries with the new extrapolated values + CALL MD_CopyInput (farm%MD%u, farm%MD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + farm%MD%InputTimes(1) = t_next + + + ! ----- map substructure kinematics to MoorDyn inputs ----- (from mapping called at start of CalcOutputs Solve INputs) + + do nt = 1,farm%p%NumTurbines + !if (farm%MD%p%NFairs(nt) > 0 ) then + + CALL Transfer_Point_to_Point( farm%FWrap(nt)%m%Turbine%ED%y%PlatformPtMesh, farm%MD%Input(1)%CoupledKinematics(nt), & + farm%m%FWrap_2_MD(nt), ErrStat2, ErrMsg2 ) + + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//'u_MD%CoupledKinematics' ) + + ! SubDyn alternative + !CALL Transfer_Point_to_Point( farm%FWrap(nt)%m%Turbine%SD%y%y2Mesh, farm%MD%Input(1)%CoupledKinematics(nt), farm%m%FWrap_2_MD(nt), ErrStat, ErrMsg ) + !end if + end do + + + ! ----- update states and calculate outputs ----- + + CALL MD_UpdateStates( t, n_FMD, farm%MD%Input, farm%MD%InputTimes, farm%MD%p, farm%MD%x, & + farm%MD%xd, farm%MD%z, farm%MD%OtherSt, farm%MD%m, ErrStat2, ErrMsg2 ) + + CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MD_CalcOutput( t, farm%MD%Input(1), farm%MD%p, farm%MD%x, farm%MD%xd, farm%MD%z, & + farm%MD%OtherSt, farm%MD%y, farm%MD%m, ErrStat2, ErrMsg2 ) + + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + ! ----- map MD load outputs to each turbine's substructure ----- (taken from U FullOpt1...) + do nt = 1,farm%p%NumTurbines + + if (farm%MD%p%nCpldCons(nt) > 0 ) then ! only map loads if MoorDyn has connections to this turbine (currently considering only Point connections <<< ) + + ! copy the MD output mesh for this turbine into a copy mesh within the FAST instance + !CALL MeshCopy ( farm%MD%y%CoupledLoads(nt), farm%FWrap(nt)%m%Turbine%MeshMapData%u_FarmMD_CoupledLoads, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':MeshCopy CoupledLoads' ) + + + ! mapping + CALL Transfer_Point_to_Point( farm%MD%y%CoupledLoads(nt), farm%FWrap(nt)%m%Turbine%MeshMapData%u_ED_PlatformPtMesh_MDf, & + farm%m%MD_2_FWrap(nt), ErrStat2, ErrMsg2, & + farm%MD%Input(1)%CoupledKinematics(nt), farm%FWrap(nt)%m%Turbine%ED%y%PlatformPtMesh ) !u_MD and y_ED contain the displacements needed for moment calculations + + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! SubDyn alternative + !CALL Transfer_Point_to_Point( farm%MD%y%CoupledLoads(nt), farm%FWrap(nt)%m%Turbine%MeshMapData%u_SD_LMesh_2, & + ! farm%m%MD_2_FWrap(nt), ErrStat2, ErrMsg2, & + ! farm%MD%Input(1)%CoupledKinematics(nt), farm%FWrap(nt)%m%Turbine%SD%y%y2Mesh ) !u_MD and y_SD contain the displacements needed for moment calculations + ! + !farm%FWrap(nt)%m%Turbine%MeshMapData%u_SD_LMesh%Force = farm%FWrap(nt)%m%Turbine%MeshMapData%u_SD_LMesh%Force + farm%FWrap(nt)%m%Turbine%MeshMapData%u_SD_LMesh_2%Force + !farm%FWrap(nt)%m%Turbine%MeshMapData%u_SD_LMesh%Moment = farm%FWrap(nt)%m%Turbine%MeshMapData%u_SD_LMesh%Moment + farm%FWrap(nt)%m%Turbine%MeshMapData%u_SD_LMesh_2%Moment + end if + end do + + +end subroutine Farm_MD_Increment +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine performs the initial call to calculate outputs (at t=0). !! The Initial Calculate Output algorithm: \n !! - In parallel: @@ -1800,23 +2132,33 @@ subroutine FARM_UpdateStates(t, n, farm, ErrStat, ErrMsg) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message - INTEGER(IntKi) :: nt - INTEGER(IntKi) :: ErrStatWD, ErrStat2 - INTEGER(IntKi), ALLOCATABLE :: ErrStatF(:) ! Temporary Error status + INTEGER(IntKi) :: nt + INTEGER(IntKi) :: n_ss + INTEGER(IntKi) :: n_FMD + REAL(DbKi) :: t2 ! time within the FAST-MoorDyn substepping loop for shared moorings + INTEGER(IntKi) :: ErrStatWD, ErrStatAWAE, ErrStatMD, ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(ErrMsgLen) :: ErrMsgWD - CHARACTER(ErrMsgLen), ALLOCATABLE :: ErrMsgF (:) ! Temporary Error message + CHARACTER(ErrMsgLen) :: ErrMsgAWAE + CHARACTER(ErrMsgLen) :: ErrMsgMD + INTEGER(IntKi), ALLOCATABLE :: ErrStatF(:) ! Temporary Error status for FAST + CHARACTER(ErrMsgLen), ALLOCATABLE :: ErrMsgF (:) ! Temporary Error message for FAST CHARACTER(*), PARAMETER :: RoutineName = 'FARM_UpdateStates' -! REAL(DbKi) :: tm1,tm2,tm3 + REAL(DbKi) :: tm1,tm2,tm3, tm01, tm02, tm03, tmSF, tmSM ! timer variables ErrStat = ErrID_None ErrMsg = "" - allocate ( ErrStatF ( farm%p%NumTurbines + 1 ), STAT=errStat2 ) + allocate ( ErrStatF ( farm%p%NumTurbines ), STAT=errStat2 ) if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for ErrStatF.', errStat, errMsg, RoutineName ) - allocate ( ErrMsgF ( farm%p%NumTurbines + 1 ), STAT=errStat2 ) + allocate ( ErrMsgF ( farm%p%NumTurbines ), STAT=errStat2 ) if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for ErrMsgF.', errStat, errMsg, RoutineName ) if (ErrStat >= AbortErrLev) return + + + + !....................................................................................... ! update module states (steps 1. and 2. and 3. and 4. can be done in parallel) !....................................................................................... @@ -1843,57 +2185,166 @@ subroutine FARM_UpdateStates(t, n, farm, ErrStat, ErrMsg) if (errStat >= AbortErrLev) return end if + !-------------------- - ! 3. CALL F_Increment and 4. CALL AWAE_UpdateStates -!#ifdef _OPENMP -! tm1 = omp_get_wtime() -!#endif - !$OMP PARALLEL DO DEFAULT(Shared) Private(nt) !Private(nt,tm2,tm3) - DO nt = 1,farm%p%NumTurbines+1 - if(nt.ne.farm%p%NumTurbines+1) then -!#ifdef _OPENMP -! tm3 = omp_get_wtime() -!#endif - call FWrap_Increment( t, n, farm%FWrap(nt)%u, farm%FWrap(nt)%p, farm%FWrap(nt)%x, farm%FWrap(nt)%xd, farm%FWrap(nt)%z, & - farm%FWrap(nt)%OtherSt, farm%FWrap(nt)%y, farm%FWrap(nt)%m, ErrStatF(nt), ErrMsgF(nt) ) + ! 3. CALL F_Increment (and FARM_MD_Increment) and 4. CALL AWAE_UpdateStates + + + ! set the inputs needed for FAST (these are slow-varying so can just be done once per farm time step) + do nt = 1,farm%p%NumTurbines + call FWrap_SetInputs(farm%FWrap(nt)%u, farm%FWrap(nt)%m, t) + end do + + + ! Original case: no shared moorings + if (farm%p%MooringMod == 0) then + + !#ifdef printthreads + ! tm1 = omp_get_wtime() + !#endif + !$OMP PARALLEL DO DEFAULT(Shared) Private(nt) !Private(nt,tm2,tm3) + DO nt = 1,farm%p%NumTurbines+1 + if(nt.ne.farm%p%NumTurbines+1) then + !#ifdef printthreads + ! tm3 = omp_get_wtime() + !#endif + call FWrap_Increment( t, n, farm%FWrap(nt)%u, farm%FWrap(nt)%p, farm%FWrap(nt)%x, farm%FWrap(nt)%xd, farm%FWrap(nt)%z, & + farm%FWrap(nt)%OtherSt, farm%FWrap(nt)%y, farm%FWrap(nt)%m, ErrStatF(nt), ErrMsgF(nt) ) + + !#ifdef printthreads + ! tm2 = omp_get_wtime() + ! write(*,*) ' FWrap_Increment for turbine #'//trim(num2lstr(nt))//' using thread #'//trim(num2lstr(omp_get_thread_num()))//' taking '//trim(num2lstr(tm2-tm3))//' seconds' + !#endif + + else + !#ifdef printthreads + ! tm3 = omp_get_wtime() + !#endif + call AWAE_UpdateStates( t, n, farm%AWAE%u, farm%AWAE%p, farm%AWAE%x, farm%AWAE%xd, farm%AWAE%z, & + farm%AWAE%OtherSt, farm%AWAE%m, ErrStatAWAE, ErrMsgAWAE ) + + !#ifdef printthreads + ! tm2 = omp_get_wtime() + ! write(*,*) ' AWAE_UpdateStates using thread #'//trim(num2lstr(omp_get_thread_num()))//' taking '//trim(num2lstr(tm2-tm3))//' seconds' + !#endif + endif -!#ifdef _OPENMP -! tm2 = omp_get_wtime() -! write(*,*) ' FWrap_Increment for turbine #'//trim(num2lstr(nt))//' using thread #'//trim(num2lstr(omp_get_thread_num()))//' taking '//trim(num2lstr(tm2-tm3))//' seconds' -!#endif + END DO + !$OMP END PARALLEL DO - else -!#ifdef _OPENMP -! tm3 = omp_get_wtime() -!#endif - call AWAE_UpdateStates( t, n, farm%AWAE%u, farm%AWAE%p, farm%AWAE%x, farm%AWAE%xd, farm%AWAE%z, & - farm%AWAE%OtherSt, farm%AWAE%m, errStatF(nt), errMsgF(nt) ) - -!#ifdef _OPENMP -! tm2 = omp_get_wtime() -! write(*,*) ' AWAE_UpdateStates using thread #'//trim(num2lstr(omp_get_thread_num()))//' taking '//trim(num2lstr(tm2-tm3))//' seconds' -!#endif - endif + !#ifdef printthreads + ! tm2 = omp_get_wtime() + ! write(*,*) 'Total Farm_US took '//trim(num2lstr(tm2-tm1))//' seconds.' + !#endif + + + ! Farm-level moorings case using MoorDyn + else if (farm%p%MooringMod == 3) then - END DO - !$OMP END PARALLEL DO + !#ifdef printthreads + ! tm1 = omp_get_wtime() + !#endif + + ! Set up two parallel sections - one for FAST-MoorDyn steps (FAST portion in parallel for each step), and the other for AWAE. + !$OMP PARALLEL SECTIONS DEFAULT(Shared) + + + ! The first section, for looping through FAST and farm-level MoorDyn time steps + !$OMP SECTION + + !#ifdef printthreads + ! tm3 = omp_get_wtime() + ! tmSF = 0.0_DbKi + ! tmSM = 0.0_DbKi + !#endif + + ! This is the FAST-MoorDyn farm-level substepping loop + do n_ss = 1, farm%p%n_mooring ! do n_mooring substeps (number of FAST/FarmMD steps per Farm time step) + + n_FMD = n*farm%p%n_mooring + n_ss - 1 ! number of the current time step of the call to FAST and MoorDyn + t2 = t + farm%p%DT_mooring*(n_ss - 1) ! current time in the loop + !#ifdef printthreads + ! tm01 = omp_get_wtime() + !#endif + + ! A nested parallel for loop to call each instance of OpenFAST in parallel + !$OMP PARALLEL DO DEFAULT(Shared) Private(nt) + DO nt = 1,farm%p%NumTurbines + call FWrap_Increment( t2, n_FMD, farm%FWrap(nt)%u, farm%FWrap(nt)%p, farm%FWrap(nt)%x, farm%FWrap(nt)%xd, farm%FWrap(nt)%z, & + farm%FWrap(nt)%OtherSt, farm%FWrap(nt)%y, farm%FWrap(nt)%m, ErrStatF(nt), ErrMsgF(nt) ) + END DO + !$OMP END PARALLEL DO + + !#ifdef printthreads + ! tm02 = omp_get_wtime() + !#endif + + ! call farm-level MoorDyn time step here (can't multithread this with FAST since it needs inputs from all FAST instances) + call Farm_MD_Increment( t2, n_FMD, farm, ErrStatMD, ErrMsgMD) + call SetErrStat(ErrStatMD, ErrMsgMD, ErrStat, ErrMsg, 'FARM_UpdateStates') ! MD error status <<<<< + + !#ifdef printthreads + ! tm03 = omp_get_wtime() + ! tmSF = tmSF + tm02-tm01 + ! tmSM = tmSM + tm03-tm02 + !#endif + + end do ! n_ss substepping + + !#ifdef printthreads + ! tm2 = omp_get_wtime() + ! write(*,*) ' Turbine and support structure simulations with parent thread #'//trim(num2lstr(omp_get_thread_num()))//' taking '//trim(num2lstr(tm2-tm3))//' seconds' + ! write(*,*) ' Time on FAST sims: '//trim(num2lstr(tmSF))//' s. Time on Farm MoorDyn: '//trim(num2lstr(tmSM))//' seconds' + !#endif + + + ! The second section, for updating AWAE states on a separate thread in parallel with the FAST/MoorDyn time stepping + !$OMP SECTION + + !#ifdef printthreads + ! tm3 = omp_get_wtime() + !#endif + + call AWAE_UpdateStates( t, n, farm%AWAE%u, farm%AWAE%p, farm%AWAE%x, farm%AWAE%xd, farm%AWAE%z, & + farm%AWAE%OtherSt, farm%AWAE%m, ErrStatAWAE, ErrMsgAWAE ) + + !#ifdef printthreads + ! tm2 = omp_get_wtime() + ! write(*,*) ' AWAE_UpdateStates using thread #'//trim(num2lstr(omp_get_thread_num()))//' taking '//trim(num2lstr(tm2-tm3))//' seconds' + !#endif + + + !$OMP END PARALLEL SECTIONS + + !#ifdef printthreads + ! tm2 = omp_get_wtime() + ! write(*,*) 'Total Farm_US took '//trim(num2lstr(tm2-tm1))//' seconds.' + !#endif + + else + CALL SetErrStat( ErrID_Fatal, 'MooringMod must be 0 or 3.', ErrStat, ErrMsg, RoutineName ) + end if + + ! update error messages from FAST's and AWAE's time steps DO nt = 1,farm%p%NumTurbines - call SetErrStat(ErrStatF(nt), ErrMsgF(nt), ErrStat, ErrMsg, 'T'//trim(num2lstr(nt))//':FARM_UpdateStates') + call SetErrStat(ErrStatF(nt), ErrMsgF(nt), ErrStat, ErrMsg, 'T'//trim(num2lstr(nt))//':FARM_UpdateStates') ! FAST error status END DO + + call SetErrStat(ErrStatAWAE, ErrMsgAWAE, ErrStat, ErrMsg, 'FARM_UpdateStates') ! AWAE error status + + ! calculate outputs from FAST as needed by FAST.Farm + do nt = 1,farm%p%NumTurbines + call FWrap_CalcOutput(farm%FWrap(nt)%p, farm%FWrap(nt)%u, farm%FWrap(nt)%y, farm%FWrap(nt)%m, ErrStat2, ErrMsg2) + call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end do - call SetErrStat(ErrStatF(farm%p%NumTurbines+1), ErrMsgF(farm%p%NumTurbines+1), ErrStat, ErrMsg, 'FARM_UpdateStates') - + if (ErrStat >= AbortErrLev) return -!#ifdef _OPENMP -! tm2 = omp_get_wtime() -! write(*,*) 'Total Farm_US took '//trim(num2lstr(tm2-tm1))//' seconds.' -!#endif - end subroutine FARM_UpdateStates - +!---------------------------------------------------------------------------------------------------------------------------------- subroutine Farm_WriteOutput(n, t, farm, ErrStat, ErrMsg) INTEGER(IntKi), INTENT(IN ) :: n !< Time step increment number REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds @@ -2334,6 +2785,15 @@ subroutine FARM_End(farm, ErrStat, ErrMsg) end if + !-------------- + ! 5. End farm-level MoorDyn + if (farm%p%MooringMod == 3) then + call MD_End(farm%MD%Input(1), farm%MD%p, farm%MD%x, farm%MD%xd, farm%MD%z, farm%MD%OtherSt, farm%MD%y, farm%MD%m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !TODO: any related items need to be cleared? + end if + + !....................................................................................... ! close output file !....................................................................................... diff --git a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 index 9d3cc3ffe4..eba7c5f052 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Types.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Types.f90 @@ -37,12 +37,13 @@ MODULE FAST_Farm_Types USE SuperController_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: NumFFModules = 4 ! The number of modules available in FAST.Farm [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: NumFFModules = 5 ! The number of modules available in FAST.Farm [-] INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_None = 0 ! No module selected [-] INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_SC = 1 ! Super Controller [-] INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_FWrap = 2 ! FAST Wrapper [-] INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_WD = 3 ! Wake Dynamics [-] INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_AWAE = 4 ! Ambient Wind and Array Effects [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ModuleFF_MD = 5 ! Farm-level MoorDyn [-] ! ========= Farm_ParameterType ======= TYPE, PUBLIC :: Farm_ParameterType REAL(DbKi) :: DT_low !< Time step for low-resolution wind data input files; will be used as the global FAST.Farm time step [seconds] @@ -54,6 +55,11 @@ MODULE FAST_Farm_Types CHARACTER(1024) :: SC_FileName !< Name/location of the dynamic library {.dll [Windows] or .so [Linux]} containing the Super Controller algorithms [-] LOGICAL :: UseSC !< Use a super controller? [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WT_Position !< X-Y-Z position of each wind turbine; index 1 = XYZ; index 2 = turbine number [meters] + INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) {0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin} [-] + INTEGER(IntKi) :: MooringMod !< Mod_SharedMooring is a flag for array-level mooring. (switch) {0: none, 3: yes/MoorDyn} [-] + CHARACTER(1024) :: MD_FileName !< Name/location of the farm-level MoorDyn input file [-] + REAL(DbKi) :: DT_mooring !< Time step for farm-levem mooring coupling with each turbine [used only when Mod_SharedMooring > 0] [seconds] + INTEGER(IntKi) :: n_mooring !< Number of FAST and MoorDyn time steps per FAST.Farm timestep when mooring > 0 [-] CHARACTER(1024) , DIMENSION(:), ALLOCATABLE :: WT_FASTInFile !< Name of input file for each turbine [-] CHARACTER(1024) :: FTitle !< The description line from the primary FAST.Farm input file [-] CHARACTER(1024) :: OutFileRoot !< The root name derived from the primary FAST.Farm input file [-] @@ -100,6 +106,8 @@ MODULE FAST_Farm_Types REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TimeData !< Array to contain the time output data for the binary file (first output time and a time [fixed] increment) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AllOutData !< Array to contain all the output data (time history of all outputs); Index 1 is NumOuts, Index 2 is Time step [-] INTEGER(IntKi) :: n_Out !< Time index into the AllOutData array [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: FWrap_2_MD !< Map platform kinematics from each FAST instance to MD [-] + TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: MD_2_FWrap !< Map MD loads at the array level to each FAST instance [-] END TYPE Farm_MiscVarType ! ======================= ! ========= FASTWrapper_Data ======= @@ -155,6 +163,21 @@ MODULE FAST_Farm_Types LOGICAL :: IsInitialized = .FALSE. !< Has SC_Init been called [-] END TYPE SC_Data ! ======================= +! ========= MD_Data ======= + TYPE, PUBLIC :: MD_Data + TYPE(MD_ContinuousStateType) :: x !< Continuous states [-] + TYPE(MD_DiscreteStateType) :: xd !< Discrete states [-] + TYPE(MD_ConstraintStateType) :: z !< Constraint states [-] + TYPE(MD_OtherStateType) :: OtherSt !< Other states [-] + TYPE(MD_ParameterType) :: p !< Parameters [-] + TYPE(MD_InputType) :: u !< Extrapolated system inputs [-] + TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< System inputs [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Current time [s] + TYPE(MD_OutputType) :: y !< System outputs [-] + TYPE(MD_MiscVarType) :: m !< Misc/optimization variables [-] + LOGICAL :: IsInitialized = .FALSE. !< Has MD_Init been called [-] + END TYPE MD_Data +! ======================= ! ========= All_FastFarm_Data ======= TYPE, PUBLIC :: All_FastFarm_Data TYPE(Farm_ParameterType) :: p !< FAST.Farm parameter data [-] @@ -163,6 +186,7 @@ MODULE FAST_Farm_Types TYPE(WakeDynamics_Data) , DIMENSION(:), ALLOCATABLE :: WD !< WakeDynamics (WD) data [-] TYPE(AWAE_Data) :: AWAE !< Ambient Wind & Array Effects (AWAE) data [-] TYPE(SC_Data) :: SC !< Super Controller (SC) data [-] + TYPE(MD_Data) :: MD !< Farm-level MoorDyn model data [-] END TYPE All_FastFarm_Data ! ======================= CONTAINS @@ -204,6 +228,11 @@ SUBROUTINE Farm_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg END IF DstParamData%WT_Position = SrcParamData%WT_Position ENDIF + DstParamData%WaveFieldMod = SrcParamData%WaveFieldMod + DstParamData%MooringMod = SrcParamData%MooringMod + DstParamData%MD_FileName = SrcParamData%MD_FileName + DstParamData%DT_mooring = SrcParamData%DT_mooring + DstParamData%n_mooring = SrcParamData%n_mooring IF (ALLOCATED(SrcParamData%WT_FASTInFile)) THEN i1_l = LBOUND(SrcParamData%WT_FASTInFile,1) i1_u = UBOUND(SrcParamData%WT_FASTInFile,1) @@ -418,6 +447,11 @@ SUBROUTINE Farm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 2*2 ! WT_Position upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WT_Position) ! WT_Position END IF + Int_BufSz = Int_BufSz + 1 ! WaveFieldMod + Int_BufSz = Int_BufSz + 1 ! MooringMod + Int_BufSz = Int_BufSz + 1*LEN(InData%MD_FileName) ! MD_FileName + Db_BufSz = Db_BufSz + 1 ! DT_mooring + Int_BufSz = Int_BufSz + 1 ! n_mooring Int_BufSz = Int_BufSz + 1 ! WT_FASTInFile allocated yes/no IF ( ALLOCATED(InData%WT_FASTInFile) ) THEN Int_BufSz = Int_BufSz + 2*1 ! WT_FASTInFile upper/lower bounds for each dimension @@ -588,6 +622,18 @@ SUBROUTINE Farm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, END DO END DO END IF + IntKiBuf(Int_Xferred) = InData%WaveFieldMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MooringMod + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%MD_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%MD_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%DT_mooring + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_mooring + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WT_FASTInFile) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -898,6 +944,18 @@ SUBROUTINE Farm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs END DO END DO END IF + OutData%WaveFieldMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MooringMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%MD_FileName) + OutData%MD_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%DT_mooring = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%n_mooring = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WT_FASTInFile not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1187,7 +1245,7 @@ SUBROUTINE Farm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs END SUBROUTINE Farm_UnPackParam SUBROUTINE Farm_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(Farm_MiscVarType), INTENT(IN) :: SrcMiscData + TYPE(Farm_MiscVarType), INTENT(INOUT) :: SrcMiscData TYPE(Farm_MiscVarType), INTENT(INOUT) :: DstMiscData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat @@ -1241,6 +1299,38 @@ SUBROUTINE Farm_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%AllOutData = SrcMiscData%AllOutData ENDIF DstMiscData%n_Out = SrcMiscData%n_Out +IF (ALLOCATED(SrcMiscData%FWrap_2_MD)) THEN + i1_l = LBOUND(SrcMiscData%FWrap_2_MD,1) + i1_u = UBOUND(SrcMiscData%FWrap_2_MD,1) + IF (.NOT. ALLOCATED(DstMiscData%FWrap_2_MD)) THEN + ALLOCATE(DstMiscData%FWrap_2_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FWrap_2_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMiscData%FWrap_2_MD,1), UBOUND(SrcMiscData%FWrap_2_MD,1) + CALL NWTC_Library_Copymeshmaptype( SrcMiscData%FWrap_2_MD(i1), DstMiscData%FWrap_2_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcMiscData%MD_2_FWrap)) THEN + i1_l = LBOUND(SrcMiscData%MD_2_FWrap,1) + i1_u = UBOUND(SrcMiscData%MD_2_FWrap,1) + IF (.NOT. ALLOCATED(DstMiscData%MD_2_FWrap)) THEN + ALLOCATE(DstMiscData%MD_2_FWrap(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MD_2_FWrap.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMiscData%MD_2_FWrap,1), UBOUND(SrcMiscData%MD_2_FWrap,1) + CALL NWTC_Library_Copymeshmaptype( SrcMiscData%MD_2_FWrap(i1), DstMiscData%MD_2_FWrap(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF END SUBROUTINE Farm_CopyMisc SUBROUTINE Farm_DestroyMisc( MiscData, ErrStat, ErrMsg ) @@ -1260,6 +1350,18 @@ SUBROUTINE Farm_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(MiscData%AllOutData)) THEN DEALLOCATE(MiscData%AllOutData) +ENDIF +IF (ALLOCATED(MiscData%FWrap_2_MD)) THEN +DO i1 = LBOUND(MiscData%FWrap_2_MD,1), UBOUND(MiscData%FWrap_2_MD,1) + CALL NWTC_Library_Destroymeshmaptype( MiscData%FWrap_2_MD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(MiscData%FWrap_2_MD) +ENDIF +IF (ALLOCATED(MiscData%MD_2_FWrap)) THEN +DO i1 = LBOUND(MiscData%MD_2_FWrap,1), UBOUND(MiscData%MD_2_FWrap,1) + CALL NWTC_Library_Destroymeshmaptype( MiscData%MD_2_FWrap(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(MiscData%MD_2_FWrap) ENDIF END SUBROUTINE Farm_DestroyMisc @@ -1314,6 +1416,53 @@ SUBROUTINE Farm_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Re_BufSz = Re_BufSz + SIZE(InData%AllOutData) ! AllOutData END IF Int_BufSz = Int_BufSz + 1 ! n_Out + Int_BufSz = Int_BufSz + 1 ! FWrap_2_MD allocated yes/no + IF ( ALLOCATED(InData%FWrap_2_MD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! FWrap_2_MD upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%FWrap_2_MD,1), UBOUND(InData%FWrap_2_MD,1) + Int_BufSz = Int_BufSz + 3 ! FWrap_2_MD: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%FWrap_2_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FWrap_2_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! FWrap_2_MD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! FWrap_2_MD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! FWrap_2_MD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! MD_2_FWrap allocated yes/no + IF ( ALLOCATED(InData%MD_2_FWrap) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! MD_2_FWrap upper/lower bounds for each dimension + DO i1 = LBOUND(InData%MD_2_FWrap,1), UBOUND(InData%MD_2_FWrap,1) + Int_BufSz = Int_BufSz + 3 ! MD_2_FWrap: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MD_2_FWrap(i1), ErrStat2, ErrMsg2, .TRUE. ) ! MD_2_FWrap + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! MD_2_FWrap + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! MD_2_FWrap + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! MD_2_FWrap + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -1393,6 +1542,88 @@ SUBROUTINE Farm_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S END IF IntKiBuf(Int_Xferred) = InData%n_Out Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%FWrap_2_MD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%FWrap_2_MD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FWrap_2_MD,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%FWrap_2_MD,1), UBOUND(InData%FWrap_2_MD,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%FWrap_2_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! FWrap_2_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%MD_2_FWrap) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MD_2_FWrap,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MD_2_FWrap,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%MD_2_FWrap,1), UBOUND(InData%MD_2_FWrap,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%MD_2_FWrap(i1), ErrStat2, ErrMsg2, OnlySize ) ! MD_2_FWrap + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF END SUBROUTINE Farm_PackMisc SUBROUTINE Farm_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1484,6 +1715,118 @@ SUBROUTINE Farm_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg END IF OutData%n_Out = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FWrap_2_MD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%FWrap_2_MD)) DEALLOCATE(OutData%FWrap_2_MD) + ALLOCATE(OutData%FWrap_2_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FWrap_2_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%FWrap_2_MD,1), UBOUND(OutData%FWrap_2_MD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%FWrap_2_MD(i1), ErrStat2, ErrMsg2 ) ! FWrap_2_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MD_2_FWrap not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%MD_2_FWrap)) DEALLOCATE(OutData%MD_2_FWrap) + ALLOCATE(OutData%MD_2_FWrap(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MD_2_FWrap.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%MD_2_FWrap,1), UBOUND(OutData%MD_2_FWrap,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%MD_2_FWrap(i1), ErrStat2, ErrMsg2 ) ! MD_2_FWrap + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF END SUBROUTINE Farm_UnPackMisc SUBROUTINE Farm_CopyFASTWrapper_Data( SrcFASTWrapper_DataData, DstFASTWrapper_DataData, CtrlCode, ErrStat, ErrMsg ) @@ -4852,9 +5195,9 @@ SUBROUTINE Farm_UnPackSC_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Xferred = Int_Xferred + 1 END SUBROUTINE Farm_UnPackSC_Data - SUBROUTINE Farm_CopyAll_FastFarm_Data( SrcAll_FastFarm_DataData, DstAll_FastFarm_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(All_FastFarm_Data), INTENT(INOUT) :: SrcAll_FastFarm_DataData - TYPE(All_FastFarm_Data), INTENT(INOUT) :: DstAll_FastFarm_DataData + SUBROUTINE Farm_CopyMD_Data( SrcMD_DataData, DstMD_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_Data), INTENT(INOUT) :: SrcMD_DataData + TYPE(MD_Data), INTENT(INOUT) :: DstMD_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -4863,28 +5206,1063 @@ SUBROUTINE Farm_CopyAll_FastFarm_Data( SrcAll_FastFarm_DataData, DstAll_FastFarm INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Farm_CopyAll_FastFarm_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'Farm_CopyMD_Data' ! ErrStat = ErrID_None ErrMsg = "" - CALL Farm_CopyParam( SrcAll_FastFarm_DataData%p, DstAll_FastFarm_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL MD_CopyContState( SrcMD_DataData%x, DstMD_DataData%x, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL Farm_CopyMisc( SrcAll_FastFarm_DataData%m, DstAll_FastFarm_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL MD_CopyDiscState( SrcMD_DataData%xd, DstMD_DataData%xd, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAll_FastFarm_DataData%FWrap)) THEN - i1_l = LBOUND(SrcAll_FastFarm_DataData%FWrap,1) - i1_u = UBOUND(SrcAll_FastFarm_DataData%FWrap,1) - IF (.NOT. ALLOCATED(DstAll_FastFarm_DataData%FWrap)) THEN - ALLOCATE(DstAll_FastFarm_DataData%FWrap(i1_l:i1_u),STAT=ErrStat2) + CALL MD_CopyConstrState( SrcMD_DataData%z, DstMD_DataData%z, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MD_CopyOtherState( SrcMD_DataData%OtherSt, DstMD_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MD_CopyParam( SrcMD_DataData%p, DstMD_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MD_CopyInput( SrcMD_DataData%u, DstMD_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcMD_DataData%Input)) THEN + i1_l = LBOUND(SrcMD_DataData%Input,1) + i1_u = UBOUND(SrcMD_DataData%Input,1) + IF (.NOT. ALLOCATED(DstMD_DataData%Input)) THEN + ALLOCATE(DstMD_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAll_FastFarm_DataData%FWrap.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMD_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcAll_FastFarm_DataData%FWrap,1), UBOUND(SrcAll_FastFarm_DataData%FWrap,1) - CALL Farm_Copyfastwrapper_data( SrcAll_FastFarm_DataData%FWrap(i1), DstAll_FastFarm_DataData%FWrap(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcMD_DataData%Input,1), UBOUND(SrcMD_DataData%Input,1) + CALL MD_CopyInput( SrcMD_DataData%Input(i1), DstMD_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcMD_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcMD_DataData%InputTimes,1) + i1_u = UBOUND(SrcMD_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstMD_DataData%InputTimes)) THEN + ALLOCATE(DstMD_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMD_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMD_DataData%InputTimes = SrcMD_DataData%InputTimes +ENDIF + CALL MD_CopyOutput( SrcMD_DataData%y, DstMD_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MD_CopyMisc( SrcMD_DataData%m, DstMD_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstMD_DataData%IsInitialized = SrcMD_DataData%IsInitialized + END SUBROUTINE Farm_CopyMD_Data + + SUBROUTINE Farm_DestroyMD_Data( MD_DataData, ErrStat, ErrMsg ) + TYPE(MD_Data), INTENT(INOUT) :: MD_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'Farm_DestroyMD_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + CALL MD_DestroyContState( MD_DataData%x, ErrStat, ErrMsg ) + CALL MD_DestroyDiscState( MD_DataData%xd, ErrStat, ErrMsg ) + CALL MD_DestroyConstrState( MD_DataData%z, ErrStat, ErrMsg ) + CALL MD_DestroyOtherState( MD_DataData%OtherSt, ErrStat, ErrMsg ) + CALL MD_DestroyParam( MD_DataData%p, ErrStat, ErrMsg ) + CALL MD_DestroyInput( MD_DataData%u, ErrStat, ErrMsg ) +IF (ALLOCATED(MD_DataData%Input)) THEN +DO i1 = LBOUND(MD_DataData%Input,1), UBOUND(MD_DataData%Input,1) + CALL MD_DestroyInput( MD_DataData%Input(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(MD_DataData%Input) +ENDIF +IF (ALLOCATED(MD_DataData%InputTimes)) THEN + DEALLOCATE(MD_DataData%InputTimes) +ENDIF + CALL MD_DestroyOutput( MD_DataData%y, ErrStat, ErrMsg ) + CALL MD_DestroyMisc( MD_DataData%m, ErrStat, ErrMsg ) + END SUBROUTINE Farm_DestroyMD_Data + + SUBROUTINE Farm_PackMD_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(MD_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Farm_PackMD_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! IsInitialized + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x, ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd, ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z, ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsInitialized, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Farm_PackMD_Data + + SUBROUTINE Farm_UnPackMD_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MD_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Farm_UnPackMD_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x, ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd, ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z, ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%IsInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsInitialized) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE Farm_UnPackMD_Data + + SUBROUTINE Farm_CopyAll_FastFarm_Data( SrcAll_FastFarm_DataData, DstAll_FastFarm_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(All_FastFarm_Data), INTENT(INOUT) :: SrcAll_FastFarm_DataData + TYPE(All_FastFarm_Data), INTENT(INOUT) :: DstAll_FastFarm_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Farm_CopyAll_FastFarm_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL Farm_CopyParam( SrcAll_FastFarm_DataData%p, DstAll_FastFarm_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL Farm_CopyMisc( SrcAll_FastFarm_DataData%m, DstAll_FastFarm_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcAll_FastFarm_DataData%FWrap)) THEN + i1_l = LBOUND(SrcAll_FastFarm_DataData%FWrap,1) + i1_u = UBOUND(SrcAll_FastFarm_DataData%FWrap,1) + IF (.NOT. ALLOCATED(DstAll_FastFarm_DataData%FWrap)) THEN + ALLOCATE(DstAll_FastFarm_DataData%FWrap(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAll_FastFarm_DataData%FWrap.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcAll_FastFarm_DataData%FWrap,1), UBOUND(SrcAll_FastFarm_DataData%FWrap,1) + CALL Farm_Copyfastwrapper_data( SrcAll_FastFarm_DataData%FWrap(i1), DstAll_FastFarm_DataData%FWrap(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO @@ -4911,6 +6289,9 @@ SUBROUTINE Farm_CopyAll_FastFarm_Data( SrcAll_FastFarm_DataData, DstAll_FastFarm CALL Farm_Copysc_data( SrcAll_FastFarm_DataData%SC, DstAll_FastFarm_DataData%SC, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL Farm_Copymd_data( SrcAll_FastFarm_DataData%MD, DstAll_FastFarm_DataData%MD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN END SUBROUTINE Farm_CopyAll_FastFarm_Data SUBROUTINE Farm_DestroyAll_FastFarm_Data( All_FastFarm_DataData, ErrStat, ErrMsg ) @@ -4938,6 +6319,7 @@ SUBROUTINE Farm_DestroyAll_FastFarm_Data( All_FastFarm_DataData, ErrStat, ErrMsg ENDIF CALL Farm_Destroyawae_data( All_FastFarm_DataData%AWAE, ErrStat, ErrMsg ) CALL Farm_Destroysc_data( All_FastFarm_DataData%SC, ErrStat, ErrMsg ) + CALL Farm_Destroymd_data( All_FastFarm_DataData%MD, ErrStat, ErrMsg ) END SUBROUTINE Farm_DestroyAll_FastFarm_Data SUBROUTINE Farm_PackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -5090,6 +6472,23 @@ SUBROUTINE Farm_PackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! MD: size of buffers for each call to pack subtype + CALL Farm_Packmd_data( Re_Buf, Db_Buf, Int_Buf, InData%MD, ErrStat2, ErrMsg2, .TRUE. ) ! MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! MD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! MD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! MD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -5311,6 +6710,34 @@ SUBROUTINE Farm_PackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + CALL Farm_Packmd_data( Re_Buf, Db_Buf, Int_Buf, InData%MD, ErrStat2, ErrMsg2, OnlySize ) ! MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END SUBROUTINE Farm_PackAll_FastFarm_Data SUBROUTINE Farm_UnPackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5612,6 +7039,46 @@ SUBROUTINE Farm_UnPackAll_FastFarm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Farm_Unpackmd_data( Re_Buf, Db_Buf, Int_Buf, OutData%MD, ErrStat2, ErrMsg2 ) ! MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE Farm_UnPackAll_FastFarm_Data END MODULE FAST_Farm_Types diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 1f8cedf0ee..2c05caa186 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -442,11 +442,14 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ! Set summary unit number in Waves, Radiation, and Morison initialization input data - InputFileData%Waves%UnSum = InputFileData%UnSum InputFileData%WAMIT%Conv_Rdtn%UnSum = InputFileData%UnSum InputFileData%Morison%UnSum = InputFileData%UnSum + ! distribute wave field and turbine location variables as needed to submodule initInputs + InputFileData%Waves%WaveFieldMod = InitInp%WaveFieldMod + InputFileData%Waves%PtfmLocationX = InitInp%PtfmLocationX + InputFileData%Waves%PtfmLocationY = InitInp%PtfmLocationY ! Now call each sub-module's *_Init subroutine ! to fully initialize each sub-module based on the necessary initialization data @@ -1355,10 +1358,7 @@ SUBROUTINE HydroDyn_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, I ErrStat, ErrMsg ) END IF - - - - + ! Check the output switch to see if Morison is needing to send outputs back to HydroDyn via the WriteOutput array IF ( InputFileData%OutSwtch > 0 ) THEN diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 038fc676a1..541a6dbcce 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -84,6 +84,7 @@ typedef ^ ^ ReKi typedef ^ ^ DbKi TMax - - - "Supplied by Driver: The total simulation time" "(sec)" typedef ^ ^ LOGICAL HasIce - - - "Supplied by Driver: Whether this simulation has ice loading (flag)" - typedef ^ ^ SiKi WaveElevXY {:}{:} - - "Supplied by Driver: X-Y locations for WaveElevation output (for visualization). First dimension is the X (1) and Y (2) coordinate. Second dimension is the point number." "m,-" +typedef ^ ^ INTEGER WaveFieldMod - - - "Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin" - typedef ^ ^ ReKi PtfmLocationX - - - "Supplied by Driver: X coordinate of platform location in the wave field" "m" typedef ^ ^ ReKi PtfmLocationY - - - "Supplied by Driver: Y coordinate of platform location in the wave field" "m" # @@ -107,6 +108,12 @@ typedef ^ ^ CHARACTER(L typedef ^ InitOutputType INTEGER DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - +typedef ^ ^ ReKi WaveVel {:}{:}{:} - - "output for now just to pass to MoorDyn" - +typedef ^ ^ ReKi WaveAcc {:}{:}{:} - - "output for now just to pass to MoorDyn" - +typedef ^ ^ ReKi WaveDynP {:}{:} - - "output for now just to pass to MoorDyn" - +typedef ^ ^ ReKi WaveElev {:}{:} - - "output for now just to pass to MoorDyn" - +typedef ^ ^ ReKi WaveTime {:} - - "output for now just to pass to MoorDyn" - + # ..... HD_ModuleMapType .................................................................................................................... typedef ^ HD_ModuleMapType MeshMapType uW_P_2_PRP_P - - - "Mesh mapping data: WAMIT body kinematics to PRP node at (0,0,0)" - diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index 3dadca82ba..a780bb03a9 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -1313,6 +1313,7 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS INTEGER :: I ! Generic loop counter index INTEGER :: J ! Generic loop counter index INTEGER :: K ! Generic loop counter index + INTEGER :: Itemp ! @mhall: additional temporary index CHARACTER(1024) :: TmpPath ! Temporary storage for relative path name LOGICAL :: FoundID ! Boolean flag indicating whether an ID from one tables is found in one of the other input table REAL(ReKi) :: MinDepth ! The minimum depth entry in the Depth-based Hydrodynamic coefficents table @@ -1483,7 +1484,7 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS ! WaveTMax - Analysis time for incident wave calculations. - IF ( InputFileData%Waves%WaveMod == 0 ) THEN ! .TRUE if we have incident waves. + IF ( InputFileData%Waves%WaveMod == 0 ) THEN ! .TRUE if we DO NOT HAVE have incident waves. ! TODO: Issue warning if WaveTMax was not already 0.0 in this case. IF ( .NOT. EqualRealNos(InputFileData%Waves%WaveTMax, 0.0_DbKi) ) THEN @@ -3223,7 +3224,6 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, Interval, InputFileData, ErrS InputFileData%Current%MorisonNodezi(I) = InputFileData%Waves%WaveKinzi(I) END DO - ! If we are using the Waves module, the node information must be copied over. InputFileData%Waves2%NWaveKin = InputFileData%Waves%NWaveKin ! Number of points where the incident wave kinematics will be computed (-) IF ( InputFileData%Waves2%WvDiffQTFF .OR. InputFileData%Waves2%WvSumQTFF ) THEN diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index 3397982a00..bacfe67df9 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -95,6 +95,7 @@ MODULE HydroDyn_Types REAL(DbKi) :: TMax !< Supplied by Driver: The total simulation time [(sec)] LOGICAL :: HasIce !< Supplied by Driver: Whether this simulation has ice loading (flag) [-] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevXY !< Supplied by Driver: X-Y locations for WaveElevation output (for visualization). First dimension is the X (1) and Y (2) coordinate. Second dimension is the point number. [m,-] + INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] REAL(ReKi) :: PtfmLocationX !< Supplied by Driver: X coordinate of platform location in the wave field [m] REAL(ReKi) :: PtfmLocationY !< Supplied by Driver: Y coordinate of platform location in the wave field [m] END TYPE HydroDyn_InitInputType @@ -117,6 +118,11 @@ MODULE HydroDyn_Types CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel !< output for now just to pass to MoorDyn [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc !< output for now just to pass to MoorDyn [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WaveDynP !< output for now just to pass to MoorDyn [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev !< output for now just to pass to MoorDyn [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< output for now just to pass to MoorDyn [-] END TYPE HydroDyn_InitOutputType ! ======================= ! ========= HD_ModuleMapType ======= @@ -1936,6 +1942,7 @@ SUBROUTINE HydroDyn_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, END IF DstInitInputData%WaveElevXY = SrcInitInputData%WaveElevXY ENDIF + DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY END SUBROUTINE HydroDyn_CopyInitInput @@ -2023,6 +2030,7 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*2 ! WaveElevXY upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveElevXY) ! WaveElevXY END IF + Int_BufSz = Int_BufSz + 1 ! WaveFieldMod Re_BufSz = Re_BufSz + 1 ! PtfmLocationX Re_BufSz = Re_BufSz + 1 ! PtfmLocationY IF ( Re_BufSz .GT. 0 ) THEN @@ -2124,6 +2132,8 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END DO END DO END IF + IntKiBuf(Int_Xferred) = InData%WaveFieldMod + Int_Xferred = Int_Xferred + 1 ReKiBuf(Re_Xferred) = InData%PtfmLocationX Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%PtfmLocationY @@ -2245,6 +2255,8 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta END DO END DO END IF + OutData%WaveFieldMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%PtfmLocationX = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 OutData%PtfmLocationY = ReKiBuf(Re_Xferred) @@ -2261,6 +2273,7 @@ SUBROUTINE HydroDyn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCo INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_CopyInitOutput' @@ -2408,6 +2421,78 @@ SUBROUTINE HydroDyn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCo END IF END IF DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveVel)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveVel,1) + i1_u = UBOUND(SrcInitOutputData%WaveVel,1) + i2_l = LBOUND(SrcInitOutputData%WaveVel,2) + i2_u = UBOUND(SrcInitOutputData%WaveVel,2) + i3_l = LBOUND(SrcInitOutputData%WaveVel,3) + i3_u = UBOUND(SrcInitOutputData%WaveVel,3) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveVel)) THEN + ALLOCATE(DstInitOutputData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveVel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveVel = SrcInitOutputData%WaveVel +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveAcc)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveAcc,1) + i1_u = UBOUND(SrcInitOutputData%WaveAcc,1) + i2_l = LBOUND(SrcInitOutputData%WaveAcc,2) + i2_u = UBOUND(SrcInitOutputData%WaveAcc,2) + i3_l = LBOUND(SrcInitOutputData%WaveAcc,3) + i3_u = UBOUND(SrcInitOutputData%WaveAcc,3) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveAcc)) THEN + ALLOCATE(DstInitOutputData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveAcc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveAcc = SrcInitOutputData%WaveAcc +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveDynP)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveDynP,1) + i1_u = UBOUND(SrcInitOutputData%WaveDynP,1) + i2_l = LBOUND(SrcInitOutputData%WaveDynP,2) + i2_u = UBOUND(SrcInitOutputData%WaveDynP,2) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveDynP)) THEN + ALLOCATE(DstInitOutputData%WaveDynP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveDynP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveDynP = SrcInitOutputData%WaveDynP +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveElev)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveElev,1) + i1_u = UBOUND(SrcInitOutputData%WaveElev,1) + i2_l = LBOUND(SrcInitOutputData%WaveElev,2) + i2_u = UBOUND(SrcInitOutputData%WaveElev,2) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveElev)) THEN + ALLOCATE(DstInitOutputData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElev.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveElev = SrcInitOutputData%WaveElev +ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveTime)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveTime,1) + i1_u = UBOUND(SrcInitOutputData%WaveTime,1) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveTime)) THEN + ALLOCATE(DstInitOutputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveTime.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveTime = SrcInitOutputData%WaveTime ENDIF END SUBROUTINE HydroDyn_CopyInitOutput @@ -2458,6 +2543,21 @@ SUBROUTINE HydroDyn_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN DEALLOCATE(InitOutputData%IsLoad_u) +ENDIF +IF (ALLOCATED(InitOutputData%WaveVel)) THEN + DEALLOCATE(InitOutputData%WaveVel) +ENDIF +IF (ALLOCATED(InitOutputData%WaveAcc)) THEN + DEALLOCATE(InitOutputData%WaveAcc) +ENDIF +IF (ALLOCATED(InitOutputData%WaveDynP)) THEN + DEALLOCATE(InitOutputData%WaveDynP) +ENDIF +IF (ALLOCATED(InitOutputData%WaveElev)) THEN + DEALLOCATE(InitOutputData%WaveElev) +ENDIF +IF (ALLOCATED(InitOutputData%WaveTime)) THEN + DEALLOCATE(InitOutputData%WaveTime) ENDIF END SUBROUTINE HydroDyn_DestroyInitOutput @@ -2637,6 +2737,31 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u END IF + Int_BufSz = Int_BufSz + 1 ! WaveVel allocated yes/no + IF ( ALLOCATED(InData%WaveVel) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! WaveVel upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveVel) ! WaveVel + END IF + Int_BufSz = Int_BufSz + 1 ! WaveAcc allocated yes/no + IF ( ALLOCATED(InData%WaveAcc) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! WaveAcc upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc) ! WaveAcc + END IF + Int_BufSz = Int_BufSz + 1 ! WaveDynP allocated yes/no + IF ( ALLOCATED(InData%WaveDynP) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WaveDynP upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveDynP) ! WaveDynP + END IF + Int_BufSz = Int_BufSz + 1 ! WaveElev allocated yes/no + IF ( ALLOCATED(InData%WaveElev) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WaveElev upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElev) ! WaveElev + END IF + Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no + IF ( ALLOCATED(InData%WaveTime) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveTime) ! WaveTime + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -2971,6 +3096,111 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) + DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) + DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) + ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveAcc) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) + DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) + DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveDynP) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveDynP,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) + DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) + DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) + ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF END SUBROUTINE HydroDyn_PackInitOutput SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2988,6 +3218,7 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: i INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackInitOutput' @@ -3398,6 +3629,126 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Xferred = Int_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveVel)) DEALLOCATE(OutData%WaveVel) + ALLOCATE(OutData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) + DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) + DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) + OutData%WaveVel(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveAcc)) DEALLOCATE(OutData%WaveAcc) + ALLOCATE(OutData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) + DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) + DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) + OutData%WaveAcc(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveDynP)) DEALLOCATE(OutData%WaveDynP) + ALLOCATE(OutData%WaveDynP(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) + DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) + OutData%WaveDynP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElev)) DEALLOCATE(OutData%WaveElev) + ALLOCATE(OutData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) + DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) + OutData%WaveElev(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) + ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF END SUBROUTINE HydroDyn_UnPackInitOutput SUBROUTINE HydroDyn_CopyHD_ModuleMapType( SrcHD_ModuleMapTypeData, DstHD_ModuleMapTypeData, CtrlCode, ErrStat, ErrMsg ) diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 6329a4117c..0d834adfa5 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -2247,9 +2247,11 @@ FUNCTION GetAlpha(R1,R2) REAL(ReKi), INTENT ( IN ) :: R1 ! interior radius of element at node point REAL(ReKi), INTENT ( IN ) :: R2 ! interior radius of other end of part-element - - GetAlpha = (R1*R1 + 2.0*R1*R2 + 3.0*R2*R2)/4.0/(R1*R1 + R1*R2 + R2*R2) - + if ( EqualRealNos(R1, 0.0_ReKi) .AND. EqualRealNos(R2, 0.0_ReKi) ) then ! if undefined, return 0 + GetAlpha = 0.0_ReKi + else + GetAlpha = (R1*R1 + 2.0*R1*R2 + 3.0*R2*R2)/4.0/(R1*R1 + R1*R2 + R2*R2) + end if END FUNCTION GetAlpha diff --git a/modules/hydrodyn/src/Waves.f90 b/modules/hydrodyn/src/Waves.f90 index 5358c49a49..8934278e16 100644 --- a/modules/hydrodyn/src/Waves.f90 +++ b/modules/hydrodyn/src/Waves.f90 @@ -34,6 +34,21 @@ MODULE Waves TYPE(ProgDesc), PARAMETER :: Waves_ProgDesc = ProgDesc( 'Waves', '', '' ) + + ! ..... @mhall: Public variables for hard-coded wave kinematics grid (temporary solution) ........................... + + INTEGER, PUBLIC :: WaveGrid_n = 0 !150 Number of wave kinematics grid points = nx*ny*nz + ! + !REAL(SiKi), PUBLIC :: WaveGrid_x0 = -35.0 ! first grid point in x direction + !REAL(SiKi), PUBLIC :: WaveGrid_dx = 10.0 ! step size in x direction + !INTEGER, PUBLIC :: WaveGrid_nx = 10 ! Number of wave kinematics grid points in x + ! + !REAL(SiKi), PUBLIC :: WaveGrid_y0 = -35.0 ! same for y + !REAL(SiKi), PUBLIC :: WaveGrid_dy = 35.0 + !INTEGER, PUBLIC :: WaveGrid_ny = 3 + ! + !INTEGER, PUBLIC :: WaveGrid_nz = 5 ! Number of wave kinematics grid points in z (locations decided by 1.0 - 2.0**(WaveGrid_nz-I)) + ! ..... Public Subroutines ................................................................................................... PUBLIC :: WavePkShpDefault ! Return the default value of the peak shape parameter of the incident wave spectrum @@ -1670,6 +1685,35 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) SinWaveDir=SIN(D2R*InitOut%WaveDirArr) + !-------------------------------------------------------------------------------- + !> ## Phase shift the discrete Fourier transform of wave elevations at the WRP + !> This changes the phasing of all wave kinematics and loads to reflect the turbine's + !! location in the larger farm, in the case of FAST.Farm simulations, based on + !! specified PtfmLocationX and PtfmLocationY. + + IF (InitInp%WaveFieldMod == 2) THEN ! case 2: adjust wave phases based on turbine offsets from farm origin + + CALL WrScr ( ' Adjusting incident wave kinematics for turbine offset from array origin.' ) + + DO I = 0,InitOut%NStepWave2 + + tmpComplex = CMPLX( InitOut%WaveElevC0(1,I), InitOut%WaveElevC0(2,I)) + + ! some redundant calculations with later, but insignificant + Omega = I*InitOut%WaveDOmega + WaveNmbr = WaveNumber ( Omega, InitInp%Gravity, InitInp%WtrDpth ) + + ! apply the phase shift + tmpComplex = tmpComplex * EXP( -ImagNmbr*WaveNmbr*( InitInp%PtfmLocationX*CosWaveDir(I) + InitInp%PtfmLocationY*SinWaveDir(I) )) + + ! put shifted complex amplitudes back into the array for use in the remainder of this module and other modules (Waves2, WAMIT, WAMIT2) + InitOut%WaveElevC0 (1,I) = REAL( tmpComplex) + InitOut%WaveElevC0 (2,I) = AIMAG(tmpComplex) + + END DO + END IF + + !-------------------------------------------------------------------------------- !> ## Compute IFFTs !> Compute the discrete Fourier transform of the instantaneous elevation of @@ -1781,6 +1825,28 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) END IF END DO ! J - All points where the incident wave elevations can be output + ! :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + !@mhall: hard-coding some additional wave elevation time series output for now + + !ALLOCATE ( InitOut%WaveElevMD (0:InitOut%NStepWave, WaveGrid_nx*WaveGrid_ny), STAT=ErrStatTmp ) + !IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array InitOut%WaveElevMD.', ErrStat,ErrMsg,'VariousWaves_Init') + ! + !DO J = 1,WaveGrid_ny !y = -60.0 + 20.0*J + ! DO K = 1,WaveGrid_nx !x = -60.0 + 20.0*K + ! + ! I = (J-1)*WaveGrid_nx + K ! index of actual node + ! + ! CALL WaveElevTimeSeriesAtXY( WaveGrid_x0 + WaveGrid_dx*(K-1), WaveGrid_y0 + WaveGrid_dy*(J-1), InitOut%WaveElevMD(:,I), ErrStatTmp, ErrMsgTmp ) + ! CALL SetErrStat(ErrStatTmp,'Error occured while applying the FFT to InitOut%WaveElevMD.',ErrStat,ErrMsg,'VariousWaves_Init') + ! IF ( ErrStat >= AbortErrLev ) THEN + ! CALL CleanUp() + ! RETURN + ! END IF + ! END DO + !END DO + + ! :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + ! For creating animations of the sea surface, the WaveElevXY array is passed in with a series of x,y coordinates ! (index 1). The second index corresponds to the number of points passed in. A two dimensional time series @@ -2182,8 +2248,13 @@ SUBROUTINE Waves_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init CALL StillWaterWaves_Init( InitInp, InitOut, ErrStatTmp, ErrMsgTmp ) CALL SetErrStat(ErrStatTmp,ErrMsgTmp,ErrStat,ErrMsg,'Waves_Init') + + !@mhall: :::: ensure all arrays needed for the wave grid to MoorDyn are allocated in the WaveMod=0 case too :::: + !ALLOCATE ( InitOut%WaveElevMD (0:InitOut%NStepWave, WaveGrid_nx*WaveGrid_ny), STAT=ErrStatTmp ) + !InitOut%WaveElevMD = 0.0_DbKi ! zero it + ! ::::: end ::::: + IF ( ErrStat >= AbortErrLev ) RETURN - CASE ( 1, 2, 3, 4, 10 ) ! 1, 10: Plane progressive (regular) wave, 2: JONSWAP/Pierson-Moskowitz spectrum (irregular) wave, 3: white-noise, or 4: user-defined spectrum (irregular) wave. diff --git a/modules/hydrodyn/src/Waves.txt b/modules/hydrodyn/src/Waves.txt index 366067469c..5469e8b88f 100644 --- a/modules/hydrodyn/src/Waves.txt +++ b/modules/hydrodyn/src/Waves.txt @@ -51,6 +51,9 @@ typedef ^ ^ INTEGER NWaveElev typedef ^ ^ SiKi WaveElevxi {:} - - "xi-coordinates for points where the incident wave elevations can be output" (meters) typedef ^ ^ SiKi WaveElevyi {:} - - "yi-coordinates for points where the incident wave elevations can be output" (meters) typedef ^ ^ SiKi WaveElevXY {:}{:} - - "Supplied by Driver: X-Y locations for WaveElevation output (for visualization). Index 1 corresponds to X or Y coordinate. Index 2 corresponds to point number." - +typedef ^ ^ ReKi PtfmLocationX - - - "Copy of X coordinate of platform location in the wave field, used to offset/phase-shift all wave kinematics to account for location in the farm" "m" +typedef ^ ^ ReKi PtfmLocationY - - - "Copy of Y coordinate of platform location in the wave field, used to offset/phase-shift all wave kinematics to account for location in the farm" "m" +typedef ^ ^ INTEGER WaveFieldMod - - - "Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin" - typedef ^ ^ INTEGER NWaveKin - - - "Number of points where the incident wave kinematics will be computed" - typedef ^ ^ SiKi WaveKinxi {:} - - "xi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) typedef ^ ^ SiKi WaveKinyi {:} - - "yi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level" (meters) @@ -82,6 +85,8 @@ typedef ^ ^ SiKi PWaveVel0 typedef ^ ^ SiKi WaveElev {:}{:} - - "Instantaneous elevation time-series of incident waves at each of the NWaveElev points where the incident wave elevations can be output" (meters) typedef ^ ^ SiKi WaveElev0 {:} - - "Instantaneous elevation time-series of incident waves at the platform reference point" (meters) +typedef ^ ^ SiKi WaveElevMD {:}{:} - - "Instantaneous elevation time-series of incident waves at hard coded grid for temporary use in MoorDyn" (m) + typedef ^ ^ SiKi WaveElevSeries {:}{:} - - "Instantaneous elevation time-series at each of the points given by WaveElevXY. Used for making movies of the waves. First index is the timestep. Second index is XY point number corresponding to second index of WaveElevXY." (m) typedef ^ ^ SiKi WaveTime {:} - - "Simulation times at which the instantaneous elevation of, velocity of, acceleration of, and loads associated with the incident waves are determined" (sec) diff --git a/modules/hydrodyn/src/Waves_Types.f90 b/modules/hydrodyn/src/Waves_Types.f90 index 9b98fdc949..beb9047fab 100644 --- a/modules/hydrodyn/src/Waves_Types.f90 +++ b/modules/hydrodyn/src/Waves_Types.f90 @@ -68,6 +68,9 @@ MODULE Waves_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevxi !< xi-coordinates for points where the incident wave elevations can be output [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevyi !< yi-coordinates for points where the incident wave elevations can be output [(meters)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevXY !< Supplied by Driver: X-Y locations for WaveElevation output (for visualization). Index 1 corresponds to X or Y coordinate. Index 2 corresponds to point number. [-] + REAL(ReKi) :: PtfmLocationX !< Copy of X coordinate of platform location in the wave field, used to offset/phase-shift all wave kinematics to account for location in the farm [m] + REAL(ReKi) :: PtfmLocationY !< Copy of Y coordinate of platform location in the wave field, used to offset/phase-shift all wave kinematics to account for location in the farm [m] + INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] INTEGER(IntKi) :: NWaveKin !< Number of points where the incident wave kinematics will be computed [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinxi !< xi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveKinyi !< yi-coordinates for points where the incident wave kinematics will be computed; these are relative to the mean sea level [(meters)] @@ -98,6 +101,7 @@ MODULE Waves_Types REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: PWaveVel0 !< Instantaneous velocity of incident waves in the xi- (1), yi- (2), and zi- (3) directions, respectively, at the location (xi,yi,0), at each of the NWaveKin points where the incident wave kinematics will be computed (The values include both the velocity of incident waves and the velocity of current.) [(m/s)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev !< Instantaneous elevation time-series of incident waves at each of the NWaveElev points where the incident wave elevations can be output [(meters)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElev0 !< Instantaneous elevation time-series of incident waves at the platform reference point [(meters)] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevMD !< Instantaneous elevation time-series of incident waves at hard coded grid for temporary use in MoorDyn [(m)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElevSeries !< Instantaneous elevation time-series at each of the points given by WaveElevXY. Used for making movies of the waves. First index is the timestep. Second index is XY point number corresponding to second index of WaveElevXY. [(m)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Simulation times at which the instantaneous elevation of, velocity of, acceleration of, and loads associated with the incident waves are determined [(sec)] REAL(DbKi) :: WaveTMax !< Analysis time for incident wave calculations; the actual analysis time may be larger than this value in order for the maintain an effecient FFT [(sec)] @@ -237,6 +241,9 @@ SUBROUTINE Waves_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er END IF DstInitInputData%WaveElevXY = SrcInitInputData%WaveElevXY ENDIF + DstInitInputData%PtfmLocationX = SrcInitInputData%PtfmLocationX + DstInitInputData%PtfmLocationY = SrcInitInputData%PtfmLocationY + DstInitInputData%WaveFieldMod = SrcInitInputData%WaveFieldMod DstInitInputData%NWaveKin = SrcInitInputData%NWaveKin IF (ALLOCATED(SrcInitInputData%WaveKinxi)) THEN i1_l = LBOUND(SrcInitInputData%WaveKinxi,1) @@ -421,6 +428,9 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_BufSz = Int_BufSz + 2*2 ! WaveElevXY upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveElevXY) ! WaveElevXY END IF + Re_BufSz = Re_BufSz + 1 ! PtfmLocationX + Re_BufSz = Re_BufSz + 1 ! PtfmLocationY + Int_BufSz = Int_BufSz + 1 ! WaveFieldMod Int_BufSz = Int_BufSz + 1 ! NWaveKin Int_BufSz = Int_BufSz + 1 ! WaveKinxi allocated yes/no IF ( ALLOCATED(InData%WaveKinxi) ) THEN @@ -616,6 +626,12 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err END DO END DO END IF + ReKiBuf(Re_Xferred) = InData%PtfmLocationX + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmLocationY + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveFieldMod + Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%NWaveKin Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveKinxi) ) THEN @@ -889,6 +905,12 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, END DO END DO END IF + OutData%PtfmLocationX = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmLocationY = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WaveFieldMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%NWaveKin = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinxi not allocated @@ -1206,6 +1228,20 @@ SUBROUTINE Waves_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, END IF DstInitOutputData%WaveElev0 = SrcInitOutputData%WaveElev0 ENDIF +IF (ALLOCATED(SrcInitOutputData%WaveElevMD)) THEN + i1_l = LBOUND(SrcInitOutputData%WaveElevMD,1) + i1_u = UBOUND(SrcInitOutputData%WaveElevMD,1) + i2_l = LBOUND(SrcInitOutputData%WaveElevMD,2) + i2_u = UBOUND(SrcInitOutputData%WaveElevMD,2) + IF (.NOT. ALLOCATED(DstInitOutputData%WaveElevMD)) THEN + ALLOCATE(DstInitOutputData%WaveElevMD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WaveElevMD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%WaveElevMD = SrcInitOutputData%WaveElevMD +ENDIF IF (ALLOCATED(SrcInitOutputData%WaveElevSeries)) THEN i1_l = LBOUND(SrcInitOutputData%WaveElevSeries,1) i1_u = UBOUND(SrcInitOutputData%WaveElevSeries,1) @@ -1294,6 +1330,9 @@ SUBROUTINE Waves_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) IF (ALLOCATED(InitOutputData%WaveElev0)) THEN DEALLOCATE(InitOutputData%WaveElev0) ENDIF +IF (ALLOCATED(InitOutputData%WaveElevMD)) THEN + DEALLOCATE(InitOutputData%WaveElevMD) +ENDIF IF (ALLOCATED(InitOutputData%WaveElevSeries)) THEN DEALLOCATE(InitOutputData%WaveElevSeries) ENDIF @@ -1401,6 +1440,11 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_BufSz = Int_BufSz + 2*1 ! WaveElev0 upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%WaveElev0) ! WaveElev0 END IF + Int_BufSz = Int_BufSz + 1 ! WaveElevMD allocated yes/no + IF ( ALLOCATED(InData%WaveElevMD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WaveElevMD upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElevMD) ! WaveElevMD + END IF Int_BufSz = Int_BufSz + 1 ! WaveElevSeries allocated yes/no IF ( ALLOCATED(InData%WaveElevSeries) ) THEN Int_BufSz = Int_BufSz + 2*2 ! WaveElevSeries upper/lower bounds for each dimension @@ -1684,6 +1728,26 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Re_Xferred = Re_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%WaveElevMD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevMD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevMD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElevMD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevMD,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WaveElevMD,2), UBOUND(InData%WaveElevMD,2) + DO i1 = LBOUND(InData%WaveElevMD,1), UBOUND(InData%WaveElevMD,1) + ReKiBuf(Re_Xferred) = InData%WaveElevMD(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( .NOT. ALLOCATED(InData%WaveElevSeries) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2048,6 +2112,29 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = Re_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevMD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElevMD)) DEALLOCATE(OutData%WaveElevMD) + ALLOCATE(OutData%WaveElevMD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevMD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WaveElevMD,2), UBOUND(OutData%WaveElevMD,2) + DO i1 = LBOUND(OutData%WaveElevMD,1), UBOUND(OutData%WaveElevMD,1) + OutData%WaveElevMD(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevSeries not allocated Int_Xferred = Int_Xferred + 1 ELSE diff --git a/modules/moordyn/CMakeLists.txt b/modules/moordyn/CMakeLists.txt index 18f66807b8..a2608c7b2a 100644 --- a/modules/moordyn/CMakeLists.txt +++ b/modules/moordyn/CMakeLists.txt @@ -20,7 +20,12 @@ endif() set(MOORDYN_LIBS_SOURCES src/MoorDyn.f90 + src/MoorDyn_Body.f90 src/MoorDyn_IO.f90 + src/MoorDyn_Line.f90 + src/MoorDyn_Misc.f90 + src/MoorDyn_Point.f90 + src/MoorDyn_Rod.f90 src/MoorDyn_Types.f90 ) @@ -41,3 +46,4 @@ install(TARGETS moordyn_driver RUNTIME DESTINATION bin LIBRARY DESTINATION lib ARCHIVE DESTINATION lib) + diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index 23d8854ef0..44f3a4f5fe 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -1,6 +1,7 @@ !********************************************************************************************************************************** ! LICENSING -! Copyright (C) 2015 Matthew Hall +! Copyright (C) 2020-2021 Alliance for Sustainable Energy, LLC +! Copyright (C) 2015-2019 Matthew Hall ! ! This file is part of MoorDyn. ! @@ -22,19 +23,32 @@ MODULE MoorDyn USE MoorDyn_Types USE MoorDyn_IO USE NWTC_Library + USE MoorDyn_Line + USE MoorDyn_Point + USE MoorDyn_Rod + USE MoorDyn_Body + USE MoorDyn_Misc + + !USE WAVES, only: WaveGrid_n, WaveGrid_x0, WaveGrid_dx, WaveGrid_nx, WaveGrid_y0, WaveGrid_dy, WaveGrid_ny, WaveGrid_nz ! seeing if I can get waves data here directly... IMPLICIT NONE PRIVATE - TYPE(ProgDesc), PARAMETER :: MD_ProgDesc = ProgDesc( 'MoorDyn', '', '' ) + TYPE(ProgDesc), PARAMETER :: MD_ProgDesc = ProgDesc( 'MoorDyn', 'v2.a27', '2022-07-20' ) + INTEGER(IntKi), PARAMETER :: wordy = 0 ! verbosity level. >1 = more console output PUBLIC :: MD_Init PUBLIC :: MD_UpdateStates PUBLIC :: MD_CalcOutput PUBLIC :: MD_CalcContStateDeriv PUBLIC :: MD_End + PUBLIC :: MD_JacobianPContState + PUBLIC :: MD_JacobianPInput + PUBLIC :: MD_JacobianPDiscState + PUBLIC :: MD_JacobianPConstrState + PUBLIC :: MD_GetOP CONTAINS @@ -43,7 +57,7 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er IMPLICIT NONE - TYPE(MD_InitInputType), INTENT(INOUT) :: InitInp ! INTENT(INOUT) : Input data for initialization routine + TYPE(MD_InitInputType), INTENT(IN ) :: InitInp ! INTENT(INOUT) : Input data for initialization routine TYPE(MD_InputType), INTENT( OUT) :: u ! INTENT( OUT) : An initial guess for the input; input mesh must be defined TYPE(MD_ParameterType), INTENT( OUT) :: p ! INTENT( OUT) : Parameters TYPE(MD_ContinuousStateType), INTENT( OUT) :: x ! INTENT( OUT) : Initial continuous states @@ -53,32 +67,94 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er TYPE(MD_OutputType), INTENT( OUT) :: y ! INTENT( OUT) : Initial system outputs (outputs are not calculated; only the output mesh is initialized) TYPE(MD_MiscVarType), INTENT( OUT) :: m ! INTENT( OUT) : Initial misc/optimization variables REAL(DbKi), INTENT(INOUT) :: DTcoupling ! Coupling interval in seconds: the rate that Output is the actual coupling interval - TYPE(MD_InitOutputType), INTENT(INOUT) :: InitOut ! Output for initialization routine + TYPE(MD_InitOutputType), INTENT( OUT) :: InitOut ! Output for initialization routine INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables + TYPE(MD_InputFileType) :: InputFileDat ! Data read from input file for setup, but not stored after Init + type(FileInfoType) :: FileInfo_In !< The derived type for holding the full input file for parsing -- we may pass this in the future + ! CHARACTER(1024) :: priPath ! The path to the primary MoorDyn input file REAL(DbKi) :: t ! instantaneous time, to be used during IC generation - INTEGER(IntKi) :: I ! index + INTEGER(IntKi) :: l ! index + INTEGER(IntKi) :: I ! Current line number of input file INTEGER(IntKi) :: J ! index INTEGER(IntKi) :: K ! index + INTEGER(IntKi) :: Itemp ! index + INTEGER(IntKi) :: iTurb ! index for turbine in FAST.Farm applications INTEGER(IntKi) :: Converged ! flag indicating whether the dynamic relaxation has converged INTEGER(IntKi) :: N ! convenience integer for readability: number of segments in the line - REAL(ReKi) :: Pos(3) ! array for setting absolute fairlead positions in mesh - REAL(DbKi) :: TransMat(3,3) ! rotation matrix for setting fairlead positions correctly if there is initial platform rotation - REAL(DbKi), ALLOCATABLE :: FairTensIC(:,:)! array of size Nfairs, 3 to store three latest fairlead tensions of each line + REAL(ReKi) :: rPos(3) ! array for setting fairlead reference positions in mesh + REAL(ReKi) :: OrMat(3,3) ! rotation matrix for setting fairlead positions correctly if there is initial platform rotation + REAL(ReKi) :: OrMat2(3,3) + REAL(R8Ki) :: OrMatRef(3,3) + REAL(DbKi), ALLOCATABLE :: FairTensIC(:,:)! array of size nCpldCons, 3 to store three latest fairlead tensions of each line CHARACTER(20) :: TempString ! temporary string for incidental use INTEGER(IntKi) :: ErrStat2 ! Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None - TYPE(MD_InputType) :: uArray(1) ! a size-one array for u to make call to TimeStep happy - REAL(DbKi) :: utimes(1) ! a size-one array saying time is 0 to make call to TimeStep happy + REAL(DbKi) :: dtM ! actual mooring dynamics time step + INTEGER(IntKi) :: NdtM ! number of time steps to integrate through with RK2 + INTEGER(IntKi) :: ntWave ! number of time steps of wave data + + TYPE(MD_InputType) :: u_array(1) ! a size-one array for u to make call to TimeStep happy + REAL(DbKi) :: t_array(1) ! a size-one array saying time is 0 to make call to TimeStep happy + TYPE(MD_InputType) :: u_interp ! interpolated instantaneous input values to be calculated for each mooring time step + + CHARACTER(MaxWrScrLen) :: Message + + ! Local variables for reading file input (Previously in MDIO_ReadInput) + INTEGER(IntKi) :: UnEc ! The local unit number for this module's echo file + INTEGER(IntKi) :: UnOut ! for outputing wave kinematics data + CHARACTER(200) :: Frmt ! a string to hold a format statement + + CHARACTER(1024) :: EchoFile ! Name of MoorDyn echo file + CHARACTER(1024) :: Line ! String to temporarially hold value of read line + CHARACTER(20) :: LineOutString ! String to temporarially hold characters specifying line output options + CHARACTER(20) :: OptString ! String to temporarially hold name of option variable + CHARACTER(40) :: OptValue ! String to temporarially hold value of options variable input + CHARACTER(40) :: DepthValue ! Temporarily stores the optional WtrDpth setting for MD, which could be a number or a filename + CHARACTER(40) :: WaterKinValue ! Temporarily stores the optional WaterKin setting for MD, which is typically a filename + INTEGER(IntKi) :: nOpts ! number of options lines in input file + CHARACTER(40) :: TempString1 ! + CHARACTER(40) :: TempString2 ! + CHARACTER(40) :: TempString3 ! + CHARACTER(40) :: TempString4 ! + CHARACTER(40) :: TempString5 ! + CHARACTER(40) :: TempStrings(6) ! Array of 6 strings used when parsing comma-separated items + CHARACTER(1024) :: FileName ! + + REAL(DbKi) :: depth ! local water depth interpolated from bathymetry grid [m] + Real(DbKi) :: nvec(3) ! local seabed surface normal vector (positive out) + + + CHARACTER(25) :: let1 ! strings used for splitting and parsing identifiers + CHARACTER(25) :: num1 + CHARACTER(25) :: let2 + CHARACTER(25) :: num2 + CHARACTER(25) :: let3 + + REAL(DbKi) :: tempArray(6) + REAL(ReKi) :: rRef(6) ! used to pass positions to mesh (real type precision) + REAL(DbKi) :: rRefDub(3) + + INTEGER(IntKi) :: TempIDnums(100) ! array to hold IdNums of controlled lines for each CtrlChan + + ! for reading output channels + CHARACTER(ChanLen),ALLOCATABLE :: OutList(:) ! array of output channel request (moved here from InitInput) + INTEGER :: MaxAryLen = 1000 ! Maximum length of the array being read + INTEGER :: NumWords ! Number of words contained on a line + INTEGER :: Nx + INTEGER :: QuoteCh ! Character position. + CHARACTER(*), PARAMETER :: RoutineName = 'MD_Init' + ErrStat = ErrID_None ErrMsg = "" + m%zeros6 = 0.0_DbKi ! Initialize the NWTC Subroutine Library CALL NWTC_Init( ) @@ -87,422 +163,2082 @@ SUBROUTINE MD_Init(InitInp, u, p, x, xd, z, other, y, m, DTcoupling, InitOut, Er CALL DispNVD( MD_ProgDesc ) InitOut%Ver = MD_ProgDesc + CALL WrScr(' This is an alpha version of MoorDyn-F v2, with significant input file changes from v1.') + CALL WrScr(' Copyright: (C) 2021 National Renewable Energy Laboratory, (C) 2019 Matt Hall') + !--------------------------------------------------------------------------------------------- ! Get all the inputs taken care of !--------------------------------------------------------------------------------------------- - - ! set environmental parameters from input data and error check - ! (should remove these values as options from MoorDyn input file for consistency?) - - p%g = InitInp%g - p%WtrDpth = InitInp%WtrDepth - p%rhoW = InitInp%rhoW - p%RootName = TRIM(InitInp%RootName)//'.MD' ! all files written from this module will have this root name + ! set default values for the simulation settings + ! these defaults are based on the glue code + p%dtM0 = DTcoupling ! default to the coupling interval (but will likely need to be smaller) + p%Tmax = InitInp%Tmax + p%g = InitInp%g + p%rhoW = InitInp%rhoW + ! TODO: add MSL2SWL from OpenFAST <<<< + ! set the following to some defaults + p%kBot = 3.0E6 + p%cBot = 3.0E5 + InputFileDat%dtIC = 2.0_DbKi + InputFileDat%TMaxIC = 60.0_DbKi + InputFileDat%CdScaleIC = 4.0_ReKi + InputFileDat%threshIC = 0.01_ReKi + p%WaveKin = 0_IntKi + p%Current = 0_IntKi + p%dtOut = 0.0_DbKi + p%mu_kT = 0.0_DbKi + p%mu_kA = 0.0_DbKi + p%mc = 1.0_DbKi + p%cv = 200.0_DbKi + DepthValue = "" ! Start off as empty string, to only be filled if MD setting is specified (otherwise InitInp%WtrDepth is used) + ! DepthValue and InitInp%WtrDepth are processed later by setupBathymetry. + WaterKinValue = "" + + m%PtfmInit = InitInp%PtfmInit(:,1) ! is this copying necssary in case this is an individual instance in FAST.Farm? - ! call function that reads input file and creates cross-referenced Connect and Line objects - CALL MDIO_ReadInput(InitInp, p, m, ErrStat2, ErrMsg2) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - - ! process the OutList array and set up the index arrays for the requested output quantities - CALL MDIO_ProcessOutList(InitInp%OutList, p, m, y, InitOut, ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - !------------------------------------------------------------------------------------------------- - ! Connect mooring system together and make necessary allocations - !------------------------------------------------------------------------------------------------- + ! Check if this MoorDyn instance is being run from FAST.Farm (indicated by FarmSize > 0) + if (InitInp%FarmSize > 0) then + CALL WrScr(' >>> MoorDyn is running in array mode <<< ') + ! could make sure the size of this is right: SIZE(InitInp%FarmCoupledKinematics) + p%nTurbines = InitInp%FarmSize + else ! FarmSize==0 indicates normal, FAST module mode + p%nTurbines = 1 ! if a regular FAST module mode, we treat it like a nTurbine=1 farm case + END IF - CALL WrNR( ' Creating mooring system. ' ) + ! allocate some parameter arrays that are for each turbine (size 1 if regular OpenFAST use) + allocate( p%nCpldBodies( p%nTurbines)) + allocate( p%nCpldRods ( p%nTurbines)) + allocate( p%nCpldCons ( p%nTurbines)) + allocate( p%TurbineRefPos(3, p%nTurbines)) + + ! initialize the arrays (to zero, except for passed in farm turbine reference positions) + p%nCpldBodies = 0 + p%nCpldRods = 0 + p%nCpldCons = 0 + + if (InitInp%FarmSize > 0) then + p%TurbineRefPos = InitInp%TurbineRefPos ! copy over turbine reference positions for later use + else + p%TurbineRefPos = 0.0_DbKi ! for now assuming this is zero for FAST use + end if - p%NFairs = 0 ! this is the number of "vessel" type Connections. being consistent with MAP terminology - p%NConns = 0 ! this is the number of "connect" type Connections. not to be confused with NConnects, the number of Connections - p%NAnchs = 0 ! this is the number of "fixed" type Connections. + + !--------------------------------------------------------------------------------------------- + ! read input file and create cross-referenced mooring system objects + !--------------------------------------------------------------------------------------------- + + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" - ! cycle through Connects and identify Connect types - DO I = 1, p%NConnects - - TempString = m%ConnectList(I)%type - CALL Conv2UC(TempString) - if (TempString == 'FIXED') then - m%ConnectList(I)%TypeNum = 0 - p%NAnchs = p%NAnchs + 1 - else if (TempString == 'VESSEL') then - m%ConnectList(I)%TypeNum = 1 - p%NFairs = p%NFairs + 1 ! if a vessel connection, increment fairlead counter - else if (TempString == 'CONNECT') then - m%ConnectList(I)%TypeNum = 2 - p%NConns = p%NConns + 1 - else - CALL CheckError( ErrID_Fatal, 'Error in provided Connect type. Must be fixed, vessel, or connect.' ) - RETURN - END IF - END DO - CALL WrScr(trim(Num2LStr(p%NFairs))//' fairleads, '//trim(Num2LStr(p%NAnchs))//' anchors, '//trim(Num2LStr(p%NConns))//' connects.') + CALL WrScr( ' Parsing MoorDyn input file: '//trim(InitInp%FileName) ) - ! allocate fairleads list - ALLOCATE ( m%FairIdList(p%NFairs), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - CALL CheckError( ErrID_Fatal, 'Error allocating space for FairIdList array.') - RETURN - END IF + ! ----------------------------------------------------------------- + ! Read the primary MoorDyn input file, or copy from passed input + if (InitInp%UsePrimaryInputFile) then + ! Read the entire input file, minus any comment lines, into the FileInfo_In + ! data structure in memory for further processing. + call ProcessComFile( InitInp%FileName, FileInfo_In, ErrStat2, ErrMsg2 ) + CALL GetPath( InitInp%FileName, p%PriPath ) ! Input files will be relative to the path where the primary input file is located. + else + call NWTC_Library_CopyFileInfoType( InitInp%PassedPrimaryInputData, FileInfo_In, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + p%PriPath = "" + endif + if (Failed()) return; - ! allocate connect list - ALLOCATE ( m%ConnIdList(p%NConns), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - CALL CheckError( ErrID_Fatal, 'Error allocating space for ConnIdList array.') - RETURN - END IF + ! For diagnostic purposes, the following can be used to display the contents + ! of the FileInfo_In data structure. + !call Print_FileInfo_Struct( CU, FileInfo_In ) ! CU is the screen -- different number on different systems. + ! Parse the FileInfo_In structure of data from the inputfile into the InitInp%InputFile structure +! CALL ParsePrimaryFileInfo_BuildModel( PriPath, InitInp, FileInfo_In, InputFileDat, p, m, UnEc, ErrStat2, ErrMsg2 ) +! if (Failed()) return; - ! now go back through and record the fairlead Id numbers (this is all the "connecting" that's required) - J = 1 ! counter for fairlead number - K = 1 ! counter for connect number - DO I = 1,p%NConnects - IF (m%ConnectList(I)%TypeNum == 1) THEN - m%FairIdList(J) = I ! if a vessel connection, add ID to list - J = J + 1 - ELSE IF (m%ConnectList(I)%TypeNum == 2) THEN - m%ConnIdList(K) = I ! if a connect connection, add ID to list - K = K + 1 - END IF - END DO - ! go through lines and allocate variables - DO I = 1, p%NLines - CALL SetupLine( m%LineList(I), m%LineTypeList(m%LineList(I)%PropsIdNum), p%rhoW , ErrStat2, ErrMsg2) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - END DO +!NOTE: This could be split into a separate routine for easier to read code + !------------------------------------------------------------------------------------------------- + ! Parsing of input file from the FileInfo_In data structure + ! - FileInfo_Type is essentially a string array with some metadata. + !------------------------------------------------------------------------------------------------- - !------------------------------------------------------------------------------------ - ! prepare state vector - !------------------------------------------------------------------------------------ + UnEc = -1 + nOpts = 0 ! Setting here rather than implied save - ! allocate list of starting state vector indices for each line - does this belong elsewhere? - ALLOCATE ( m%LineStateIndList(p%NLines), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - CALL CheckError(ErrID_Fatal, ' Error allocating LineStateIndList array.') - RETURN - END IF + ! ----------------- go through file contents a first time, counting each entry ----------------------- - ! figure out required size of state vector and how it will be apportioned to Connect and Lines (J is keeping track of the growing size of the state vector) - J = p%NConns*6 ! start index of first line's states (added six state variables for each "connect"-type connection) + i = 0 ! set line number counter to before first line + Line = NextLine(i); ! Get the line and increment counter. See description of routine. + + do while ( i <= FileInfo_In%NumLines ) - DO I = 1, p%NLines - m%LineStateIndList(I) = J+1 ! assign start index of each line - J = J + 6*(m%LineList(I)%N - 1) !add 6 state variables for each internal node - END DO + if (INDEX(Line, "---") > 0) then ! look for a header line + if ( ( INDEX(Line, "LINE DICTIONARY") > 0) .or. ( INDEX(Line, "LINE TYPES") > 0) ) then ! if line dictionary header - ! allocate state vector for RK2 based on size just calculated - ALLOCATE ( x%states(J), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating state vector.' - !CALL CleanUp() - RETURN - END IF + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! find how many elements of this type there are + Line = NextLine(i) + DO while (INDEX(Line, "---") == 0) ! while we DON'T find another header line + p%nLineTypes = p%nLineTypes + 1 + Line = NextLine(i) + END DO + else if ( (INDEX(Line, "ROD DICTIONARY") > 0) .or. ( INDEX(Line, "ROD TYPES") > 0) ) then ! if rod dictionary header - ! get header information for the FAST output file <<< what does this mean? + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! find how many elements of this type there are + Line = NextLine(i) + DO while (INDEX(Line, "---") == 0) ! while we DON'T find another header line + p%nRodTypes = p%nRodTypes + 1 + Line = NextLine(i) + END DO + else if ((INDEX(Line, "BODIES") > 0 ) .or. (INDEX(Line, "BODY LIST") > 0 ) .or. (INDEX(Line, "BODY PROPERTIES") > 0 )) then - !-------------------------------------------------------------------------- - ! create i/o meshes for fairlead positions and forces - !-------------------------------------------------------------------------- + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! find how many elements of this type there are + Line = NextLine(i) + DO while (INDEX(Line, "---") == 0) ! while we DON'T find another header line + p%nBodies = p%nBodies + 1 + Line = NextLine(i) + END DO - ! create input mesh for fairlead kinematics - CALL MeshCreate(BlankMesh=u%PtFairleadDisplacement , & - IOS= COMPONENT_INPUT , & - Nnodes=p%NFairs , & - TranslationDisp=.TRUE. , & - TranslationVel=.TRUE. , & - ErrStat=ErrStat2 , & - ErrMess=ErrMsg2) + else if ((INDEX(Line, "RODS") > 0 ) .or. (INDEX(Line, "ROD LIST") > 0) .or. (INDEX(Line, "ROD PROPERTIES") > 0)) then ! if rod properties header - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! find how many elements of this type there are + Line = NextLine(i) + DO while (INDEX(Line, "---") == 0) ! while we DON'T find another header line + p%nRods = p%nRods + 1 + Line = NextLine(i) + END DO + else if ((INDEX(Line, "POINTS") > 0 ) .or. (INDEX(Line, "CONNECTION PROPERTIES") > 0) .or. (INDEX(Line, "NODE PROPERTIES") > 0) .or. (INDEX(Line, "POINT PROPERTIES") > 0) .or. (INDEX(Line, "POINT LIST") > 0) ) then ! if node properties header - ! --------------------------- set up initial condition of each fairlead ------------------------------- - DO i = 1,p%NFairs + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! find how many elements of this type there are + Line = NextLine(i) + DO while (INDEX(Line, "---") == 0) ! while we DON'T find another header line + p%nConnects = p%nConnects + 1 + Line = NextLine(i) + END DO - Pos(1) = m%ConnectList(m%FairIdList(i))%conX ! set relative position of each fairlead i (I'm pretty sure this is just relative to ptfm origin) - Pos(2) = m%ConnectList(m%FairIdList(i))%conY - Pos(3) = m%ConnectList(m%FairIdList(i))%conZ + else if ((INDEX(Line, "LINES") > 0 ) .or. (INDEX(Line, "LINE PROPERTIES") > 0) .or. (INDEX(Line, "LINE LIST") > 0) ) then ! if line properties header - CALL MeshPositionNode(u%PtFairleadDisplacement,i,Pos,ErrStat2,ErrMsg2)! "assign the coordinates of each node in the global coordinate space" + ! skip following two lines (label line and unit line) + i=i+2 + + ! find how many elements of this type there are + Line = NextLine(i) + DO while (INDEX(Line, "---") == 0) ! while we DON'T find another header line + p%nLines = p%nLines + 1 + Line = NextLine(i) + END DO - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN + else if (INDEX(Line, "CONTROL") > 0) then ! if failure conditions header + IF (wordy > 1) print *, " Reading control channels: "; + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! find how many elements of this type there are + Line = NextLine(i) + DO while (INDEX(Line, "---") == 0) ! while we DON'T find another header line + p%nCtrlChans = p%nCtrlChans + 1 + Line = NextLine(i) + END DO + + else if (INDEX(Line, "FAILURE") > 0) then ! if failure conditions header - ! set offset position of each node to according to initial platform position - CALL SmllRotTrans('initial fairlead positions due to platform rotation', InitInp%PtfmInit(4),InitInp%PtfmInit(5),InitInp%PtfmInit(6), TransMat, '', ErrStat2, ErrMsg2) ! account for possible platform rotation + IF (wordy > 1) print *, " Reading failure conditions: "; + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! find how many elements of this type there are + Line = NextLine(i) + DO while (INDEX(Line, "---") == 0) ! while we DON'T find another header line + p%nFails = p%nFails + 1 + Line = NextLine(i) + END DO + + + else if (INDEX(Line, "OPTIONS") > 0) then ! if options header - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN + IF (wordy > 0) print *, "Reading Options" + + ! don't skip any lines (no column headers for the options section) + ! process each line in this section + Line = NextLine(i) + DO while (INDEX(Line, "---") == 0) ! while we DON'T find another header line + + ! parse out entries: value, option keyword + READ(Line,*,IOSTAT=ErrStat2) OptValue, OptString ! look at first two entries, ignore remaining words in line, which should be comments + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Failed to read options.', ErrStat, ErrMsg, RoutineName ) ! would be nice to specify which line had the error + CALL CleanUp() + RETURN + END IF + + CALL Conv2UC(OptString) + + ! check all possible options types and see if OptString is one of them, in which case set the variable. + if ( OptString == 'WRITELOG') THEN + read (OptValue,*) p%writeLog + if (p%writeLog > 0) then ! if not zero, open a log file for output + CALL GetNewUnit( p%UnLog ) + CALL OpenFOutFile ( p%UnLog, TRIM(p%RootName)//'.log', ErrStat, ErrMsg ) + IF ( ErrStat > AbortErrLev ) THEN + ErrMsg = ' Failed to open MoorDyn log file: '//TRIM(ErrMsg) + RETURN + END IF + write(p%UnLog,'(A)', IOSTAT=ErrStat2) "MoorDyn v2 log file with output level "//TRIM(Num2LStr(p%writeLog)) + write(p%UnLog,'(A)', IOSTAT=ErrStat2) "Note: options above the writeLog line in the input file will not be recorded." + end if + else if ( OptString == 'DTM') THEN + read (OptValue,*) p%dtM0 + else if ( OptString == 'G') then + read (OptValue,*) p%g + else if (( OptString == 'RHOW') .or. ( OptString == 'RHO')) then + read (OptValue,*) p%rhoW + else if (( OptString == 'WTRDPTH') .or. ( OptString == 'DEPTH') .or. ( OptString == 'WATERDEPTH')) then + read (OptValue,*) DepthValue ! water depth input read in as a string to be processed by setupBathymetry + else if (( OptString == 'KBOT') .or. ( OptString == 'KB')) then + read (OptValue,*) p%kBot + else if (( OptString == 'CBOT') .or. ( OptString == 'CB')) then + read (OptValue,*) p%cBot + else if ( OptString == 'DTIC') then + read (OptValue,*) InputFileDat%dtIC + else if ( OptString == 'TMAXIC') then + read (OptValue,*) InputFileDat%TMaxIC + else if ( OptString == 'CDSCALEIC') then + read (OptValue,*) InputFileDat%CdScaleIC + else if ( OptString == 'THRESHIC') then + read (OptValue,*) InputFileDat%threshIC + else if ( OptString == 'WATERKIN') then + read (OptValue,*) WaterKinValue + else if ( OptString == 'DTOUT') then + read (OptValue,*) p%dtOut + else if ( OptString == 'MU_KT') then + read (OptValue,*) p%mu_kT + else if ( OptString == 'MU_KA') then + read (OptValue,*) p%mu_kA + else if ( OptString == 'MC') then + read (OptValue,*) p%mc + else if ( OptString == 'CV') then + read (OptValue,*) p%cv + else + CALL SetErrStat( ErrID_Warn, 'Unable to interpret input '//trim(OptString)//' in OPTIONS section.', ErrStat, ErrMsg, RoutineName ) + end if + + nOpts = nOpts + 1 + Line = NextLine(i) + END DO + - ! Apply initial platform rotations and translations (fixed Jun 19, 2015) - u%PtFairleadDisplacement%TranslationDisp(1,i) = InitInp%PtfmInit(1) + Transmat(1,1)*Pos(1) + Transmat(2,1)*Pos(2) + TransMat(3,1)*Pos(3) - Pos(1) - u%PtFairleadDisplacement%TranslationDisp(2,i) = InitInp%PtfmInit(2) + Transmat(1,2)*Pos(1) + Transmat(2,2)*Pos(2) + TransMat(3,2)*Pos(3) - Pos(2) - u%PtFairleadDisplacement%TranslationDisp(3,i) = InitInp%PtfmInit(3) + Transmat(1,3)*Pos(1) + Transmat(2,3)*Pos(2) + TransMat(3,3)*Pos(3) - Pos(3) + else if (INDEX(Line, "OUTPUT") > 0) then ! if output header - ! set velocity of each node to zero - u%PtFairleadDisplacement%TranslationVel(1,i) = 0.0_DbKi - u%PtFairleadDisplacement%TranslationVel(2,i) = 0.0_DbKi - u%PtFairleadDisplacement%TranslationVel(3,i) = 0.0_DbKi - - !print *, 'Fairlead ', i, ' z TranslationDisp at start is ', u%PtFairleadDisplacement%TranslationDisp(3,i) - !print *, 'Fairlead ', i, ' z Position at start is ', u%PtFairleadDisplacement%Position(3,i) + ! we don't need to count this section... + Line = NextLine(i) - ! set each node as a point element - CALL MeshConstructElement(u%PtFairleadDisplacement, ELEMENT_POINT, ErrStat2, ErrMsg2, i) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN + else ! otherwise ignore this line that isn't a recognized header line and read the next line + Line = NextLine(i) + end if - END DO ! I + else ! otherwise ignore this line, which doesn't have the "---" or header line and read the next line + Line = NextLine(i) + end if + + end do + p%nConnectsExtra = p%nConnects + 2*p%nLines ! set maximum number of connections, accounting for possible detachment of each line end and a connection for that - CALL MeshCommit ( u%PtFairleadDisplacement, ErrStat, ErrMsg ) + IF (wordy > 0) print *, " Identified ", p%nLineTypes , "LineTypes in input file." + IF (wordy > 0) print *, " Identified ", p%nRodTypes , "RodTypes in input file." + IF (wordy > 0) print *, " Identified ", p%nBodies , "Bodies in input file." + IF (wordy > 0) print *, " Identified ", p%nRods , "Rods in input file." + IF (wordy > 0) print *, " Identified ", p%nConnects , "Connections in input file." + IF (wordy > 0) print *, " Identified ", p%nLines , "Lines in input file." + IF (wordy > 0) print *, " Identified ", nOpts , "Options in input file." - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN + ! set up seabed bathymetry + CALL setupBathymetry(DepthValue, InitInp%WtrDepth, m%BathymetryGrid, m%BathGrid_Xs, m%BathGrid_Ys, ErrStat2, ErrMsg2) + CALL getDepthFromBathymetry(m%BathymetryGrid, m%BathGrid_Xs, m%BathGrid_Ys, 0.0_DbKi, 0.0_DbKi, p%WtrDpth, nvec) ! set depth at 0,0 as nominal for waves etc + + + ! set up wave and current kinematics + CALL setupWaterKin(WaterKinValue, p, InitInp%Tmax, ErrStat2, ErrMsg2); if(Failed()) return - ! copy the input fairlead kinematics mesh to make the output mesh for fairlead loads, PtFairleadLoad - CALL MeshCopy ( SrcMesh = u%PtFairleadDisplacement, DestMesh = y%PtFairleadLoad, & - CtrlCode = MESH_SIBLING, IOS = COMPONENT_OUTPUT, & - Force = .TRUE., ErrStat = ErrStat2, ErrMess=ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN + ! ----------------------------- misc checks to be sorted ----------------------------- - ! -------------------------------------------------------------------- - ! go through all Connects and set position based on input file - ! -------------------------------------------------------------------- - ! first do it for all connections (connect and anchor types will be saved) - DO I = 1, p%NConnects - m%ConnectList(I)%r(1) = m%ConnectList(I)%conX - m%ConnectList(I)%r(2) = m%ConnectList(I)%conY - m%ConnectList(I)%r(3) = m%ConnectList(I)%conZ - m%ConnectList(I)%rd(1) = 0.0_DbKi - m%ConnectList(I)%rd(2) = 0.0_DbKi - m%ConnectList(I)%rd(3) = 0.0_DbKi - END DO + ! make sure nLineTypes isn't zero + IF ( p%nLineTypes < 1 ) THEN + CALL SetErrStat( ErrID_Fatal, 'nLineTypes parameter must be greater than zero.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + ! make sure NLines is at least one + IF ( p%NLines < 1 ) THEN + CALL SetErrStat( ErrID_Fatal, 'NLines parameter must be at least 1.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF - ! then do it for fairlead types - DO I = 1,p%NFairs - DO J = 1, 3 - m%ConnectList(m%FairIdList(I))%r(J) = u%PtFairleadDisplacement%Position(J,I) + u%PtFairleadDisplacement%TranslationDisp(J,I) - m%ConnectList(m%FairIdList(I))%rd(J) = 0.0_DbKi - END DO - END DO - ! for connect types, write the coordinates to the state vector - DO I = 1,p%NConns - x%states(6*I-2:6*I) = m%ConnectList(m%ConnIdList(I))%r ! double check order of r vs rd - x%states(6*I-5:6*I-3) = m%ConnectList(m%ConnIdList(I))%rd - END DO + + - ! -------------------------------------------------------------------- - ! open output file(s) and write header lines - CALL MDIO_OpenOutput( InitInp%FileName, p, m, InitOut, ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - ! -------------------------------------------------------------------- + ! ----------------------------- allocate necessary arrays ---------------------------- + ! Allocate object arrays - ! -------------------------------------------------------------------- - ! size active tensioning inputs arrays based on highest channel number read from input file for now <<<<<<< - ! -------------------------------------------------------------------- + ALLOCATE(m%LineTypeList(p%nLineTypes), STAT = ErrStat2 ); if(AllocateFailed("LineTypeList")) return + ALLOCATE(m%RodTypeList( p%nRodTypes ), STAT = ErrStat2 ); if(AllocateFailed("LineTypeList")) return + + ALLOCATE(m%BodyList( p%nBodies ), STAT = ErrStat2 ); if(AllocateFailed("BodyList" )) return + ALLOCATE(m%RodList( p%nRods ), STAT = ErrStat2 ); if(AllocateFailed("RodList" )) return + ALLOCATE(m%ConnectList( p%nConnects ), STAT = ErrStat2 ); if(AllocateFailed("ConnectList" )) return + ALLOCATE(m%LineList( p%nLines ), STAT = ErrStat2 ); if(AllocateFailed("LineList" )) return - ! find the highest channel number - N = 0 - DO I = 1, p%NLines - IF ( m%LineList(I)%CtrlChan > N ) then - N = m%LineList(I)%CtrlChan - END IF - END DO + ALLOCATE(m%FailList( p%nFails ), STAT = ErrStat2 ); if(AllocateFailed("FailList" )) return + - ! allocate the input arrays (if any requested) - if (N > 0) then - call AllocAry( u%DeltaL, N, 'u%DeltaL', ErrStat2, ErrMsg2 ) - call CheckError( ErrStat2, ErrMsg2 ) - if (ErrStat >= AbortErrLev) return - u%DeltaL = 0.0_ReKi - call AllocAry( u%DeltaLdot, N, 'u%DeltaLdot', ErrStat2, ErrMsg2 ) - call CheckError( ErrStat2, ErrMsg2 ) - if (ErrStat >= AbortErrLev) return - u%DeltaLdot = 0.0_ReKi - call AllocAry( InitOut%CableCChanRqst, N, 'CableCChanRqst', ErrStat2, ErrMsg2 ) - call CheckError( ErrStat2, ErrMsg2 ) - if (ErrStat >= AbortErrLev) return - InitOut%CableCChanRqst = .FALSE. ! Initialize to false - do J=1,p%NLines - if (m%LineList(J)%CtrlChan > 0) InitOut%CableCChanRqst(m%LineList(J)%CtrlChan) = .TRUE. - enddo - endif + ! Allocate associated index arrays (note: some are allocated larger than will be used, for simplicity) + ALLOCATE(m%BodyStateIs1(p%nBodies ), m%BodyStateIsN(p%nBodies ), STAT=ErrStat2); if(AllocateFailed("BodyStateIs1/N")) return + ALLOCATE(m%RodStateIs1(p%nRods ), m%RodStateIsN(p%nRods ), STAT=ErrStat2); if(AllocateFailed("RodStateIs1/N" )) return + ALLOCATE(m%ConStateIs1(p%nConnects), m%ConStateIsN(p%nConnects), STAT=ErrStat2); if(AllocateFailed("ConStateIs1/N" )) return + ALLOCATE(m%LineStateIs1(p%nLines) , m%LineStateIsN(p%nLines) , STAT=ErrStat2); if(AllocateFailed("LineStateIs1/N")) return + ALLOCATE(m%FreeBodyIs( p%nBodies ), STAT=ErrStat2); if(AllocateFailed("FreeBodyIs")) return + ALLOCATE(m%FreeRodIs( p%nRods ), STAT=ErrStat2); if(AllocateFailed("FreeRodIs")) return + ALLOCATE(m%FreeConIs( p%nConnects), STAT=ErrStat2); if(AllocateFailed("FreeConnectIs")) return - ! -------------------------------------------------------------------- - ! go through lines and initialize internal node positions using Catenary() - ! -------------------------------------------------------------------- - DO I = 1, p%NLines - - N = m%LineList(I)%N ! for convenience - - !TODO: apply any initial adjustment of line length from active tensioning <<<<<<<<<<<< - ! >>> maybe this should be skipped <<<< - - ! set end node positions and velocities from connect objects - m%LineList(I)%r(:,N) = m%ConnectList(m%LineList(I)%FairConnect)%r - m%LineList(I)%r(:,0) = m%ConnectList(m%LineList(I)%AnchConnect)%r - m%LineList(I)%rd(:,N) = (/ 0.0, 0.0, 0.0 /) ! set anchor end velocities to zero - m%LineList(I)%rd(:,0) = (/ 0.0, 0.0, 0.0 /) ! set fairlead end velocities to zero + ALLOCATE(m%CpldBodyIs(p%nBodies , p%nTurbines), STAT=ErrStat2); if(AllocateFailed("CpldBodyIs")) return + ALLOCATE(m%CpldRodIs( p%nRods , p%nTurbines), STAT=ErrStat2); if(AllocateFailed("CpldRodIs")) return + ALLOCATE(m%CpldConIs(p%nConnects, p%nTurbines), STAT=ErrStat2); if(AllocateFailed("CpldConnectIs")) return - ! set initial line internal node positions using quasi-static model or straight-line interpolation from anchor to fairlead - CALL InitializeLine( m%LineList(I), m%LineTypeList(m%LineList(I)%PropsIdNum), p%rhoW , ErrStat2, ErrMsg2) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - IF (ErrStat >= ErrId_Warn) CALL WrScr(" Catenary solver failed for one or more lines. Using linear node spacing.") ! make this statement more accurate - ! assign the resulting internal node positions to the integrator initial state vector! (velocities leave at 0) - DO J = 1, N-1 - DO K = 1, 3 - x%states(m%LineStateIndList(I) + 3*N-3 + 3*J-3 + K-1 ) = m%LineList(I)%r(K,J) ! assign position - x%states(m%LineStateIndList(I) + 3*J-3 + K-1 ) = 0.0_DbKi ! assign velocities (of zero) - END DO - END DO + ! ---------------------- now go through again and process file contents -------------------- - END DO !I = 1, p%NLines + call Body_Setup( m%GroundBody, m%zeros6, p, ErrStat2, ErrMsg2) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + ! note: no longer worrying about "Echo" option + + Nx = 0 ! set state counter to zero + i = 0 ! set line number counter to before first line + Line = NextLine(i) + + do while ( i <= FileInfo_In%NumLines ) + + if (INDEX(Line, "---") > 0) then ! look for a header line + + CALL Conv2UC(Line) ! allow lowercase section header names as well -! ! try writing output for troubleshooting purposes (TEMPORARY) -! CALL MDIO_WriteOutputs(-1.0_DbKi, p, m, y, ErrStat, ErrMsg) -! IF ( ErrStat >= AbortErrLev ) THEN -! ErrMsg = ' Error in MDIO_WriteOutputs: '//TRIM(ErrMsg) -! RETURN -! END IF + !------------------------------------------------------------------------------------------- + if ( ( INDEX(Line, "LINE DICTIONARY") > 0) .or. ( INDEX(Line, "LINE TYPES") > 0) ) then ! if line dictionary header + + IF (wordy > 0) print *, "Reading line types" + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! process each line + DO l = 1,p%nLineTypes + + !read into a line + Line = NextLine(i) + + ! check for correct number of columns in current line + IF ( CountWords( Line ) /= 10 ) THEN + CALL SetErrStat( ErrID_Fatal, ' Unable to parse Line type '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file. Row has wrong number of columns. Must be 10 columns.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + ! parse out entries: Name Diam MassDenInAir EA cIntDamp EI Cd Ca CdAx CaAx + READ(Line,*,IOSTAT=ErrStat2) m%LineTypeList(l)%name, m%LineTypeList(l)%d, & + m%LineTypeList(l)%w, tempString1, tempString2, tempString3, & + m%LineTypeList(l)%Cdn, m%LineTypeList(l)%Can, m%LineTypeList(l)%Cdt, m%LineTypeList(l)%Cat + + IF ( ErrStat2 /= ErrID_None ) THEN + CALL SetErrStat( ErrID_Fatal, 'Failed to process line type inputs of entry '//trim(Num2LStr(l))//'. Check formatting and correct number of columns.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + !TODO: add check if %name is maximum length, which might indicate the full name was too long <<< + + ! process stiffness coefficients + CALL SplitByBars(tempString1, N, tempStrings) + if (N > 2) then + CALL SetErrStat( ErrID_Fatal, 'A line type EA entry can have at most 2 (comma-separated) values.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + else if (N==2) then ! visco-elastic case! + m%LineTypeList(l)%ElasticMod = 2 + read(tempStrings(2), *) m%LineTypeList(l)%EA_D + else + m%LineTypeList(l)%ElasticMod = 1 ! normal case + end if + ! get the regular/static coefficient or relation in all cases (can be from a lookup table) + CALL getCoefficientOrCurve(tempStrings(1), m%LineTypeList(l)%EA, & + m%LineTypeList(l)%nEApoints, & + m%LineTypeList(l)%stiffXs, & + m%LineTypeList(l)%stiffYs, ErrStat2, ErrMsg2) + + + ! process damping coefficients + CALL SplitByBars(tempString2, N, tempStrings) + if (N > m%LineTypeList(l)%ElasticMod) then + CALL SetErrStat( ErrID_Fatal, 'A line type BA entry cannot have more (comma-separated) values its EA entry.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + else if (N==2) then ! visco-elastic case when two BA values provided + read(tempStrings(2), *) m%LineTypeList(l)%BA_D + else if (m%LineTypeList(l)%ElasticMod == 2) then ! case where there is no dynamic damping for viscoelastic model (will it work)? + CALL WrScr("Warning, viscoelastic model being used with zero damping on the dynamic stiffness.") + end if + ! get the regular/static coefficient or relation in all cases (can be from a lookup table?) + CALL getCoefficientOrCurve(tempStrings(1), m%LineTypeList(l)%BA, & + m%LineTypeList(l)%nBApoints, & + m%LineTypeList(l)%dampXs, & + m%LineTypeList(l)%dampYs, ErrStat2, ErrMsg2) + + ! process bending stiffness coefficients (which might use lookup tables) + CALL getCoefficientOrCurve(tempString3, m%LineTypeList(l)%EI, & + m%LineTypeList(l)%nEIpoints, & + m%LineTypeList(l)%bstiffXs, & + m%LineTypeList(l)%bstiffYs, ErrStat2, ErrMsg2) + + ! specify IdNum of line type for error checking + m%LineTypeList(l)%IdNum = l + + ! write lineType information to log file + if (p%writeLog > 1) then + write(p%UnLog, '(A12,A20)' ) " LineType"//trim(num2lstr(l))//":" + write(p%UnLog, '(A12,A20)' ) " name: ", m%LineTypeList(l)%name + write(p%UnLog, '(A12,f12.4)') " d : ", m%LineTypeList(l)%d + write(p%UnLog, '(A12,f12.4)') " w : ", m%LineTypeList(l)%w + write(p%UnLog, '(A12,f12.4)') " Cdn : ", m%LineTypeList(l)%Cdn + write(p%UnLog, '(A12,f12.4)') " Can : ", m%LineTypeList(l)%Can + write(p%UnLog, '(A12,f12.4)') " Cdt : ", m%LineTypeList(l)%Cdt + write(p%UnLog, '(A12,f12.4)') " Cat : ", m%LineTypeList(l)%Cat + end if + + IF ( ErrStat2 /= ErrID_None ) THEN + CALL SetErrStat( ErrID_Fatal, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + END DO - ! -------------------------------------------------------------------- - ! do dynamic relaxation to get ICs - ! -------------------------------------------------------------------- - CALL WrScr(" Finalizing ICs using dynamic relaxation."//NewLine) ! newline because next line writes over itself + !------------------------------------------------------------------------------------------- + else if ( (INDEX(Line, "ROD DICTIONARY") > 0) .or. ( INDEX(Line, "ROD TYPES") > 0) ) then ! if rod dictionary header + + IF (wordy > 0) print *, "Reading rod types" + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! process each line + DO l = 1,p%nRodTypes + + !read into a line + Line = NextLine(i) + + ! check for correct number of columns in current line + IF ( CountWords( Line ) /= 7 ) THEN + CALL SetErrStat( ErrID_Fatal, ' Unable to parse Rod Type '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file. Row has wrong number of columns. Must be 7 columns.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + ! parse out entries: Name Diam MassDen Cd Ca CdEnd CaEnd + IF (ErrStat2 == 0) THEN + READ(Line,*,IOSTAT=ErrStat2) m%RodTypeList(l)%name, m%RodTypeList(l)%d, m%RodTypeList(l)%w, & + m%RodTypeList(l)%Cdn, m%RodTypeList(l)%Can, m%RodTypeList(l)%CdEnd, m%RodTypeList(l)%CaEnd + + m%RodTypeList(l)%Cdt = 0.0_DbKi ! not used + m%RodTypeList(l)%Cat = 0.0_DbKi ! not used + END IF + + ! specify IdNum of rod type for error checking + m%RodTypeList(l)%IdNum = l + + ! write lineType information to log file + if (p%writeLog > 1) then + write(p%UnLog, '(A12,A20)' ) " RodType"//trim(num2lstr(l))//":" + write(p%UnLog, '(A12,A20)' ) " name: ", m%RodTypeList(l)%name + write(p%UnLog, '(A12,f12.4)') " d : ", m%RodTypeList(l)%d + write(p%UnLog, '(A12,f12.4)') " w : ", m%RodTypeList(l)%w + write(p%UnLog, '(A12,f12.4)') " Cdn : ", m%RodTypeList(l)%Cdn + write(p%UnLog, '(A12,f12.4)') " Can : ", m%RodTypeList(l)%Can + write(p%UnLog, '(A12,f12.4)') " Cdt : ", m%RodTypeList(l)%CdEnd + write(p%UnLog, '(A12,f12.4)') " Cat : ", m%RodTypeList(l)%CaEnd + end if + + IF ( ErrStat2 /= ErrID_None ) THEN + CALL SetErrStat( ErrID_Fatal, 'Failed to process rod type properties for rod '//trim(Num2LStr(l))//'. Check formatting and correct number of columns.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + END DO + + + !------------------------------------------------------------------------------------------- + else if ((INDEX(Line, "BODIES") > 0 ) .or. (INDEX(Line, "BODY LIST") > 0 ) .or. (INDEX(Line, "BODY PROPERTIES") > 0 )) then + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! process each body + DO l = 1,p%nBodies + + !read into a line + Line = NextLine(i) + + ! check for correct number of columns in current line + IF ( CountWords( Line ) /= 14 ) THEN + CALL SetErrStat( ErrID_Fatal, ' Unable to parse Body '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file. Row has wrong number of columns. Must be 14 columns.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF - ! boost drag coefficient of each line type - DO I = 1, p%NTypes - m%LineTypeList(I)%Cdn = m%LineTypeList(I)%Cdn * InitInp%CdScaleIC - m%LineTypeList(I)%Cdt = m%LineTypeList(I)%Cdt * InitInp%CdScaleIC - END DO + ! parse out entries: ID Attachment X0 Y0 Z0 r0 p0 y0 M CG* I* V CdA* Ca* + IF (ErrStat2 == 0) THEN + READ(Line,*,IOSTAT=ErrStat2) m%BodyList(l)%IdNum, tempString1, & + tempArray(1), tempArray(2), tempArray(3), tempArray(4), tempArray(5), tempArray(6), & + m%BodyList(l)%bodyM, tempString2, tempString3, m%BodyList(l)%bodyV, tempString4, tempString5 + END IF + + ! process CG + CALL SplitByBars(tempString2, N, tempStrings) + if (N == 1) then ! if only one entry, it is the z coordinate + m%BodyList(l)%rCG(1) = 0.0_DbKi + m%BodyList(l)%rCG(2) = 0.0_DbKi + READ(tempString2, *) m%BodyList(l)%rCG(3) + else if (N==3) then ! all three coordinates provided + READ(tempStrings(1), *) m%BodyList(l)%rCG(1) + READ(tempStrings(2), *) m%BodyList(l)%rCG(2) + READ(tempStrings(3), *) m%BodyList(l)%rCG(3) + else + CALL SetErrStat( ErrID_Fatal, 'Body '//trim(Num2LStr(l))//' CG entry (col 10) must have 1 or 3 numbers.' , ErrStat, ErrMsg, RoutineName ) + end if + ! process mements of inertia + CALL SplitByBars(tempString3, N, tempStrings) + if (N == 1) then ! if only one entry, use it for all directions + READ(tempString3, *) m%BodyList(l)%BodyI(1) + m%BodyList(l)%BodyI(2) = m%BodyList(l)%BodyI(1) + m%BodyList(l)%BodyI(3) = m%BodyList(l)%BodyI(1) + else if (N==3) then ! all three directions provided separately + READ(tempStrings(1), *) m%BodyList(l)%BodyI(1) + READ(tempStrings(2), *) m%BodyList(l)%BodyI(2) + READ(tempStrings(3), *) m%BodyList(l)%BodyI(3) + else + CALL SetErrStat( ErrID_Fatal, 'Body '//trim(Num2LStr(l))//' inertia entry (col 11) must have 1 or 3 numbers.' , ErrStat, ErrMsg, RoutineName ) + end if + ! process drag ceofficient by area product + CALL SplitByBars(tempString4, N, tempStrings) + if (N == 1) then ! if only one entry, use it for all directions + READ(tempString4, *) m%BodyList(l)%BodyCdA(1) + m%BodyList(l)%BodyCdA(2) = m%BodyList(l)%BodyCdA(1) + m%BodyList(l)%BodyCdA(3) = m%BodyList(l)%BodyCdA(1) + else if (N==3) then ! all three coordinates provided + READ(tempStrings(1), *) m%BodyList(l)%BodyCdA(1) + READ(tempStrings(2), *) m%BodyList(l)%BodyCdA(2) + READ(tempStrings(3), *) m%BodyList(l)%BodyCdA(3) + else + CALL SetErrStat( ErrID_Fatal, 'Body '//trim(Num2LStr(l))//' CdA entry (col 13) must have 1 or 3 numbers.' , ErrStat, ErrMsg, RoutineName ) + end if + ! process added mass coefficient + CALL SplitByBars(tempString5, N, tempStrings) + if (N == 1) then ! if only one entry, use it for all directions + READ(tempString5, *) m%BodyList(l)%BodyCa(1) + m%BodyList(l)%BodyCa(2) = m%BodyList(l)%BodyCa(1) + m%BodyList(l)%BodyCa(3) = m%BodyList(l)%BodyCa(1) + else if (N==3) then ! all three coordinates provided + READ(tempStrings(1), *) m%BodyList(l)%BodyCa(1) + READ(tempStrings(2), *) m%BodyList(l)%BodyCa(2) + READ(tempStrings(3), *) m%BodyList(l)%BodyCa(3) + else + CALL SetErrStat( ErrID_Fatal, 'Body '//trim(Num2LStr(l))//' Ca entry (col 14) must have 1 or 3 numbers.' , ErrStat, ErrMsg, RoutineName ) + end if + + + IF ( ErrStat2 /= 0 ) THEN + CALL WrScr(' Unable to parse Body '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file.') ! Specific screen output because errors likely + CALL WrScr(' Ensure row has all 13 columns needed in MDv2 input file (13th Dec 2021).') + CALL SetErrStat( ErrID_Fatal, 'Failed to read bodies.' , ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + - ! allocate array holding three latest fairlead tensions - ALLOCATE ( FairTensIC(p%NFairs,3), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - CALL CheckError( ErrID_Fatal, ErrMsg2 ) - RETURN - END IF + !----------- process body type ----------------- - ! initialize fairlead tension memory at zero - DO J = 1,p%NFairs - DO I = 1, 3 - FairTensIC(J,I) = 0.0_DbKi - END DO - END DO + call DecomposeString(tempString1, let1, num1, let2, num2, let3) ! note: this call is overkill (it's just a string) but leaving it here for potential future expansions + + if ((let1 == "ANCHOR") .or. (let1 == "FIXED") .or. (let1 == "FIX")) then ! if a fixed body (this would just be used if someone wanted to temporarly fix a body that things were attached to) + + m%BodyList(l)%typeNum = 1 + + else if ((let1 == "COUPLED") .or. (let1 == "VESSEL") .or. (let1 == "CPLD") .or. (let1 == "VES")) then ! if a coupled body + + m%BodyList(l)%typeNum = -1 + p%nCpldBodies(1)=p%nCpldBodies(1)+1 ! add this body to coupled list + m%CpldBodyIs(p%nCpldBodies(1),1) = l - t = 0.0_DbKi ! start time at zero + ! body initial position due to coupling will be adjusted later + + ! TODO: add option for body coupling to different turbines in FAST.Farm <<< + + else if (let1 == "FREE") then ! if a free body + m%BodyList(l)%typeNum = 0 + + p%nFreeBodies=p%nFreeBodies+1 + + m%BodyStateIs1(p%nFreeBodies) = Nx+1 + m%BodyStateIsN(p%nFreeBodies) = Nx+12 + Nx = Nx + 12 ! add 12 state variables for free Body + + m%FreeBodyIs(p%nFreeBodies) = l + + m%BodyList(l)%r6 = tempArray ! set initial body position and orientation + + else + CALL SetErrStat( ErrID_Fatal, "Unidentified Body type string for Body "//trim(Num2LStr(l))//": "//trim(tempString1), ErrStat, ErrMsg, RoutineName ) + return + end if + + + ! check for sequential IdNums + IF ( m%BodyList(l)%IdNum .NE. l ) THEN + CALL SetErrStat( ErrID_Fatal, 'Body numbers must be sequential starting from 1.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + + ! set up body + CALL Body_Setup( m%BodyList(l), tempArray, p, ErrStat2, ErrMsg2) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Failed to read data for body '//trim(Num2LStr(l)), ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + IF (wordy > 1) print *, "Set up body ", l, " of type ", m%BodyList(l)%typeNum - ! because TimeStep wants an array... - call MD_CopyInput( u, uArray(1), MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + END DO + + + !------------------------------------------------------------------------------------------- + else if ((INDEX(Line, "RODS") > 0 ) .or. (INDEX(Line, "ROD LIST") > 0) .or. (INDEX(Line, "ROD PROPERTIES") > 0)) then ! if rod properties header + IF (wordy > 0) print *, "Reading Rods" + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! process each rod + DO l = 1,p%nRods + + !read into a line + Line = NextLine(i) + + ! check for correct number of columns in current line + IF ( CountWords( Line ) /= 11 ) THEN + CALL SetErrStat( ErrID_Fatal, ' Unable to parse Rod '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file. Row has wrong number of columns. Must be 11 columns.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + ! parse out entries: RodID RodType Attachment Xa Ya Za Xb Yb Zb NumSegs Flags/Outputs + IF (ErrStat2 == 0) THEN + READ(Line,*,IOSTAT=ErrStat2) m%RodList(l)%IdNum, tempString1, tempString2, & + tempArray(1), tempArray(2), tempArray(3), tempArray(4), tempArray(5), tempArray(6), & + m%RodList(l)%N, LineOutString + END IF - DO I = 1, ceiling(InitInp%TMaxIC/InitInp%DTIC) ! loop through IC gen time steps, up to maximum + ! find Rod properties index + DO J = 1,p%nRodTypes + IF (trim(tempString1) == trim(m%RodTypeList(J)%name)) THEN + m%RodList(l)%PropsIdNum = J + EXIT + END IF + IF (J == p%nRodTypes) THEN ! call an error if there is no match + CALL SetErrStat( ErrID_Fatal, 'Unable to find matching rod type name for Rod '//trim(Num2LStr(l))//": "//trim(tempString1), ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + END DO - ! integrate the EOMs one DTIC s time step - CALL TimeStep ( t, InitInp%DTIC, uArray, utimes, p, x, xd, z, other, m, ErrStat, ErrMsg ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - ! store new fairlead tension (and previous fairlead tensions for comparison) - DO J = 1, p%NFairs - FairTensIC(J,3) = FairTensIC(J,2) - FairTensIC(J,2) = FairTensIC(J,1) - FairTensIC(J,1) = TwoNorm(m%ConnectList(m%FairIdList(J))%Ftot(:)) - END DO + !----------- process rod type ----------------- - ! provide status message - ! bjj: putting this in a string so we get blanks to cover up previous values (if current string is shorter than previous one) - Message = ' t='//trim(Num2LStr(t))//' FairTen 1: '//trim(Num2LStr(FairTensIC(1,1)))// & - ', '//trim(Num2LStr(FairTensIC(1,2)))//', '//trim(Num2LStr(FairTensIC(1,3))) - CALL WrOver( Message ) - - ! check for convergence (compare current tension at each fairlead with previous two values) - IF (I > 2) THEN - Converged = 1 - DO J = 1, p%NFairs ! check for non-convergence - IF (( abs( FairTensIC(J,1)/FairTensIC(J,2) - 1.0 ) > InitInp%threshIC ) .OR. ( abs( FairTensIC(J,1)/FairTensIC(J,3) - 1.0 ) > InitInp%threshIC ) ) THEN - Converged = 0 - EXIT - END IF - END DO + call DecomposeString(tempString2, let1, num1, let2, num2, let3) + + if ((let1 == "ANCHOR") .or. (let1 == "FIXED") .or. (let1 == "FIX")) then + + m%RodList(l)%typeNum = 2 + CALL Body_AddRod(m%GroundBody, l, tempArray) ! add rod l to Ground body + - IF (Converged == 1) THEN ! (J == p%NFairs) THEN ! if we made it with all cases satisfying the threshold - CALL WrScr(' Fairlead tensions converged to '//trim(Num2LStr(100.0*InitInp%threshIC))//'% after '//trim(Num2LStr(t))//' seconds.') - EXIT ! break out of the time stepping loop - END IF - END IF + else if ((let1 == "PINNED") .or. (let1 == "PIN")) then + m%RodList(l)%typeNum = 1 + CALL Body_AddRod(m%GroundBody, l, tempArray) ! add rod l to Ground body + + p%nFreeRods=p%nFreeRods+1 ! add this pinned rod to the free list because it is half free + + m%RodStateIs1(p%nFreeRods) = Nx+1 + m%RodStateIsN(p%nFreeRods) = Nx+6 + Nx = Nx + 6 ! add 6 state variables for each pinned rod + + m%FreeRodIs(p%nFreeRods) = l + + else if (let1 == "BODY") then ! attached to a body (either rididly or pinned) + + if (len_trim(num1) > 0) then + + READ(num1,*) J ! convert to int, representing parent body index + + if ((J <= p%nBodies) .and. (J > 0)) then + + CALL Body_AddRod(m%BodyList(J), l, tempArray) ! add rod l to the body + + if ( (let2 == "PINNED") .or. (let2 == "PIN") ) then + m%RodList(l)%typeNum = 1 + + p%nFreeRods=p%nFreeRods+1 ! add this pinned rod to the free list because it is half free + + m%RodStateIs1(p%nFreeRods) = Nx+1 + m%RodStateIsN(p%nFreeRods) = Nx+6 + Nx = Nx + 6 ! add 6 state variables for each pinned rod + + m%FreeRodIs(p%nFreeRods) = l + + else if (let2 == " ") then ! rod is not requested to be pinned, so add this rod as a fixed one + m%RodList(l)%typeNum = 2 + + else + CALL SetErrStat( ErrID_Fatal, "Unidentified Type/BodyID for Rod "//trim(Num2LStr(l))//": "//trim(tempString2), ErrStat, ErrMsg, RoutineName ) + return + end if + + else + CALL SetErrStat( ErrID_Fatal, "Body ID out of bounds for Rod "//trim(Num2LStr(l))//".", ErrStat, ErrMsg, RoutineName ) + return + end if + + else + CALL SetErrStat( ErrID_Fatal, "No number provided for Rod "//trim(Num2LStr(l))//" Body attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if + + else if ((let1 == "VESSEL") .or. (let1 == "VES") .or. (let1 == "COUPLED") .or. (let1 == "CPLD")) then ! if a rigidly coupled rod, add to list and add + m%RodList(l)%typeNum = -2 + + p%nCpldRods(1)=p%nCpldRods(1)+1 ! add this rod to coupled list + + m%CpldRodIs(p%nCpldRods(1),1) = l + + else if ((let1 == "VESSELPINNED") .or. (let1 == "VESPIN") .or. (let1 == "COUPLEDPINNED") .or. (let1 == "CPLDPIN")) then ! if a pinned coupled rod, add to list and add + m%RodList(l)%typeNum = -1 + + p%nCpldRods(1)=p%nCpldRods(1)+1 ! add + p%nFreeRods =p%nFreeRods+1 ! add this pinned rod to the free list because it is half free + + m%RodStateIs1(p%nFreeRods) = Nx+1 + m%RodStateIsN(p%nFreeRods) = Nx+6 + Nx = Nx + 6 ! add 6 state variables for each pinned rod + + m%CpldRodIs(p%nCpldRods(1),1) = l + m%FreeRodIs(p%nFreeRods) = l + + ! TODO: add option for body coupling to different turbines in FAST.Farm <<< + + else if ((let1 == "CONNECT") .or. (let1 == "CON") .or. (let1 == "FREE")) then + m%RodList(l)%typeNum = 0 + + p%nFreeRods=p%nFreeRods+1 ! add this pinned rod to the free list because it is half free + + m%RodStateIs1(p%nFreeRods) = Nx+1 + m%RodStateIsN(p%nFreeRods) = Nx+12 + Nx = Nx + 12 ! add 12 state variables for free Rod + + m%FreeRodIs(p%nFreeRods) = l + + else + + CALL SetErrStat( ErrID_Fatal, "Unidentified Type/BodyID for Rod "//trim(Num2LStr(l))//": "//trim(tempString2), ErrStat, ErrMsg, RoutineName ) + return + end if + + + ! process output flag characters (LineOutString) and set line output flag array (OutFlagList) + m%RodList(l)%OutFlagList = 0 ! first set array all to zero + ! per node, 3 component + IF ( scan( LineOutString, 'p') > 0 ) m%RodList(l)%OutFlagList(2 ) = 1 ! node position + IF ( scan( LineOutString, 'v') > 0 ) m%RodList(l)%OutFlagList(3 ) = 1 ! node velocity + IF ( scan( LineOutString, 'U') > 0 ) m%RodList(l)%OutFlagList(4 ) = 1 ! water velocity + IF ( scan( LineOutString, 'B') > 0 ) m%RodList(l)%OutFlagList(5 ) = 1 ! node buoyancy force + IF ( scan( LineOutString, 'D') > 0 ) m%RodList(l)%OutFlagList(6 ) = 1 ! drag force + IF ( scan( LineOutString, 'I') > 0 ) m%RodList(l)%OutFlagList(7 ) = 1 ! inertia force + IF ( scan( LineOutString, 'P') > 0 ) m%RodList(l)%OutFlagList(8 ) = 1 ! dynamic pressure force + IF ( scan( LineOutString, 'b') > 0 ) m%RodList(l)%OutFlagList(9 ) = 1 ! seabed contact forces + ! per node, 1 component + IF ( scan( LineOutString, 'W') > 0 ) m%RodList(l)%OutFlagList(10) = 1 ! node weight/buoyancy (positive up) + IF ( scan( LineOutString, 'K') > 0 ) m%RodList(l)%OutFlagList(11) = 1 ! curvature at node + ! per element, 1 component >>> these don't apply to a rod!! <<< + IF ( scan( LineOutString, 't') > 0 ) m%RodList(l)%OutFlagList(12) = 1 ! segment tension force (just EA) + IF ( scan( LineOutString, 'c') > 0 ) m%RodList(l)%OutFlagList(13) = 1 ! segment internal damping force + IF ( scan( LineOutString, 's') > 0 ) m%RodList(l)%OutFlagList(14) = 1 ! Segment strain + IF ( scan( LineOutString, 'd') > 0 ) m%RodList(l)%OutFlagList(15) = 1 ! Segment strain rate + + IF (SUM(m%RodList(l)%OutFlagList) > 0) m%RodList(l)%OutFlagList(1) = 1 ! this first entry signals whether to create any output file at all + ! the above letter-index combinations define which OutFlagList entry corresponds to which output type + + + ! specify IdNum of line for error checking + m%RodList(l)%IdNum = l + + ! check for sequential IdNums + IF ( m%RodList(l)%IdNum .NE. l ) THEN + CALL SetErrStat( ErrID_Fatal, 'Line numbers must be sequential starting from 1.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + ! set up rod + CALL Rod_Setup( m%RodList(l), m%RodTypeList(m%RodList(l)%PropsIdNum), tempArray, p, ErrStat2, ErrMsg2) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + ! note: Rod was already added to its respective parent body if type > 0 + + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Failed to read rod data for Rod '//trim(Num2LStr(l)), ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF - IF (I == ceiling(InitInp%TMaxIC/InitInp%DTIC) ) THEN - CALL WrScr(' Fairlead tensions did not converge within TMaxIC='//trim(Num2LStr(InitInp%TMaxIC))//' seconds.') - !ErrStat = ErrID_Warn - !ErrMsg = ' MD_Init: ran dynamic convergence to TMaxIC without convergence' - END IF + END DO ! l = 1,p%nRods - END DO ! I ... looping through time steps - CALL MD_DestroyInput( uArray(1), ErrStat2, ErrMsg2 ) + !------------------------------------------------------------------------------------------- + else if ((INDEX(Line, "POINTS") > 0 ) .or. (INDEX(Line, "CONNECTION PROPERTIES") > 0) .or. (INDEX(Line, "NODE PROPERTIES") > 0) .or. (INDEX(Line, "POINT PROPERTIES") > 0) .or. (INDEX(Line, "POINT LIST") > 0) ) then ! if node properties header + + IF (wordy > 0) print *, "Reading Points" + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! process each point + DO l = 1,p%nConnects + + !read into a line + Line = NextLine(i) + + ! check for correct number of columns in current line + IF ( CountWords( Line ) /= 9 ) THEN + CALL SetErrStat( ErrID_Fatal, ' Unable to parse Point '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file. Row has wrong number of columns. Must be 9 columns.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + ! parse out entries: PointID Attachment X Y Z M V CdA Ca + IF (ErrStat2 == 0) THEN + READ(Line,*,IOSTAT=ErrStat2) m%ConnectList(l)%IdNum, tempString1, tempArray(1), & + tempArray(2), tempString4, m%ConnectList(l)%conM, & + m%ConnectList(l)%conV, m%ConnectList(l)%conCdA, m%ConnectList(l)%conCa + + CALL Conv2UC(tempString4) ! convert to uppercase so that matching is not case-sensitive + + if ((INDEX(tempString4, "SEABED") > 0 ) .or. (INDEX(tempString4, "GROUND") > 0 ) .or. (INDEX(tempString4, "FLOOR") > 0 )) then ! if keyword used + CALL WrScr('Point '//trim(Num2LStr(l))//' depth set to be on the seabed; finding z location based on depth/bathymetry') ! interpret the anchor depth value as a 'seabed' input + CALL getDepthFromBathymetry(m%BathymetryGrid, m%BathGrid_Xs, m%BathGrid_Ys, tempArray(1), tempArray(2), depth, nvec) ! meaning the anchor should be at the depth of the local bathymetry + tempArray(3) = -depth + else ! if the anchor depth input isn't one of the supported keywords, + READ(tempString4, *, IOSTAT=ErrStat2) tempArray(3) ! assume it's a scalar depth value + !TODO: add error check for if the above read fails + end if + + ! not used + m%ConnectList(l)%conFX = 0.0_DbKi + m%ConnectList(l)%conFY = 0.0_DbKi + m%ConnectList(l)%conFZ = 0.0_DbKi + + END IF + + + IF ( ErrStat2 /= 0 ) THEN + CALL WrScr(' Unable to parse Point '//trim(Num2LStr(l))//' row in input file.') ! Specific screen output because errors likely + CALL WrScr(' Ensure row has all 9 columns, including CdA and Ca.') ! to be caused by non-updated input file formats. + CALL SetErrStat( ErrID_Fatal, 'Failed to read connects.' , ErrStat, ErrMsg, RoutineName ) ! would be nice to specify which line <<<<<<<<< + CALL CleanUp() + RETURN + END IF + + m%ConnectList(l)%r = tempArray(1:3) ! set initial, or reference, node position (for coupled or child objects, this will be the local reference location about the parent) - ! UNboost drag coefficient of each line type - DO I = 1, p%NTypes - m%LineTypeList(I)%Cdn = m%LineTypeList(I)%Cdn / InitInp%CdScaleIC - m%LineTypeList(I)%Cdt = m%LineTypeList(I)%Cdt / InitInp%CdScaleIC - END DO + !----------- process connection type ----------------- + call DecomposeString(tempString1, let1, num1, let2, num2, let3) + + if ((let1 == "ANCHOR") .or. (let1 == "FIXED") .or. (let1 == "FIX")) then + m%ConnectList(l)%typeNum = 1 + + !m%ConnectList(l)%r = tempArray(1:3) ! set initial node position + + CALL Body_AddConnect(m%GroundBody, l, tempArray(1:3)) ! add connection l to Ground body + + else if (let1 == "BODY") then ! attached to a body + if (len_trim(num1) > 0) then + READ(num1, *) J ! convert to int, representing parent body index + + if ((J <= p%nBodies) .and. (J > 0)) then + m%ConnectList(l)%typeNum = 1 + + CALL Body_AddConnect(m%BodyList(J), l, tempArray(1:3)) ! add connection l to Ground body + + else + CALL SetErrStat( ErrID_Fatal, "Body ID out of bounds for Connection "//trim(Num2LStr(l))//".", ErrStat, ErrMsg, RoutineName ) + return + end if + else + CALL SetErrStat( ErrID_Fatal, "No number provided for Connection "//trim(Num2LStr(l))//" Body attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if + + else if ((let1 == "VESSEL") .or. (let1 == "VES") .or. (let1 == "COUPLED") .or. (let1 == "CPLD")) then ! if a fairlead, add to list and add + m%ConnectList(l)%typeNum = -1 + p%nCpldCons(1)=p%nCpldCons(1)+1 + m%CpldConIs(p%nCpldCons(1),1) = l + + else if ((let1 == "CONNECT") .or. (let1 == "CON") .or. (let1 == "FREE")) then + m%ConnectList(l)%typeNum = 0 + + p%nFreeCons=p%nFreeCons+1 ! add this pinned rod to the free list because it is half free + + m%ConStateIs1(p%nFreeCons) = Nx+1 + m%ConStateIsN(p%nFreeCons) = Nx+6 + Nx = Nx + 6 ! add 12 state variables for free Connection + + m%FreeConIs(p%nFreeCons) = l + + !m%ConnectList(l)%r = tempArray(1:3) ! set initial node position + + else if ((let1 == "TURBINE") .or. (let1 == "T")) then ! turbine-coupled in FAST.Farm case + + if (len_trim(num1) > 0) then + READ(num1, *) J ! convert to int, representing turbine index + + if ((J <= p%nTurbines) .and. (J > 0)) then + + m%ConnectList(l)%TypeNum = -1 ! set as coupled type + p%nCpldCons(J) = p%nCpldCons(J) + 1 ! increment counter for the appropriate turbine + m%CpldConIs(p%nCpldCons(J),J) = l + CALL WrScr(' added connection '//TRIM(int2lstr(l))//' as fairlead for turbine '//trim(int2lstr(J))) + + + else + CALL SetErrStat( ErrID_Fatal, "Turbine ID out of bounds for Connection "//trim(Num2LStr(l))//".", ErrStat, ErrMsg, RoutineName ) + return + end if + else + CALL SetErrStat( ErrID_Fatal, "No number provided for Connection "//trim(Num2LStr(l))//" Turbine attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if + + else + CALL SetErrStat( ErrID_Fatal, "Unidentified Type/BodyID for Connection "//trim(Num2LStr(l))//": "//trim(tempString1), ErrStat, ErrMsg, RoutineName ) + return + end if + + ! set initial velocity to zero + m%ConnectList(l)%rd(1) = 0.0_DbKi + m%ConnectList(l)%rd(2) = 0.0_DbKi + m%ConnectList(l)%rd(3) = 0.0_DbKi + + !also set number of attached lines to zero initially + m%ConnectList(l)%nAttached = 0 + + + ! check for sequential IdNums + IF ( m%ConnectList(l)%IdNum .NE. l ) THEN + CALL SetErrStat( ErrID_Fatal, 'Connection numbers must be sequential starting from 1.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + - p%dtCoupling = DTcoupling ! store coupling time step for use in updatestates + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Failed to read data for Connection '//trim(Num2LStr(l)), ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + IF (wordy > 0) print *, "Set up Point ", l, " of type ", m%ConnectList(l)%typeNum - other%dummy = 0 - xd%dummy = 0 - z%dummy = 0 + END DO ! l = 1,p%nRods - CONTAINS + !------------------------------------------------------------------------------------------- + else if ((INDEX(Line, "LINES") > 0 ) .or. (INDEX(Line, "LINE PROPERTIES") > 0) .or. (INDEX(Line, "LINE LIST") > 0) ) then ! if line properties header - SUBROUTINE CheckError(ErrID,Msg) - ! This subroutine sets the error message and level and cleans up if the error is >= AbortErrLev + IF (wordy > 0) print *, "Reading Lines" + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! process each line + DO l = 1,p%nLines + + !read into a line + Line = NextLine(i) + + ! check for correct number of columns in current line + IF ( CountWords( Line ) /= 7 ) THEN + CALL SetErrStat( ErrID_Fatal, ' Unable to parse Line '//trim(Num2LStr(l))//' on row '//trim(Num2LStr(i))//' in input file. Row has wrong number of columns. Must be 7 columns.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + ! parse out entries: ID LineType AttachA AttachB UnstrLen NumSegs Outputs (note: order changed Dec 13, 2021 before MDv2 release) + IF (ErrStat2 == 0) THEN + READ(Line,*,IOSTAT=ErrStat2) m%LineList(l)%IdNum, tempString1, tempString2, tempString3, & + m%LineList(l)%UnstrLen, m%LineList(l)%N, LineOutString + END IF + + ! identify index of line type + DO J = 1,p%nLineTypes + IF (trim(tempString1) == trim(m%LineTypeList(J)%name)) THEN + m%LineList(l)%PropsIdNum = J + EXIT + END IF + IF (J == p%nLineTypes) THEN ! call an error if there is no match + CALL SetErrStat( ErrID_Fatal, 'Unable to find matching line type name for Line '//trim(Num2LStr(l)), ErrStat, ErrMsg, RoutineName ) + RETURN + END IF + END DO + + ! account for states of line + m%LineStateIs1(l) = Nx + 1 + if (m%LineTypeList(m%LineList(l)%PropsIdNum)%ElasticMod == 2) then + Nx = Nx + 7*m%LineList(l)%N - 6 ! if using viscoelastic model, need one more state per segment + m%LineStateIsN(l) = Nx + else + Nx = Nx + 6*m%LineList(l)%N - 6 ! normal case, just 6 states per internal node + m%LineStateIsN(l) = Nx + end if + + ! Process attachment identfiers and attach line ends + + ! First for the anchor (or end A)... + + call DecomposeString(tempString2, let1, num1, let2, num2, let3) + + if (len_trim(num1)<1) then + CALL SetErrStat( ErrID_Fatal, "Error: no number provided for line "//trim(Num2LStr(l))//" end A attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if + + READ(num1, *) J ! convert to int + + ! if id starts with an "R" or "Rod" + if ((let1 == "R") .or. (let1 == "ROD")) then + + if ((J <= p%nRods) .and. (J > 0)) then + if (let2 == "A") then + CALL Rod_AddLine(m%RodList(J), l, 0, 0) ! add line l (end A, denoted by 0) to rod J (end A, denoted by 0) + else if (let2 == "B") then + CALL Rod_AddLine(m%RodList(J), l, 0, 1) ! add line l (end A, denoted by 0) to rod J (end B, denoted by 1) + else + CALL SetErrStat( ErrID_Fatal, "Error: rod end (A or B) must be specified for line "//trim(Num2LStr(l))//" end A attachment. Instead seeing "//let2, ErrStat, ErrMsg, RoutineName ) + return + end if + else + CALL SetErrStat( ErrID_Fatal, "Error: rod connection ID out of bounds for line "//trim(Num2LStr(l))//" end A attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if + + ! if J starts with a "C" or "Con" or goes straight ot the number then it's attached to a Connection + else if ((len_trim(let1)==0) .or. (let1 == "C") .or. (let1 == "CON")) then + + if ((J <= p%nConnects) .and. (J > 0)) then + CALL Connect_AddLine(m%ConnectList(J), l, 0) ! add line l (end A, denoted by 0) to connection J + else + CALL SetErrStat( ErrID_Fatal, "Error: connection out of bounds for line "//trim(Num2LStr(l))//" end A attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if + + end if + + + ! Then again for the fairlead (or end B)... + + call DecomposeString(tempString3, let1, num1, let2, num2, let3) + + if (len_trim(num1)<1) then + CALL SetErrStat( ErrID_Fatal, "Error: no number provided for line "//trim(Num2LStr(l))//" end B attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if + + READ(num1, *) J ! convert to int + + ! if id starts with an "R" or "Rod" + if ((let1 == "R") .or. (let1 == "ROD")) then + + if ((J <= p%nRods) .and. (J > 0)) then + if (let2 == "A") then + CALL Rod_AddLine(m%RodList(J), l, 1, 0) ! add line l (end B, denoted by 1) to rod J (end A, denoted by 0) + else if (let2 == "B") then + CALL Rod_AddLine(m%RodList(J), l, 1, 1) ! add line l (end B, denoted by 1) to rod J (end B, denoted by 1) + else + CALL SetErrStat( ErrID_Fatal, "Error: rod end (A or B) must be specified for line "//trim(Num2LStr(l))//" end B attachment. Instead seeing "//let2, ErrStat, ErrMsg, RoutineName ) + return + end if + else + CALL SetErrStat( ErrID_Fatal, "Error: rod connection ID out of bounds for line "//trim(Num2LStr(l))//" end B attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if + + ! if J starts with a "C" or "Con" or goes straight ot the number then it's attached to a Connection + else if ((len_trim(let1)==0) .or. (let1 == "C") .or. (let1 == "CON")) then + + if ((J <= p%nConnects) .and. (J > 0)) then + CALL Connect_AddLine(m%ConnectList(J), l, 1) ! add line l (end B, denoted by 1) to connection J + else + CALL SetErrStat( ErrID_Fatal, "Error: connection out of bounds for line "//trim(Num2LStr(l))//" end B attachment.", ErrStat, ErrMsg, RoutineName ) + return + end if + + end if + + + ! process output flag characters (LineOutString) and set line output flag array (OutFlagList) + m%LineList(l)%OutFlagList = 0 ! first set array all to zero + ! per node 3 component + IF ( scan( LineOutString, 'p') > 0 ) m%LineList(l)%OutFlagList(2) = 1 + IF ( scan( LineOutString, 'v') > 0 ) m%LineList(l)%OutFlagList(3) = 1 + IF ( scan( LineOutString, 'U') > 0 ) m%LineList(l)%OutFlagList(4) = 1 + IF ( scan( LineOutString, 'D') > 0 ) m%LineList(l)%OutFlagList(5) = 1 + IF ( scan( LineOutString, 'b') > 0 ) m%LineList(l)%OutFlagList(6) = 1 ! seabed contact forces + ! per node 1 component + IF ( scan( LineOutString, 'W') > 0 ) m%LineList(l)%OutFlagList(7) = 1 ! node weight/buoyancy (positive up) + IF ( scan( LineOutString, 'K') > 0 ) m%LineList(l)%OutFlagList(8) = 1 ! curvature at node + ! per element 1 component + IF ( scan( LineOutString, 't') > 0 ) m%LineList(l)%OutFlagList(10) = 1 ! segment tension force (just EA) + IF ( scan( LineOutString, 'c') > 0 ) m%LineList(l)%OutFlagList(11) = 1 ! segment internal damping force + IF ( scan( LineOutString, 's') > 0 ) m%LineList(l)%OutFlagList(12) = 1 ! Segment strain + IF ( scan( LineOutString, 'd') > 0 ) m%LineList(l)%OutFlagList(13) = 1 ! Segment strain rate + IF ( scan( LineOutString, 'l') > 0 ) m%LineList(l)%OutFlagList(14) = 1 ! Segment stretched length + + IF (SUM(m%LineList(l)%OutFlagList) > 0) m%LineList(l)%OutFlagList(1) = 1 ! this first entry signals whether to create any output file at all + ! the above letter-index combinations define which OutFlagList entry corresponds to which output type + + + ! specify IdNum of line for error checking + m%LineList(l)%IdNum = l + + + ! check for sequential IdNums + IF ( m%LineList(l)%IdNum .NE. l ) THEN + CALL SetErrStat( ErrID_Fatal, 'Line numbers must be sequential starting from 1.', ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + + ! setup line + CALL SetupLine( m%LineList(l), m%LineTypeList(m%LineList(l)%PropsIdNum), p, ErrStat2, ErrMsg2) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Failed to read line data for Line '//trim(Num2LStr(l)), ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + END IF + + END DO ! l = 1,p%nLines + + + + !------------------------------------------------------------------------------------------- + else if (INDEX(Line, "CONTROL") > 0) then ! if control inputs header + + IF (wordy > 0) print *, " Reading control inputs"; + + ! TODO: add stuff <<<<<<<< + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! process each line + DO l = 1,p%nCtrlChans + + !read into a line + Line = NextLine(i) + + ! count commas to determine how many line IDs specified for this channel + N = count(transfer(Line, 'a', len(Line)) == ",") + 1 ! number of line IDs given + + ! parse out entries: CtrlChan, LineIdNums + read(Line, *) Itemp, TempIDnums(1:N) ! parse out each line ID + + DO J = 1,N + if (TempIDnums(J) <= p%nLines) then ! ensure line ID is in range + if (m%LineList( TempIDnums(J) )%CtrlChan == 0) then ! ensure line doesn't already have a CtrlChan assigned + m%LineList( TempIDnums(J) )%CtrlChan = Itemp + CALL WrScr('Assigned Line '//TRIM(Int2LStr(TempIDnums(J)))//' to control channel '//TRIM(Int2LStr(Itemp))) + else + CALL WrScr('Error: Line '//TRIM(Int2LStr(TempIDnums(J)))//' already is assigned to control channel '//TRIM(Int2LStr(m%LineList( TempIDnums(J) )%CtrlChan))//' so cannot also be assigned to channel '//TRIM(Int2LStr(Itemp))) + end if + else + CALL WrScr('Error: Line ID '//TRIM(Int2LStr(TempIDnums(J)))//' of CtrlChan '//TRIM(Int2LStr(Itemp))//' is out of range') + end if + + END DO + + END DO + + + !------------------------------------------------------------------------------------------- + else if (INDEX(Line, "FAILURE") > 0) then ! if failure conditions header + + IF (wordy > 0) print *, " Reading failure conditions: (not implemented yet) "; + + ! TODO: add stuff <<<<<<<< + + ! skip following two lines (label line and unit line) + Line = NextLine(i) + Line = NextLine(i) + + ! process each line + DO l = 1,p%nFails + + !read into a line + Line = NextLine(i) + + + READ(Line,*,IOSTAT=ErrStat2) m%LineList(l)%IdNum, tempString1, m%LineList(l)%UnstrLen, & + m%LineList(l)%N, tempString2, tempString3, LineOutString + + END DO + + + !------------------------------------------------------------------------------------------- + else if (INDEX(Line, "OUTPUT") > 0) then ! if output header + + IF (wordy > 0) print *, "Reading Outputs" + + ! (don't skip any lines) + + ! allocate InitInp%Outliest (to a really big number for now...) + CALL AllocAry( OutList, MaxAryLen, "MoorDyn Input File's Outlist", ErrStat2, ErrMsg2 ); if(Failed()) return + + + ! Initialize some values + p%NumOuts = 0 ! start counter at zero + OutList = '' + + + ! Read in all of the lines containing output parameters and store them in OutList(:) + ! customm implementation to avoid need for "END" keyword line + DO + ! read a line + Line = NextLine(i) + Line = adjustl(trim(Line)) ! remove leading whitespace + + CALL Conv2UC(Line) ! convert to uppercase for easy string matching + + if ((INDEX(Line, "---") > 0) .or. (INDEX(Line, "END") > 0)) EXIT ! stop if we hit a header line or the keyword "END" + + ! Check if we have a quoted string at the beginning. Ignore anything outside the quotes if so (this is the ReadVar behaviour for quoted strings). + IF (SCAN(Line(1:1), '''"' ) == 1_IntKi ) THEN + QuoteCh = SCAN( Line(2:), '''"' ) ! last quote + IF (QuoteCh < 1) QuoteCh = LEN_TRIM(Line) ! in case no end quote + Line(QuoteCh+2:) = ' ' ! blank out everything after last quote + END IF + + NumWords = CountWords( Line ) ! The number of words in Line. + + p%NumOuts = p%NumOuts + NumWords ! The total number of output channels read in so far. + + + IF ( p%NumOuts > MaxAryLen ) THEN ! Check to see if the maximum # allowable in the array has been reached. + + ErrStat = ErrID_Fatal + ErrMsg = 'Error while reading output channels: The maximum number of output channels allowed is '//TRIM( Int2LStr(MaxAryLen) )//'.' + EXIT + + ELSE + CALL GetWords ( Line, OutList((p%NumOuts - NumWords + 1):p%NumOuts), NumWords ) + + END IF + + END DO + + ! process the OutList array and set up the index arrays for the requested output quantities + CALL MDIO_ProcessOutList(OutList, p, m, y, InitOut, ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + + !------------------------------------------------------------------------------------------- + else ! otherwise ignore this line that isn't a recognized header line and read the next line + Line = NextLine(i) + end if + + !------------------------------------------------------------------------------------------- + + else ! otherwise ignore this line, which doesn't have the "---" or header line and read the next line + Line = NextLine(i) + end if + + end do + + + ! this is the end of parsing the input file, so cleanup anything we don't need anymore + CALL CleanUp() + + ! End of input file parsing from the FileInfo_In data structure + !------------------------------------------------------------------------------------------------- + + + + + + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + + + !------------------------------------------------------------------------------------------------- + ! Connect mooring system together and make necessary allocations + !------------------------------------------------------------------------------------------------- + + CALL WrNr(' Created mooring system: ' ) + +! p%NAnchs = 0 ! this is the number of "fixed" type Connections. <<<<<<<<<<<<<< + + CALL WrScr(trim(Num2LStr(p%nLines))//' lines, '//trim(Num2LStr(p%NConnects))//' points, '//trim(Num2LStr(p%nRods))//' rods, '//trim(Num2LStr(p%nBodies))//' bodies.') + + + + + ! ! now go back through and record the fairlead Id numbers (this >>>WAS<<< all the "connecting" that's required) <<<< + ! J = 1 ! counter for fairlead number + ! K = 1 ! counter for connect number + ! DO I = 1,p%NConnects + ! IF (m%ConnectList(I)%typeNum == 1) THEN + ! m%CpldConIs(J) = I ! if a vessel connection, add ID to list + ! J = J + 1 + ! ELSE IF (m%ConnectList(I)%typeNum == 2) THEN + ! m%FreeConIs(K) = I ! if a connect connection, add ID to list + ! K = K + 1 + ! END IF + ! END DO + + IF (wordy > 1) print *, "nLineTypes = ",p%nLineTypes + IF (wordy > 1) print *, "nRodTypes = ",p%nRodTypes + IF (wordy > 1) print *, "nConnects = ",p%nConnects + IF (wordy > 1) print *, "nConnectsExtra = ",p%nConnectsExtra + IF (wordy > 1) print *, "nBodies = ",p%nBodies + IF (wordy > 1) print *, "nRods = ",p%nRods + IF (wordy > 1) print *, "nLines = ",p%nLines + IF (wordy > 1) print *, "nCtrlChans = ",p%nCtrlChans + IF (wordy > 1) print *, "nFails = ",p%nFails + IF (wordy > 1) print *, "nFreeBodies = ",p%nFreeBodies + IF (wordy > 1) print *, "nFreeRods = ",p%nFreeRods + IF (wordy > 1) print *, "nFreeCons = ",p%nFreeCons + IF (wordy > 1) print *, "nCpldBodies = ",p%nCpldBodies + IF (wordy > 1) print *, "nCpldRods = ",p%nCpldRods + IF (wordy > 1) print *, "nCpldCons = ",p%nCpldCons + IF (wordy > 1) print *, "NConns = ",p%NConns + IF (wordy > 1) print *, "NAnchs = ",p%NAnchs + + IF (wordy > 2) print *, "FreeConIs are ", m%FreeConIs + IF (wordy > 2) print *, "CpldConIs are ", m%CpldConIs + + + ! write system description to log file + if (p%writeLog > 1) then + write(p%UnLog, '(A)') "----- MoorDyn Model Summary (to be written) -----" + end if + + + + !------------------------------------------------------------------------------------ + ! fill in state vector index record holders + !------------------------------------------------------------------------------------ + + ! allocate state vector index record holders... + + + + ! ! allocate list of starting and ending state vector indices for each free connection + ! ALLOCATE ( m%ConStateIs1(p%nFreeCons), m%ConStateIsN(p%nFreeCons), STAT = ErrStat ) + ! IF ( ErrStat /= ErrID_None ) THEN + ! CALL CheckError(ErrID_Fatal, ' Error allocating ConStateIs array.') + ! RETURN + ! END IF + ! + ! ! allocate list of starting and ending state vector indices for each line - does this belong elsewhere? + ! ALLOCATE ( m%LineStateIs1(p%nLines), m%LineStateIsN(p%nLines), STAT = ErrStat ) + ! IF ( ErrStat /= ErrID_None ) THEN + ! CALL CheckError(ErrID_Fatal, ' Error allocating LineStateIs arrays.') + ! RETURN + ! END IF + ! + ! + ! ! fill in values for state vector index record holders... + ! + ! J=0 ! start off index counter at zero + ! + ! ! Free Bodies... + ! ! Free Rods... + ! + ! ! Free Connections... + ! DO l = 1, p%nFreeCons + ! J = J + 1 ! assign start index + ! m%ConStateIs1(l) = J + ! + ! J = J + 5 ! assign end index (5 entries further, since nodes have 2*3 states) + ! m%ConStateIsN(l) = J + ! END DO + ! + ! ! Lines + ! DO l = 1, p%nLines + ! J = J + 1 ! assign start index + ! m%LineStateIs1(l) = J + ! + ! J = J + 6*(m%LineList(l)%N - 1) - 1 ! !add 6 state variables for each internal node + ! m%LineStateIsN(l) = J + ! END DO + ! + ! + ! ! record number of states + ! m%Nx = J + + + !------------------------------------------------------------------------------------ + ! prepare state vector etc. + !------------------------------------------------------------------------------------ + + ! the number of states is Nx + m%Nx = Nx + + IF (wordy > 0) print *, "allocating state vectors to size ", Nx + + ! allocate state vector and temporary state vectors based on size just calculated + ALLOCATE ( x%states(m%Nx), m%xTemp%states(m%Nx), m%xdTemp%states(m%Nx), STAT = ErrStat2 ) + IF ( ErrStat2 /= ErrID_None ) THEN + ErrMsg = ' Error allocating state vectors.' + !CALL CleanUp() + RETURN + END IF + x%states = 0.0_DbKi + m%xTemp%states = 0.0_DbKi + m%xdTemp%states = 0.0_DbKi + + + + ! ================================ initialize system ================================ + ! This will also set the initial positions of any dependent (child) objects + + ! call ground body to update all the fixed things... + m%GroundBody%r6(4:6) = 0.0_DbKi + CALL Body_SetDependentKin(m%GroundBody, 0.0_DbKi, m) + + ! m%GroundBody%OrMat = EulerConstruct( m%GroundBody%r6(4:6) ) ! make sure it's OrMat is set up <<< need to check this approach + + ! ! first set/update the kinematics of all the fixed things (>>>> eventually do this by using a ground body <<<<) + ! ! only doing connections so far + ! DO J = 1,p%nConnects + ! if (m%ConnectList(J)%typeNum == 1) then + ! ! set the attached line endpoint positions: + ! CALL Connect_SetKinematics(m%ConnectList(J), m%ConnectList(J)%r, (/0.0_DbKi,0.0_DbKi,0.0_DbKi/), 0.0_DbKi, m%LineList) + ! end if + ! END DO + + + ! Initialize coupled objects based on passed kinematics + ! (set up initial condition of each coupled object based on values specified by glue code) + ! Also create i/o meshes + + ALLOCATE ( u%CoupledKinematics(p%nTurbines), STAT = ErrStat2 ) + IF ( ErrStat2 /= ErrID_None ) THEN + CALL CheckError(ErrID_Fatal, ' Error allocating CoupledKinematics input array.') + RETURN + END IF + ALLOCATE ( y%CoupledLoads(p%nTurbines), STAT = ErrStat2 ) + IF ( ErrStat2 /= ErrID_None ) THEN + CALL CheckError(ErrID_Fatal, ' Error allocating CoupledLoads output array.') + RETURN + END IF + + ! Go through each turbine and set up its mesh and initial positions of coupled objects + DO iTurb = 1,p%nTurbines + + ! calculate rotation matrix OrMat for the initial orientation provided for this turbine + CALL SmllRotTrans('PtfmInit', InitInp%PtfmInit(4,iTurb),InitInp%PtfmInit(5,iTurb),InitInp%PtfmInit(6,iTurb), OrMat, '', ErrStat2, ErrMsg2) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + ! count number of coupling nodes needed for the mesh of this turbine + K = p%nCpldBodies(iTurb) + p%nCpldRods(iTurb) + p%nCpldCons(iTurb) + if (K == 0) K = 1 ! Always have at least one node (it will be a dummy node if no fairleads are attached) + + ! create input mesh for fairlead kinematics + CALL MeshCreate(BlankMesh=u%CoupledKinematics(iTurb) , & + IOS= COMPONENT_INPUT, Nnodes = K, & + TranslationDisp=.TRUE., TranslationVel=.TRUE., & + Orientation=.TRUE., RotationVel=.TRUE., & + TranslationAcc=.TRUE., RotationAcc= .TRUE., & + ErrStat=ErrStat2, ErrMess=ErrMsg2) + + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + ! note: in MoorDyn-F v2, the points in the mesh correspond in order to all the coupled bodies, then rods, then connections + ! >>> make sure all coupled objects have been offset correctly by the PtfmInit values, including if it's a farm situation -- below or where the objects are first created <<<< + + + J = 0 ! this is the counter through the mesh points for each turbine + + DO l = 1,p%nCpldBodies(iTurb) + J = J + 1 + + rRef = m%BodyList(m%CpldBodyIs(l,iTurb))%r6 ! for now set reference position as per input file <<< + !OrMatRef = + + CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2) ! defaults to identity orientation matrix + !TODO: >>> should also maybe set reference orientation (which might make part of a couple lines down redundant) <<< + + ! calculate initial point relative position, adjusted due to initial platform translations + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) = InitInp%PtfmInit(1:3,iTurb) - rRef(1:3) + + OrMat2 = MATMUL(OrMat, TRANSPOSE( EulerConstruct( rRef(4:6)))) ! combine the Body's relative orientation with the turbine's initial orientation + u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the body <<< + + ! set absolute initial positions in MoorDyn + m%BodyList(m%CpldBodyIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) + m%BodyList(m%CpldBodyIs(l,iTurb))%r6(4:6) = EulerExtract(MATMUL(OrMat, TRANSPOSE( EulerConstruct( rRef(4:6))))) ! apply rotation from PtfmInit onto input file's body orientation to get its true initial orientation + + CALL MeshConstructElement(u%CoupledKinematics(iTurb), ELEMENT_POINT, ErrStat2, ErrMsg2, J) ! set node as point element + + ! lastly, do this to initialize any attached Rods or Points and set their positions + CALL Body_InitializeUnfree( m%BodyList(m%CpldBodyIs(l,iTurb)), m ) + + END DO + + DO l = 1,p%nCpldRods(iTurb) ! keeping this one simple for now, positioning at whatever is specified in input file <<<<< should change to glue code! + J = J + 1 + + rRef = m%RodList(m%CpldRodIs(l,iTurb))%r6 ! for now set reference position as per input file <<< + OrMatRef = TRANSPOSE( m%RodList(m%CpldRodIs(l,iTurb))%OrMat ) ! for now set reference orientation as per input file <<< + CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2, OrMatRef) ! assign the reference position and orientation + + ! calculate initial point relative position, adjusted due to initial platform rotations and translations <<< could convert to array math + u%CoupledKinematics(iTurb)%TranslationDisp(1,J) = InitInp%PtfmInit(1,iTurb) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) + u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) + u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) + + OrMat2 = MATMUL(OrMat, TRANSPOSE( EulerConstruct( rRef(4:6)))) ! combine the Rod's relative orientation with the turbine's initial orientation + u%CoupledKinematics(iTurb)%Orientation(:,:,J) = OrMat2 ! set the result as the current orientation of the rod <<< + + ! set absolute initial positions in MoorDyn + m%RodList(m%CpldRodIs(l,iTurb))%r6(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) + m%RodList(m%CpldRodIs(l,iTurb))%r6(4:6) = EulerExtract(MATMUL(OrMat, OrMatRef)) ! apply rotation from PtfmInit onto input file's rod orientation to get its true initial orientation + + ! >>> still need to set Rod initial orientations accounting for PtfmInit rotation <<< + + CALL MeshConstructElement(u%CoupledKinematics(iTurb), ELEMENT_POINT, ErrStat2, ErrMsg2, J) + + ! lastly, do this to set the attached line endpoint positions: + CALL Rod_SetKinematics(m%RodList(m%CpldRodIs(l,iTurb)), DBLE(rRef), m%zeros6, m%zeros6, 0.0_DbKi, m) + END DO + + DO l = 1,p%nCpldCons(iTurb) ! keeping this one simple for now, positioning at whatever is specified by glue code <<< + J = J + 1 + + ! set reference position as per input file <<< what about turbine positions in array? + rRef(1:3) = m%ConnectList(m%CpldConIs(l,iTurb))%r + CALL MeshPositionNode(u%CoupledKinematics(iTurb), J, rRef(1:3), ErrStat2, ErrMsg2) + + ! calculate initial point relative position, adjusted due to initial platform rotations and translations <<< could convert to array math + u%CoupledKinematics(iTurb)%TranslationDisp(1,J) = InitInp%PtfmInit(1,iTurb) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) + u%CoupledKinematics(iTurb)%TranslationDisp(2,J) = InitInp%PtfmInit(2,iTurb) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) + u%CoupledKinematics(iTurb)%TranslationDisp(3,J) = InitInp%PtfmInit(3,iTurb) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) + + ! set absolute initial positions in MoorDyn + m%ConnectList(m%CpldConIs(l,iTurb))%r = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) + + CALL MeshConstructElement(u%CoupledKinematics(iTurb), ELEMENT_POINT, ErrStat2, ErrMsg2, J) + + ! lastly, do this to set the attached line endpoint positions: + rRefDub = rRef(1:3) + CALL Connect_SetKinematics(m%ConnectList(m%CpldConIs(l,iTurb)), rRefDub, m%zeros6(1:3), m%zeros6(1:3), 0.0_DbKi, m) + END DO + + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + ! if no coupled objects exist for this turbine, add a single dummy element to keep I/O interp/extrap routines happy + if (J == 0) then + rRef = 0.0_DbKi ! position at PRP + CALL MeshPositionNode(u%CoupledKinematics(iTurb), 1, rRef, ErrStat2, ErrMsg2) + CALL MeshConstructElement(u%CoupledKinematics(iTurb), ELEMENT_POINT, ErrStat2, ErrMsg2, 1) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + end if + + ! set velocities/accelerations of all mesh nodes to zero + u%CoupledKinematics(iTurb)%TranslationVel = 0.0_ReKi + u%CoupledKinematics(iTurb)%TranslationAcc = 0.0_ReKi + u%CoupledKinematics(iTurb)%RotationVel = 0.0_ReKi + u%CoupledKinematics(iTurb)%RotationAcc = 0.0_ReKi + + CALL MeshCommit ( u%CoupledKinematics(iTurb), ErrStat2, ErrMsg ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + ! copy the input fairlead kinematics mesh to make the output mesh for fairlead loads, PtFairleadLoad + CALL MeshCopy ( SrcMesh = u%CoupledKinematics(iTurb), DestMesh = y%CoupledLoads(iTurb), & + CtrlCode = MESH_SIBLING, IOS = COMPONENT_OUTPUT, & + Force = .TRUE., Moment = .TRUE., ErrStat = ErrStat2, ErrMess=ErrMsg2 ) + + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + end do ! iTurb + + ! >>>>>> ensure the output mesh includes all elements from u%(Farm)CoupledKinematics, OR make a seperate array of output meshes for each turbine <<<<<<<<< + + + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + + ! ----------------------------- Arrays for active tensioning --------------------------- + + ! size active tensioning inputs arrays based on highest channel number read from input file for now <<<<<<< + + ! find the highest channel number + N = 0 + DO I = 1, p%NLines + IF ( m%LineList(I)%CtrlChan > N ) then + N = m%LineList(I)%CtrlChan + END IF + END DO + + ! note: it would be nice to just have input arrays of the number of control channels used, rather than from 1 up to N (the highest CtrlChan) + + ! allocate the input arrays (if any requested) + if (N > 0) then + call AllocAry( u%DeltaL, N, 'u%DeltaL', ErrStat2, ErrMsg2 ) + call CheckError( ErrStat2, ErrMsg2 ) + if (ErrStat >= AbortErrLev) return + u%DeltaL = 0.0_ReKi + call AllocAry( u%DeltaLdot, N, 'u%DeltaLdot', ErrStat2, ErrMsg2 ) + call CheckError( ErrStat2, ErrMsg2 ) + if (ErrStat >= AbortErrLev) return + u%DeltaLdot = 0.0_ReKi + call AllocAry( InitOut%CableCChanRqst, N, 'CableCChanRqst', ErrStat2, ErrMsg2 ) + call CheckError( ErrStat2, ErrMsg2 ) + if (ErrStat >= AbortErrLev) return + InitOut%CableCChanRqst = .FALSE. ! Initialize to false + do J=1,p%NLines + if (m%LineList(J)%CtrlChan > 0) InitOut%CableCChanRqst(m%LineList(J)%CtrlChan) = .TRUE. ! set the flag of the corresponding channel to true + enddo + endif + + + ! >>> set up wave stuff here??? <<< + + + m%WaveTi = 1 ! set initial wave grid time interpolation index to 1 to start with + + + ! Frmt = '(A10,'//TRIM(Int2LStr(p%NumOuts))//'(A1,A12))' + ! + ! WRITE(p%MDUnOut,Frmt, IOSTAT=ErrStat2) TRIM( 'Time' ), ( p%Delim, TRIM( p%OutParam(I)%Name), I=1,p%NumOuts ) + ! + ! WRITE(p%MDUnOut,Frmt) TRIM( '(s)' ), ( p%Delim, TRIM( p%OutParam(I)%Units ), I=1,p%NumOuts ) + ! + ! + ! + ! ! Write the output parameters to the file + ! + ! Frmt = '(F10.4,'//TRIM(Int2LStr(p%NumOuts))//'(A1,e10.4))' + ! + ! WRITE(p%MDUnOut,Frmt) Time, ( p%Delim, y%WriteOutput(I), I=1,p%NumOuts ) + + + + ! ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + + + ! if any of the coupled objects need initialization steps, that should have been taken care of already <<<< + + + ! initialize objects with states, writing their initial states to the master state vector (x%states) + + + !TODO: apply any initial adjustment of line length from active tensioning <<<<<<<<<<<< + ! >>> maybe this should be skipped <<<< + + + ! Go through Bodys and write the coordinates to the state vector + DO l = 1,p%nFreeBodies + CALL Body_Initialize(m%BodyList(m%FreeBodyIs(l)), x%states(m%BodyStateIs1(l) : m%BodyStateIsN(l)), m) + END DO + + ! Go through independent (including pinned) Rods and write the coordinates to the state vector + DO l = 1,p%nFreeRods + CALL Rod_Initialize(m%RodList(m%FreeRodIs(l)), x%states(m%RodStateIs1(l):m%RodStateIsN(l)), m) + END DO + + ! Go through independent connections (Connects) and write the coordinates to the state vector and set positions of attached line ends + DO l = 1, p%nFreeCons + CALL Connect_Initialize(m%ConnectList(m%FreeConIs(l)), x%states(m%ConStateIs1(l) : m%conStateIsN(l)), m) + END DO + + + ! Lastly, go through lines and initialize internal node positions using quasi-static model + DO l = 1, p%NLines + + N = m%LineList(l)%N ! for convenience + + ! ! set end node positions and velocities from connect objects + ! m%LineList(l)%r(:,N) = m%ConnectList(m%LineList(l)%FairConnect)%r + ! m%LineList(l)%r(:,0) = m%ConnectList(m%LineList(l)%AnchConnect)%r + ! m%LineList(l)%rd(:,N) = (/ 0.0, 0.0, 0.0 /) ! set anchor end velocities to zero + ! m%LineList(l)%rd(:,0) = (/ 0.0, 0.0, 0.0 /) ! set fairlead end velocities to zero + + ! set initial line internal node positions using quasi-static model or straight-line interpolation from anchor to fairlead + CALL Line_Initialize( m%LineList(l), m%LineTypeList(m%LineList(l)%PropsIdNum), p%rhoW , ErrStat2, ErrMsg2) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + !IF (ErrStat >= ErrId_Warn) CALL WrScr(" Note: Catenary pre-solver was unsuccessful for one or more lines so started with linear node spacing instead.") ! make this statement more accurate + + IF (wordy > 2) print *, "Line ", l, " with NumSegs =", N + IF (wordy > 2) print *, "its states range from index ", m%LineStateIs1(l), " to ", m%LineStateIsN(l) + + ! assign the resulting internal node positions to the integrator initial state vector! (velocities leave at 0) + DO I = 1, N-1 +! print *, "I=", I + DO J = 1, 3 +! print*, J, " ... writing position state to index ", 1*(m%LineStateIs1(l) + 3*N-3 + 3*I-3 + J-1) + x%states(m%LineStateIs1(l) + 3*N-3 + 3*I-3 + J-1 ) = m%LineList(l)%r(J,I) ! assign position + x%states(m%LineStateIs1(l) + 3*I-3 + J-1 ) = 0.0_DbKi ! assign velocities (of zero) + END DO +! print *, m%LineList(l)%r(:,I) + END DO + + ! if using viscoelastic model, initialize the internal states + if (m%LineList(l)%ElasticMod == 2) then + do I = 1,N + x%states(m%LineStateIs1(l) + 6*N-6 + I-1) = m%LineList(l)%dl_1(I) ! should be zero + end do + end if + + + END DO !l = 1, p%NLines + + + + ! -------------------------------------------------------------------- + ! open output file(s) and write header lines + CALL MDIO_OpenOutput( p, m, InitOut, ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + ! -------------------------------------------------------------------- + + + IF (wordy > 2) THEN + print *,"Done setup of the system (before any dynamic relaxation. State vector is as follows:" + + DO I = 1, m%Nx + print *, x%states(I) + END DO + END IF + +! ! try writing output for troubleshooting purposes (TEMPORARY) +! CALL MDIO_WriteOutputs(-1.0_DbKi, p, m, y, ErrStat, ErrMsg) +! IF ( ErrStat >= AbortErrLev ) THEN +! ErrMsg = ' Error in MDIO_WriteOutputs: '//TRIM(ErrMsg) +! RETURN +! END IF +! END DO + + ! ------------------------------------------------------------------- + ! if log file, compute and write some object properties + ! ------------------------------------------------------------------- + if (p%writeLog > 1) then + + write(p%UnLog, '(A)' ) " Bodies:" + DO l = 1,p%nBodies + write(p%UnLog, '(A)' ) " Body"//trim(num2lstr(l))//":" + write(p%UnLog, '(A12, f12.4)') " mass: ", m%BodyList(l)%M(1,1) + END DO + + write(p%UnLog, '(A)' ) " Rods:" + DO l = 1,p%nRods + write(p%UnLog, '(A)' ) " Rod"//trim(num2lstr(l))//":" + ! m%RodList(l) + END DO + + write(p%UnLog, '(A)' ) " Points:" + DO l = 1,p%nFreeCons + write(p%UnLog, '(A)' ) " Point"//trim(num2lstr(l))//":" + ! m%ConnectList(l) + END DO + + write(p%UnLog, '(A)' ) " Lines:" + DO l = 1,p%nLines + write(p%UnLog, '(A)' ) " Line"//trim(num2lstr(l))//":" + ! m%LineList(l) + END DO + + end if + + + ! -------------------------------------------------------------------- + ! do dynamic relaxation to get ICs + ! -------------------------------------------------------------------- + + ! only do this if TMaxIC > 0 + if (InputFileDat%TMaxIC > 0.0_DbKi) then + + CALL WrScr(" Finalizing initial conditions using dynamic relaxation."//NewLine) ! newline because next line writes over itself + + ! boost drag coefficient of each line type <<<<<<<< does this actually do anything or do lines hold these coefficients??? + DO I = 1, p%nLineTypes + m%LineTypeList(I)%Cdn = m%LineTypeList(I)%Cdn * InputFileDat%CdScaleIC + m%LineTypeList(I)%Cdt = m%LineTypeList(I)%Cdt * InputFileDat%CdScaleIC ! <<<<< need to update this to apply to all objects' drag + END DO + + ! allocate array holding 10 latest fairlead tensions + ALLOCATE ( FairTensIC(p%nLines, 10), STAT = ErrStat2 ) + IF ( ErrStat2 /= ErrID_None ) THEN + CALL CheckError( ErrID_Fatal, ErrMsg2 ) + RETURN + END IF + + ! initialize fairlead tension memory at changing values so things start unconverged + DO J = 1,p%nLines + DO I = 1, 10 + FairTensIC(J,I) = I + END DO + END DO + + + ! round dt to integer number of time steps + NdtM = ceiling(InputFileDat%dtIC/p%dtM0) ! get number of mooring time steps to do based on desired time step size + dtM = InputFileDat%dtIC/real(NdtM, DbKi) ! adjust desired time step to satisfy dt with an integer number of time steps + + t = 0.0_DbKi ! start time at zero + + ! because TimeStep wants an array... + call MD_CopyInput( u, u_array(1), MESH_NEWCOPY, ErrStat2, ErrMsg2 ) ! make a size=1 array of inputs (since MD_RK2 expects an array to InterpExtrap) + call MD_CopyInput( u, u_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) ! also make an inputs object to interpExtrap to + t_array(1) = t ! fill in the times "array" for u_array + + DO I = 1, ceiling(InputFileDat%TMaxIC/InputFileDat%dtIC) ! loop through IC gen time steps, up to maximum + + + !loop through line integration time steps + DO J = 1, NdtM ! for (double ts=t; ts<=t+ICdt-dts; ts+=dts) + + CALL MD_RK2(t, dtM, u_interp, u_array, t_array, p, x, xd, z, other, m, ErrStat2, ErrMsg2) + + ! check for NaNs - is this a good place/way to do it? + DO K = 1, m%Nx + IF (Is_NaN(x%states(K))) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' NaN state detected.' + EXIT + END IF + END DO + + IF (ErrStat == ErrID_Fatal) THEN + CALL WrScr("NaN detected at time "//TRIM(Num2LStr(t))//" during MoorDyn's dynamic relaxation process.") + IF (wordy > 1) THEN + print *, "Here is the state vector: " + print *, x%states + END IF + EXIT + END IF + + END DO ! J time steps + + ! ! integrate the EOMs one DTIC s time step + ! CALL TimeStep ( t, InputFileDat%dtIC, u_array, t_array, p, x, xd, z, other, m, ErrStat, ErrMsg ) + ! CALL CheckError( ErrStat2, ErrMsg2 ) + ! IF (ErrStat >= AbortErrLev) RETURN + + ! store new fairlead tension (and previous fairlead tensions for comparison) + DO l = 1, p%nLines + + DO K=0,8 ! we want to count down from 10 to 2 . + FairTensIC(l, 10-K) = FairTensIC(l, 9-K) ! this pushes stored values up in the array + END DO + + ! now store latest value of each line's fairlead (end B) tension + FairTensIC(l,1) = TwoNorm(m%LineList(l)%Fnet(:, m%LineList(l)%N)) + END DO + + + ! provide status message + ! bjj: putting this in a string so we get blanks to cover up previous values (if current string is shorter than previous one) + Message = ' t='//trim(Num2LStr(t))//' FairTen 1: '//trim(Num2LStr(FairTensIC(1,1)))// & + ', '//trim(Num2LStr(FairTensIC(1,2)))//', '//trim(Num2LStr(FairTensIC(1,3))) + CALL WrOver( Message ) + + ! check for convergence (compare current tension at each fairlead with previous 9 values) + IF (I > 9) THEN + + Converged = 1 + + ! check for non-convergence + + DO l = 1, p%nLines + DO K = 1,9 + IF ( abs( FairTensIC(l,K)/FairTensIC(l,K+1) - 1.0 ) > InputFileDat%threshIC ) THEN + Converged = 0 + EXIT + END IF + END DO + + IF (Converged == 0) EXIT ! make sure we exit this loop too + END DO + + IF (Converged == 1) THEN ! if we made it with all cases satisfying the threshold + CALL WrScr(' Fairlead tensions converged to '//trim(Num2LStr(100.0*InputFileDat%threshIC))//'% after '//trim(Num2LStr(t))//' seconds.') + EXIT ! break out of the time stepping loop + END IF + END IF + + IF (I == ceiling(InputFileDat%TMaxIC/InputFileDat%dtIC) ) THEN + CALL WrScr(' Fairlead tensions did not converge within TMaxIC='//trim(Num2LStr(InputFileDat%TMaxIC))//' seconds.') + !ErrStat = ErrID_Warn + !ErrMsg = ' MD_Init: ran dynamic convergence to TMaxIC without convergence' + END IF + + END DO ! I ... looping through time steps + + + + CALL MD_DestroyInput( u_array(1), ErrStat2, ErrMsg2 ) + + ! UNboost drag coefficient of each line type <<< + DO I = 1, p%nLineTypes + m%LineTypeList(I)%Cdn = m%LineTypeList(I)%Cdn / InputFileDat%CdScaleIC + m%LineTypeList(I)%Cdt = m%LineTypeList(I)%Cdt / InputFileDat%CdScaleIC + END DO + + end if ! InputFileDat%TMaxIC > 0 + + + p%dtCoupling = DTcoupling ! store coupling time step for use in updatestates + + other%dummy = 0 + xd%dummy = 0 + z%dummy = 0 + + if (InitInp%Linearize) then + call MD_Init_Jacobian(InitInp, p, u, y, m, InitOut, ErrStat2, ErrMsg2); if(Failed()) return + endif + + CALL WrScr(' MoorDyn initialization completed.') + + m%LastOutTime = -1.0_DbKi ! set to nonzero to ensure that output happens at the start of simulation at t=0 + + ! TODO: add feature for automatic water depth increase based on max anchor depth! + + CONTAINS + + + LOGICAL FUNCTION AllocateFailed(arrayName) + + CHARACTER(*), INTENT(IN ) :: arrayName ! The array name + + call SetErrStat(ErrStat2, "Error allocating space for "//trim(arrayName)//" array.", ErrStat, ErrMsg, 'MD_Init') + AllocateFailed = ErrStat2 >= AbortErrLev + if (AllocateFailed) call CleanUp() !<<<<<<<<<< need to fix this up + END FUNCTION AllocateFailed + + + LOGICAL FUNCTION Failed() + + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MD_Init') + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + END FUNCTION Failed + + + SUBROUTINE CheckError(ErrID,Msg) + ! This subroutine sets the error message and level and cleans up if the error is >= AbortErrLev ! Passed arguments INTEGER(IntKi), INTENT(IN) :: ErrID ! The error identifier (ErrStat) CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) + CHARACTER(1024) :: ErrMsg3 ! The error message (ErrMsg) ! Set error status/message; IF ( ErrID /= ErrID_None ) THEN @@ -516,29 +2252,54 @@ SUBROUTINE CheckError(ErrID,Msg) IF ( ErrStat >= AbortErrLev ) THEN - IF (ALLOCATED(m%FairIdList )) DEALLOCATE(m%FairIdList ) - IF (ALLOCATED(m%ConnIdList )) DEALLOCATE(m%ConnIdList ) - IF (ALLOCATED(m%LineStateIndList )) DEALLOCATE(m%LineStateIndList ) + IF (ALLOCATED(m%CpldConIs )) DEALLOCATE(m%CpldConIs ) + IF (ALLOCATED(m%FreeConIs )) DEALLOCATE(m%FreeConIs ) + IF (ALLOCATED(m%LineStateIs1 )) DEALLOCATE(m%LineStateIs1 ) + IF (ALLOCATED(m%LineStateIsN )) DEALLOCATE(m%LineStateIsN ) + IF (ALLOCATED(m%ConStateIs1 )) DEALLOCATE(m%ConStateIs1 ) + IF (ALLOCATED(m%ConStateIsN )) DEALLOCATE(m%ConStateIsN ) IF (ALLOCATED(x%states )) DEALLOCATE(x%states ) - IF (ALLOCATED(FairTensIC )) DEALLOCATE(FairTensIC ) + IF (ALLOCATED(FairTensIC )) DEALLOCATE(FairTensIC ) + + call CleanUp() ! make sure to close files END IF END IF END SUBROUTINE CheckError + SUBROUTINE CleanUp() + ! ErrStat = ErrID_Fatal + call MD_DestroyInputFileType( InputFileDat, ErrStat2, ErrMsg2 ) ! Ignore any error messages from this + IF (p%UnLog > 0_IntKi) CLOSE( p%UnLog ) ! Remove this when the log file is kept open during the full simulation + END SUBROUTINE + + !> If for some reason the file is truncated, it is possible to get into an infinite loop + !! in a while looking for the next section and accidentally overstep the end of the array + !! resulting in a segfault. This function will trap that issue and return a section break + CHARACTER(1024) function NextLine(i) + integer, intent(inout) :: i ! Current line number corresponding to contents of NextLine + i=i+1 ! Increment to line next line. + if (i>FileInfo_In%NumLines) then + NextLine="---" ! Set as a separator so we can escape some of the while loops + else + NextLine=trim(FileInfo_In%Lines(i)) + !TODO: add comment character recognition here? (discard any characters past a #) + endif + end function NextLine + END SUBROUTINE MD_Init - !============================================================================================== + !----------------------------------------------------------------------------------------====== - !============================================================================================== - SUBROUTINE MD_UpdateStates( t, n, u, utimes, p, x, xd, z, other, m, ErrStat, ErrMsg) + !----------------------------------------------------------------------------------------====== + SUBROUTINE MD_UpdateStates( t, n, u, t_array, p, x, xd, z, other, m, ErrStat, ErrMsg) REAL(DbKi) , INTENT(IN ) :: t INTEGER(IntKi) , INTENT(IN ) :: n TYPE(MD_InputType) , INTENT(INOUT) :: u(:) ! INTENT(INOUT) ! had to change this to INOUT - REAL(DbKi) , INTENT(IN ) :: utimes(:) + REAL(DbKi) , INTENT(IN ) :: t_array(:) TYPE(MD_ParameterType) , INTENT(IN ) :: p ! INTENT(IN ) TYPE(MD_ContinuousStateType) , INTENT(INOUT) :: x ! INTENT(INOUT) TYPE(MD_DiscreteStateType) , INTENT(INOUT) :: xd ! INTENT(INOUT) @@ -553,11 +2314,16 @@ SUBROUTINE MD_UpdateStates( t, n, u, utimes, p, x, xd, z, other, m, ErrStat, Err ! moved to TimeStep TYPE(MD_InputType) :: u_interp ! INTEGER(IntKi) :: nTime + + TYPE(MD_InputType) :: u_interp ! interpolated instantaneous input values to be calculated for each mooring time step - REAL(DbKi) :: t2 ! copy of time passed to TimeStep - + REAL(DbKi) :: t2 ! copy of time variable that will get advanced by the integrator (not sure this is necessary<<<) + REAL(DbKi) :: dtM ! actual mooring dynamics time step + INTEGER(IntKi) :: NdtM ! number of time steps to integrate through with RK2 + INTEGER(IntKi) :: I + INTEGER(IntKi) :: J - nTime = size(u) ! the number of times of input data provided? + nTime = size(u) ! the number of times of input data provided? <<<<<<< not used t2 = t @@ -568,29 +2334,90 @@ SUBROUTINE MD_UpdateStates( t, n, u, utimes, p, x, xd, z, other, m, ErrStat, Err ! IF (ErrStat >= AbortErrLev) RETURN ! ! ! interpolate input mesh to correct time -! CALL MD_Input_ExtrapInterp(u, utimes, u_interp, t, ErrStat2, ErrMsg2) +! CALL MD_Input_ExtrapInterp(u, t_array, u_interp, t, ErrStat2, ErrMsg2) ! CALL CheckError( ErrStat2, ErrMsg2 ) ! IF (ErrStat >= AbortErrLev) RETURN ! ! ! ! go through fairleads and apply motions from driver -! DO I = 1, p%NFairs +! DO I = 1, p%nCpldCons ! DO J = 1,3 -! m%ConnectList(m%FairIdList(I))%r(J) = u_interp%PtFairleadDisplacement%Position(J,I) + u_interp%PtFairleadDisplacement%TranslationDisp(J,I) -! m%ConnectList(m%FairIdList(I))%rd(J) = u_interp%PtFairleadDisplacement%TranslationVel(J,I) ! is this right? <<< +! m%ConnectList(m%CpldConIs(I))%r(J) = u_interp%PtFairleadDisplacement%Position(J,I) + u_interp%PtFairleadDisplacement%TranslationDisp(J,I) +! m%ConnectList(m%CpldConIs(I))%rd(J) = u_interp%PtFairleadDisplacement%TranslationVel(J,I) ! is this right? <<< ! END DO ! END DO ! - ! call function that loops through mooring model time steps - CALL TimeStep ( t2, p%dtCoupling, u, utimes, p, x, xd, z, other, m, ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - ! clean up input interpolation stuff - ! moved to TimeStep CALL MD_DestroyInput(u_interp, ErrStat, ErrMsg) +! ! call function that loops through mooring model time steps +! CALL TimeStep ( t2, p%dtCoupling, u, t_array, p, x, xd, z, other, m, ErrStat2, ErrMsg2 ) +! CALL CheckError( ErrStat2, ErrMsg2 ) +! IF (ErrStat >= AbortErrLev) RETURN + + + ! create space for arrays/meshes in u_interp ... is it efficient to do this every time step??? + CALL MD_CopyInput(u(1), u_interp, MESH_NEWCOPY, ErrStat, ErrMsg) + + + ! round dt to integer number of time steps <<<< should this be calculated only once, up front? + NdtM = ceiling(p%dtCoupling/p%dtM0) ! get number of mooring time steps to do based on desired time step size + dtM = p%dtCoupling/REAL(NdtM,DbKi) ! adjust desired time step to satisfy dt with an integer number of time steps + + + !loop through line integration time steps + DO I = 1, NdtM ! for (double ts=t; ts<=t+ICdt-dts; ts+=dts) + + CALL MD_RK2(t2, dtM, u_interp, u, t_array, p, x, xd, z, other, m, ErrStat2, ErrMsg2) + + + ! check for NaNs - is this a good place/way to do it? + DO J = 1, m%Nx + IF (Is_NaN(x%states(J))) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' NaN state detected.' + EXIT + END IF + END DO + + IF (ErrStat == ErrID_Fatal) THEN + CALL WrScr("NaN detected at time "//TRIM(Num2LStr(t2))//" in MoorDyn.") + IF (wordy > 1) THEN + print *, ". Here is the state vector: " + print *, x%states + END IF + EXIT + END IF + + END DO ! I time steps + + + ! destroy dxdt and x2, and u_interp + !CALL MD_DestroyContState( dxdt, ErrStat, ErrMsg) + !CALL MD_DestroyContState( x2, ErrStat, ErrMsg) + CALL MD_DestroyInput(u_interp, ErrStat, ErrMsg) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error destroying dxdt or x2.' + END IF + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MD_UpdateStates') + + ! check for NaNs - is this a good place/way to do it? + DO J = 1, m%Nx + IF (Is_NaN(x%states(J))) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' NaN state detected.' + EXIT + END IF + END DO + + IF (ErrStat == ErrID_Fatal) THEN + CALL WrScr("NaN detected at time "//TRIM(Num2LStr(t2))//" in MoorDyn.") + IF (wordy > 1) THEN + print *, ". Here is the state vector: " + print *, x%states + END IF + END IF CONTAINS @@ -618,11 +2445,11 @@ SUBROUTINE CheckError(ErrId, Msg) END SUBROUTINE CheckError END SUBROUTINE MD_UpdateStates - !======================================================================================== + !---------------------------------------------------------------------------------------- - !======================================================================================== + !---------------------------------------------------------------------------------------- SUBROUTINE MD_CalcOutput( t, u, p, x, xd, z, other, y, m, ErrStat, ErrMsg ) REAL(DbKi) , INTENT(IN ) :: t @@ -637,46 +2464,148 @@ SUBROUTINE MD_CalcOutput( t, u, p, x, xd, z, other, y, m, ErrStat, ErrMsg ) INTEGER(IntKi) , INTENT(INOUT) :: ErrStat CHARACTER(*) , INTENT(INOUT) :: ErrMsg - TYPE(MD_ContinuousStateType) :: dxdt ! time derivatives of continuous states (initialized in CalcContStateDeriv) - INTEGER(IntKi) :: I ! counter - INTEGER(IntKi) :: J ! counter - - INTEGER(IntKi) :: ErrStat2 ! Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None + ! TYPE(MD_ContinuousStateType) :: dxdt ! time derivatives of continuous states (initialized in CalcContStateDeriv) + INTEGER(IntKi) :: I ! counter + INTEGER(IntKi) :: J ! counter + INTEGER(IntKi) :: K ! counter + INTEGER(IntKi) :: l ! index used for objects + INTEGER(IntKi) :: iTurb ! counter + + Real(DbKi) :: F6net(6) ! net force and moment calculated on coupled objects + + INTEGER(IntKi) :: ErrStat2 ! Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None ! below updated to make sure outputs are current (based on provided x and u) - similar to what's in UpdateStates - ! go through fairleads and apply motions from driver - DO I = 1, p%NFairs - DO J = 1,3 - m%ConnectList(m%FairIdList(I))%r(J) = u%PtFairleadDisplacement%Position(J,I) + u%PtFairleadDisplacement%TranslationDisp(J,I) - m%ConnectList(m%FairIdList(I))%rd(J) = u%PtFairleadDisplacement%TranslationVel(J,I) ! is this right? <<< - END DO - END DO + ! ! go through fairleads and apply motions from driver + ! DO I = 1, p%nCpldCons + ! DO J = 1,3 + ! m%ConnectList(m%CpldConIs(I))%r(J) = u%CoupledKinematics%Position(J,I) + u%CoupledKinematics%TranslationDisp(J,I) + ! m%ConnectList(m%CpldConIs(I))%rd(J) = u%CoupledKinematics%TranslationVel(J,I) ! is this right? <<< + ! END DO + ! END DO + + + ! ! go through nodes and apply wave kinematics from driver (if water kinematics were passed in at each node in future) + ! IF (p%WaterKin > 0) THEN + ! + ! J=0 + ! ! Body reference point coordinates + ! DO I = 1, p%nBodies + ! J = J + 1 + ! m%BodyList(I)%U = u%U(:,J) + ! m%BodyList(I)%Ud = u%Ud(:,J) + ! m%BodyList(I)%zeta = u%zeta(J) + ! END DO + ! ! Rod node coordinates + ! DO I = 1, p%nRods + ! DO K = 0,m%RodList(I)%N + ! J = J + 1 + ! m%RodList(I)%U (:,K) = u%U(:,J) + ! m%RodList(I)%Ud(:,K) = u%Ud(:,J) + ! m%RodList(I)%zeta(K) = u%zeta(J) + ! m%RodList(I)%PDyn(K) = u%PDyn(J) + ! END DO + ! END DO + ! ! Point reference point coordinates + ! DO I = 1, p%nConnects + ! J = J + 1 + ! m%ConnectList(I)%U = u%U(:,J) + ! m%ConnectList(I)%Ud = u%Ud(:,J) + ! m%ConnectList(I)%zeta = u%zeta(J) + ! END DO + ! ! Line internal node coordinates + ! DO I = 1, p%nLines + ! DO K = 1, m%LineList(I)%N-1 + ! J = J + 1 + ! m%LineList(I)%U (:,K) = u%U(:,J) + ! m%LineList(I)%Ud(:,K) = u%Ud(:,J) + ! m%LineList(I)%zeta(K) = u%zeta(J) + ! END DO + ! END DO + ! + ! END IF + + ! call CalcContStateDeriv in order to run model and calculate dynamics with provided x and u - CALL MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, ErrMsg ) - - - ! assign net force on fairlead Connects to the output mesh - DO i = 1, p%NFairs - DO J=1,3 - y%PtFairleadLoad%Force(J,I) = m%ConnectList(m%FairIdList(I))%Ftot(J) + CALL MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, m%xdTemp, ErrStat, ErrMsg ) + + ! ! assign net force on fairlead Connects to the fairlead force output mesh + ! DO i = 1, p%nCpldCons + ! DO J=1,3 + ! y%PtFairleadLoad%Force(J,I) = m%ConnectList(m%CpldConIs(I))%Fnet(J) + ! END DO + ! END DO + + ! now that forces have been updated, write them to the output mesh + + do iTurb = 1,p%nTurbines + + J = 0 ! mesh index + DO l = 1,p%nCpldBodies(iTurb) + J = J + 1 + CALL Body_GetCoupledForce(m%BodyList(m%CpldBodyIs(l,iTurb)), F6net, m, p) + y%CoupledLoads(iTurb)%Force( :,J) = F6net(1:3) + y%CoupledLoads(iTurb)%Moment(:,J) = F6net(4:6) END DO - END DO - + + DO l = 1,p%nCpldRods(iTurb) + J = J + 1 + CALL Rod_GetCoupledForce(m%RodList(m%CpldRodIs(l,iTurb)), F6net, m, p) + y%CoupledLoads(iTurb)%Force( :,J) = F6net(1:3) + y%CoupledLoads(iTurb)%Moment(:,J) = F6net(4:6) + END DO + + DO l = 1,p%nCpldCons(iTurb) + J = J + 1 + CALL Connect_GetCoupledForce(m%ConnectList(m%CpldConIs(l,iTurb)), F6net(1:3), m, p) + y%CoupledLoads(iTurb)%Force(:,J) = F6net(1:3) + END DO + + end do + + ! ! write all node positions to the node positons output array (if water kinematics were passed in at each node in future) + ! ! go through the nodes and fill in the data (this should maybe be turned into a global function) + ! J=0 + ! ! Body reference point coordinates + ! DO I = 1, p%nBodies + ! J = J + 1 + ! y%rAll(:,J) = m%BodyList(I)%r6(1:3) + ! END DO + ! ! Rod node coordinates + ! DO I = 1, p%nRods + ! DO K = 0,m%RodList(I)%N + ! J = J + 1 + ! y%rAll(:,J) = m%RodList(I)%r(:,K) + ! END DO + ! END DO + ! ! Point reference point coordinates + ! DO I = 1, p%nConnects + ! J = J + 1 + ! y%rAll(:,J) = m%ConnectList(I)%r + ! END DO + ! ! Line internal node coordinates + ! DO I = 1, p%nLines + ! DO K = 1, m%LineList(I)%N-1 + ! J = J + 1 + ! y%rAll(:,J) = m%LineList(I)%r(:,K) + ! END DO + ! END DO + ! calculate outputs (y%WriteOutput) for glue code and write any m outputs to MoorDyn output files - CALL MDIO_WriteOutputs(t, p, m, y, ErrStat2, ErrMsg2) + CALL MDIO_WriteOutputs(REAL(t,DbKi) , p, m, y, ErrStat2, ErrMsg2) CALL CheckError(ErrStat2, 'In MDIO_WriteOutputs: '//trim(ErrMsg2)) IF ( ErrStat >= AbortErrLev ) RETURN - ! destroy dxdt - CALL MD_DestroyContState( dxdt, ErrStat2, ErrMsg2) - CALL CheckError(ErrStat2, 'When destroying dxdt: '//trim(ErrMsg2)) - IF ( ErrStat >= AbortErrLev ) RETURN + ! ! destroy dxdt + ! CALL MD_DestroyContState( dxdt, ErrStat2, ErrMsg2) + ! CALL CheckError(ErrStat2, 'When destroying dxdt: '//trim(ErrMsg2)) + ! IF ( ErrStat >= AbortErrLev ) RETURN @@ -697,18 +2626,18 @@ SUBROUTINE CheckError(ErrId, Msg) CALL WrScr( ErrMsg ) ! do this always or only if warning level? <<<<<<<<<<<<<<<<<<<<<< probably should remove all instances - IF( ErrStat > ErrID_Warn ) THEN - CALL MD_DestroyContState( dxdt, ErrStat2, ErrMsg2) - END IF + ! IF( ErrStat > ErrID_Warn ) THEN + ! CALL MD_DestroyContState( dxdt, ErrStat2, ErrMsg2) + ! END IF END IF END SUBROUTINE CheckError END SUBROUTINE MD_CalcOutput - !============================================================================================= + !---------------------------------------------------------------------------------------- - !============================================================================================= + !---------------------------------------------------------------------------------------- SUBROUTINE MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, ErrMsg ) ! Tight coupling routine for computing derivatives of continuous states ! this is modelled off what used to be subroutine DoRHSmaster @@ -721,430 +2650,279 @@ SUBROUTINE MD_CalcContStateDeriv( t, u, p, x, xd, z, other, m, dxdt, ErrStat, Er TYPE(MD_ConstraintStateType), INTENT(IN ) :: z ! Constraint states at t TYPE(MD_OtherStateType), INTENT(IN ) :: other ! Other states at t TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! misc/optimization variables - TYPE(MD_ContinuousStateType), INTENT( OUT) :: dxdt ! Continuous state derivatives at t + TYPE(MD_ContinuousStateType), INTENT(INOUT) :: dxdt ! Continuous state derivatives at t INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None INTEGER(IntKi) :: L ! index + INTEGER(IntKi) :: I ! index INTEGER(IntKi) :: J ! index INTEGER(IntKi) :: K ! index + INTEGER(IntKi) :: iTurb ! index INTEGER(IntKi) :: Istart ! start index of line/connect in state vector INTEGER(IntKi) :: Iend ! end index of line/connect in state vector - + REAL(DbKi) :: temp(3) ! temporary for passing kinematics + + REAL(DbKi) :: r6_in(6) ! temporary for passing kinematics + REAL(DbKi) :: v6_in(6) ! temporary for passing kinematics + REAL(DbKi) :: a6_in(6) ! temporary for passing kinematics + REAL(DbKi) :: r_in(3) ! temporary for passing kinematics + REAL(DbKi) :: rd_in(3) ! temporary for passing kinematics + REAL(DbKi) :: a_in(3) ! temporary for passing kinematics + + INTEGER(IntKi) :: ErrStat2 ! Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None + character(*), parameter :: RoutineName = 'MD_CalcContStateDeriv' + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" - ! allocations of dxdt (as in SubDyn. "INTENT(OUT) automatically deallocates the arrays on entry, we have to allocate them here" is this right/efficient?) - ALLOCATE ( dxdt%states(size(x%states)), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating dxdt%states array.' - RETURN + ! allocate dxdt if not already allocated (e.g. if called for linearization) + IF (.NOT. ALLOCATED(dxdt%states) ) THEN + CALL AllocAry( dxdt%states, SIZE(x%states), 'dxdt%states', ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF ( ErrStat >= AbortErrLev ) RETURN END IF - - ! clear connection force and mass values + ! clear connection force and mass values updateFairlead( t ); <<<< manually set anchored connection stuff for now here + r6_in = 0.0_DbKi + v6_in = 0.0_DbKi + CALL Body_SetKinematics(m%GroundBody, r6_in, v6_in, m%zeros6, t, m) + + ! ---------------------------------- coupled things --------------------------------- + ! Apply displacement and velocity terms here. Accelerations will be considered to calculate inertial loads at the end. + ! Note: TurbineRefPos is to offset into farm's true global reference based on turbine X and Y reference positions (these should be 0 for regular FAST use) + - ! update fairlead positions for instantaneous values (fixed 2015-06-22) - DO K = 1, p%NFairs - DO J = 1,3 - m%ConnectList(m%FairIdList(K))%r(J) = u%PtFairleadDisplacement%Position(J,K) + u%PtFairleadDisplacement%TranslationDisp(J,K) - m%ConnectList(m%FairIdList(K))%rd(J) = u%PtFairleadDisplacement%TranslationVel(J,K) ! is this right? <<< + DO iTurb = 1, p%nTurbines + + J = 0 ! J is the index of the coupling points in the input mesh CoupledKinematics + ! any coupled bodies (type -1) + DO l = 1,p%nCpldBodies(iTurb) + J = J + 1 + r6_in(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) + !r6_in(4:6) = EulerExtract( TRANSPOSE( u%CoupledKinematics(iTurb)%Orientation(:,:,J) ) ) + r6_in(4:6) = EulerExtract( u%CoupledKinematics(iTurb)%Orientation(:,:,J) ) ! <<< changing back + v6_in(1:3) = u%CoupledKinematics(iTurb)%TranslationVel(:,J) + v6_in(4:6) = u%CoupledKinematics(iTurb)%RotationVel(:,J) + a6_in(1:3) = u%CoupledKinematics(iTurb)%TranslationAcc(:,J) + a6_in(4:6) = u%CoupledKinematics(iTurb)%RotationAcc(:,J) + + CALL Body_SetKinematics(m%BodyList(m%CpldBodyIs(l,iTurb)), r6_in, v6_in, a6_in, t, m) END DO - END DO - + + ! any coupled rods (type -1 or -2) note, rotations ignored if it's a pinned rod + DO l = 1,p%nCpldRods(iTurb) + J = J + 1 + + r6_in(1:3) = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) + r6_in(4:6) = MATMUL( u%CoupledKinematics(iTurb)%Orientation(:,:,J) , (/0.0, 0.0, 1.0/) ) ! <<<< CHECK ! adjustment because rod's rotational entries are a unit vector, q + v6_in(1:3) = u%CoupledKinematics(iTurb)%TranslationVel(:,J) + v6_in(4:6) = u%CoupledKinematics(iTurb)%RotationVel(:,J) + a6_in(1:3) = u%CoupledKinematics(iTurb)%TranslationAcc(:,J) + a6_in(4:6) = u%CoupledKinematics(iTurb)%RotationAcc(:,J) + + CALL Rod_SetKinematics(m%RodList(m%CpldRodIs(l,iTurb)), r6_in, v6_in, a6_in, t, m) + + END DO + + ! any coupled points (type -1) + DO l = 1, p%nCpldCons(iTurb) + J = J + 1 + + r_in = u%CoupledKinematics(iTurb)%Position(:,J) + u%CoupledKinematics(iTurb)%TranslationDisp(:,J) + p%TurbineRefPos(:,iTurb) + rd_in = u%CoupledKinematics(iTurb)%TranslationVel(:,J) + a_in(1:3) = u%CoupledKinematics(iTurb)%TranslationAcc(:,J) + CALL Connect_SetKinematics(m%ConnectList(m%CpldConIs(l,iTurb)), r_in, rd_in, a_in, t, m) + + !print "(f8.5, f12.6, f12.6, f8.4, f8.4, f8.4, f8.4)", t, r_in(1), r_in(3), rd_in(1), rd_in(3), a_in(1), a_in(3) + + END DO + + end do ! iTurb + + + ! >>>>> in theory I would repeat the above but for each turbine in the case of array use here <<<<< + ! DO I = 1,p%nTurbines + ! J = 0? + ! other logic? + ! nvm: need to get kinematics from entries in u%FarmCoupledKinematics(I)%Position etc. + ! nvm: using knowledge of p%meshIndex or something + ! in theory might also support individual line tensioning control commands from turbines this way too, or maybe it's supercontroller level (not a short term problem though) + + ! apply line length changes from active tensioning if applicable DO L = 1, p%NLines IF (m%LineList(L)%CtrlChan > 0) then - + ! do a bounds check to prohibit excessive segment length changes (until a method to add/remove segments is created) IF ( u%DeltaL(m%LineList(L)%CtrlChan) > m%LineList(L)%UnstrLen / m%LineList(L)%N ) then ErrStat = ErrID_Fatal ErrMsg = ' Active tension command will make a segment longer than the limit of twice its original length.' - print *, u%DeltaL(m%LineList(L)%CtrlChan), " is an increase of more than ", (m%LineList(L)%UnstrLen / m%LineList(L)%N) - print *, u%DeltaL - print*, m%LineList(L)%CtrlChan + call WrScr(trim(Num2LStr(u%DeltaL(m%LineList(L)%CtrlChan)))//" is an increase of more than "//trim(Num2LStr(m%LineList(L)%UnstrLen / m%LineList(L)%N))) + IF (wordy > 0) print *, u%DeltaL + IF (wordy > 0) print*, m%LineList(L)%CtrlChan RETURN END IF IF ( u%DeltaL(m%LineList(L)%CtrlChan) < -0.5 * m%LineList(L)%UnstrLen / m%LineList(L)%N ) then ErrStat = ErrID_Fatal ErrMsg = ' Active tension command will make a segment shorter than the limit of half its original length.' - print *, u%DeltaL(m%LineList(L)%CtrlChan), " is a reduction of more than half of ", (m%LineList(L)%UnstrLen / m%LineList(L)%N) - print *, u%DeltaL - print*, m%LineList(L)%CtrlChan + call WrScr(trim(Num2LStr(u%DeltaL(m%LineList(L)%CtrlChan)))//" is a reduction of more than half of "//trim(Num2LStr(m%LineList(L)%UnstrLen / m%LineList(L)%N))) + IF (wordy > 0) print *, u%DeltaL + IF (wordy > 0) print*, m%LineList(L)%CtrlChan RETURN END IF - + ! for now this approach only acts on the fairlead end segment, and assumes all segment lengths are otherwise equal size m%LineList(L)%l( m%LineList(L)%N) = m%LineList(L)%UnstrLen/m%LineList(L)%N + u%DeltaL(m%LineList(L)%CtrlChan) m%LineList(L)%ld(m%LineList(L)%N) = u%DeltaLdot(m%LineList(L)%CtrlChan) END IF END DO - - ! do Line force and acceleration calculations, also add end masses/forces to respective Connects - DO L = 1, p%NLines - Istart = m%LineStateIndList(L) - Iend = Istart + 6*(m%LineList(L)%N - 1) - 1 - CALL DoLineRHS(x%states(Istart:Iend), dxdt%states(Istart:Iend), t, m%LineList(L), & - m%LineTypeList(m%LineList(L)%PropsIdNum), & - m%ConnectList(m%LineList(L)%FairConnect)%Ftot, m%ConnectList(m%LineList(L)%FairConnect)%Mtot, & - m%ConnectList(m%LineList(L)%AnchConnect)%Ftot, m%ConnectList(m%LineList(L)%AnchConnect)%Mtot ) + + + ! ! go through nodes and apply wave kinematics from driver (if water kinematics were passed in at each node in future) + ! IF (p%WaterKin > 0) THEN + ! + ! J=0 + ! ! Body reference point coordinates + ! DO I = 1, p%nBodies + ! J = J + 1 + ! m%BodyList(I)%U = u%U(:,J) + ! m%BodyList(I)%Ud = u%Ud(:,J) + ! m%BodyList(I)%zeta = u%zeta(J) + ! END DO + ! ! Rod node coordinates + ! DO I = 1, p%nRods + ! DO K = 0,m%RodList(I)%N + ! J = J + 1 + ! m%RodList(I)%U (:,K) = u%U(:,J) + ! m%RodList(I)%Ud(:,K) = u%Ud(:,J) + ! m%RodList(I)%zeta(K) = u%zeta(J) + ! m%RodList(I)%PDyn(K) = u%PDyn(J) + ! END DO + ! END DO + ! ! Point reference point coordinates + ! DO I = 1, p%nConnects + ! J = J + 1 + ! m%ConnectList(I)%U = u%U(:,J) + ! m%ConnectList(I)%Ud = u%Ud(:,J) + ! m%ConnectList(I)%zeta = u%zeta(J) + ! END DO + ! ! Line internal node coordinates + ! DO I = 1, p%nLines + ! DO K = 1, m%LineList(I)%N-1 + ! J = J + 1 + ! m%LineList(I)%U (:,K) = u%U(:,J) + ! m%LineList(I)%Ud(:,K) = u%Ud(:,J) + ! m%LineList(I)%zeta(K) = u%zeta(J) + ! END DO + ! END DO + ! + ! END IF + + + ! independent or semi-independent things with their own states... + + ! give Bodies latest state variables (kinematics will also be assigned to dependent connections and rods, and thus line ends) + DO l = 1,p%nFreeBodies + CALL Body_SetState(m%BodyList(m%FreeBodyIs(l)), x%states(m%BodyStateIs1(l):m%BodyStateIsN(l)), t, m) END DO - - - ! perform connection force and mass calculations (done to all connects for sake of calculating fairlead/anchor loads) - DO L = 1, p%NConnects - ! add Connect's own forces including buoyancy and weight - m%ConnectList(L)%Ftot(1) =m%ConnectList(L)%Ftot(1) + m%ConnectList(L)%conFX - m%ConnectList(L)%Ftot(2) =m%ConnectList(L)%Ftot(2) + m%ConnectList(L)%conFY - m%ConnectList(L)%Ftot(3) =m%ConnectList(L)%Ftot(3) + m%ConnectList(L)%conFZ + m%ConnectList(L)%conV*p%rhoW*p%g - m%ConnectList(L)%conM*p%g - - ! add Connect's own mass - DO J = 1,3 - m%ConnectList(L)%Mtot(J,J) = m%ConnectList(L)%Mtot(J,J) + m%ConnectList(L)%conM - END DO - END DO ! L - - - ! do Connect acceleration calculations - changed to do only connect types - DO L = 1, p%NConns - Istart = L*6-5 - Iend = L*6 - CALL DoConnectRHS(x%states(Istart:Iend), dxdt%states(Istart:Iend), t, m%ConnectList(m%ConnIDList(L))) + + ! give independent or pinned rods' latest state variables (kinematics will also be assigned to attached line ends) + DO l = 1,p%nFreeRods + CALL Rod_SetState(m%RodList(m%FreeRodIs(l)), x%states(m%RodStateIs1(l):m%RodStateIsN(l)), t, m) END DO - - - CONTAINS - - - !====================================================================== - SUBROUTINE DoLineRHS (X, Xd, t, Line, LineProp, FairFtot, FairMtot, AnchFtot, AnchMtot) - - Real(DbKi), INTENT( IN ) :: X(:) ! state vector, provided - Real(DbKi), INTENT( INOUT ) :: Xd(:) ! derivative of state vector, returned ! cahnged to INOUT - Real(DbKi), INTENT (IN) :: t ! instantaneous time - TYPE(MD_Line), INTENT (INOUT) :: Line ! label for the current line, for convenience - TYPE(MD_LineProp), INTENT(IN) :: LineProp ! the single line property set for the line of interest - Real(DbKi), INTENT(INOUT) :: FairFtot(:) ! total force on Connect top of line is attached to - Real(DbKi), INTENT(INOUT) :: FairMtot(:,:) ! total mass of Connect top of line is attached to - Real(DbKi), INTENT(INOUT) :: AnchFtot(:) ! total force on Connect bottom of line is attached to - Real(DbKi), INTENT(INOUT) :: AnchMtot(:,:) ! total mass of Connect bottom of line is attached to - - - INTEGER(IntKi) :: I ! index of segments or nodes along line - INTEGER(IntKi) :: J ! index - INTEGER(IntKi) :: K ! index - INTEGER(IntKi) :: N ! number of segments in line - Real(DbKi) :: d ! line diameter - Real(DbKi) :: rho ! line material density [kg/m^3] - Real(DbKi) :: Sum1 ! for summing squares - Real(DbKi) :: m_i ! node mass - Real(DbKi) :: v_i ! node submerged volume - Real(DbKi) :: Vi(3) ! relative water velocity at a given node - Real(DbKi) :: Vp(3) ! transverse relative water velocity component at a given node - Real(DbKi) :: Vq(3) ! tangential relative water velocity component at a given node - Real(DbKi) :: SumSqVp ! - Real(DbKi) :: SumSqVq ! - Real(DbKi) :: MagVp ! - Real(DbKi) :: MagVq ! - - - N = Line%N ! for convenience - d = LineProp%d ! for convenience - rho = LineProp%w/(Pi/4.0*d*d) - - - - ! set end node positions and velocities from connect objects' states - DO J = 1, 3 - Line%r( J,N) = m%ConnectList(Line%FairConnect)%r(J) - Line%r( J,0) = m%ConnectList(Line%AnchConnect)%r(J) - Line%rd(J,N) = m%ConnectList(Line%FairConnect)%rd(J) - Line%rd(J,0) = m%ConnectList(Line%AnchConnect)%rd(J) - END DO - - ! set interior node positions and velocities - DO I = 1, N-1 - DO J = 1, 3 - Line%r( J,I) = X( 3*N-3 + 3*I-3 + J) ! r(J,I) = X[3*N-3 + 3*i-3 + J]; // get positions .. used to start from m%LineStateIndList(Line%IdNum) in whole state vector - Line%rd(J,I) = X( 3*I-3 + J) ! rd(J,I) = X[ 3*i-3 + J]; // get velocities - END DO - END DO - - ! calculate instantaneous (stretched) segment lengths and rates << should add catch here for if lstr is ever zero - DO I = 1, N - Sum1 = 0.0_DbKi - DO J = 1, 3 - Sum1 = Sum1 + (Line%r(J,I) - Line%r(J,I-1)) * (Line%r(J,I) - Line%r(J,I-1)) - END DO - Line%lstr(I) = sqrt(Sum1) ! stretched segment length - - Sum1 = 0.0_DbKi - DO J = 1, 3 - Sum1 = Sum1 + (Line%r(J,I) - Line%r(J,I-1))*(Line%rd(J,I) - Line%rd(J,I-1)) - END DO - Line%lstrd(I) = Sum1/Line%lstr(I) ! segment stretched length rate of change - - ! Line%V(I) = Pi/4.0 * d*d*Line%l(I) !volume attributed to segment - END DO - - !calculate unit tangent vectors (q) for each node (including ends) note: I think these are pointing toward 0 rather than N! - CALL UnitVector(Line%q(:,0), Line%r(:,1), Line%r(:,0)) ! compute unit vector q - DO I = 1, N-1 - CALL UnitVector(Line%q(:,I), Line%r(:,I+1), Line%r(:,I-1)) ! compute unit vector q ... using adjacent two nodes! - END DO - CALL UnitVector(Line%q(:,N), Line%r(:,N), Line%r(:,N-1)) ! compute unit vector q - - - ! wave kinematics not implemented yet - - - !calculate mass (including added mass) matrix for each node - DO I = 0, N - IF (I==0) THEN - m_i = Pi/8.0 *d*d*Line%l(1)*rho - v_i = 0.5 *Line%V(1) - ELSE IF (I==N) THEN - m_i = pi/8.0 *d*d*Line%l(N)*rho; - v_i = 0.5*Line%V(N) - ELSE - m_i = pi/8.0 * d*d*rho*(Line%l(I) + Line%l(I+1)) - v_i = 0.5 *(Line%V(I) + Line%V(I+1)) - END IF - - DO J=1,3 - DO K=1,3 - IF (J==K) THEN - Line%M(K,J,I) = m_i + p%rhoW*v_i*( LineProp%Can*(1 - Line%q(J,I)*Line%q(K,I)) + LineProp%Cat*Line%q(J,I)*Line%q(K,I) ) - ELSE - Line%M(K,J,I) = p%rhoW*v_i*( LineProp%Can*(-Line%q(J,I)*Line%q(K,I)) + LineProp%Cat*Line%q(J,I)*Line%q(K,I) ) - END IF - END DO - END DO - - CALL Inverse3by3(Line%S(:,:,I), Line%M(:,:,I)) ! invert mass matrix - END DO - - - ! ------------------ CALCULATE FORCES ON EACH NODE ---------------------------- - - ! loop through the segments - DO I = 1, N - - ! line tension, inherently including possibility of dynamic length changes in l term - IF (Line%lstr(I)/Line%l(I) > 1.0) THEN - DO J = 1, 3 - Line%T(J,I) = LineProp%EA *( 1.0/Line%l(I) - 1.0/Line%lstr(I) ) * (Line%r(J,I)-Line%r(J,I-1)) - END DO - ELSE - DO J = 1, 3 - Line%T(J,I) = 0.0_DbKi ! cable can't "push" - END DO - END if - - ! line internal damping force based on line-specific BA value, including possibility of dynamic length changes in l and ld terms - DO J = 1, 3 - Line%Td(J,I) = Line%BA* ( Line%lstrd(I) - Line%lstr(I)*Line%ld(I)/Line%l(I) )/Line%l(I) * (Line%r(J,I)-Line%r(J,I-1)) / Line%lstr(I) - END DO - END DO - - - - ! loop through the nodes - DO I = 0, N - - !submerged weight (including buoyancy) - IF (I==0) THEN - Line%W(3,I) = Pi/8.0*d*d* Line%l(1)*(rho - p%rhoW) *(-p%g) ! assuming g is positive - ELSE IF (i==N) THEN - Line%W(3,I) = pi/8.0*d*d* Line%l(N)*(rho - p%rhoW) *(-p%g) - ELSE - Line%W(3,I) = pi/8.0*d*d* (Line%l(I)*(rho - p%rhoW) + Line%l(I+1)*(rho - p%rhoW) )*(-p%g) ! left in this form for future free surface handling - END IF - - !relative flow velocities - DO J = 1, 3 - Vi(J) = 0.0 - Line%rd(J,I) ! relative flow velocity over node -- this is where wave velicites would be added - END DO - - ! decomponse relative flow into components - SumSqVp = 0.0_DbKi ! start sums of squares at zero - SumSqVq = 0.0_DbKi - DO J = 1, 3 - Vq(J) = DOT_PRODUCT( Vi , Line%q(:,I) ) * Line%q(J,I); ! tangential relative flow component - Vp(J) = Vi(J) - Vq(J) ! transverse relative flow component - SumSqVq = SumSqVq + Vq(J)*Vq(J) - SumSqVp = SumSqVp + Vp(J)*Vp(J) - END DO - MagVp = sqrt(SumSqVp) ! get magnitudes of flow components - MagVq = sqrt(SumSqVq) - - ! transverse and tangenential drag - IF (I==0) THEN - DO J = 1, 3 - Line%Dp(J,I) = 0.25*p%rhoW*LineProp%Cdn* d*Line%l(1) * MagVp * Vp(J) - Line%Dq(J,I) = 0.25*p%rhoW*LineProp%Cdt* Pi*d*Line%l(1) * MagVq * Vq(J) - END DO - ELSE IF (I==N) THEN - DO J = 1, 3 - Line%Dp(J,I) = 0.25*p%rhoW*LineProp%Cdn* d*Line%l(N) * MagVp * Vp(J); - Line%Dq(J,I) = 0.25*p%rhoW*LineProp%Cdt* Pi*d*Line%l(N) * MagVq * Vq(J) - END DO - ELSE - DO J = 1, 3 - Line%Dp(J,I) = 0.25*p%rhoW*LineProp%Cdn* d*(Line%l(I) + Line%l(I+1)) * MagVp * vp(J); - Line%Dq(J,I) = 0.25*p%rhoW*LineProp%Cdt* Pi*d*(Line%l(I) + Line%l(I+1)) * MagVq * vq(J); - END DO - END IF - - ! F-K force from fluid acceleration not implemented yet - - ! bottom contact (stiffness and damping, vertical-only for now) - updated Nov 24 for general case where anchor and fairlead ends may deal with bottom contact forces - - IF (Line%r(3,I) < -p%WtrDpth) THEN - IF (I==0) THEN - Line%B(3,I) = ( (-p%WtrDpth - Line%r(3,I))*p%kBot - Line%rd(3,I)*p%cBot) * 0.5*d*( Line%l(I+1) ) - ELSE IF (I==N) THEN - Line%B(3,I) = ( (-p%WtrDpth - Line%r(3,I))*p%kBot - Line%rd(3,I)*p%cBot) * 0.5*d*(Line%l(I) ) - ELSE - Line%B(3,I) = ( (-p%WtrDpth - Line%r(3,I))*p%kBot - Line%rd(3,I)*p%cBot) * 0.5*d*(Line%l(I) + Line%l(I+1) ) - - - - END IF - ELSE - Line%B(3,I) = 0.0_DbKi - END IF - - ! total forces - IF (I==0) THEN - DO J = 1, 3 - Line%F(J,I) = Line%T(J,1) + Line%Td(J,1) + Line%W(J,I) + Line%Dp(J,I) + Line%Dq(J,I) + Line%B(J,I) - END DO - ELSE IF (I==N) THEN - DO J = 1, 3 - Line%F(J,I) = -Line%T(J,N) - Line%Td(J,N) + Line%W(J,I) + Line%Dp(J,I) + Line%Dq(J,I) + Line%B(J,I) - END DO - ELSE - DO J = 1, 3 - Line%F(J,I) = Line%T(J,I+1) - Line%T(J,I) + Line%Td(J,I+1) - Line%Td(J,I) + Line%W(J,I) + Line%Dp(J,I) + Line%Dq(J,I) + Line%B(J,I) - END DO - END IF - - END DO ! I - done looping through nodes - - - ! loop through internal nodes and update their states - DO I=1, N-1 - DO J=1,3 - - ! calculate RHS constant (premultiplying force vector by inverse of mass matrix ... i.e. rhs = S*Forces) - Sum1 = 0.0_DbKi ! reset temporary accumulator - DO K = 1, 3 - Sum1 = Sum1 + Line%S(K,J,I) * Line%F(K,I) ! matrix-vector multiplication [S i]{Forces i} << double check indices - END DO ! K - - ! update states - Xd(3*N-3 + 3*I-3 + J) = X(3*I-3 + J); ! dxdt = V (velocities) - Xd( 3*I-3 + J) = Sum1 ! dVdt = RHS * A (accelerations) - - END DO ! J - END DO ! I - - - ! add force and mass of end nodes to the Connects they correspond to - DO J = 1,3 - FairFtot(J) = FairFtot(J) + Line%F(J,N) - AnchFtot(J) = AnchFtot(J) + Line%F(J,0) - DO K = 1,3 - FairMtot(K,J) = FairMtot(K,J) + Line%M(K,J,N) - AnchMtot(K,J) = AnchMtot(K,J) + Line%M(K,J,0) - END DO - END DO - - END SUBROUTINE DoLineRHS - !===================================================================== - - - !====================================================================== - SUBROUTINE DoConnectRHS (X, Xd, t, Connect) - - ! This subroutine is for the "Connect" type of Connections only. Other types don't have their own state variables. - Real(DbKi), INTENT( IN ) :: X(:) ! state vector for this connect, provided - Real(DbKi), INTENT( OUT ) :: Xd(:) ! derivative of state vector for this connect, returned - Real(DbKi), INTENT (IN) :: t ! instantaneous time - Type(MD_Connect), INTENT (INOUT) :: Connect ! Connect number - - - !INTEGER(IntKi) :: I ! index of segments or nodes along line - INTEGER(IntKi) :: J ! index - INTEGER(IntKi) :: K ! index - Real(DbKi) :: Sum1 ! for adding things - - ! When this sub is called, the force and mass contributions from the attached Lines should already have been added to - ! Fto and Mtot by the Line RHS function. Also, any self weight, buoyancy, or external forcing should have already been - ! added by the calling subroutine. The only thing left is any added mass or drag forces from the connection (e.g. float) - ! itself, which will be added below. - - - IF (EqualRealNos(t, 0.0_DbKi)) THEN ! this is old: with current IC gen approach, we skip the first call to the line objects, because they're set AFTER the call to the connects + ! give Connects (independent connections) latest state variable values (kinematics will also be assigned to attached line ends) + DO l = 1,p%nFreeCons + ! Print *, "calling SetState for free connection, con#", m%FreeConIs(l), " with state range: ", m%ConStateIs1(l), "-", m%ConStateIsN(l) + !K=K+1 + CALL Connect_SetState(m%ConnectList(m%FreeConIs(l)), x%states(m%ConStateIs1(l):m%ConStateIsN(l)), t, m) + END DO + + ! give Lines latest state variable values for internal nodes + DO l = 1,p%nLines + CALL Line_SetState(m%LineList(l), x%states(m%LineStateIs1(l):m%LineStateIsN(l)), t) + END DO - DO J = 1,3 - Xd(3+J) = X(J) ! velocities - these are unused in integration - Xd(J) = 0.0_DbKi ! accelerations - these are unused in integration - END DO - ELSE - ! from state values, get r and rdot values - DO J = 1,3 - Connect%r(J) = X(3 + J) ! get positions - Connect%rd(J) = X(J) ! get velocities - END DO - END IF + ! calculate dynamics of free objects (will also calculate forces (doRHS()) from any child/dependent objects)... - - ! add any added mass and drag forces from the Connect body itself - DO J = 1,3 - Connect%Ftot(J) = Connect%Ftot(J) - 0.5 * p%rhoW * Connect%rd(J) * abs(Connect%rd(J)) * Connect%conCdA; ! add drag forces - corrected Nov 24 - Connect%Mtot(J,J) = Connect%Mtot(J,J) + Connect%conV*p%rhoW*Connect%conCa; ! add added mass + ! calculate line dynamics (and calculate line forces and masses attributed to connections) + DO l = 1,p%nLines + CALL Line_GetStateDeriv(m%LineList(l), dxdt%states(m%LineStateIs1(l):m%LineStateIsN(l)), m, p) !dt might also be passed for fancy friction models + END DO + + ! calculate connect dynamics (including contributions from attached lines + ! as well as hydrodynamic forces etc. on connect object itself if applicable) + DO l = 1,p%nFreeCons + CALL Connect_GetStateDeriv(m%ConnectList(m%FreeConIs(l)), dxdt%states(m%ConStateIs1(l):m%ConStateIsN(l)), m, p) + END DO + + ! calculate dynamics of independent Rods + DO l = 1,p%nFreeRods + CALL Rod_GetStateDeriv(m%RodList(m%FreeRodIs(l)), dxdt%states(m%RodStateIs1(l):m%RodStateIsN(l)), m, p) + END DO + + ! calculate dynamics of Bodies + DO l = 1,p%nFreeBodies + CALL Body_GetStateDeriv(m%BodyList(m%FreeBodyIs(l)), dxdt%states(m%BodyStateIs1(l):m%BodyStateIsN(l)), m, p) + END DO + + + + ! get dynamics/forces (doRHS()) of coupled objects, which weren't addressed in above calls (this includes inertial loads) + ! note: can do this in any order since there are no dependencies among coupled objects + + DO iTurb = 1,p%nTurbines + DO l = 1,p%nCpldCons(iTurb) + + ! >>>>>>>> here we should pass along accelerations and include inertial loads in the calculation!!! << 0_IntKi) CLOSE( p%UnLog ) ! close log file if it's open + !TODO: any need to specifically deallocate things like m%xTemp%states in the above? <<<< ! IF ( ErrStat==ErrID_None) THEN ! CALL WrScr('MoorDyn closed without errors') @@ -1219,30 +3000,83 @@ SUBROUTINE CheckError(ErrId, Msg) END SUBROUTINE CheckError - END SUBROUTINE MD_End ! -------+ - !========================================================================================================== + END SUBROUTINE MD_End ! -------+ + !----------------------------------------------------------------------------------------================== + + +!!========== MD_CheckError ======= <---------------------------------------------------------------+ +! SUBROUTINE MD_CheckError(InMsg,OutMsg) +! ! Passed arguments +!! CHARACTER(*), INTENT(IN ) :: InMsg ! The input string +! CHARACTER(*), INTENT(INOUT) :: OutMsg ! The error message (ErrMsg)! +! + ! OutMsg = InMsg + ! RETURN + !END SUBROUTINE MD_CheckError ! -------+ + !----------------------------------------------------------------------------------------================== + + + ! RK2 integrater (part of what was in TimeStep) + !-------------------------------------------------------------- + SUBROUTINE MD_RK2 ( t, dtM, u_interp, u, t_array, p, x, xd, z, other, m, ErrStat, ErrMsg ) + + REAL(DbKi) , INTENT(INOUT) :: t ! intial time (s) for this integration step + REAL(DbKi) , INTENT(IN ) :: dtM ! single time step size (s) for this integration step + TYPE( MD_InputType ) , INTENT(INOUT) :: u_interp ! interpolated instantaneous input values to be calculated for each mooring time step + TYPE( MD_InputType ) , INTENT(INOUT) :: u(:) ! INTENT(IN ) + REAL(DbKi) , INTENT(IN ) :: t_array(:) ! times corresponding to elements of u(:)? + TYPE( MD_ParameterType ) , INTENT(IN ) :: p ! INTENT(IN ) + TYPE( MD_ContinuousStateType ) , INTENT(INOUT) :: x + TYPE( MD_DiscreteStateType ) , INTENT(IN ) :: xd ! INTENT(IN ) + TYPE( MD_ConstraintStateType ) , INTENT(IN ) :: z ! INTENT(IN ) + TYPE( MD_OtherStateType ) , INTENT(IN ) :: other ! INTENT(INOUT) + TYPE(MD_MiscVarType) , INTENT(INOUT) :: m ! INTENT(INOUT) + INTEGER(IntKi) , INTENT( OUT) :: ErrStat + CHARACTER(*) , INTENT( OUT) :: ErrMsg + + + INTEGER(IntKi) :: I ! counter + INTEGER(IntKi) :: J ! counter + + + ! ------------------------------------------------------------------------------- + ! RK2 integrator written here, now calling CalcContStateDeriv + !-------------------------------------------------------------------------------- + + ! step 1 + + CALL MD_Input_ExtrapInterp(u, t_array, u_interp, t , ErrStat, ErrMsg) ! interpolate input mesh to correct time (t) + + CALL MD_CalcContStateDeriv( t, u_interp, p, x, xd, z, other, m, m%xdTemp, ErrStat, ErrMsg ) + DO J = 1, m%Nx + m%xTemp%states(J) = x%states(J) + 0.5*dtM*m%xdTemp%states(J) !x1 = x0 + dt*f0/2.0; + END DO + ! step 2 -!!========== MD_CheckError ======= <---------------------------------------------------------------+ -! SUBROUTINE MD_CheckError(InMsg,OutMsg) -! ! Passed arguments -!! CHARACTER(*), INTENT(IN ) :: InMsg ! The input string -! CHARACTER(*), INTENT(INOUT) :: OutMsg ! The error message (ErrMsg)! -! - ! OutMsg = InMsg - ! RETURN - !END SUBROUTINE MD_CheckError ! -------+ - !========================================================================================================== + CALL MD_Input_ExtrapInterp(u, t_array, u_interp, t + 0.5_DbKi*dtM, ErrStat, ErrMsg) ! interpolate input mesh to correct time (t+0.5*dtM) + + CALL MD_CalcContStateDeriv( (t + 0.5_DbKi*dtM), u_interp, p, m%xTemp, xd, z, other, m, m%xdTemp, ErrStat, ErrMsg ) !called with updated states x2 and time = t + dt/2.0 + DO J = 1, m%Nx + x%states(J) = x%states(J) + dtM*m%xdTemp%states(J) + END DO + t = t + dtM ! update time + + !TODO error check? <<<< + END SUBROUTINE MD_RK2 + !-------------------------------------------------------------- - !======================================================================================================== - SUBROUTINE TimeStep ( t, dtStep, u, utimes, p, x, xd, z, other, m, ErrStat, ErrMsg ) + !----------------------------------------------------------------------------------------================ + ! this would do a full (coupling) time step and is no longer used + SUBROUTINE TimeStep ( t, dtStep, u, t_array, p, x, xd, z, other, m, ErrStat, ErrMsg ) + REAL(DbKi) , INTENT(INOUT) :: t - REAL(ReKi) , INTENT(IN ) :: dtStep ! how long to advance the time for + REAL(DbKi) , INTENT(IN ) :: dtStep ! how long to advance the time for TYPE( MD_InputType ) , INTENT(INOUT) :: u(:) ! INTENT(IN ) - REAL(DbKi) , INTENT(IN ) :: utimes(:) ! times corresponding to elements of u(:)? + REAL(DbKi) , INTENT(IN ) :: t_array(:) ! times corresponding to elements of u(:)? TYPE( MD_ParameterType ) , INTENT(IN ) :: p ! INTENT(IN ) TYPE( MD_ContinuousStateType ) , INTENT(INOUT) :: x TYPE( MD_DiscreteStateType ) , INTENT(IN ) :: xd ! INTENT(IN ) @@ -1262,7 +3096,7 @@ SUBROUTINE TimeStep ( t, dtStep, u, utimes, p, x, xd, z, other, m, ErrStat, ErrM INTEGER(IntKi) :: J ! counter TYPE(MD_InputType) :: u_interp ! interpolated instantaneous input values to be calculated for each mooring time step - Real(DbKi) :: tDbKi ! double version because that's what MD_Input_ExtrapInterp needs. + ! Real(DbKi) :: tDbKi ! double version because that's what MD_Input_ExtrapInterp needs. ! allocate space for x2 @@ -1272,19 +3106,19 @@ SUBROUTINE TimeStep ( t, dtStep, u, utimes, p, x, xd, z, other, m, ErrStat, ErrM CALL MD_CopyInput(u(1), u_interp, MESH_NEWCOPY, ErrStat, ErrMsg) - Nx = size(x%states) + Nx = size(x%states) ! <<<< should this be the m%Nx parameter instead? ! round dt to integer number of time steps NdtM = ceiling(dtStep/p%dtM0) ! get number of mooring time steps to do based on desired time step size - dtM = dtStep/float(NdtM) ! adjust desired time step to satisfy dt with an integer number of time steps + dtM = dtStep/REAL(NdtM,DbKi) ! adjust desired time step to satisfy dt with an integer number of time steps !loop through line integration time steps DO I = 1, NdtM ! for (double ts=t; ts<=t+ICdt-dts; ts+=dts) - !tDbKi = t ! get DbKi version of current time (why does ExtrapInterp except different time type than UpdateStates?) + ! tDbKi = t ! get DbKi version of current time (why does ExtrapInterp except different time type than UpdateStates?) ! ------------------------------------------------------------------------------- @@ -1293,7 +3127,7 @@ SUBROUTINE TimeStep ( t, dtStep, u, utimes, p, x, xd, z, other, m, ErrStat, ErrM ! step 1 - CALL MD_Input_ExtrapInterp(u, utimes, u_interp, t , ErrStat, ErrMsg) ! interpolate input mesh to correct time (t) + CALL MD_Input_ExtrapInterp(u, t_array, u_interp, t , ErrStat, ErrMsg) ! interpolate input mesh to correct time (t) CALL MD_CalcContStateDeriv( t, u_interp, p, x, xd, z, other, m, dxdt, ErrStat, ErrMsg ) DO J = 1, Nx @@ -1302,7 +3136,7 @@ SUBROUTINE TimeStep ( t, dtStep, u, utimes, p, x, xd, z, other, m, ErrStat, ErrM ! step 2 - CALL MD_Input_ExtrapInterp(u, utimes, u_interp, t + 0.5_DbKi*dtM, ErrStat, ErrMsg) ! interpolate input mesh to correct time (t+0.5*dtM) + CALL MD_Input_ExtrapInterp(u, t_array, u_interp, t + 0.5_DbKi*dtM, ErrStat, ErrMsg) ! interpolate input mesh to correct time (t+0.5*dtM) CALL MD_CalcContStateDeriv( (t + 0.5_DbKi*dtM), u_interp, p, x2, xd, z, other, m, dxdt, ErrStat, ErrMsg ) !called with updated states x2 and time = t + dt/2.0 DO J = 1, Nx @@ -1310,16 +3144,14 @@ SUBROUTINE TimeStep ( t, dtStep, u, utimes, p, x, xd, z, other, m, ErrStat, ErrM END DO t = t + dtM ! update time - - !print *, " In TimeStep t=", t, ", L1N8Pz=", M%LineList(1)%r(3,8), ", dL1=", u_interp%DeltaL(1) !---------------------------------------------------------------------------------- ! >>> below should no longer be necessary thanks to using ExtrapInterp of u(:) within the mooring time stepping loop.. <<< ! ! update Fairlead positions by integrating velocity and last position (do this AFTER the processing of the time step rather than before) - ! DO J = 1, p%NFairs + ! DO J = 1, p%nCpldCons ! DO K = 1, 3 - ! m%ConnectList(m%FairIdList(J))%r(K) = m%ConnectList(m%FairIdList(J))%r(K) + m%ConnectList(m%FairIdList(J))%rd(K)*dtM + ! m%ConnectList(m%CpldConIs(J))%r(K) = m%ConnectList(m%CpldConIs(J))%r(K) + m%ConnectList(m%CpldConIs(J))%rd(K)*dtM ! END DO ! END DO @@ -1339,7 +3171,7 @@ SUBROUTINE TimeStep ( t, dtStep, u, utimes, p, x, xd, z, other, m, ErrStat, ErrM ! check for NaNs - is this a good place/way to do it? DO J = 1, Nx - IF (Is_NaN(REAL(x%states(J),DbKi))) THEN + IF (Is_NaN(x%states(J))) THEN ErrStat = ErrID_Fatal ErrMsg = ' NaN state detected.' END IF @@ -1347,880 +3179,904 @@ SUBROUTINE TimeStep ( t, dtStep, u, utimes, p, x, xd, z, other, m, ErrStat, ErrM END SUBROUTINE TimeStep - !====================================================================== - - - - !======================================================================= - SUBROUTINE SetupLine (Line, LineProp, rhoW, ErrStat, ErrMsg) - ! allocate arrays in line object - - TYPE(MD_Line), INTENT(INOUT) :: Line ! the single line object of interest - TYPE(MD_LineProp), INTENT(INOUT) :: LineProp ! the single line property set for the line of interest - REAL(ReKi), INTENT(IN) :: rhoW - INTEGER, INTENT( INOUT ) :: ErrStat ! returns a non-zero value when an error occurs - CHARACTER(*), INTENT( INOUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - INTEGER(4) :: J ! Generic index - INTEGER(4) :: K ! Generic index - INTEGER(IntKi) :: N - - N = Line%N ! number of segments in this line (for code readability) - - ! allocate node positions and velocities (NOTE: these arrays start at ZERO) - ALLOCATE ( Line%r(3, 0:N), Line%rd(3, 0:N), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating r and rd arrays.' - !CALL CleanUp() - RETURN - END IF - - ! allocate node tangent vectors - ALLOCATE ( Line%q(3, 0:N), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating q array.' - !CALL CleanUp() - RETURN - END IF - - ! allocate segment scalar quantities - ALLOCATE ( Line%l(N), Line%ld(N), Line%lstr(N), Line%lstrd(N), Line%V(N), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating segment scalar quantity arrays.' - !CALL CleanUp() - RETURN - END IF - - ! assign values for l and V - DO J=1,N - Line%l(J) = Line%UnstrLen/REAL(N, DbKi) - Line%ld(J)= 0.0_DbKi - Line%V(J) = Line%l(J)*0.25*Pi*LineProp%d*LineProp%d - END DO - - ! allocate segment tension and internal damping force vectors - ALLOCATE ( Line%T(3, N), Line%Td(3, N), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating T and Td arrays.' - !CALL CleanUp() - RETURN - END IF - - ! allocate node force vectors - ALLOCATE ( Line%W(3, 0:N), Line%Dp(3, 0:N), Line%Dq(3, 0:N), Line%Ap(3, 0:N), & - Line%Aq(3, 0:N), Line%B(3, 0:N), Line%F(3, 0:N), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating node force arrays.' - !CALL CleanUp() - RETURN - END IF - - ! set gravity and bottom contact forces to zero initially (because the horizontal components should remain at zero) - DO J = 0,N - DO K = 1,3 - Line%W(K,J) = 0.0_DbKi - Line%B(K,J) = 0.0_DbKi - END DO - END DO - - ! allocate mass and inverse mass matrices for each node (including ends) - ALLOCATE ( Line%S(3, 3, 0:N), Line%M(3, 3, 0:N), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating T and Td arrays.' - !CALL CleanUp() - RETURN - END IF - - ! Specify specific internal damping coefficient (BA) for this line. - ! Will be equal to inputted BA of LineType if input value is positive. - ! If input value is negative, it is considered to be desired damping ratio (zeta) - ! from which the line's BA can be calculated based on the segment natural frequency. - IF (LineProp%BA < 0) THEN - ! - we assume desired damping coefficient is zeta = -LineProp%BA - ! - highest axial vibration mode of a segment is wn = sqrt(k/m) = 2N/UnstrLen*sqrt(EA/w) - Line%BA = -LineProp%BA * Line%UnstrLen / Line%N * SQRT(LineProp%EA * LineProp%w) - ! print *, 'Based on zeta, BA set to ', Line%BA - - ! print *, 'Negative BA input detected, treating as -zeta. For zeta = ', -LineProp%BA, ', setting BA to ', Line%BA - - ELSE - Line%BA = LineProp%BA - ! temp = Line%N * Line%BA / Line%UnstrLen * SQRT(1.0/(LineProp%EA * LineProp%w)) - ! print *, 'BA set as input to ', Line%BA, '. Corresponding zeta is ', temp - END IF - - !temp = 2*Line%N / Line%UnstrLen * sqrt( LineProp%EA / LineProp%w) / TwoPi - !print *, 'Segment natural frequency is ', temp, ' Hz' - - - ! need to add cleanup sub <<< - - - END SUBROUTINE SetupLine - !====================================================================== - - - - - !=============================================================================================== - SUBROUTINE InitializeLine (Line, LineProp, rhoW, ErrStat, ErrMsg) - ! calculate initial profile of the line using quasi-static model - - TYPE(MD_Line), INTENT(INOUT) :: Line ! the single line object of interest - TYPE(MD_LineProp), INTENT(INOUT) :: LineProp ! the single line property set for the line of interest - REAL(ReKi), INTENT(IN) :: rhoW - INTEGER, INTENT( INOUT ) :: ErrStat ! returns a non-zero value when an error occurs - CHARACTER(*), INTENT( INOUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - REAL(DbKi) :: COSPhi ! Cosine of the angle between the xi-axis of the inertia frame and the X-axis of the local coordinate system of the current mooring line (-) - REAL(DbKi) :: SINPhi ! Sine of the angle between the xi-axis of the inertia frame and the X-axis of the local coordinate system of the current mooring line (-) - REAL(DbKi) :: XF ! Horizontal distance between anchor and fairlead of the current mooring line (meters) - REAL(DbKi) :: ZF ! Vertical distance between anchor and fairlead of the current mooring line (meters) - INTEGER(4) :: I ! Generic index - INTEGER(4) :: J ! Generic index - - - INTEGER(IntKi) :: ErrStat2 ! Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None - REAL(DbKi) :: WetWeight - REAL(DbKi) :: SeabedCD = 0.0_DbKi - REAL(DbKi) :: TenTol = 0.0001_DbKi - REAL(DbKi), ALLOCATABLE :: LSNodes(:) - REAL(DbKi), ALLOCATABLE :: LNodesX(:) - REAL(DbKi), ALLOCATABLE :: LNodesZ(:) - INTEGER(IntKi) :: N + !-------------------------------------------------------------- - N = Line%N ! for convenience - ! try to calculate initial line profile using catenary routine (from FAST v.7) - ! note: much of this function is adapted from the FAST source code +!-------------------------------------------------------------- +! Connection-Specific Subroutines +!-------------------------------------------------------------- - ! Transform the fairlead location from the inertial frame coordinate system - ! to the local coordinate system of the current line (this coordinate - ! system lies at the current anchor, Z being vertical, and X directed from - ! current anchor to the current fairlead). Also, compute the orientation - ! of this local coordinate system: - XF = SQRT( ( Line%r(1,N) - Line%r(1,0) )**2.0 + ( Line%r(2,N) - Line%r(2,0) )**2.0 ) - ZF = Line%r(3,N) - Line%r(3,0) - IF ( XF == 0.0 ) THEN ! .TRUE. if the current mooring line is exactly vertical; thus, the solution below is ill-conditioned because the orientation is undefined; so set it such that the tensions and nodal positions are only vertical - COSPhi = 0.0_DbKi - SINPhi = 0.0_DbKi - ELSE ! The current mooring line must not be vertical; use simple trigonometry - COSPhi = ( Line%r(1,N) - Line%r(1,0) )/XF - SINPhi = ( Line%r(2,N) - Line%r(2,0) )/XF - ENDIF - WetWeight = LineProp%w - 0.25*Pi*LineProp%d*LineProp%d*rhoW +!-------------------------------------------------------------- +! Rod-Specific Subroutines +!-------------------------------------------------------------- - !LineNodes = Line%N + 1 ! number of nodes in line for catenary model to worry about - ! allocate temporary arrays for catenary routine - ALLOCATE ( LSNodes(N+1), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating LSNodes array.' - CALL CleanUp() - RETURN - END IF - ALLOCATE ( LNodesX(N+1), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating LNodesX array.' - CALL CleanUp() - RETURN - END IF - ALLOCATE ( LNodesZ(N+1), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating LNodesZ array.' - CALL CleanUp() - RETURN - END IF - ! Assign node arc length locations - LSNodes(1) = 0.0_DbKi - DO I=2,N - LSNodes(I) = LSNodes(I-1) + Line%l(I-1) ! note: l index is because line segment indices start at 1 - END DO - LSNodes(N+1) = Line%UnstrLen ! ensure the last node length isn't longer than the line due to numerical error - - ! Solve the analytical, static equilibrium equations for a catenary (or - ! taut) mooring line with seabed interaction in order to find the - ! horizontal and vertical tensions at the fairlead in the local coordinate - ! system of the current line: - ! NOTE: The values for the horizontal and vertical tensions at the fairlead - ! from the previous time step are used as the initial guess values at - ! at this time step (because the LAnchHTe(:) and LAnchVTe(:) arrays - ! are stored in a module and thus their values are saved from CALL to - ! CALL). - - - CALL Catenary ( XF , ZF , Line%UnstrLen, LineProp%EA , & - WetWeight , SeabedCD, TenTol, (N+1) , & - LSNodes, LNodesX, LNodesZ , ErrStat2, ErrMsg2) - IF (ErrStat2 == ErrID_None) THEN ! if it worked, use it - ! Transform the positions of each node on the current line from the local - ! coordinate system of the current line to the inertial frame coordinate - ! system: - DO J = 0,Line%N ! Loop through all nodes per line where the line position and tension can be output - Line%r(1,J) = Line%r(1,0) + LNodesX(J+1)*COSPhi - Line%r(2,J) = Line%r(2,0) + LNodesX(J+1)*SINPhi - Line%r(3,J) = Line%r(3,0) + LNodesZ(J+1) - ENDDO ! J - All nodes per line where the line position and tension can be output +!-------------------------------------------------------------- +! Body-Specific Subroutines +!-------------------------------------------------------------- - ELSE ! if there is a problem with the catenary approach, just stretch the nodes linearly between fairlead and anchor - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'InitializeLine') - DO J = 0,Line%N ! Loop through all nodes per line where the line position and tension can be output - Line%r(1,J) = Line%r(1,0) + (Line%r(1,N) - Line%r(1,0))*REAL(J, DbKi)/REAL(N, DbKi) - Line%r(2,J) = Line%r(2,0) + (Line%r(2,N) - Line%r(2,0))*REAL(J, DbKi)/REAL(N, DbKi) - Line%r(3,J) = Line%r(3,0) + (Line%r(3,N) - Line%r(3,0))*REAL(J, DbKi)/REAL(N, DbKi) - ENDDO - ENDIF +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +! ###### The following four routines are Jacobian routines for linearization capabilities ####### +! If the module does not implement them, set ErrStat = ErrID_Fatal in SD_Init() when InitInp%Linearize is .true. +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions +!! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. +SUBROUTINE MD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(MD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(MD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(MD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(MD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(MD_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); Output fields are not used by this routine, but type is available here so that mesh parameter information (i.e., connectivity) does not have to be recalculated for dYdu. + TYPE(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) wrt the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) wrt the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) wrt the inputs (u) [intent in to avoid deallocation] + + ! local variables + TYPE(MD_OutputType) :: y_m, y_p + TYPE(MD_ContinuousStateType) :: x_m, x_p + TYPE(MD_InputType) :: u_perturb + REAL(R8Ki) :: delta_p, delta_m ! delta change in input (plus, minus) + INTEGER(IntKi) :: i + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'MD_JacobianPInput' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + + ! get OP values here: + call MD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ); if(Failed()) return + + ! make a copy of the inputs to perturb + call MD_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return + + IF ( PRESENT( dYdu ) ) THEN + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + if (.not. allocated(dYdu) ) then + call AllocAry(dYdu, p%Jac_ny, size(p%Jac_u_indx,1),'dYdu', ErrStat2, ErrMsg2); if(Failed()) return + end if + ! make a copy of outputs because we will need two for the central difference computations (with orientations) + call MD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return + call MD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return + do i=1,size(p%Jac_u_indx,1) + ! get u_op + delta_p u + call MD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call MD_Perturb_u( p, i, 1, u_perturb, delta_p ) + ! compute y at u_op + delta_p u + call MD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! get u_op - delta_m u + call MD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call MD_Perturb_u( p, i, -1, u_perturb, delta_m ) + ! compute y at u_op - delta_m u + call MD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! get central difference: + call MD_Compute_dY( p, y_p, y_m, delta_p, dYdu(:,i) ) + end do + if(Failed()) return + END IF + IF ( PRESENT( dXdu ) ) THEN + if (.not. allocated(dXdu)) then + call AllocAry(dXdu, p%Jac_nx, size(p%Jac_u_indx,1), 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return + endif + do i=1,size(p%Jac_u_indx,1) + ! get u_op + delta u + call MD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call MD_Perturb_u( p, i, 1, u_perturb, delta_p ) + ! compute x at u_op + delta u + call MD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! get u_op - delta u + call MD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call MD_Perturb_u( p, i, -1, u_perturb, delta_m ) + ! compute x at u_op - delta u + call MD_CalcContStateDeriv( t, u_perturb, p, x, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! get central difference: + ! we may have had an error allocating memory, so we'll check + if(Failed()) return + ! get central difference (state entries are mapped the the dXdu column in routine): + call MD_Compute_dX( p, x_p, x_m, delta_p, dXdu(:,i) ) + end do + END IF ! dXdu + IF ( PRESENT( dXddu ) ) THEN + if (allocated(dXddu)) deallocate(dXddu) + END IF + IF ( PRESENT( dZdu ) ) THEN + if (allocated(dZdu)) deallocate(dZdu) + END IF + call CleanUp() +contains + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + end function Failed + + subroutine CleanUp() + call MD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more + call MD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more + call MD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) + call MD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) + call MD_DestroyInput(u_perturb, ErrStat2, ErrMsg2 ) + end subroutine cleanup + +END SUBROUTINE MD_JacobianPInput +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions +!! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. +SUBROUTINE MD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx) + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(MD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(MD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(MD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(MD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(MD_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); Output fields are not used by this routine, but type is available here so that mesh parameter information (i.e., connectivity) does not have to be recalculated for dYdx. + TYPE(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions wrt the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state functions (X) wrt the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state functions (Xd) wrt the continuous states (x) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state functions (Z) wrt the continuous states (x) [intent in to avoid deallocation] + ! local variables + TYPE(MD_OutputType) :: y_p, y_m + TYPE(MD_ContinuousStateType) :: x_p, x_m + TYPE(MD_ContinuousStateType) :: x_perturb + REAL(R8Ki) :: delta ! delta change in input or state + INTEGER(IntKi) :: i, k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_JacobianPContState' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + + ! make a copy of the continuous states to perturb NOTE: MESH_NEWCOPY + call MD_CopyContState( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return + + IF ( PRESENT( dYdx ) ) THEN + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: + if (.not. allocated(dYdx)) then + call AllocAry(dYdx, p%Jac_ny, p%Jac_nx, 'dYdx', ErrStat2, ErrMsg2); if(Failed()) return + end if + ! make a copy of outputs because we will need two for the central difference computations (with orientations) + call MD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call MD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return + ! Loop over the dx dimension of the dYdx array. Perturb the corresponding state (note difference in ordering of dYdx and x%states). + ! The p%dxIdx_map2_xStateIdx(i) is the index to the state array for the given dx index + do i=1,p%Jac_nx ! index into dx dimension + ! get x_op + delta x + call MD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call MD_perturb_x(p, p%dxIdx_map2_xStateIdx(i), 1, x_perturb, delta ) + ! compute y at x_op + delta x + call MD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! get x_op - delta x + call MD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call MD_perturb_x(p, p%dxIdx_map2_xStateIdx(i), -1, x_perturb, delta ) + ! compute y at x_op - delta x + call MD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! get central difference: + call MD_Compute_dY( p, y_p, y_m, delta, dYdx(:,i) ) + end do + if(Failed()) return + END IF + + IF ( PRESENT( dXdx ) ) THEN + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: + if (.not. allocated(dXdx)) then + call AllocAry(dXdx, p%Jac_nx, p%Jac_nx, 'dXdx', ErrStat2, ErrMsg2); if(Failed()) return + end if + ! Loop over the dx dimension of the array. Perturb the corresponding state (note difference in ordering of dXdx and x%states). + ! The resulting x_p and x_m are used to calculate the column for dXdx (mapping of state entry to dXdx row entry occurs in MD_Compute_dX) + ! The p%dxIdx_map2_xStateIdx(i) is the index to the state array for the given dx index + do i=1,p%Jac_nx ! index into dx dimension + ! get x_op + delta x + call MD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call MD_perturb_x(p, p%dxIdx_map2_xStateIdx(i), 1, x_perturb, delta ) + ! compute x at x_op + delta x + call MD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! get x_op - delta x + call MD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call MD_perturb_x(p, p%dxIdx_map2_xStateIdx(i), -1, x_perturb, delta ) + ! compute x at x_op - delta x + call MD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if(Failed()) return + ! get central difference: + call MD_Compute_dX( p, x_p, x_m, delta, dXdx(:,i) ) + end do + END IF + IF ( PRESENT( dXddx ) ) THEN + if (allocated(dXddx)) deallocate(dXddx) + END IF + IF ( PRESENT( dZdx ) ) THEN + if (allocated(dZdx)) deallocate(dZdx) + END IF + call CleanUp() + +contains + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MD_JacobianPContState') + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + end function Failed + + subroutine CleanUp() + call MD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) + call MD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) + call MD_DestroyContState( x_p, ErrStat2, ErrMsg2 ) + call MD_DestroyContState( x_m, ErrStat2, ErrMsg2 ) + call MD_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) + end subroutine cleanup + +END SUBROUTINE MD_JacobianPContState + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions +!! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and DZ/dxd are returned. +SUBROUTINE MD_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(MD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(MD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(MD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(MD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(MD_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); Output fields are not used by this routine, but type is available here so that mesh parameter information (i.e., connectivity) does not have to be recalculated for dYdx. + TYPE(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdxd(:,:) !< Partial derivatives of output functions (Y) wrt the discrete states (xd) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdxd(:,:) !< Partial derivatives of continuous state functions (X) wrt the discrete states (xd) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddxd(:,:)!< Partial derivatives of discrete state functions (Xd) wrt the discrete states (xd) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdxd(:,:) !< Partial derivatives of constraint state functions (Z) wrt discrete states (xd) [intent in to avoid deallocation] + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + IF ( PRESENT( dYdxd ) ) THEN + END IF + IF ( PRESENT( dXdxd ) ) THEN + END IF + IF ( PRESENT( dXddxd ) ) THEN + END IF + IF ( PRESENT( dZdxd ) ) THEN + END IF +END SUBROUTINE MD_JacobianPDiscState +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions +!! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and DZ/dz are returned. +SUBROUTINE MD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(MD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(MD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(MD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(MD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(MD_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); Output fields are not used by this routine, but type is available here so that mesh parameter information (i.e., connectivity) does not have to be recalculated for dYdx. + TYPE(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdz(:,:) !< Partial derivatives of output functions (Y) with respect to the constraint states (z) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdz(:,:) !< Partial derivatives of continuous state functions (X) with respect to the constraint states (z) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddz(:,:) !< Partial derivatives of discrete state functions (Xd) with respect to the constraint states (z) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdz(:,:) !< Partial derivatives of constraint state functions (Z) with respect to the constraint states (z) [intent in to avoid deallocation] + ! local variables + character(*), parameter :: RoutineName = 'MD_JacobianPConstrState' + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + IF ( PRESENT( dYdz ) ) THEN + END IF + IF ( PRESENT( dXdz ) ) THEN + if (allocated(dXdz)) deallocate(dXdz) + END IF + IF ( PRESENT( dXddz ) ) THEN + if (allocated(dXddz)) deallocate(dXddz) + END IF + IF ( PRESENT(dZdz) ) THEN + END IF +END SUBROUTINE MD_JacobianPConstrState +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +!> Routine to pack the data structures representing the operating points into arrays for linearization. +SUBROUTINE MD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(MD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(MD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(MD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(MD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(MD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(MD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(MD_OutputType), INTENT(IN ) :: y !< Output at operating point + TYPE(MD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states + REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + ! Local + INTEGER(IntKi) :: idx, i + INTEGER(IntKi) :: nu + INTEGER(IntKi) :: ny + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_GetOP' + LOGICAL :: FieldMask(FIELDMASK_SIZE) + TYPE(MD_ContinuousStateType) :: dx ! derivative of continuous states at operating point + ErrStat = ErrID_None + ErrMsg = '' + ! inputs + IF ( PRESENT( u_op ) ) THEN + nu = size(p%Jac_u_indx,1) + u%CoupledKinematics(1)%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) + if (.not. allocated(u_op)) then + call AllocAry(u_op, nu, 'u_op', ErrStat2, ErrMsg2); if(Failed()) return + end if + idx = 1 + FieldMask = .false. + FieldMask(MASKID_TranslationDisp) = .true. + FieldMask(MASKID_Orientation) = .true. + FieldMask(MASKID_TranslationVel) = .true. + FieldMask(MASKID_RotationVel) = .true. + FieldMask(MASKID_TranslationAcc) = .true. + FieldMask(MASKID_RotationAcc) = .true. + ! fill in the u_op values from the input mesh + call PackMotionMesh(u%CoupledKinematics(1), u_op, idx, FieldMask=FieldMask) + + ! now do the active tensioning commands if there are any + if (allocated(u%DeltaL)) then + do i=1,size(u%DeltaL) + u_op(idx) = u%DeltaL(i) + idx = idx + 1 + u_op(idx) = u%DeltaLdot(i) + idx = idx + 1 + end do + endif + END IF + ! outputs + IF ( PRESENT( y_op ) ) THEN + ny = p%Jac_ny + y%CoupledLoads(1)%NNodes * 6 ! Jac_ny has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) + if (.not. allocated(y_op)) then + call AllocAry(y_op, ny, 'y_op', ErrStat2, ErrMsg2); if(Failed()) return + end if + idx = 1 + call PackLoadMesh(y%CoupledLoads(1), y_op, idx) + do i=1,p%NumOuts + y_op(idx) = y%WriteOutput(i) + idx = idx + 1 + end do + END IF + ! states + IF ( PRESENT( x_op ) ) THEN + if (.not. allocated(x_op)) then + call AllocAry(x_op, p%Jac_nx,'x_op',ErrStat2,ErrMsg2); if (Failed()) return + end if + do i=1, p%Jac_nx + x_op(i) = x%states(p%dxIdx_map2_xStateIdx(i)) ! x for lin is different order, so use mapping + end do + END IF + ! state derivatives? + IF ( PRESENT( dx_op ) ) THEN + if (.not. allocated(dx_op)) then + call AllocAry(dx_op, p%Jac_nx,'dx_op',ErrStat2,ErrMsg2); if(failed()) return + end if + call MD_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dx, ErrStat2, ErrMsg2 ) ; if(Failed()) return + do i=1, p%Jac_nx + dx_op(i) = dx%states(p%dxIdx_map2_xStateIdx(i)) ! x for lin is different order, so use mapping + end do + END IF + IF ( PRESENT( xd_op ) ) THEN + ! pass + END IF + IF ( PRESENT( z_op ) ) THEN + ! pass + END IF + call CleanUp() +contains + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MD_GetOP') + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + end function Failed + + subroutine CleanUp() + call MD_DestroyContState(dx, ErrStat2, ErrMsg2); + end subroutine +END SUBROUTINE MD_GetOP + + + +!==================================================================================================== +!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. +!! Do not change the order of this packing without changing subroutines calculating dXdx etc (MD_Compute_dX) +SUBROUTINE MD_Init_Jacobian(Init, p, u, y, m, InitOut, ErrStat, ErrMsg) + TYPE(MD_InitInputType) , INTENT(IN ) :: Init !< Init + TYPE(MD_ParameterType) , INTENT(INOUT) :: p !< parameters + TYPE(MD_InputType) , INTENT(IN ) :: u !< inputs + TYPE(MD_OutputType) , INTENT(IN ) :: y !< outputs + TYPE(MD_MiscVarType) , INTENT(INOUT) :: m !< misc variables <<<<<<<< + TYPE(MD_InitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) + INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SD_Init_Jacobian' + real(ReKi) :: dx, dy, dz, maxDim + + INTEGER(IntKi) :: l, I + real(ReKi) :: dl_slack ! how much a given line segment is stretched [m] + real(ReKi) :: dl_slack_min ! minimum change in a node position for the least-strained segment in the simulation to go slack [m] + + + ! local variables: + ErrStat = ErrID_None + ErrMsg = "" + + !! --- System dimension + !dx = maxval(Init%Nodes(:,2))- minval(Init%Nodes(:,2)) + !dy = maxval(Init%Nodes(:,3))- minval(Init%Nodes(:,3)) + !dz = maxval(Init%Nodes(:,4))- minval(Init%Nodes(:,4)) + !maxDim = max(dx, dy, dz) + + + ! Figure out appropriate transverse perturbation size to avoid slack segments + dl_slack_min = 0.1_ReKi ! start at 0.1 m + + do l = 1,p%nLines + do I = 1, m%LineList(l)%N + dl_slack = m%LineList(l)%lstr(I) - m%LineList(l)%l(I) + + ! store the smallest positive length margin to a segment going slack + if (( dl_slack > 0.0_ReKi) .and. (dl_slack < dl_slack_min)) then + dl_slack_min = dl_slack + end if + end do + end do + + dl_slack_min = 0.5*dl_slack_min ! apply 0.5 safety factor + + !TODO: consider attachment radii to also produce a rotational perturbation size from the above + + + ! --- System dimension + call Init_Jacobian_y(); if (Failed()) return + call Init_Jacobian_x(); if (Failed()) return + call Init_Jacobian_u(); if (Failed()) return + +contains + LOGICAL FUNCTION Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SD_Init_Jacobian') + Failed = ErrStat >= AbortErrLev + END FUNCTION Failed + + !> This routine initializes the Jacobian parameters and initialization outputs for the linearized outputs. + SUBROUTINE Init_Jacobian_y() + INTEGER(IntKi) :: index_next, i + + ! Number of outputs + p%Jac_ny = y%CoupledLoads(1)%nNodes * 6 & ! 3 forces + 3 moments at each node (moments may be zero) + + p%NumOuts ! WriteOutput values + ! Storage info for each output (names, rotframe) + call AllocAry(InitOut%LinNames_y, p%Jac_ny, 'LinNames_y',ErrStat2,ErrMsg2); if(ErrStat2/=ErrID_None) return + call AllocAry(InitOut%RotFrame_y, p%Jac_ny, 'RotFrame_y',ErrStat2,ErrMsg2); if(ErrStat2/=ErrID_None) return + ! Names + index_next = 1 + call PackLoadMesh_Names( y%CoupledLoads(1), 'LinNames_y', InitOut%LinNames_y, index_next) ! <<< should a specific name be provided here? + do i=1,p%NumOuts + InitOut%LinNames_y(i+index_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) + end do + + InitOut%RotFrame_y(:) = .false. + END SUBROUTINE Init_Jacobian_y + !> This routine initializes the Jacobian parameters and initialization outputs for the linearized continuous states. + SUBROUTINE Init_Jacobian_x() + INTEGER(IntKi) :: idx ! index into the LinNames_x array + INTEGER(IntKi) :: i + INTEGER(IntKi) :: l + INTEGER(IntKi) :: N + + p%Jac_nx = m%Nx ! size of (continuous) state vector (includes the first derivatives) + + ! allocate space for the row/column names and for perturbation sizes + CALL AllocAry(InitOut%LinNames_x , p%Jac_nx, 'LinNames_x' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return + CALL AllocAry(InitOut%RotFrame_x , p%Jac_nx, 'RotFrame_x' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return + CALL AllocAry(InitOut%DerivOrder_x , p%Jac_nx, 'DerivOrder_x' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return + CALL AllocAry(p%dx , p%Jac_nx, 'p%dx' , ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return + CALL AllocAry(p%dxIdx_map2_xStateIdx, p%Jac_nx, 'p%dxIdx_map2_xStateIdx', ErrStat2, ErrMsg2); if(ErrStat/=ErrID_None) return + + p%dxIdx_map2_xStateIdx = 0_IntKi ! all values should be overwritten by logic below + + ! set linearization output names and default perturbations, p%dx: + ! NOTE: the order is different than the order of the internal states. This is to + ! match what the OpenFAST framework is expecting: all positions first, then all + ! derviatives of positions (velocity terms) second. This adds slight complexity + ! here, but considerably simplifies post processing of the full OpenFAST results + ! for linearization. + ! The p%dxIdx_map2_xStateIdx array holds the index for the x%states array + ! corresponding to the current jacobian index. + + !----------------- + ! position states + !----------------- + idx = 0 + ! Free bodies + DO l = 1,p%nFreeBodies ! Body m%BodyList(m%FreeBodyIs(l)) + p%dx(idx+1:idx+3) = dl_slack_min ! body displacement [m] + p%dx(idx+4:idx+6) = 0.02 ! body rotation [rad] + ! corresponds to state indices: (m%BodyStateIs1(l)+6:m%BodyStateIs1(l)+11) + InitOut%LinNames_x(idx+1) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Px, m' + InitOut%LinNames_x(idx+2) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Py, m' + InitOut%LinNames_x(idx+3) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Pz, m' + InitOut%LinNames_x(idx+4) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_x, rad' + InitOut%LinNames_x(idx+5) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_y, rad' + InitOut%LinNames_x(idx+6) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' rot_z, rad' + p%dxIdx_map2_xStateIdx(idx+1) = m%BodyStateIs1(l)+6 ! x%state index for Px + p%dxIdx_map2_xStateIdx(idx+2) = m%BodyStateIs1(l)+7 ! x%state index for Py + p%dxIdx_map2_xStateIdx(idx+3) = m%BodyStateIs1(l)+8 ! x%state index for Pz + p%dxIdx_map2_xStateIdx(idx+4) = m%BodyStateIs1(l)+9 ! x%state index for rot_x + p%dxIdx_map2_xStateIdx(idx+5) = m%BodyStateIs1(l)+10 ! x%state index for rot_y + p%dxIdx_map2_xStateIdx(idx+6) = m%BodyStateIs1(l)+11 ! x%state index for rot_z + idx = idx + 6 + END DO - CALL CleanUp() ! deallocate temporary arrays + ! Rods + DO l = 1,p%nFreeRods ! Rod m%RodList(m%FreeRodIs(l)) + if (m%RodList(m%FreeRodIs(l))%typeNum == 1) then ! pinned rod + p%dx(idx+1:idx+3) = 0.02 ! rod rotation [rad] + ! corresponds to state indices: (m%RodStateIs1(l)+3:m%RodStateIs1(l)+5) + InitOut%LinNames_x(idx+1) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_x, rad' + InitOut%LinNames_x(idx+2) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_y, rad' + InitOut%LinNames_x(idx+3) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_z, rad' + p%dxIdx_map2_xStateIdx(idx+4) = m%RodStateIs1(l)+3 ! x%state index for rot_x + p%dxIdx_map2_xStateIdx(idx+5) = m%RodStateIs1(l)+4 ! x%state index for rot_y + p%dxIdx_map2_xStateIdx(idx+6) = m%RodStateIs1(l)+5 ! x%state index for rot_z + idx = idx + 3 + else ! free rod + p%dx(idx+1:idx+3) = dl_slack_min ! rod displacement [m] + p%dx(idx+4:idx+6) = 0.02 ! rod rotation [rad] + ! corresponds to state indices: (m%RodStateIs1(l)+6:m%RodStateIs1(l)+11) + InitOut%LinNames_x(idx+1) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Px, m' + InitOut%LinNames_x(idx+2) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Py, m' + InitOut%LinNames_x(idx+3) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Pz, m' + InitOut%LinNames_x(idx+4) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_x, rad' + InitOut%LinNames_x(idx+5) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_y, rad' + InitOut%LinNames_x(idx+6) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' rot_z, rad' + p%dxIdx_map2_xStateIdx(idx+1) = m%RodStateIs1(l)+6 ! x%state index for Px + p%dxIdx_map2_xStateIdx(idx+2) = m%RodStateIs1(l)+7 ! x%state index for Py + p%dxIdx_map2_xStateIdx(idx+3) = m%RodStateIs1(l)+8 ! x%state index for Pz + p%dxIdx_map2_xStateIdx(idx+4) = m%RodStateIs1(l)+9 ! x%state index for rot_x + p%dxIdx_map2_xStateIdx(idx+5) = m%RodStateIs1(l)+10 ! x%state index for rot_y + p%dxIdx_map2_xStateIdx(idx+6) = m%RodStateIs1(l)+11 ! x%state index for rot_z + idx = idx + 6 + end if + END DO + ! Free Connnections + DO l = 1,p%nFreeCons ! Point m%ConnectList(m%FreeConIs(l)) + ! corresponds to state indices: (m%ConStateIs1(l)+3:m%ConStateIs1(l)+5) + p%dx(idx+1:idx+3) = dl_slack_min ! point displacement [m] + InitOut%LinNames_x(idx+1) = 'Point '//trim(num2lstr(m%FreeConIs(l)))//' Px, m' + InitOut%LinNames_x(idx+2) = 'Point '//trim(num2lstr(m%FreeConIs(l)))//' Py, m' + InitOut%LinNames_x(idx+3) = 'Point '//trim(num2lstr(m%FreeConIs(l)))//' Pz, m' + p%dxIdx_map2_xStateIdx(idx+1) = m%ConStateIs1(l)+3 ! x%state index for Px + p%dxIdx_map2_xStateIdx(idx+2) = m%ConStateIs1(l)+4 ! x%state index for Py + p%dxIdx_map2_xStateIdx(idx+3) = m%ConStateIs1(l)+5 ! x%state index for Pz + idx = idx + 3 + END DO + ! Lines + DO l = 1,p%nLines ! Line m%LineList(l) + ! corresponds to state indices: (m%LineStateIs1(l)+3*N-3:m%LineStateIs1(l)+6*N-7) -- NOTE: end nodes not included + N = m%LineList(l)%N ! number of segments in the line + DO i = 0,N-2 + p%dx(idx+1:idx+3) = dl_slack_min ! line internal node displacement [m] + InitOut%LinNames_x(idx+1) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Px, m' + InitOut%LinNames_x(idx+2) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Py, m' + InitOut%LinNames_x(idx+3) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Pz, m' + p%dxIdx_map2_xStateIdx(idx+1) = m%LineStateIs1(l)+3*N+3*i-3 ! x%state index for Px + p%dxIdx_map2_xStateIdx(idx+2) = m%LineStateIs1(l)+3*N+3*i-2 ! x%state index for Py + p%dxIdx_map2_xStateIdx(idx+3) = m%LineStateIs1(l)+3*N+3*i-1 ! x%state index for Pz + idx = idx + 3 + END DO + END DO - CONTAINS + !----------------- + ! velocity states + !----------------- + ! Free bodies + DO l = 1,p%nFreeBodies ! Body m%BodyList(m%FreeBodyIs(l)) + ! corresponds to state indices: (m%BodyStateIs1(l):m%BodyStateIs1(l)+5) + p%dx(idx+1:idx+3) = 0.1 ! body translational velocity [m/s] + p%dx(idx+4:idx+6) = 0.1 ! body rotational velocity [rad/s] + InitOut%LinNames_x(idx+1) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Vx, m/s' + InitOut%LinNames_x(idx+2) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Vy, m/s' + InitOut%LinNames_x(idx+3) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' Vz, m/s' + InitOut%LinNames_x(idx+4) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_x, rad/s' + InitOut%LinNames_x(idx+5) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_y, rad/s' + InitOut%LinNames_x(idx+6) = 'Body '//trim(num2lstr(m%FreeBodyIs(l)))//' omega_z, rad/s' + p%dxIdx_map2_xStateIdx(idx+1) = m%BodyStateIs1(l)+0 ! x%state index for Rx + p%dxIdx_map2_xStateIdx(idx+2) = m%BodyStateIs1(l)+1 ! x%state index for Ry + p%dxIdx_map2_xStateIdx(idx+3) = m%BodyStateIs1(l)+2 ! x%state index for Rz + p%dxIdx_map2_xStateIdx(idx+4) = m%BodyStateIs1(l)+3 ! x%state index for omega_x + p%dxIdx_map2_xStateIdx(idx+5) = m%BodyStateIs1(l)+4 ! x%state index for omega_y + p%dxIdx_map2_xStateIdx(idx+6) = m%BodyStateIs1(l)+5 ! x%state index for omega_z + idx = idx + 6 + END DO + ! Rods + DO l = 1,p%nFreeRods ! Rod m%RodList(m%FreeRodIs(l)) + if (m%RodList(m%FreeRodIs(l))%typeNum == 1) then ! pinned rod + ! corresponds to state indices: (m%RodStateIs1(l):m%RodStateIs1(l)+2) + p%dx(idx+1:idx+3) = 0.1 ! body rotational velocity [rad/s] + InitOut%LinNames_x(idx+1) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_x, rad/s' + InitOut%LinNames_x(idx+2) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_y, rad/s' + InitOut%LinNames_x(idx+3) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_z, rad/s' + p%dxIdx_map2_xStateIdx(idx+1) = m%RodStateIs1(l)+0 ! x%state index for Vx + p%dxIdx_map2_xStateIdx(idx+2) = m%RodStateIs1(l)+1 ! x%state index for Vy + p%dxIdx_map2_xStateIdx(idx+3) = m%RodStateIs1(l)+2 ! x%state index for Vz + idx = idx + 3 + else ! free rod + ! corresponds to state indices: (m%RodStateIs1(l):m%RodStateIs1(l)+5) + p%dx(idx+1:idx+3) = 0.1 ! body translational velocity [m/s] + p%dx(idx+4:idx+6) = 0.02 ! body rotational velocity [rad/s] + InitOut%LinNames_x(idx+1) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Vx, m/s' + InitOut%LinNames_x(idx+2) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Vy, m/s' + InitOut%LinNames_x(idx+3) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' Vz, m/s' + InitOut%LinNames_x(idx+4) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_x, rad/s' + InitOut%LinNames_x(idx+5) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_y, rad/s' + InitOut%LinNames_x(idx+6) = 'Rod '//trim(num2lstr(m%FreeRodIs(l)))//' omega_z, rad/s' + p%dxIdx_map2_xStateIdx(idx+1) = m%RodStateIs1(l)+0 ! x%state index for Vx + p%dxIdx_map2_xStateIdx(idx+2) = m%RodStateIs1(l)+1 ! x%state index for Vy + p%dxIdx_map2_xStateIdx(idx+3) = m%RodStateIs1(l)+2 ! x%state index for Vz + p%dxIdx_map2_xStateIdx(idx+4) = m%RodStateIs1(l)+3 ! x%state index for omega_x + p%dxIdx_map2_xStateIdx(idx+5) = m%RodStateIs1(l)+4 ! x%state index for omega_y + p%dxIdx_map2_xStateIdx(idx+6) = m%RodStateIs1(l)+5 ! x%state index for omega_z + idx = idx + 6 + end if + END DO - !======================================================================= - SUBROUTINE CleanUp() - ! deallocate temporary arrays - - IF (ALLOCATED(LSNodes)) DEALLOCATE(LSNodes) - IF (ALLOCATED(LNodesX)) DEALLOCATE(LNodesX) - IF (ALLOCATED(LNodesZ)) DEALLOCATE(LNodesZ) - - END SUBROUTINE CleanUp - !======================================================================= - - - !======================================================================= - SUBROUTINE Catenary ( XF_In, ZF_In, L_In , EA_In, & - W_In , CB_In, Tol_In, N , & - s_In , X_In , Z_In , ErrStat, ErrMsg ) - - ! This subroutine is copied from FAST v7 with minor modifications - - ! This routine solves the analytical, static equilibrium equations - ! for a catenary (or taut) mooring line with seabed interaction. - ! Stretching of the line is accounted for, but bending stiffness - ! is not. Given the mooring line properties and the fairlead - ! position relative to the anchor, this routine finds the line - ! configuration and tensions. Since the analytical solution - ! involves two nonlinear equations (XF and ZF) in two unknowns - ! (HF and VF), a Newton-Raphson iteration scheme is implemented in - ! order to solve for the solution. The values of HF and VF that - ! are passed into this routine are used as the initial guess in - ! the iteration. The Newton-Raphson iteration is only accurate in - ! double precision, so all of the input/output arguments are - ! converteds to/from double precision from/to default precision. - - - ! USE Precision - - - IMPLICIT NONE - - - ! Passed Variables: - - INTEGER(4), INTENT(IN ) :: N ! Number of nodes where the line position and tension can be output (-) - - REAL(DbKi), INTENT(IN ) :: CB_In ! Coefficient of seabed static friction drag (a negative value indicates no seabed) (-) - REAL(DbKi), INTENT(IN ) :: EA_In ! Extensional stiffness of line (N) - ! REAL(DbKi), INTENT( OUT) :: HA_In ! Effective horizontal tension in line at the anchor (N) - ! REAL(DbKi), INTENT(INOUT) :: HF_In ! Effective horizontal tension in line at the fairlead (N) - REAL(DbKi), INTENT(IN ) :: L_In ! Unstretched length of line (meters) - REAL(DbKi), INTENT(IN ) :: s_In (N) ! Unstretched arc distance along line from anchor to each node where the line position and tension can be output (meters) - ! REAL(DbKi), INTENT( OUT) :: Te_In (N) ! Effective line tensions at each node (N) - REAL(DbKi), INTENT(IN ) :: Tol_In ! Convergence tolerance within Newton-Raphson iteration specified as a fraction of tension (-) - ! REAL(DbKi), INTENT( OUT) :: VA_In ! Effective vertical tension in line at the anchor (N) - ! REAL(DbKi), INTENT(INOUT) :: VF_In ! Effective vertical tension in line at the fairlead (N) - REAL(DbKi), INTENT(IN ) :: W_In ! Weight of line in fluid per unit length (N/m) - REAL(DbKi), INTENT( OUT) :: X_In (N) ! Horizontal locations of each line node relative to the anchor (meters) - REAL(DbKi), INTENT(IN ) :: XF_In ! Horizontal distance between anchor and fairlead (meters) - REAL(DbKi), INTENT( OUT) :: Z_In (N) ! Vertical locations of each line node relative to the anchor (meters) - REAL(DbKi), INTENT(IN ) :: ZF_In ! Vertical distance between anchor and fairlead (meters) - INTEGER, INTENT( OUT ) :: ErrStat ! returns a non-zero value when an error occurs - CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - - ! Local Variables: - - REAL(DbKi) :: CB ! Coefficient of seabed static friction (a negative value indicates no seabed) (-) - REAL(DbKi) :: CBOvrEA ! = CB/EA - REAL(DbKi) :: DET ! Determinant of the Jacobian matrix (m^2/N^2) - REAL(DbKi) :: dHF ! Increment in HF predicted by Newton-Raphson (N) - REAL(DbKi) :: dVF ! Increment in VF predicted by Newton-Raphson (N) - REAL(DbKi) :: dXFdHF ! Partial derivative of the calculated horizontal distance with respect to the horizontal fairlead tension (m/N): dXF(HF,VF)/dHF - REAL(DbKi) :: dXFdVF ! Partial derivative of the calculated horizontal distance with respect to the vertical fairlead tension (m/N): dXF(HF,VF)/dVF - REAL(DbKi) :: dZFdHF ! Partial derivative of the calculated vertical distance with respect to the horizontal fairlead tension (m/N): dZF(HF,VF)/dHF - REAL(DbKi) :: dZFdVF ! Partial derivative of the calculated vertical distance with respect to the vertical fairlead tension (m/N): dZF(HF,VF)/dVF - REAL(DbKi) :: EA ! Extensional stiffness of line (N) - REAL(DbKi) :: EXF ! Error function between calculated and known horizontal distance (meters): XF(HF,VF) - XF - REAL(DbKi) :: EZF ! Error function between calculated and known vertical distance (meters): ZF(HF,VF) - ZF - REAL(DbKi) :: HA ! Effective horizontal tension in line at the anchor (N) - REAL(DbKi) :: HF ! Effective horizontal tension in line at the fairlead (N) - REAL(DbKi) :: HFOvrW ! = HF/W - REAL(DbKi) :: HFOvrWEA ! = HF/WEA - REAL(DbKi) :: L ! Unstretched length of line (meters) - REAL(DbKi) :: Lamda0 ! Catenary parameter used to generate the initial guesses of the horizontal and vertical tensions at the fairlead for the Newton-Raphson iteration (-) - REAL(DbKi) :: LMax ! Maximum stretched length of the line with seabed interaction beyond which the line would have to double-back on itself; here the line forms an "L" between the anchor and fairlead (i.e. it is horizontal along the seabed from the anchor, then vertical to the fairlead) (meters) - REAL(DbKi) :: LMinVFOvrW ! = L - VF/W - REAL(DbKi) :: LOvrEA ! = L/EA - REAL(DbKi) :: s (N) ! Unstretched arc distance along line from anchor to each node where the line position and tension can be output (meters) - REAL(DbKi) :: sOvrEA ! = s(I)/EA - REAL(DbKi) :: SQRT1VFOvrHF2 ! = SQRT( 1.0_DbKi + VFOvrHF2 ) - REAL(DbKi) :: SQRT1VFMinWLOvrHF2 ! = SQRT( 1.0_DbKi + VFMinWLOvrHF2 ) - REAL(DbKi) :: SQRT1VFMinWLsOvrHF2 ! = SQRT( 1.0_DbKi + VFMinWLsOvrHF*VFMinWLsOvrHF ) - REAL(DbKi) :: Te (N) ! Effective line tensions at each node (N) - REAL(DbKi) :: Tol ! Convergence tolerance within Newton-Raphson iteration specified as a fraction of tension (-) - REAL(DbKi) :: VA ! Effective vertical tension in line at the anchor (N) - REAL(DbKi) :: VF ! Effective vertical tension in line at the fairlead (N) - REAL(DbKi) :: VFMinWL ! = VF - WL - REAL(DbKi) :: VFMinWLOvrHF ! = VFMinWL/HF - REAL(DbKi) :: VFMinWLOvrHF2 ! = VFMinWLOvrHF*VFMinWLOvrHF - REAL(DbKi) :: VFMinWLs ! = VFMinWL + Ws - REAL(DbKi) :: VFMinWLsOvrHF ! = VFMinWLs/HF - REAL(DbKi) :: VFOvrHF ! = VF/HF - REAL(DbKi) :: VFOvrHF2 ! = VFOvrHF*VFOvrHF - REAL(DbKi) :: VFOvrWEA ! = VF/WEA - REAL(DbKi) :: W ! Weight of line in fluid per unit length (N/m) - REAL(DbKi) :: WEA ! = W*EA - REAL(DbKi) :: WL ! Total weight of line in fluid (N): W*L - REAL(DbKi) :: Ws ! = W*s(I) - REAL(DbKi) :: X (N) ! Horizontal locations of each line node relative to the anchor (meters) - REAL(DbKi) :: XF ! Horizontal distance between anchor and fairlead (meters) - REAL(DbKi) :: XF2 ! = XF*XF - REAL(DbKi) :: Z (N) ! Vertical locations of each line node relative to the anchor (meters) - REAL(DbKi) :: ZF ! Vertical distance between anchor and fairlead (meters) - REAL(DbKi) :: ZF2 ! = ZF*ZF - - INTEGER(4) :: I ! Index for counting iterations or looping through line nodes (-) - INTEGER(4) :: MaxIter ! Maximum number of Newton-Raphson iterations possible before giving up (-) - - LOGICAL :: FirstIter ! Flag to determine whether or not this is the first time through the Newton-Raphson interation (flag) - - - ErrStat = ERrId_None - - - ! The Newton-Raphson iteration is only accurate in double precision, so - ! convert the input arguments into double precision: - - CB = REAL( CB_In , DbKi ) - EA = REAL( EA_In , DbKi ) - HF = 0.0_DbKi ! = REAL( HF_In , DbKi ) - L = REAL( L_In , DbKi ) - s (:) = REAL( s_In (:), DbKi ) - Tol = REAL( Tol_In , DbKi ) - VF = 0.0_DbKi ! keeping this for some error catching functionality? (at first glance) ! VF = REAL( VF_In , DbKi ) - W = REAL( W_In , DbKi ) - XF = REAL( XF_In , DbKi ) - ZF = REAL( ZF_In , DbKi ) + ! Free Connnections + DO l = 1,p%nFreeCons ! Point m%ConnectList(m%FreeConIs(l)) + ! corresponds to state indices: (m%ConStateIs1(l):m%ConStateIs1(l)+2) + p%dx(idx+1:idx+3) = 0.1 ! point translational velocity [m/s] + InitOut%LinNames_x(idx+1) = 'Point '//trim(num2lstr(m%FreeConIs(l)))//' Vx, m/s' + InitOut%LinNames_x(idx+2) = 'Point '//trim(num2lstr(m%FreeConIs(l)))//' Vy, m/s' + InitOut%LinNames_x(idx+3) = 'Point '//trim(num2lstr(m%FreeConIs(l)))//' Vz, m/s' + p%dxIdx_map2_xStateIdx(idx+1) = m%ConStateIs1(l)+0 ! x%state index for Vx + p%dxIdx_map2_xStateIdx(idx+2) = m%ConStateIs1(l)+1 ! x%state index for Vy + p%dxIdx_map2_xStateIdx(idx+3) = m%ConStateIs1(l)+2 ! x%state index for Vz + idx = idx + 3 + END DO + ! Lines + DO l = 1,p%nLines ! Line m%LineList(l) + ! corresponds to state indices: (m%LineStateIs1(l):m%LineStateIs1(l)+3*N-4) -- NOTE: end nodes not included + N = m%LineList(l)%N ! number of segments in the line + DO i = 0,N-2 + p%dx(idx+1:idx+3) = 0.1 ! line internal node translational velocity [m/s] + InitOut%LinNames_x(idx+1) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Vx, m/s' + InitOut%LinNames_x(idx+2) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Vy, m/s' + InitOut%LinNames_x(idx+3) = 'Line '//trim(num2lstr(l))//' node '//trim(num2lstr(i+1))//' Vz, m/s' + p%dxIdx_map2_xStateIdx(idx+1) = m%LineStateIs1(l)+3*i+0 ! x%state index for Vx + p%dxIdx_map2_xStateIdx(idx+2) = m%LineStateIs1(l)+3*i+1 ! x%state index for Vy + p%dxIdx_map2_xStateIdx(idx+3) = m%LineStateIs1(l)+3*i+2 ! x%state index for Vz + idx = idx + 3 + END DO + END DO + ! If a summary file is ever made... + ! !Formatting may be needed to make it pretty + ! if(UnSum > 0) then + ! write(UnSum,*) ' Lin_Jac_x idx x%state idx' + ! do i=1,p%Jac_nx + ! write(UnSum,*) InitOut%LinNames_x(i),' ',i,' ',p%dxIdx_map2_xStateIdx(i) + ! enddo + ! endif + + InitOut%RotFrame_x = .false. + InitOut%DerivOrder_x = 2 + END SUBROUTINE Init_Jacobian_x + + SUBROUTINE Init_Jacobian_u() + INTEGER(IntKi) :: i, j, idx, nu, i_meshField + character(10) :: LinStr ! for noting which line a DeltaL control is attached to + logical :: LinCtrl ! Is the current DeltaL channel associated with a line? + ! Number of inputs + i = 0 + if (allocated(u%DeltaL)) i=size(u%DeltaL) + nu = u%CoupledKinematics(1)%nNodes * 18 & ! 3 Translation Displacements + 3 orientations + 6 velocities + 6 accelerations at each node <<<<<<< + + i*2 ! a deltaL and rate of change for each active tension control channel + + ! --- Info of linearized inputs (Names, RotFrame, IsLoad) + call AllocAry(InitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return + call AllocAry(InitOut%RotFrame_u, nu, 'RotFrame_u', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return + call AllocAry(InitOut%IsLoad_u , nu, 'IsLoad_u' , ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return + + InitOut%IsLoad_u = .false. ! None of MoorDyn's inputs are loads + InitOut%RotFrame_u = .false. ! every input is on a mesh, which stores values in the global (not rotating) frame + + idx = 1 + call PackMotionMesh_Names(u%CoupledKinematics(1), 'CoupledKinematics', InitOut%LinNames_u, idx) ! all 6 motion fields + + ! --- Jac_u_indx: matrix to store index to help us figure out what the ith value of the u vector really means + ! (see perturb_u ... these MUST match ) + ! column 1 indicates module's mesh and field + ! column 2 indicates the first index (x-y-z component) of the field + ! column 3 is the node + call allocAry( p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return + p%Jac_u_indx = 0 ! initialize to zero + idx = 1 + !Module/Mesh/Field: u%CoupledKinematics(1)%TranslationDisp = 1; + !Module/Mesh/Field: u%CoupledKinematics(1)%Orientation = 2; + !Module/Mesh/Field: u%CoupledKinematics(1)%TranslationVel = 3; + !Module/Mesh/Field: u%CoupledKinematics(1)%RotationVel = 4; + !Module/Mesh/Field: u%CoupledKinematics(1)%TranslationAcc = 5; + !Module/Mesh/Field: u%CoupledKinematics(1)%RotationAcc = 6; + do i_meshField = 1,6 + do i=1,u%CoupledKinematics(1)%nNodes + do j=1,3 + p%Jac_u_indx(idx,1) = i_meshField ! mesh field type (indicated by 1-6) + p%Jac_u_indx(idx,2) = j ! x, y, or z + p%Jac_u_indx(idx,3) = i ! node + idx = idx + 1 + end do !j + end do !i + end do + ! now do the active tensioning commands if there are any + if (allocated(u%DeltaL)) then + do i=1,size(u%DeltaL) ! Signals may be passed in without being requested for control + ! Figure out if this DeltaL control channel is associated with a line or multiple or none and label + LinCtrl = .FALSE. + LinStr = '(lines: ' + do J=1,p%NLines + if (m%LineList(J)%CtrlChan == i) then + LinCtrl = .TRUE. + LinStr = LinStr//trim(num2lstr(i))//' ' + endif + enddo + if ( LinCtrl) LinStr = LinStr//' )' + if (.not. LinCtrl) LinStr = '(lines: none)' + + p%Jac_u_indx(idx,1) = 10 ! 10-11 mean active tension changes (10: deltaL; 11: deltaLdot) + p%Jac_u_indx(idx,2) = 0 ! not used + p%Jac_u_indx(idx,3) = i ! indicates DeltaL entry number + InitOut%LinNames_u(idx) = 'CtrlChan DeltaL '//trim(num2lstr(i))//', m '//trim(LinStr) + idx = idx + 1 - ! HF and VF cannot be initialized to zero when a portion of the line rests on the seabed and the anchor tension is nonzero - - ! Generate the initial guess values for the horizontal and vertical tensions - ! at the fairlead in the Newton-Raphson iteration for the catenary mooring - ! line solution. Use starting values documented in: Peyrot, Alain H. and - ! Goulois, A. M., "Analysis Of Cable Structures," Computers & Structures, - ! Vol. 10, 1979, pp. 805-813: - XF2 = XF*XF - ZF2 = ZF*ZF - - IF ( XF == 0.0_DbKi ) THEN ! .TRUE. if the current mooring line is exactly vertical - Lamda0 = 1.0D+06 - ELSEIF ( L <= SQRT( XF2 + ZF2 ) ) THEN ! .TRUE. if the current mooring line is taut - Lamda0 = 0.2_DbKi - ELSE ! The current mooring line must be slack and not vertical - Lamda0 = SQRT( 3.0_DbKi*( ( L**2 - ZF2 )/XF2 - 1.0_DbKi ) ) - ENDIF - - HF = ABS( 0.5_DbKi*W* XF/ Lamda0 ) - VF = 0.5_DbKi*W*( ZF/TANH(Lamda0) + L ) - - - ! Abort when there is no solution or when the only possible solution is - ! illogical: - - IF ( Tol <= EPSILON(TOL) ) THEN ! .TRUE. when the convergence tolerance is specified incorrectly - ErrStat = ErrID_Warn - ErrMsg = ' Convergence tolerance must be greater than zero in routine Catenary().' - return - ELSEIF ( XF < 0.0_DbKi ) THEN ! .TRUE. only when the local coordinate system is not computed correctly - ErrStat = ErrID_Warn - ErrMsg = ' The horizontal distance between an anchor and its'// & - ' fairlead must not be less than zero in routine Catenary().' - return - - ELSEIF ( ZF < 0.0_DbKi ) THEN ! .TRUE. if the fairlead has passed below its anchor - ErrStat = ErrID_Warn - ErrMsg = ' A fairlead has passed below its anchor.' - return - - ELSEIF ( L <= 0.0_DbKi ) THEN ! .TRUE. when the unstretched line length is specified incorrectly - ErrStat = ErrID_Warn - ErrMsg = ' Unstretched length of line must be greater than zero in routine Catenary().' - return - - ELSEIF ( EA <= 0.0_DbKi ) THEN ! .TRUE. when the unstretched line length is specified incorrectly - ErrStat = ErrID_Warn - ErrMsg = ' Extensional stiffness of line must be greater than zero in routine Catenary().' - return - - ELSEIF ( W == 0.0_DbKi ) THEN ! .TRUE. when the weight of the line in fluid is zero so that catenary solution is ill-conditioned - ErrStat = ErrID_Warn - ErrMsg = ' The weight of the line in fluid must not be zero. '// & - ' Routine Catenary() cannot solve quasi-static mooring line solution.' - return - - - ELSEIF ( W > 0.0_DbKi ) THEN ! .TRUE. when the line will sink in fluid - - LMax = XF - EA/W + SQRT( (EA/W)*(EA/W) + 2.0_DbKi*ZF*EA/W ) ! Compute the maximum stretched length of the line with seabed interaction beyond which the line would have to double-back on itself; here the line forms an "L" between the anchor and fairlead (i.e. it is horizontal along the seabed from the anchor, then vertical to the fairlead) - - IF ( ( L >= LMax ) .AND. ( CB >= 0.0_DbKi ) ) then ! .TRUE. if the line is as long or longer than its maximum possible value with seabed interaction - ErrStat = ErrID_Warn - ErrMsg = ' Unstretched mooring line length too large. '// & - ' Routine Catenary() cannot solve quasi-static mooring line solution.' - return - END IF - - ENDIF - - - ! Initialize some commonly used terms that don't depend on the iteration: - - WL = W *L - WEA = W *EA - LOvrEA = L /EA - CBOvrEA = CB /EA - MaxIter = INT(1.0_DbKi/Tol) ! Smaller tolerances may take more iterations, so choose a maximum inversely proportional to the tolerance - - - - ! To avoid an ill-conditioned situation, ensure that the initial guess for - ! HF is not less than or equal to zero. Similarly, avoid the problems - ! associated with having exactly vertical (so that HF is zero) or exactly - ! horizontal (so that VF is zero) lines by setting the minimum values - ! equal to the tolerance. This prevents us from needing to implement - ! the known limiting solutions for vertical or horizontal lines (and thus - ! complicating this routine): - - HF = MAX( HF, Tol ) - XF = MAX( XF, Tol ) - ZF = MAX( ZF, TOl ) - - - - ! Solve the analytical, static equilibrium equations for a catenary (or - ! taut) mooring line with seabed interaction: - - ! Begin Newton-Raphson iteration: - - I = 1 ! Initialize iteration counter - FirstIter = .TRUE. ! Initialize iteration flag - - DO - - - ! Initialize some commonly used terms that depend on HF and VF: - - VFMinWL = VF - WL - LMinVFOvrW = L - VF/W - HFOvrW = HF/W - HFOvrWEA = HF/WEA - VFOvrWEA = VF/WEA - VFOvrHF = VF/HF - VFMinWLOvrHF = VFMinWL/HF - VFOvrHF2 = VFOvrHF *VFOvrHF - VFMinWLOvrHF2 = VFMinWLOvrHF*VFMinWLOvrHF - SQRT1VFOvrHF2 = SQRT( 1.0_DbKi + VFOvrHF2 ) - SQRT1VFMinWLOvrHF2 = SQRT( 1.0_DbKi + VFMinWLOvrHF2 ) - - - ! Compute the error functions (to be zeroed) and the Jacobian matrix - ! (these depend on the anticipated configuration of the mooring line): - - IF ( ( CB < 0.0_DbKi ) .OR. ( W < 0.0_DbKi ) .OR. ( VFMinWL > 0.0_DbKi ) ) THEN ! .TRUE. when no portion of the line rests on the seabed - - EXF = ( LOG( VFOvrHF + SQRT1VFOvrHF2 ) & - - LOG( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )*HFOvrW & - + LOvrEA* HF - XF - EZF = ( SQRT1VFOvrHF2 & - - SQRT1VFMinWLOvrHF2 )*HFOvrW & - + LOvrEA*( VF - 0.5_DbKi*WL ) - ZF - - dXFdHF = ( LOG( VFOvrHF + SQRT1VFOvrHF2 ) & - - LOG( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )/ W & - - ( ( VFOvrHF + VFOvrHF2 /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) & - - ( VFMinWLOvrHF + VFMinWLOvrHF2/SQRT1VFMinWLOvrHF2 )/( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )/ W & - + LOvrEA - dXFdVF = ( ( 1.0_DbKi + VFOvrHF /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) & - - ( 1.0_DbKi + VFMinWLOvrHF /SQRT1VFMinWLOvrHF2 )/( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )/ W - dZFdHF = ( SQRT1VFOvrHF2 & - - SQRT1VFMinWLOvrHF2 )/ W & - - ( VFOvrHF2 /SQRT1VFOvrHF2 & - - VFMinWLOvrHF2/SQRT1VFMinWLOvrHF2 )/ W - dZFdVF = ( VFOvrHF /SQRT1VFOvrHF2 & - - VFMinWLOvrHF /SQRT1VFMinWLOvrHF2 )/ W & - + LOvrEA - - - ELSEIF ( -CB*VFMinWL < HF ) THEN ! .TRUE. when a portion of the line rests on the seabed and the anchor tension is nonzero - - EXF = LOG( VFOvrHF + SQRT1VFOvrHF2 ) *HFOvrW & - - 0.5_DbKi*CBOvrEA*W* LMinVFOvrW*LMinVFOvrW & - + LOvrEA* HF + LMinVFOvrW - XF - EZF = ( SQRT1VFOvrHF2 - 1.0_DbKi )*HFOvrW & - + 0.5_DbKi*VF*VFOvrWEA - ZF - - dXFdHF = LOG( VFOvrHF + SQRT1VFOvrHF2 ) / W & - - ( ( VFOvrHF + VFOvrHF2 /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) )/ W & - + LOvrEA - dXFdVF = ( ( 1.0_DbKi + VFOvrHF /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) )/ W & - + CBOvrEA*LMinVFOvrW - 1.0_DbKi/W - dZFdHF = ( SQRT1VFOvrHF2 - 1.0_DbKi & - - VFOvrHF2 /SQRT1VFOvrHF2 )/ W - dZFdVF = ( VFOvrHF /SQRT1VFOvrHF2 )/ W & - + VFOvrWEA - - - ELSE ! 0.0_DbKi < HF <= -CB*VFMinWL ! A portion of the line must rest on the seabed and the anchor tension is zero - - EXF = LOG( VFOvrHF + SQRT1VFOvrHF2 ) *HFOvrW & - - 0.5_DbKi*CBOvrEA*W*( LMinVFOvrW*LMinVFOvrW - ( LMinVFOvrW - HFOvrW/CB )*( LMinVFOvrW - HFOvrW/CB ) ) & - + LOvrEA* HF + LMinVFOvrW - XF - EZF = ( SQRT1VFOvrHF2 - 1.0_DbKi )*HFOvrW & - + 0.5_DbKi*VF*VFOvrWEA - ZF - - dXFdHF = LOG( VFOvrHF + SQRT1VFOvrHF2 ) / W & - - ( ( VFOvrHF + VFOvrHF2 /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) )/ W & - + LOvrEA - ( LMinVFOvrW - HFOvrW/CB )/EA - dXFdVF = ( ( 1.0_DbKi + VFOvrHF /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) )/ W & - + HFOvrWEA - 1.0_DbKi/W - dZFdHF = ( SQRT1VFOvrHF2 - 1.0_DbKi & - - VFOvrHF2 /SQRT1VFOvrHF2 )/ W - dZFdVF = ( VFOvrHF /SQRT1VFOvrHF2 )/ W & - + VFOvrWEA - - - ENDIF - - - ! Compute the determinant of the Jacobian matrix and the incremental - ! tensions predicted by Newton-Raphson: - - - DET = dXFdHF*dZFdVF - dXFdVF*dZFdHF - - if ( EqualRealNos( DET, 0.0_DbKi ) ) then -!bjj: there is a serious problem with the debugger here when DET = 0 - ErrStat = ErrID_Warn - ErrMsg = ' Iteration not convergent (DET is 0). '// & - ' Routine Catenary() cannot solve quasi-static mooring line solution.' - return - endif - - - dHF = ( -dZFdVF*EXF + dXFdVF*EZF )/DET ! This is the incremental change in horizontal tension at the fairlead as predicted by Newton-Raphson - dVF = ( dZFdHF*EXF - dXFdHF*EZF )/DET ! This is the incremental change in vertical tension at the fairlead as predicted by Newton-Raphson - - dHF = dHF*( 1.0_DbKi - Tol*I ) ! Reduce dHF by factor (between 1 at I = 1 and 0 at I = MaxIter) that reduces linearly with iteration count to ensure that we converge on a solution even in the case were we obtain a nonconvergent cycle about the correct solution (this happens, for example, if we jump to quickly between a taut and slack catenary) - dVF = dVF*( 1.0_DbKi - Tol*I ) ! Reduce dHF by factor (between 1 at I = 1 and 0 at I = MaxIter) that reduces linearly with iteration count to ensure that we converge on a solution even in the case were we obtain a nonconvergent cycle about the correct solution (this happens, for example, if we jump to quickly between a taut and slack catenary) - - dHF = MAX( dHF, ( Tol - 1.0_DbKi )*HF ) ! To avoid an ill-conditioned situation, make sure HF does not go less than or equal to zero by having a lower limit of Tol*HF [NOTE: the value of dHF = ( Tol - 1.0_DbKi )*HF comes from: HF = HF + dHF = Tol*HF when dHF = ( Tol - 1.0_DbKi )*HF] - - ! Check if we have converged on a solution, or restart the iteration, or - ! Abort if we cannot find a solution: - - IF ( ( ABS(dHF) <= ABS(Tol*HF) ) .AND. ( ABS(dVF) <= ABS(Tol*VF) ) ) THEN ! .TRUE. if we have converged; stop iterating! [The converge tolerance, Tol, is a fraction of tension] - - EXIT - - - ELSEIF ( ( I == MaxIter ) .AND. ( FirstIter ) ) THEN ! .TRUE. if we've iterated MaxIter-times for the first time; - - ! Perhaps we failed to converge because our initial guess was too far off. - ! (This could happen, for example, while linearizing a model via large - ! pertubations in the DOFs.) Instead, use starting values documented in: - ! Peyrot, Alain H. and Goulois, A. M., "Analysis Of Cable Structures," - ! Computers & Structures, Vol. 10, 1979, pp. 805-813: - ! NOTE: We don't need to check if the current mooring line is exactly - ! vertical (i.e., we don't need to check if XF == 0.0), because XF is - ! limited by the tolerance above. - - XF2 = XF*XF - ZF2 = ZF*ZF - - IF ( L <= SQRT( XF2 + ZF2 ) ) THEN ! .TRUE. if the current mooring line is taut - Lamda0 = 0.2_DbKi - ELSE ! The current mooring line must be slack and not vertical - Lamda0 = SQRT( 3.0_DbKi*( ( L*L - ZF2 )/XF2 - 1.0_DbKi ) ) - ENDIF - - HF = MAX( ABS( 0.5_DbKi*W* XF/ Lamda0 ), Tol ) ! As above, set the lower limit of the guess value of HF to the tolerance - VF = 0.5_DbKi*W*( ZF/TANH(Lamda0) + L ) - - - ! Restart Newton-Raphson iteration: - - I = 0 - FirstIter = .FALSE. - dHF = 0.0_DbKi - dVF = 0.0_DbKi - - - ELSEIF ( ( I == MaxIter ) .AND. ( .NOT. FirstIter ) ) THEN ! .TRUE. if we've iterated as much as we can take without finding a solution; Abort - ErrStat = ErrID_Warn - ErrMsg = ' Iteration not convergent. '// & - ' Routine Catenary() cannot solve quasi-static mooring line solution.' - RETURN - - - ENDIF - - - ! Increment fairlead tensions and iteration counter so we can try again: - - HF = HF + dHF - VF = VF + dVF - - I = I + 1 - - - ENDDO - - - - ! We have found a solution for the tensions at the fairlead! - - ! Now compute the tensions at the anchor and the line position and tension - ! at each node (again, these depend on the configuration of the mooring - ! line): - - IF ( ( CB < 0.0_DbKi ) .OR. ( W < 0.0_DbKi ) .OR. ( VFMinWL > 0.0_DbKi ) ) THEN ! .TRUE. when no portion of the line rests on the seabed - - ! Anchor tensions: - - HA = HF - VA = VFMinWL - - - ! Line position and tension at each node: - - DO I = 1,N ! Loop through all nodes where the line position and tension are to be computed - - IF ( ( s(I) < 0.0_DbKi ) .OR. ( s(I) > L ) ) THEN - ErrStat = ErrID_Warn - ErrMsg = ' All line nodes must be located between the anchor ' & - //'and fairlead (inclusive) in routine Catenary().' - RETURN - END IF - - Ws = W *s(I) ! Initialize - VFMinWLs = VFMinWL + Ws ! some commonly - VFMinWLsOvrHF = VFMinWLs/HF ! used terms - sOvrEA = s(I) /EA ! that depend - SQRT1VFMinWLsOvrHF2 = SQRT( 1.0_DbKi + VFMinWLsOvrHF*VFMinWLsOvrHF ) ! on s(I) - - X (I) = ( LOG( VFMinWLsOvrHF + SQRT1VFMinWLsOvrHF2 ) & - - LOG( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )*HFOvrW & - + sOvrEA* HF - Z (I) = ( SQRT1VFMinWLsOvrHF2 & - - SQRT1VFMinWLOvrHF2 )*HFOvrW & - + sOvrEA*( VFMinWL + 0.5_DbKi*Ws ) - Te(I) = SQRT( HF*HF + VFMinWLs*VFMinWLs ) - - ENDDO ! I - All nodes where the line position and tension are to be computed - - - ELSEIF ( -CB*VFMinWL < HF ) THEN ! .TRUE. when a portion of the line rests on the seabed and the anchor tension is nonzero - - ! Anchor tensions: - - HA = HF + CB*VFMinWL - VA = 0.0_DbKi - - - ! Line position and tension at each node: - - DO I = 1,N ! Loop through all nodes where the line position and tension are to be computed - - IF ( ( s(I) < 0.0_DbKi ) .OR. ( s(I) > L ) ) THEN - ErrStat = ErrID_Warn - ErrMsg = ' All line nodes must be located between the anchor ' & - //'and fairlead (inclusive) in routine Catenary().' - RETURN - END IF - - Ws = W *s(I) ! Initialize - VFMinWLs = VFMinWL + Ws ! some commonly - VFMinWLsOvrHF = VFMinWLs/HF ! used terms - sOvrEA = s(I) /EA ! that depend - SQRT1VFMinWLsOvrHF2 = SQRT( 1.0_DbKi + VFMinWLsOvrHF*VFMinWLsOvrHF ) ! on s(I) - - IF ( s(I) <= LMinVFOvrW ) THEN ! .TRUE. if this node rests on the seabed and the tension is nonzero - - X (I) = s(I) & - + sOvrEA*( HF + CB*VFMinWL + 0.5_DbKi*Ws*CB ) - Z (I) = 0.0_DbKi - Te(I) = HF + CB*VFMinWLs - - ELSE ! LMinVFOvrW < s <= L ! This node must be above the seabed - - X (I) = LOG( VFMinWLsOvrHF + SQRT1VFMinWLsOvrHF2 ) *HFOvrW & - + sOvrEA* HF + LMinVFOvrW - 0.5_DbKi*CB*VFMinWL*VFMinWL/WEA - Z (I) = ( - 1.0_DbKi + SQRT1VFMinWLsOvrHF2 )*HFOvrW & - + sOvrEA*( VFMinWL + 0.5_DbKi*Ws ) + 0.5_DbKi* VFMinWL*VFMinWL/WEA - Te(I) = SQRT( HF*HF + VFMinWLs*VFMinWLs ) - - ENDIF - - ENDDO ! I - All nodes where the line position and tension are to be computed - - - ELSE ! 0.0_DbKi < HF <= -CB*VFMinWL ! A portion of the line must rest on the seabed and the anchor tension is zero - - ! Anchor tensions: - - HA = 0.0_DbKi - VA = 0.0_DbKi - - - ! Line position and tension at each node: - - DO I = 1,N ! Loop through all nodes where the line position and tension are to be computed - - IF ( ( s(I) < 0.0_DbKi ) .OR. ( s(I) > L ) ) THEN - ErrStat = ErrID_Warn - ErrMsg = ' All line nodes must be located between the anchor ' & - //'and fairlead (inclusive) in routine Catenary().' - RETURN - END IF - - Ws = W *s(I) ! Initialize - VFMinWLs = VFMinWL + Ws ! some commonly - VFMinWLsOvrHF = VFMinWLs/HF ! used terms - sOvrEA = s(I) /EA ! that depend - SQRT1VFMinWLsOvrHF2 = SQRT( 1.0_DbKi + VFMinWLsOvrHF*VFMinWLsOvrHF ) ! on s(I) - - IF ( s(I) <= LMinVFOvrW - HFOvrW/CB ) THEN ! .TRUE. if this node rests on the seabed and the tension is zero - - X (I) = s(I) - Z (I) = 0.0_DbKi - Te(I) = 0.0_DbKi - - ELSEIF ( s(I) <= LMinVFOvrW ) THEN ! .TRUE. if this node rests on the seabed and the tension is nonzero - - X (I) = s(I) - ( LMinVFOvrW - 0.5_DbKi*HFOvrW/CB )*HF/EA & - + sOvrEA*( HF + CB*VFMinWL + 0.5_DbKi*Ws*CB ) + 0.5_DbKi*CB*VFMinWL*VFMinWL/WEA - Z (I) = 0.0_DbKi - Te(I) = HF + CB*VFMinWLs - - ELSE ! LMinVFOvrW < s <= L ! This node must be above the seabed - - X (I) = LOG( VFMinWLsOvrHF + SQRT1VFMinWLsOvrHF2 ) *HFOvrW & - + sOvrEA* HF + LMinVFOvrW - ( LMinVFOvrW - 0.5_DbKi*HFOvrW/CB )*HF/EA - Z (I) = ( - 1.0_DbKi + SQRT1VFMinWLsOvrHF2 )*HFOvrW & - + sOvrEA*( VFMinWL + 0.5_DbKi*Ws ) + 0.5_DbKi* VFMinWL*VFMinWL/WEA - Te(I) = SQRT( HF*HF + VFMinWLs*VFMinWLs ) - - ENDIF - - ENDDO ! I - All nodes where the line position and tension are to be computed - - - ENDIF - - - - ! The Newton-Raphson iteration is only accurate in double precision, so - ! convert the output arguments back into the default precision for real - ! numbers: - - !HA_In = REAL( HA , DbKi ) !mth: for this I only care about returning node positions - !HF_In = REAL( HF , DbKi ) - !Te_In(:) = REAL( Te(:), DbKi ) - !VA_In = REAL( VA , DbKi ) - !VF_In = REAL( VF , DbKi ) - X_In (:) = REAL( X (:), DbKi ) - Z_In (:) = REAL( Z (:), DbKi ) - - END SUBROUTINE Catenary - !======================================================================= - - - END SUBROUTINE InitializeLine - !====================================================================== - - - - ! ============ below are some math convenience functions =============== - ! should add error checking if I keep these, but hopefully there are existing NWTCLib functions to replace them - - - ! return unit vector (u) in direction from r1 to r2 - !======================================================================= - SUBROUTINE UnitVector( u, r1, r2 ) - REAL(DbKi), INTENT(OUT) :: u(:) - REAL(DbKi), INTENT(IN) :: r1(:) - REAL(DbKi), INTENT(IN) :: r2(:) - - REAL(DbKi) :: Length - - u = r2 - r1 - Length = TwoNorm(u) - - if ( .NOT. EqualRealNos(length, 0.0_DbKi ) ) THEN - u = u / Length - END IF - - END SUBROUTINE UnitVector - !======================================================================= - - - !compute the inverse of a 3-by-3 matrix m - !======================================================================= - SUBROUTINE Inverse3by3( Minv, M ) - Real(DbKi), INTENT(OUT) :: Minv(:,:) ! returned inverse matrix - Real(DbKi), INTENT(IN) :: M(:,:) ! inputted matrix - - Real(DbKi) :: det ! the determinant - Real(DbKi) :: invdet ! inverse of the determinant - - det = M(1, 1) * (M(2, 2) * M(3, 3) - M(3, 2) * M(2, 3)) - & - M(1, 2) * (M(2, 1) * M(3, 3) - M(2, 3) * M(3, 1)) + & - M(1, 3) * (M(2, 1) * M(3, 2) - M(2, 2) * M(3, 1)); - - invdet = 1.0 / det ! because multiplying is faster than dividing + p%Jac_u_indx(idx,1) = 11 + p%Jac_u_indx(idx,2) = 0 + p%Jac_u_indx(idx,3) = i + InitOut%LinNames_u(idx) = 'CtrlChan DeltaLdot '//trim(num2lstr(i))//', m/s'//trim(LinStr) + idx = idx + 1 + end do + endif - Minv(1, 1) = (M(2, 2) * M(3, 3) - M(3, 2) * M(2, 3)) * invdet - Minv(1, 2) = (M(1, 3) * M(3, 2) - M(1, 2) * M(3, 3)) * invdet - Minv(1, 3) = (M(1, 2) * M(2, 3) - M(1, 3) * M(2, 2)) * invdet - Minv(2, 1) = (M(2, 3) * M(3, 1) - M(2, 1) * M(3, 3)) * invdet - Minv(2, 2) = (M(1, 1) * M(3, 3) - M(1, 3) * M(3, 1)) * invdet - Minv(2, 3) = (M(2, 1) * M(1, 3) - M(1, 1) * M(2, 3)) * invdet - Minv(3, 1) = (M(2, 1) * M(3, 2) - M(3, 1) * M(2, 2)) * invdet - Minv(3, 2) = (M(3, 1) * M(1, 2) - M(1, 1) * M(3, 2)) * invdet - Minv(3, 3) = (M(1, 1) * M(2, 2) - M(2, 1) * M(1, 2)) * invdet + ! --- Default perturbations, p%du: + call allocAry( p%du, 11, 'p%du', ErrStat2, ErrMsg2); if(ErrStat2/=ErrID_None) return + p%du( 1) = dl_slack_min ! u%CoupledKinematics(1)%TranslationDisp = 1; + p%du( 2) = 0.1_ReKi ! u%CoupledKinematics(1)%Orientation = 2; + p%du( 3) = 0.1_ReKi ! u%CoupledKinematics(1)%TranslationVel = 3; + p%du( 4) = 0.1_ReKi ! u%CoupledKinematics(1)%RotationVel = 4; + p%du( 5) = 0.1_ReKi ! u%CoupledKinematics(1)%TranslationAcc = 5; + p%du( 6) = 0.1_ReKi ! u%CoupledKinematics(1)%RotationAcc = 6; + p%du(10) = dl_slack_min ! deltaL [m] + p%du(11) = 0.2_ReKi ! deltaLdot [m/s] + END SUBROUTINE Init_Jacobian_u + +END SUBROUTINE MD_Init_Jacobian +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) +!! Do not change this without making sure subroutine MD_init_jacobian is consistant with this routine! +SUBROUTINE MD_Perturb_u( p, n, perturb_sign, u, du ) + TYPE(MD_ParameterType) , INTENT(IN ) :: p !< parameters + INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use + INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) + TYPE(MD_InputType) , INTENT(INOUT) :: u !< perturbed MD inputs + REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed + ! local variables + INTEGER :: fieldIndx + INTEGER :: node + fieldIndx = p%Jac_u_indx(n,2) + node = p%Jac_u_indx(n,3) + du = p%du( p%Jac_u_indx(n,1) ) + ! determine which mesh we're trying to perturb and perturb the input: + SELECT CASE( p%Jac_u_indx(n,1) ) + CASE ( 1) + u%CoupledKinematics(1)%TranslationDisp( fieldIndx,node) = u%CoupledKinematics(1)%TranslationDisp( fieldIndx,node) + du * perturb_sign + CASE ( 2) + CALL PerturbOrientationMatrix( u%CoupledKinematics(1)%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) + CASE ( 3) + u%CoupledKinematics(1)%TranslationVel( fieldIndx,node) = u%CoupledKinematics(1)%TranslationVel( fieldIndx,node) + du * perturb_sign + CASE ( 4) + u%CoupledKinematics(1)%RotationVel(fieldIndx,node) = u%CoupledKinematics(1)%RotationVel(fieldIndx,node) + du * perturb_sign + CASE ( 5) + u%CoupledKinematics(1)%TranslationAcc( fieldIndx,node) = u%CoupledKinematics(1)%TranslationAcc( fieldIndx,node) + du * perturb_sign + CASE ( 6) + u%CoupledKinematics(1)%RotationAcc(fieldIndx,node) = u%CoupledKinematics(1)%RotationAcc(fieldIndx,node) + du * perturb_sign + CASE (10) + u%deltaL(node) = u%deltaL(node) + du * perturb_sign + CASE (11) + u%deltaLdot(node) = u%deltaLdot(node) + du * perturb_sign + END SELECT +END SUBROUTINE MD_Perturb_u +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine uses values of two output types to compute an array of differences. +!! Do not change this packing without making sure subroutine MD_init_jacobian is consistant with this routine! +SUBROUTINE MD_Compute_dY(p, y_p, y_m, delta, dY) + TYPE(MD_ParameterType) , INTENT(IN ) :: p !< parameters + TYPE(MD_OutputType) , INTENT(IN ) :: y_p !< MD outputs at \f$ u + \Delta_p u \f$ or \f$ z + \Delta_p z \f$ (p=plus) + TYPE(MD_OutputType) , INTENT(IN ) :: y_m !< MD outputs at \f$ u - \Delta_m u \f$ or \f$ z - \Delta_m z \f$ (m=minus) + REAL(R8Ki) , INTENT(IN ) :: delta !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p x \f$ + REAL(R8Ki) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdx: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial z_i} = \frac{y_p - y_m}{2 \, \Delta x}\f$ + ! local variables: + INTEGER(IntKi) :: i ! loop over outputs + INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled + indx_first = 1 + call PackLoadMesh_dY( y_p%CoupledLoads(1), y_m%CoupledLoads(1), dY, indx_first) + !call PackMotionMesh_dY(y_p%Y2Mesh, y_m%Y2Mesh, dY, indx_first) ! all 6 motion fields + do i=1,p%NumOuts + dY(i+indx_first-1) = y_p%WriteOutput(i) - y_m%WriteOutput(i) + end do + dY = dY / (2.0_R8Ki*delta) +END SUBROUTINE MD_Compute_dY +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine perturbs the nth element of the x array (and mesh/field it corresponds to) +!! Do not change this without making sure subroutine MD_init_jacobian is consistant with this routine! +SUBROUTINE MD_Perturb_x( p, i, perturb_sign, x, dx ) + TYPE(MD_ParameterType) , INTENT(IN ) :: p !< parameters + INTEGER( IntKi ) , INTENT(IN ) :: i !< state array index number + INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) + TYPE(MD_ContinuousStateType), INTENT(INOUT) :: x !< perturbed MD states + REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific state was perturbed + + dx=p%dx(i) + x%states(i) = x%states(i) + dx * perturb_sign +END SUBROUTINE MD_Perturb_x +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine uses values of two output types to compute an array of differences. +!! Do not change this packing without making sure subroutine MD_init_jacobian is consistant with this routine! +SUBROUTINE MD_Compute_dX(p, x_p, x_m, delta, dX) + TYPE(MD_ParameterType) , INTENT(IN ) :: p !< parameters + TYPE(MD_ContinuousStateType), INTENT(IN ) :: x_p !< 1 = more console output + + PUBLIC :: Body_Setup + PUBLIC :: Body_Initialize + PUBLIC :: Body_InitializeUnfree + PUBLIC :: Body_SetKinematics + PUBLIC :: Body_SetState + PUBLIC :: Body_SetDependentKin + PUBLIC :: Body_GetStateDeriv + PUBLIC :: Body_DoRHS + PUBLIC :: Body_GetCoupledForce + PUBLIC :: Body_AddConnect + PUBLIC :: Body_AddRod + + + +CONTAINS + + + SUBROUTINE Body_Setup( Body, tempArray, p, ErrStat, ErrMsg) + + TYPE(MD_Body), INTENT(INOUT) :: Body ! the single body object of interest + REAL(DbKi), INTENT(IN) :: tempArray(6) ! initial pose of body + TYPE(MD_ParameterType), INTENT(IN ) :: p ! Parameters + INTEGER, INTENT(INOUT ) :: ErrStat ! returns a non-zero value when an error occurs + CHARACTER(*), INTENT(INOUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + INTEGER(4) :: J ! Generic index + INTEGER(4) :: K ! Generic index + INTEGER(IntKi) :: N + + REAL(DbKi) :: Mtemp(6,6) + + ! set initial velocity to zero + Body%v6 = 0.0_DbKi + + !also set number of attached rods and points to zero initially + Body%nAttachedC = 0 + Body%nAttachedR = 0 + + ! set up body initial mass matrix (excluding any rods or attachements) + DO J=1,3 + Mtemp(J,J) = Body%BodyM ! fill in mass + Mtemp(3+J,3+J) = Body%BodyI(J) ! fill in inertia + END DO + + CALL TranslateMass6to6DOF(Body%rCG, Mtemp, Body%M0) ! account for potential CG offset <<< is the direction right? <<< + + DO J=1,3 + Body%M0(J,J) = Body%M0(J,J) + Body%BodyV*Body%BodyCa(J) ! add added mass in each direction about ref point (so only diagonals) <<< eventually expand to multi D + END DO + + ! --------------- if this is an independent body (not coupled) ---------- + ! set initial position and orientation of body from input file + Body%r6 = tempArray + + ! calculate orientation matrix based on latest angles + !RotMat(r6[3], r6[4], r6[5], OrMat); + Body%OrMat = TRANSPOSE( EulerConstruct( Body%r6(4:6) ) ) ! full Euler angle approach <<<< need to check order + + IF (wordy > 0) print *, "Set up Body ",Body%IdNum, ", type ", Body%typeNum + + ! need to add cleanup sub <<< + + END SUBROUTINE Body_Setup + +! ! used to initialize bodies that aren't free i.e. don't have states +! !-------------------------------------------------------------- +! SUBROUTINE Body_InitializeUnfree(Body, r6_in, mesh, mesh_index, m) +! +! Type(MD_Body), INTENT(INOUT) :: Body ! the Body object +! Real(DbKi), INTENT(IN ) :: r6_in(6) ! state vector section for this line +! TYPE(MeshType), INTENT(INOUT) :: mesh ! +! Integer(IntKi), INTENT(IN ) :: mesh_index ! index of the node in the mesh for the current object being initialized +! TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects +! +! INTEGER(IntKi) :: l ! index of segments or nodes along line +! REAL(DbKi) :: rRef(3) ! reference position of mesh node +! REAL(DbKi) :: OrMat(3,3) ! DCM for body orientation based on r6_in +! REAL(DbKi) :: dummyStates(12) +! +! +! rRef = 0.0_DbKi ! <<< maybe this should be the offsets of the local platform origins from the global origins in future? And that's what's specificed by the Body input coordinates? +! +! CALL MeshPositionNode(mesh, mesh+index, rRef,ErrStat2,ErrMsg2)! "assign the coordinates (u%PtFairleadDisplacement%Position) of each node in the global coordinate space" +! +! CALL CheckError( ErrStat2, ErrMsg2 ) +! IF (ErrStat >= AbortErrLev) RETURN +! +! ! Apply offsets due to initial platform rotations and translations (fixed Jun 19, 2015) +! CALL SmllRotTrans('body rotation matrix', r6_in(4),r6_in(5),r6_in(6), OrMat, '', ErrStat2, ErrMsg2) +! mesh%TranslationDisp(1, mesh_index) = r6_in(1) + OrMat(1,1)*rRef(1) + OrMat(2,1)*rRef(2) + OrMat(3,1)*rRef(3) - rRef(1) +! mesh%TranslationDisp(2, mesh_index) = r6_in(2) + OrMat(1,2)*rRef(1) + OrMat(2,2)*rRef(2) + OrMat(3,2)*rRef(3) - rRef(2) +! mesh%TranslationDisp(3, mesh_index) = r6_in(3) + OrMat(1,3)*rRef(1) + OrMat(2,3)*rRef(2) + OrMat(3,3)*rRef(3) - rRef(3) +! +! ! what about node point orientation ??? +! +! ! If any Rod is fixed to the body (not pinned), initialize it now because otherwise it won't be initialized +! DO l=1, Body%nAttachedR +! if (m%RodList(Body%attachedR(l))%typeNum == 2) CALL Rod_Initialize(m%RodList(Body%attachedR(l)), dummyStates, m%LineList) +! END DO +! +! ! Note: Connections don't need any initialization +! +! END SUBROUTINE Body_InitializeUnfree +! !-------------------------------------------------------------- + + + ! used to initialize bodies that are free + !-------------------------------------------------------------- + SUBROUTINE Body_Initialize(Body, states, m) + + Type(MD_Body), INTENT(INOUT) :: Body ! the Body object + Real(DbKi), INTENT(INOUT) :: states(:) ! state vector section for this Body + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + + INTEGER(IntKi) :: l ! index of segments or nodes along line + REAL(DbKi) :: dummyStates(12) ! dummy vector to mimic states when initializing a rigidly attached rod + + + ! assign initial body kinematics to state vector + states(7:12) = Body%r6 + states(1:6 ) = Body%v6 + + + ! set positions of any dependent connections and rods now (before they are initialized) + CALL Body_SetDependentKin(Body, 0.0_DbKi, m) + + ! If any Rod is fixed to the body (not pinned), initialize it now because otherwise it won't be initialized + DO l=1, Body%nAttachedR + if (m%RodList(Body%attachedR(l))%typeNum == 2) CALL Rod_Initialize(m%RodList(Body%attachedR(l)), dummyStates, m) + END DO + + ! Note: Connections don't need any initialization + + END SUBROUTINE Body_Initialize + !-------------------------------------------------------------- + + ! used to initialize bodies that are coupled or fixed + !-------------------------------------------------------------- + SUBROUTINE Body_InitializeUnfree(Body, m) + + Type(MD_Body), INTENT(INOUT) :: Body ! the Body object + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + + INTEGER(IntKi) :: l ! index of segments or nodes along line + REAL(DbKi) :: dummyStates(12) ! dummy vector to mimic states when initializing a rigidly attached rod + + + ! set positions of any dependent connections and rods now (before they are initialized) + CALL Body_SetDependentKin(Body, 0.0_DbKi, m) + + ! If any Rod is fixed to the body (not pinned), initialize it now because otherwise it won't be initialized + DO l=1, Body%nAttachedR + if (m%RodList(Body%attachedR(l))%typeNum == 2) CALL Rod_Initialize(m%RodList(Body%attachedR(l)), dummyStates, m) + END DO + + ! Note: Connections don't need any initialization + + END SUBROUTINE Body_InitializeUnfree + !-------------------------------------------------------------- + + + + + ! set kinematics for Bodies if they are coupled (or ground) + !-------------------------------------------------------------- + SUBROUTINE Body_SetKinematics(Body, r_in, v_in, a_in, t, m) + + Type(MD_Body), INTENT(INOUT) :: Body ! the Body object + Real(DbKi), INTENT(IN ) :: r_in(6) ! 6-DOF position + Real(DbKi), INTENT(IN ) :: v_in(6) ! 6-DOF velocity + Real(DbKi), INTENT(IN ) :: a_in(6) ! 6-DOF acceleration (only used for coupled rods) + Real(DbKi), INTENT(IN ) :: t ! instantaneous time + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects (for simplicity, since Bodies deal with Rods and Connections) + + + INTEGER(IntKi) :: l + + ! store current time + Body%time = t + + ! if (abs(Body%typeNum) == 2) then ! body coupled in 6 DOF, or ground + Body%r6 = r_in + Body%v6 = v_in + Body%a6 = a_in + + ! since this body has no states and all DOFs have been set, pass its kinematics to dependent attachments + CALL Body_SetDependentKin(Body, t, m) + + ! else if (abs(Body%typeNum) == 1) then ! body pinned at reference point + ! + ! ! set Body *end A only* kinematics based on BCs (linear model for now) + ! Body%r6(1:3) = r_in(1:3) + ! Body%v6(1:3) = v_in(1:3) + ! + ! ! Body is pinned so only ref point posiiton is specified, rotations are left alone and will be + ! ! handled, along with passing kinematics to attached objects, by separate call to setState + ! + ! else + ! print *, "Error: Body_SetKinematics called for a free Body." ! <<< + ! end if + + END SUBROUTINE Body_SetKinematics + !-------------------------------------------------------------- + + + !-------------------------------------------------------------- + SUBROUTINE Body_SetState(Body, X, t, m) + + Type(MD_Body), INTENT(INOUT) :: Body ! the Body object + Real(DbKi), INTENT(IN ) :: X(:) ! state vector section for this line + Real(DbKi), INTENT(IN ) :: t ! instantaneous time + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + + INTEGER(IntKi) :: l ! index of segments or nodes along line + INTEGER(IntKi) :: J ! index + + ! store current time + Body%time = t + + + + Body%r6 = X(7:12) ! get positions + Body%v6 = X(1:6) ! get velocities + + + ! set positions of any dependent connections and rods + CALL Body_SetDependentKin(Body, t, m) + + END SUBROUTINE Body_SetState + !-------------------------------------------------------------- + + + ! set the states (positions and velocities) of any connects or rods that are part of this body + ! also computes the orientation matrix (never skip this sub!) + !-------------------------------------------------------------- + SUBROUTINE Body_SetDependentKin(Body, t, m) + + Type(MD_Body), INTENT(INOUT) :: Body ! the Bodyion object + REAL(DbKi), INTENT(IN ) :: t + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects (for simplicity, since Bodies deal with Rods and Connections) + + INTEGER(IntKi) :: l ! index of attached objects + + Real(DbKi) :: rConnect(3) + Real(DbKi) :: rdConnect(3) + Real(DbKi) :: rRod(6) + Real(DbKi) :: vRod(6) + Real(DbKi) :: aRod(6) + + + + ! calculate orientation matrix based on latest angles + !CALL SmllRotTrans('', Body%r6(4), Body%r6(5), Body%r6(6), Body%TransMat, '', ErrStat2, ErrMsg2) + Body%OrMat = TRANSPOSE( EulerConstruct( Body%r6(4:6) ) ) ! full Euler angle approach <<<< need to check order + + ! set kinematics of any dependent connections + do l = 1,Body%nAttachedC + + CALL transformKinematics(Body%rConnectRel(:,l), Body%r6, Body%OrMat, Body%v6, rConnect, rdConnect) !<<< should double check this function + + ! >>> need to add acceleration terms here too? <<< + + ! pass above to the connection and get it to calculate the forces + CALL Connect_SetKinematics( m%ConnectList(Body%attachedC(l)), rConnect, rdConnect, m%zeros6(1:3), t, m) + end do + + ! set kinematics of any dependent Rods + do l=1,Body%nAttachedR + + ! calculate displaced coordinates/orientation and velocities of each rod <<<<<<<<<<<<< + ! do 3d details of Rod ref point + CALL TransformKinematicsA( Body%r6RodRel(1:3,l), Body%r6(1:3), Body%OrMat, Body%v6, Body%a6, rRod(1:3), vRod(1:3), aRod(1:3)) ! set first three entires (end A translation) of rRod and rdRod + ! does the above function need to take in all 6 elements of r6RodRel?? + + ! do rotational stuff + rRod(4:6) = MATMUL(Body%OrMat, Body%r6RodRel(4:6,l)) !<<<<<< correct? <<<<< rotateVector3(r6RodRel[i]+3, OrMat, rRod+3); ! rotate rod relative unit vector by OrMat to get unit vec in reference coords + vRod(4:6) = Body%v6(4:6) ! transformed rotational velocity. <<< is this okay as is? <<<< + aRod(4:6) = Body%a6(4:6) + + ! pass above to the rod and get it to calculate the forces + CALL Rod_SetKinematics(m%RodList(Body%attachedR(l)), rRod, vRod, aRod, t, m) + end do + + END SUBROUTINE Body_SetDependentKin + !-------------------------------------------------------------- + + + !-------------------------------------------------------------- + SUBROUTINE Body_GetStateDeriv(Body, Xd, m, p) + + Type(MD_Body), INTENT(INOUT) :: Body ! the Bodyion object + Real(DbKi), INTENT(INOUT) :: Xd(:) ! state derivative vector section for this line + + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + TYPE(MD_ParameterType),INTENT(IN ) :: p ! Parameters + + INTEGER(IntKi) :: J ! index + + Real(DbKi) :: acc(6) ! 6DOF acceleration vector + + Real(DbKi) :: y_temp (6) ! temporary vector for LU decomposition + Real(DbKi) :: LU_temp(6,6) ! temporary matrix for LU decomposition + + + ! Initialize temp variables + y_temp = 0.0_DbKi +! FIXME: should LU_temp be set to M_out before calling LUsolve????? + LU_temp = 0.0_DbKi + + CALL Body_DoRHS(Body, m, p) + + ! solve for accelerations in [M]{a}={f} using LU decomposition + CALL LUsolve(6, Body%M, LU_temp, Body%F6net, y_temp, acc) + + ! fill in state derivatives + Xd(7:12) = Body%v6 ! dxdt = V (velocities) + Xd(1:6) = acc ! dVdt = a (accelerations) + + ! store accelerations in case they're useful as output + Body%a6 = acc + + ! check for NaNs (should check all state derivatives, not just first 6) + DO J = 1, 6 + IF (Is_NaN(Xd(J))) THEN + CALL WrScr("NaN detected at time "//trim(Num2LStr(Body%time))//" in Body "//trim(Int2LStr(Body%IdNum))//"in MoorDyn,") + IF (wordy > 0) print *, "state derivatives:" + IF (wordy > 0) print *, Xd + EXIT + END IF + END DO + + + END SUBROUTINE Body_GetStateDeriv + !-------------------------------------------------------------- + + !-------------------------------------------------------------- + SUBROUTINE Body_DoRHS(Body, m, p) + + Type(MD_Body), INTENT(INOUT) :: Body ! the Bodyion object + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + TYPE(MD_ParameterType),INTENT(IN ) :: p ! Parameters + + !TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! misc/optimization variables + + INTEGER(IntKi) :: l ! index of attached lines + INTEGER(IntKi) :: I ! index + INTEGER(IntKi) :: J ! index + INTEGER(IntKi) :: K ! index + + Real(DbKi) :: Fgrav(3) ! body weight force + Real(DbKi) :: body_rCGrotated(3) ! instantaneous vector from body ref point to CG + Real(DbKi) :: U(3) ! water velocity - zero for now + Real(DbKi) :: Ud(3) ! water acceleration- zero for now + Real(DbKi) :: vi(6) ! relative water velocity (last 3 terms are rotatonal and will be set to zero + Real(DbKi) :: F6_i(6) ! net force and moments from an attached object + Real(DbKi) :: M6_i(6,6) ! mass and inertia from an attached object + + ! Initialize variables + U = 0.0_DbKi ! Set to zero for now + Body%F6net = 0.0_DbKi + + ! First, the body's own mass matrix must be adjusted based on its orientation so that + ! we have a mass matrix in the global orientation frame + Body%M = RotateM6(Body%M0, Body%OrMat) + + !gravity on core body + Fgrav(1) = 0.0_DbKi + Fgrav(2) = 0.0_DbKi + Fgrav(3) = Body%bodyV * p%rhow * p%g - Body%bodyM * p%g ! weight+buoyancy vector + + body_rCGrotated = MATMUL(Body%OrMat, Body%rCG) ! rotateVector3(body_rCG, OrMat, body_rCGrotated); ! relative vector to body CG in inertial orientation + CALL translateForce3to6DOF(body_rCGrotated, Fgrav, Body%F6net) ! gravity forces and moments about body ref point given CG location + + + ! --------------------------------- apply wave kinematics ------------------------------------ + !env->waves->getU(r6, t, U); ! call generic function to get water velocities <<<<<<<<< all needs updating + + ! for (int J=0; J<3; J++) + ! Ud[J] = 0.0; ! set water accelerations as zero for now + ! ------------------------------------------------------------------------------------------ + + ! viscous drag calculation (on core body) + vi(1:3) = U - Body%v6(1:3) ! relative flow velocity over body ref point + vi(4:6) = - Body%v6(4:6) ! for rotation, this is just the negative of the body's rotation for now (not allowing flow rotation) + + Body%F6net = Body%F6net + 0.5*p%rhoW * vi * abs(vi) * Body%bodyCdA + ! <<< NOTE, for body this should be fixed to account for orientation!! <<< what about drag in rotational DOFs??? <<<<<<<<<<<<<< + + + + ! Get contributions from any dependent connections + do l = 1,Body%nAttachedC + + ! get net force and mass from Connection on body ref point (global orientation) + CALL Connect_GetNetForceAndMass( m%ConnectList(Body%attachedC(l)), Body%r6(1:3), F6_i, M6_i, m, p) + + if (ABS(F6_i(5)) > 1.0E12) then + print *, "Warning: extreme pitch moment from body-attached Point ", l + end if + + ! sum quantitites + Body%F6net = Body%F6net + F6_i + Body%M = Body%M + M6_i + end do + + ! Get contributions from any dependent Rods + do l=1,Body%nAttachedR + + ! get net force and mass from Rod on body ref point (global orientation) + CALL Rod_GetNetForceAndMass(m%RodList(Body%attachedR(l)), Body%r6(1:3), F6_i, M6_i, m, p) + + if (ABS(F6_i(5)) > 1.0E12) then + print *, "Warning: extreme pitch moment from body-attached Rod ", l + end if + + ! sum quantitites + Body%F6net = Body%F6net + F6_i + Body%M = Body%M + M6_i + end do + + + END SUBROUTINE Body_DoRHS + !===================================================================== + + + ! calculate the aggregate 3/6DOF rigid-body loads of a coupled rod including inertial loads + !-------------------------------------------------------------- + SUBROUTINE Body_GetCoupledForce(Body, Fnet_out, m, p) + + Type(MD_Body), INTENT(INOUT) :: Body ! the Body object + Real(DbKi), INTENT( OUT) :: Fnet_out(6) ! force and moment vector + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + TYPE(MD_ParameterType),INTENT(IN ) :: p ! Parameters + + Real(DbKi) :: F6_iner(6) ! inertial reaction force + + ! do calculations of forces and masses on the body + CALL Body_DoRHS(Body, m, p) + + ! add inertial loads as appropriate + if (Body%typeNum == -1) then + + F6_iner = 0.0_DbKi !-MATMUL(Body%M, Body%a6) <<<<<<<< why does including F6_iner cause instability??? + Fnet_out = Body%F6net + F6_iner ! add inertial loads + + else + print *, "ERROR, Body_GetCoupledForce called for wrong (non-coupled) body type in MoorDyn!" + end if + + END SUBROUTINE Body_GetCoupledForce + !-------------------------------------------------------------- + + + + ! this function handles assigning a connection to a body + !-------------------------------------------------------------- + SUBROUTINE Body_AddConnect(Body, connectID, coords) + + Type(MD_Body), INTENT(INOUT) :: Body ! the Connection object + Integer(IntKi), INTENT(IN ) :: connectID + REAL(DbKi), INTENT(IN ) :: coords(3) + + + IF (wordy > 0) Print*, "C", connectID, "->B", Body%IdNum + + IF(Body%nAttachedC < 30) THEN ! this is currently just a maximum imposed by a fixed array size. could be improved. + Body%nAttachedC = Body%nAttachedC + 1 ! increment the number connected + Body%AttachedC(Body%nAttachedC) = connectID + Body%rConnectRel(:,Body%nAttachedC) = coords ! store relative position of connect on body + ELSE + Print*, "too many Points attached to Body ", Body%IdNum, " in MoorDyn!" + END IF + + END SUBROUTINE Body_AddConnect + + + ! this function handles assigning a rod to a body + !-------------------------------------------------------------- + SUBROUTINE Body_AddRod(Body, rodID, coords) + + Type(MD_Body), INTENT(INOUT) :: Body ! the Connection object + Integer(IntKi), INTENT(IN ) :: rodID + REAL(DbKi), INTENT(IN ) :: coords(6) ! positions of rod ends A and B relative to body + + REAL(DbKi) :: tempUnitVec(3) + REAL(DbKi) :: dummyLength + + IF (wordy > 0) Print*, "R", rodID, "->B", Body%IdNum + + IF(Body%nAttachedR < 30) THEN ! this is currently just a maximum imposed by a fixed array size. could be improved. + Body%nAttachedR = Body%nAttachedR + 1 ! increment the number connected + + ! store rod ID + Body%AttachedR(Body%nAttachedR) = rodID + + ! store Rod end A relative position and unit vector from end A to B + CALL UnitVector(coords(1:3), coords(4:6), tempUnitVec, dummyLength) + Body%r6RodRel(1:3, Body%nAttachedR) = coords(1:3) + Body%r6RodRel(4:6, Body%nAttachedR) = tempUnitVec + + ELSE + Print*, "too many rods attached to Body ", Body%IdNum, " in MoorDyn" + END IF + + END SUBROUTINE Body_AddRod + + + +END MODULE MoorDyn_Body diff --git a/modules/moordyn/src/MoorDyn_Driver.f90 b/modules/moordyn/src/MoorDyn_Driver.f90 index 0b501336ea..582219d2fa 100644 --- a/modules/moordyn/src/MoorDyn_Driver.f90 +++ b/modules/moordyn/src/MoorDyn_Driver.f90 @@ -1,7 +1,7 @@ !********************************************************************************************************************************** ! LICENSING -! Copyright (C) 2020 National Renewable Energy Laboratory -! Copyright (C) 2020 Matthew Hall +! Copyright (C) 2020-2021 Alliance for Sustainable Energy, LLC +! Copyright (C) 2015-2019 Matthew Hall ! ! This file is part of MoorDyn. ! @@ -27,27 +27,61 @@ PROGRAM MoorDyn_Driver IMPLICIT NONE + TYPE MD_Drvr_InitInput + LOGICAL :: Echo + REAL(DbKi) :: Gravity + REAL(DbKi) :: rhoW + REAL(DbKi) :: WtrDepth + + CHARACTER(1024) :: MDInputFile + CHARACTER(1024) :: OutRootName + REAL(DbKi) :: TMax + REAL(DbKi) :: dtC + + INTEGER :: FarmSize + REAL(DbKi) :: FarmPositions(8,40) + + INTEGER :: InputsMod + CHARACTER(1024) :: InputsFile + INTEGER :: nTurb + END TYPE MD_Drvr_InitInput + + INTEGER(IntKi) :: ErrStat ! Status of error message CHARACTER(1024) :: ErrMsg ! Error message if ErrStat /= ErrID_None - TYPE (MD_InitInputType) :: MD_InitInput - TYPE (MD_ParameterType) :: MD_Parameter - TYPE (MD_ContinuousStateType) :: MD_ContinuousState - TYPE (MD_InitOutputType) :: MD_InitOutput - TYPE (MD_DiscreteStateType) :: MD_DiscreteState - TYPE (MD_ConstraintStateType) :: MD_ConstraintState - TYPE (MD_OtherStateType) :: MD_OtherState - TYPE (MD_MiscVarType) :: MD_MiscVar + INTEGER(IntKi) :: ErrStat2 ! Status of error message + CHARACTER(1024) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None - TYPE (MD_InputType), ALLOCATABLE :: MD_Input(:) - REAL(DbKi), DIMENSION(:), ALLOCATABLE :: MD_InputTimes + CHARACTER(1024) :: drvrFilename ! Filename and path for the driver input file. This is passed in as a command line argument when running the Driver exe. + TYPE(MD_Drvr_InitInput) :: drvrInitInp ! Initialization data for the driver program + INTEGER :: UnIn ! Unit number for the input file + INTEGER :: UnEcho ! The local unit number for this module's echo file + + + TYPE (MD_InitInputType) :: MD_InitInp + TYPE (MD_ParameterType) :: MD_p + TYPE (MD_ContinuousStateType) :: MD_x ! continuous states + TYPE (MD_InitOutputType) :: MD_InitOut + TYPE (MD_DiscreteStateType) :: MD_xd ! discrete states + TYPE (MD_ConstraintStateType) :: MD_xc ! constraint states + TYPE (MD_OtherStateType) :: MD_xo ! other states + TYPE (MD_MiscVarType) :: MD_m - TYPE (MD_OutputType) :: MD_Output ! Output file identifier + TYPE (MD_InputType), ALLOCATABLE :: MD_u(:) + REAL(DbKi), DIMENSION(:), ALLOCATABLE :: MD_uTimes + + TYPE (MD_OutputType) :: MD_y ! Output file identifier INTEGER(IntKi) :: UnPtfmMotIn ! platform motion input file identifier CHARACTER(100) :: Line ! String to temporarially hold value of read line REAL(ReKi), ALLOCATABLE :: PtfmMotIn(:,:) ! Variable for storing time, and DOF time series from driver input file - REAL(ReKi), ALLOCATABLE :: PtfmMot(:,:) ! Variable for storing interpolated DOF time series from driver input file + REAL(ReKi), ALLOCATABLE :: r_in(:,:) ! Variable for storing interpolated DOF time series from driver input file + REAL(ReKi), ALLOCATABLE :: r_in2(:,:) ! used for filtering + REAL(ReKi), ALLOCATABLE :: rd_in(:,:) ! Variable for storing 1st derivative of interpolate DOF time series + REAL(ReKi), ALLOCATABLE :: rd_in2(:,:) ! used for filtering + REAL(ReKi), ALLOCATABLE :: rdd_in(:,:) ! Variable for storing 2nd derivative of interpolate DOF time series + REAL(ReKi), ALLOCATABLE :: rdd_in2(:,:) ! used for filtering INTEGER(IntKi) :: ntIn ! number of time steps read from driver input file INTEGER(IntKi) :: ncIn ! number of channels read from driver input file INTEGER(IntKi) :: nt ! number of coupling time steps to use in simulation @@ -60,244 +94,422 @@ PROGRAM MoorDyn_Driver INTEGER(IntKi) :: MD_interp_order ! order of interpolation/extrapolation ! Local variables - Integer(IntKi) :: i ! counter for various loops - Integer(IntKi) :: j ! counter for various loops - Integer(IntKi) :: k ! counter for various loops + Integer(IntKi) :: i,j,k,l ! counter for various loops + Integer(IntKi) :: iTurb + Integer(IntKi) :: nTurbines Integer(IntKi) :: iIn integer(intKi) :: Un - + + ! data for SimStatus/RunTimes: + REAL(DbKi) :: PrevSimTime !< Previous time message was written to screen (s > 0) + REAL(ReKi) :: PrevClockTime !< Previous clock time in seconds past midnight + INTEGER :: SimStrtTime (8) !< An array containing the elements of the start time (after initialization). + INTEGER :: ProgStrtTime (8) !< An array containing the elements of the program start time (before initialization). + REAL(ReKi) :: SimStrtCPU !< User CPU time for simulation (without intialization) + REAL(ReKi) :: ProgStrtCPU !< User CPU time for program (with intialization) + + CHARACTER(20) :: FlagArg ! flag argument from command line - CHARACTER(1024) :: PlatformInitInputFile + !CHARACTER(1024) :: drvrInitInp%%InputsFile CHARACTER(200) :: git_commit ! String containing the current git commit hash TYPE(ProgDesc), PARAMETER :: version = ProgDesc( 'MoorDyn Driver', '', '' ) + + + ErrMsg = "" + ErrStat = ErrID_None + UnEcho=-1 + UnIn =-1 + + ! TODO: Sort out error handling (two sets of flags currently used) + CALL NWTC_Init( ProgNameIn=version%Name ) - MD_InitInput%FileName = "MoorDyn.dat" ! initialize to empty string to make sure it's input from the command line - CALL CheckArgs( MD_InitInput%FileName, Arg2=PlatformInitInputFile, Flag=FlagArg ) + MD_InitInp%FileName = "MoorDyn.dat" ! initialize to empty string to make sure it's input from the command line + CALL CheckArgs( MD_InitInp%FileName, Arg2=drvrInitInp%InputsFile, Flag=FlagArg ) IF ( LEN( TRIM(FlagArg) ) > 0 ) CALL NormStop() ! Display the copyright notice - CALL DispCopyrightLicense( version%Name, 'Copyright (C) 2020 Matthew Hall' ) + CALL DispCopyrightLicense( version%Name, 'Copyright (C) 2021 NREL, 2019 Matt Hall' ) ! Obtain OpenFAST git commit hash git_commit = QueryGitVersion() ! Tell our users what they're running CALL WrScr( ' Running '//TRIM( version%Name )//' a part of OpenFAST - '//TRIM(git_commit)//NewLine//' linked with '//TRIM( NWTC_Ver%Name )//NewLine ) - ! ------------------------------------------------------------------------- - ! Initialize MoorDyn - ! ------------------------------------------------------------------------- + + + CALL DATE_AND_TIME ( Values=ProgStrtTime ) ! Let's time the whole simulation + CALL CPU_TIME ( ProgStrtCPU ) ! Initial time (this zeros the start time when used as a MATLAB function) + + + CALL WrScr( ' MD Driver updated 2022-01-12') + + ! Parse the driver input file and run the simulation based on that file + CALL get_command_argument(1, drvrFilename) + CALL ReadDriverInputFile( drvrFilename, drvrInitInp); + + ! do any initializing and allocating needed in prep for calling MD_Init + + ! set the input file name and other environment terms + !MD_InitInp%NStepWave = 1 ! an arbitrary number > 0 (to set the size of the wave data, which currently contains all zero values) + MD_InitInp%Tmax = drvrInitInp%TMax + MD_InitInp%g = drvrInitInp%Gravity + MD_InitInp%rhoW = drvrInitInp%rhoW + MD_InitInp%WtrDepth = drvrInitInp%WtrDepth + MD_InitInp%FileName = drvrInitInp%MDInputFile + MD_InitInp%RootName = drvrInitInp%OutRootName + MD_InitInp%UsePrimaryInputFile = .TRUE. + !MD_InitInp%PassedPrimaryInputData = + MD_InitInp%Echo = drvrInitInp%Echo + !MD_InitInp%OutList = <<<< never used? + MD_InitInp%Linearize = .FALSE. + + TMax = drvrInitInp%TMax + dtC = drvrInitInp%dtC ! desired coupling time step size for communicating with MoorDyn - dtC = 0.01 ! desired coupling time step size for communicating with MoorDyn + ! do OpenFAST vs FAST.Farm related setup + + MD_InitInp%FarmSize = drvrInitInp%FarmSize + + if (drvrInitInp%FarmSize > 0) then ! Check if this MoorDyn instance is being run from FAST.Farm (indicated by FarmSize > 0) + nTurbines = drvrInitInp%FarmSize + else ! FarmSize==0 indicates normal, FAST module mode + nTurbines = 1 ! if a regular FAST module mode, we treat it like a nTurbine=1 farm case + end if + + CALL AllocAry(MD_InitInp%PtfmInit, 6, nTurbines, 'PtfmInit array' , ErrStat2, ErrMsg2); call AbortIfFailed() + CALL AllocAry(MD_InitInp%TurbineRefPos, 3, nTurbines, 'TurbineRefPos array', ErrStat2, ErrMsg2); call AbortIfFailed() - MD_interp_order = 0 + do J=1,nTurbines + MD_InitInp%TurbineRefPos(1,J) = drvrInitInp%FarmPositions(1,J) + MD_InitInp%TurbineRefPos(2,J) = drvrInitInp%FarmPositions(2,J) + MD_InitInp%TurbineRefPos(3,J) = 0.0_DbKi + MD_InitInp%PtfmInit(1,J) = drvrInitInp%FarmPositions(3,J) + MD_InitInp%PtfmInit(2,J) = drvrInitInp%FarmPositions(4,J) + MD_InitInp%PtfmInit(3,J) = drvrInitInp%FarmPositions(5,J) + MD_InitInp%PtfmInit(4,J) = drvrInitInp%FarmPositions(6,J)*3.14159265/180.0 + MD_InitInp%PtfmInit(5,J) = drvrInitInp%FarmPositions(7,J)*3.14159265/180.0 + MD_InitInp%PtfmInit(6,J) = drvrInitInp%FarmPositions(8,J)*3.14159265/180.0 + end do + + MD_interp_order = 1 - ! MAP: allocate Input and Output arrays; used for interpolation and extrapolation - Allocate(MD_InputTimes(MD_interp_order + 1)) + ! allocate Input and Output arrays; used for interpolation and extrapolation + Allocate(MD_uTimes(MD_interp_order + 1)) ! @bonnie : This is in the FAST developers glue code example, but it's probably not needed here. - Allocate(MD_Input(MD_interp_order + 1)) + Allocate(MD_u(MD_interp_order + 1)) - ! set the input file name and other environment terms. - !MD_InitInput%NStepWave = 1 ! an arbitrary number > 0 (to set the size of the wave data, which currently contains all zero values) - MD_InitInput%g = 9.81 ! This need to be according to g used in ElastoDyn - MD_InitInput%rhoW = 1025 ! This needs to be set according to seawater density in HydroDyn - MD_InitInput%PtfmInit = 0.0 - MD_InitInput%RootName = "MoorDyn.MD" + + if (drvrInitInp%InputsMod > 1) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = ' ERROR: MoorDyn Driver InputsMod must be 0 or 1.' + CALL AbortIfFailed() + end if + + ! -------------------------------- ----------------------------------- + + ! fill in the hydrodynamics data + ALLOCATE( MD_InitInp%WaveVel (2,200,3)) + ALLOCATE( MD_InitInp%WaveAcc (2,200,3)) + ALLOCATE( MD_InitInp%WavePDyn(2,200) ) + ALLOCATE( MD_InitInp%WaveElev(2,200) ) + ALLOCATE( MD_InitInp%WaveTime(2) ) + MD_InitInp%WaveVel = 0.0_ReKi + MD_InitInp%WaveAcc = 0.0_ReKi + MD_InitInp%WavePDyn = 0.0_ReKi + MD_InitInp%WaveElev = 0.0_ReKi + MD_InitInp%WaveTime = 0.0_ReKi + DO I = 1,SIZE(MD_InitInp%WaveTime) + MD_InitInp%WaveTime(I) = 600.0*I + END DO + + ! open driver output file >>> not yet used <<< CALL GetNewUnit( Un ) OPEN(Unit=Un,FILE='MD.out',STATUS='UNKNOWN') ! call the initialization routine - CALL MD_Init( MD_InitInput , & - MD_Input(1) , & - MD_Parameter , & - MD_ContinuousState , & - MD_DiscreteState , & - MD_ConstraintState , & - MD_OtherState , & - MD_Output , & - MD_MiscVar , & - dtC , & - MD_InitOutput , & - ErrStat , & - ErrMsg ) - IF ( ErrStat .NE. ErrID_None ) THEN - IF (ErrStat >=AbortErrLev) CALL ProgAbort(ErrMsg) - CALL WrScr( ErrMsg ) - END IF + CALL MD_Init( MD_InitInp, MD_u(1), MD_p, MD_x , MD_xd, MD_xc, MD_xo, MD_y, MD_m, dtC, MD_InitOut, ErrStat, ErrMsg2 ); call AbortIfFailed() - CALL MD_DestroyInitInput ( MD_InitInput , ErrStat, ErrMsg ) - CALL MD_DestroyInitOutput ( MD_InitOutput , ErrStat, ErrMsg ) + CALL MD_DestroyInitInput ( MD_InitInp , ErrStat, ErrMsg ); call AbortIfFailed() + CALL MD_DestroyInitOutput ( MD_InitOut , ErrStat, ErrMsg ); call AbortIfFailed() - CALL DispNVD( MD_InitOutput%Ver ) + CALL DispNVD( MD_InitOut%Ver ) - ncIn = 6 + size(MD_Input(1)%DeltaL) ! determine number of input channels expected from driver input file time series (DOFs including active tensioning channels) + ! determine number of input channels expected from driver input file time series (DOFs including active tensioning channels) + ncIn = size(MD_u(1)%DeltaL) - ! ------------------------------------------------------------------------- - ! Read in prescribed motions from text file if available - ! (single 6DOF platform for now, plus one active tensioning command) - ! (to be updated for versatile coupling in future) - ! ------------------------------------------------------------------------- - IF( LEN( TRIM(PlatformInitInputFile) ) < 1 ) THEN - ntIn = 0 ! flag to indicate no motion input file - print *, "No MoorDyn Driver input file provided, so using zero values." + do iTurb = 1, MD_p%nTurbines + ncIn = ncIn + MD_p%nCpldBodies(iTurb)*6 + MD_p%nCpldRods(iTurb)*6 + MD_p%nCpldCons(iTurb)*3 + end do + + print *, 'MoorDyn has '//trim(num2lstr(ncIn))//' coupled DOFs and/or active-tensioned inputs.' - ELSE - CALL GetNewUnit( UnPtfmMotIn ) - CALL OpenFInpFile ( UnPtfmMotIn, PlatformInitInputFile, ErrStat, ErrMsg ) - IF (ErrStat /= 0 ) THEN - print *, ErrStat, ErrMsg - STOP - ENDIF - print *, "Reading platform motion input data from ", PlatformInitInputFile + if (drvrInitInp%InputsMod == 1 ) then + + if ( LEN( TRIM(drvrInitInp%InputsFile) ) < 1 ) then + ErrStat = ErrID_Fatal + ErrMsg = ' ERROR: MoorDyn Driver InputFile cannot be empty if InputsMode is 2.' + CALL AbortIfFailed() + end if + + CALL GetNewUnit( UnPtfmMotIn ) + + CALL OpenFInpFile ( UnPtfmMotIn, drvrInitInp%InputsFile, ErrStat2, ErrMsg2 ); call AbortIfFailed() + + print *, 'Reading platform motion input data from ', trim(drvrInitInp%InputsFile) + print *, 'MD driver is expecting '//trim(num2lstr(ncIn))//' columns of input data, plus time, in motion input file.' ! Read through length of file to find its length i = 1 ! start counter DO - READ(UnPtfmMotIn,'(A)',IOSTAT=ErrStat) Line !read into a line - - - IF (ErrStat /= 0) EXIT - - print *, TRIM(Line) + READ(UnPtfmMotIn,'(A)',IOSTAT=ErrStat2) Line !read into a line + IF (ErrStat2 /= 0) EXIT ! break out of the loop if it couldn't read the line (i.e. if at end of file) + !print *, TRIM(Line) i = i+1 END DO ! rewind to start of input file to re-read things now that we know how long it is REWIND(UnPtfmMotIn) - - ntIn = i-1 ! save number of lines of file + + ErrStat2 = 0 ! reset the error state after it may be used to exit the loop above + + ntIn = i-3 ! save number of lines of file ! allocate space for input motion array (including time column) - ALLOCATE ( PtfmMotIn(ntIn, ncIn+1), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN + ALLOCATE ( PtfmMotIn(ntIn, ncIn+1), STAT=ErrStat2) + IF ( ErrStat2 /= ErrID_None ) THEN + ErrStat = ErrID_Fatal ErrMsg = ' Error allocating space for PtfmMotIn array.' - CALL WrScr( ErrMsg ) - END IF + call AbortIfFailed() + END IF ! read the data in from the file + READ(UnPtfmMotIn,'(A)',IOSTAT=ErrStat2) Line !read into a line + READ(UnPtfmMotIn,'(A)',IOSTAT=ErrStat2) Line !read into a line + DO i = 1, ntIn - READ (UnPtfmMotIn,*,IOSTAT=ErrStat) (PtfmMotIn (i,J), J=1,ncIn+1) + READ (UnPtfmMotIn, *, IOSTAT=ErrStat2) (PtfmMotIn (i,J), J=1,ncIn+1) - IF ( ErrStat /= 0 ) THEN - ErrMsg = ' Error reading the input time-series file. Expecting '//TRIM(Int2LStr(ncIn))//' channels plus time.' - CALL WrScr( ErrMsg ) + IF ( ErrStat2 /= 0 ) THEN + ErrStat = ErrID_Fatal + ErrMsg = ' Error reading the input time-series file. Expecting '//TRIM(Int2LStr(ncIn))//' channels plus time.' + call AbortIfFailed() END IF END DO - ! Close the inputs file + ! Close the inputs file CLOSE ( UnPtfmMotIn ) print *, "Read ", ntIn, " time steps from input file." - print *, PtfmMotIn + !print *, PtfmMotIn - END IF + ! trim simulation duration to length of input file if needed + if (PtfmMotIn(ntIn, 1) < TMax) then + TMax = PtfmMotIn(ntIn, 1) + end if + - ! ----------------------- specify stepping details ----------------------- + ! specify stepping details + nt = tMax/dtC - 1 ! number of coupling time steps - IF (ntIn > 0) THEN - tMax = PtfmMotIn(ntIn, 1) ! save last time step as total sim time - ELSE - tMax = 60 - END IF - + + ! allocate space for processed motion array + ALLOCATE ( r_in(nt, ncIn), r_in2(nt, ncIn), rd_in(nt, ncIn), rd_in2(nt, ncIn), rdd_in(nt, ncIn), rdd_in2(nt, ncIn), STAT=ErrStat2) + IF ( ErrStat2 /= ErrID_None ) THEN + ErrStat2 = ErrID_Fatal + ErrMsg = ' Error allocating space for r_in or rd_in array.' + call AbortIfFailed() + END IF - nt = tMax/dtC - 1 ! number of coupling time steps - CALL WrScr(" ") - print *, "Tmax - ", tMax, " and nt=", nt - CALL WrScr(" ") + ! go through and interpolate inputs to new regular time steps (if nt=0 this array should be left as zeros) - ! allocate space for processed motion array - ALLOCATE ( PtfmMot(nt, ncIn), STAT = ErrStat ) - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Error allocating space for PtfmMot array.' - CALL WrScr( ErrMsg ) - END IF - - - ! go through and interpolate inputs to new regular time steps (if nt=0 this array should be left as zeros) - IF (ntIn > 0) THEN - DO i = 1,nt - + DO i = 1,nt t = dtC*(i-1) - ! interpolation routine + ! interpolation routine DO iIn = 1,ntIn-1 - IF (PtfmMotIn(iIn+1, 1) > t) THEN - frac = (t - PtfmMotIn(iIn, 1) )/( PtfmMotIn(iIn+1, 1) - PtfmMotIn(iIn, 1) ) - - ! print *, "t=", t, ", iIn=", iIn, ", frac=", frac + IF (PtfmMotIn(iIn+1, 1) > t) THEN ! find the right two points to interpolate between (remember that the first column of PtfmMotIn is time) + frac = (t - PtfmMotIn(iIn, 1) )/( PtfmMotIn(iIn+1, 1) - PtfmMotIn(iIn, 1) ) ! interpolation fraction (0-1) between two interpolation points DO J=1,ncIn - PtfmMot(i, J) = PtfmMotIn(iIn, J+1) + frac*(PtfmMotIn(iIn+1, J+1) - PtfmMotIn(iIn, J+1)) + ! get interpolated position of coupling point + r_in(i, J) = PtfmMotIn(iIn, J+1) + frac*(PtfmMotIn(iIn+1, J+1) - PtfmMotIn(iIn, J+1)) + + if (iIn==1) then + ! use forward different to estimate velocity of coupling point + rd_in(i, J) = (PtfmMotIn(iIn+1, J+1) - PtfmMotIn(iIn, J+1)) / (PtfmMotIn(iIn+1, 1) - PtfmMotIn(iIn, 1)) + else + ! use central different to estimate velocity of coupling point + rd_in(i, J) = (PtfmMotIn(iIn+1, J+1) - PtfmMotIn(iIn-1, J+1)) / (PtfmMotIn(iIn+1, 1) - PtfmMotIn(iIn-1, 1)) + + end if END DO - EXIT + EXIT ! break out of the loop for this time step once we've done its interpolation END IF END DO - ! print *, t, "s", PtfmMot(i,:) + END DO + ! ----- filter position ----- + ! now filter forward + DO i = 1,nt + DO J=1,ncIn + if (i==1) then + r_in2(i, J) = r_in(i, J) + else + r_in2(i, J) = 0.1*r_in(i, J) + 0.9*r_in2(i-1, J) + end if + END DO + END DO + ! now filter backward and save back to original variable + DO i = nt,1,-1 + DO J=1,ncIn + if (i==nt) then + r_in(i, J) = r_in2(i, J) + else + r_in(i, J) = 0.1*r_in2(i, J) + 0.9*r_in(i+1, J) + end if + END DO END DO - ELSE - PtfmMot = 0.0_Reki - END IF - + ! now get derivative after filtering has been applied (derivative no longer needs to be calculated earlier) + DO i = 1,nt + DO J=1,ncIn + if (i==1) then + ! use forward different to estimate velocity of coupling point + rd_in(i, J) = (r_in(i+1, J) - r_in(i, J)) / dtC + else if (i==nt) then + ! use forward different to estimate velocity of coupling point + rd_in(i, J) = (r_in(i, J) - r_in(i-1, J)) / dtC + else + ! use central different to estimate velocity of coupling point + rd_in(i, J) = (r_in(i+1, J) - r_in(i-1, J)) / (2.0*dtC) + end if + END DO + END DO + + + + ! ----- filter velocity ----- + ! now filter forward + DO i = 1,nt + DO J=1,ncIn + if (i==1) then + rd_in2(i, J) = rd_in(i, J) + else + rd_in2(i, J) = 0.1*rd_in(i, J) + 0.9*rd_in2(i-1, J) + end if + END DO + END DO + ! now filter backward and save back to original variable + DO i = nt,1,-1 + DO J=1,ncIn + if (i==nt) then + rd_in(i, J) = rd_in2(i, J) + else + rd_in(i, J) = 0.1*rd_in2(i, J) + 0.9*rd_in(i+1, J) + end if + END DO + END DO + + + ! now get derivative after filtering has been applied (derivative no longer needs to be calculated earlier) + DO i = 1,nt + DO J=1,ncIn + if (i==1) then + ! use forward different to estimate velocity of coupling point + rdd_in(i, J) = (rd_in(i+1, J) - rd_in(i, J)) / dtC + else if (i==nt) then + ! use forward different to estimate velocity of coupling point + rdd_in(i, J) = (rd_in(i, J) - rd_in(i-1, J)) / dtC + else + ! use central different to estimate velocity of coupling point + rdd_in(i, J) = (rd_in(i+1, J) - rd_in(i-1, J)) / (2.0*dtC) + end if + END DO + END DO + + + ! ----- filter acceleration ----- + ! now filter forward + DO i = 1,nt + DO J=1,ncIn + if (i==1) then + rdd_in2(i, J) = rdd_in(i, J) + else + rdd_in2(i, J) = 0.2*rdd_in(i, J) + 0.8*rdd_in2(i-1, J) + end if + END DO + END DO + ! now filter backward and save back to original variable + DO i = nt,1,-1 + DO J=1,ncIn + if (i==nt) then + rdd_in(i, J) = rdd_in2(i, J) + else + rdd_in(i, J) = 0.2*rdd_in2(i, J) + 0.8*rdd_in(i+1, J) + end if + END DO + END DO + + + else + nt = tMax/dtC - 1 ! number of coupling time steps + end if + CALL WrScr(" ") + print *, "Tmax - ", tMax, " and nt=", nt + CALL WrScr(" ") ! --------------------------------------------------------------- ! Set the initial input values ! --------------------------------------------------------------- - - ! start with zeros >>> or should this be the initial row of DOFs? <<< - MD_Input(1)%PtFairleadDisplacement%TranslationDisp = 0.0_ReKi - MD_Input(1)%DeltaL = 0.0_ReKi - MD_Input(1)%DeltaLdot = 0.0_ReKi + ! zero the tension commands + MD_u(1)%DeltaL = 0.0_ReKi + MD_u(1)%DeltaLdot = 0.0_ReKi + +! ! zero water inputs (if passing wave info in from glue code) +! MD_u(1)%U = 0.0 +! MD_u(1)%Ud = 0.0 +! MD_u(1)%zeta = 0.0 +! MD_u(1)%PDyn = 0.0 +! ! now add some current in x for testing +! MD_u(1)%U(1,:) = 1.0 + + ! copy inputs to initialize input arrays for higher interp orders if applicable DO i = 2, MD_interp_order + 1 - CALL MD_CopyInput( MD_Input(1), MD_Input(i), MESH_NEWCOPY, ErrStat, ErrMsg ) - END DO - + CALL MD_CopyInput( MD_u(1), MD_u(i), MESH_NEWCOPY, ErrStat2, ErrMsg2 ); call AbortIfFailed() + END DO DO i = 1, MD_interp_order + 1 - MD_InputTimes(i) = -(i - 1) * dtC - ENDDO - + MD_uTimes(i) = -(i - 1) * dtC + END DO + ! get output at initialization (before time stepping) t = 0 + CALL MD_CalcOutput( t, MD_u(1), MD_p, MD_x, MD_xd, MD_xc , MD_xo, MD_y, MD_m, ErrStat2, ErrMsg2 ); call AbortIfFailed() - CALL MD_CalcOutput( t , & - MD_Input(1) , & - MD_Parameter , & - MD_ContinuousState , & - MD_DiscreteState , & - MD_ConstraintState , & - MD_OtherState , & - MD_Output , & - MD_MiscVar , & - ErrStat , & - ErrMsg ) - IF ( ErrStat .NE. ErrID_None ) THEN - IF (ErrStat >=AbortErrLev) CALL ProgAbort(ErrMsg) - CALL WrScr( ErrMsg ) - END IF ! ------------------------------------------------------------------------- - ! BEGIN time marching >>> note that 3 rotational platform DOFs are currently neglected <<< + ! BEGIN time marching ! ------------------------------------------------------------------------- - + print *,"Doing time marching now..." + + CALL SimStatus_FirstTime( PrevSimTime, PrevClockTime, SimStrtTime, SimStrtCPU, t, tMax ) DO i = 1,nt @@ -305,77 +517,98 @@ PROGRAM MoorDyn_Driver t = dtC*(i-1) - MD_InputTimes(1) = t + dtC - !MD_InputTimes(2) = MD_InputTimes(1) - dtC - !MD_InputTimes(3) = MD_InputTimes(2) - dtC - ! apply platform translations (neglecting rotations for now) - MD_Input(1)%PtFairleadDisplacement%TranslationDisp(1,1) = PtfmMot(i, 1) - MD_Input(1)%PtFairleadDisplacement%TranslationDisp(1,2) = PtfmMot(i, 2) - MD_Input(1)%PtFairleadDisplacement%TranslationDisp(1,3) = PtfmMot(i, 3) + if ( MOD( i, 20 ) == 0 ) THEN + CALL SimStatus( PrevSimTime, PrevClockTime, t, tMax ) + end if + + ! shift older inputs back in the buffer + CALL MD_CopyInput( MD_u(1), MD_u(2), MESH_NEWCOPY, ErrStat2, ErrMsg2 ); call AbortIfFailed() ! copy from 1 to 2 before 1 is updated with latest. + MD_uTimes(1) = t + dtC + MD_uTimes(2) = MD_uTimes(1) - dtC + !MD_uTimes(3) = MD_uTimes(2) - dtC + + ! update coupled object kinematics iff we're reading input time series + if (drvrInitInp%InputsMod == 1 ) then + + DO iTurb = 1, MD_p%nTurbines + + K = 1 ! the index of the coupling points in the input mesh CoupledKinematics + J = 1 ! the starting index of the relevant DOFs in the input array + ! any coupled bodies (type -1) + DO l = 1,MD_p%nCpldBodies(iTurb) + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + MD_u(1)%CoupledKinematics(iTurb)%Orientation( :,:,K) = EulerConstruct( r_in(i, J+3:J+5) ) ! full Euler angle approach + MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) + MD_u(1)%CoupledKinematics(iTurb)%RotationVel( :,K) = rd_in(i, J+3:J+5) + MD_u(1)%CoupledKinematics(iTurb)%TranslationAcc( :,K) = rdd_in(i, J:J+2) + MD_u(1)%CoupledKinematics(iTurb)%RotationAcc( :,K) = rdd_in(i, J+3:J+5) + + K = K + 1 + J = J + 6 + END DO + + ! any coupled rods (type -1 or -2) >>> need to make rotations ignored if it's a pinned rod <<< + DO l = 1,MD_p%nCpldRods(iTurb) + + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + MD_u(1)%CoupledKinematics(iTurb)%Orientation( :,:,K) = EulerConstruct( r_in(i, J+3:J+5) ) + MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) + MD_u(1)%CoupledKinematics(iTurb)%RotationVel( :,K) = rd_in(i, J+3:J+5) + MD_u(1)%CoupledKinematics(iTurb)%TranslationAcc( :,K) = rdd_in(i, J:J+2) + MD_u(1)%CoupledKinematics(iTurb)%RotationAcc( :,K) = rdd_in(i, J+3:J+5) + + K = K + 1 + J = J + 6 + END DO + + ! any coupled points (type -1) + DO l = 1, MD_p%nCpldCons(iTurb) + + MD_u(1)%CoupledKinematics(iTurb)%TranslationDisp(:,K) = r_in(i, J:J+2) - MD_u(1)%CoupledKinematics(iTurb)%Position(:,K) - MD_p%TurbineRefPos(:,iTurb) + MD_u(1)%CoupledKinematics(iTurb)%TranslationVel( :,K) = rd_in(i, J:J+2) + MD_u(1)%CoupledKinematics(iTurb)%TranslationAcc( :,K) = 0.0_DbKi !rdd_in(i, J:J+2) + + !print *, u%PtFairleadDisplacement%Position(:,l) + u%PtFairleadDisplacement%TranslationDisp(:,l) + !print *, u%PtFairleadDisplacement%TranslationVel(:,l) + + K = K + 1 + J = J + 3 + END DO + + end do ! iTurb + + ! also provide any active tensioning commands + do l = 1, size(MD_u(1)%DeltaL) + + MD_u(1)%DeltaL( l) = 0.0_DbKi ! r_in(i, J) + MD_u(1)%DeltaLdot(l) = 0.0_DbKi !rd_in(i, J) - !MD_Input(2)%PtFairleadDisplacement%TranslationDisp(1,1) = .001*n_t_global - !MD_Input(3)%PtFairleadDisplacement%TranslationDisp(1,1) = .001*n_t_global + J = J + 1 + end do - ! what about velocities?? + end if ! InputsMod == 1 - ! also provide any active tensioning commands (just using delta L, and finite differencing to get derivative) - DO j = 1,ncIn-6 + ! >>> otherwise, mesh kinematics should all still be zero ... maybe worth checking <<< - MD_Input(1)%DeltaL(j) = PtfmMot(i, 6+j) - - IF (i>1) then - MD_Input(1)%DeltaLdot(j) = (PtfmMot(i, 6+j) - PtfmMot(i-1, 6+j))/dtC - ELSE - MD_Input(1)%DeltaLdot(j) = 0.0_ReKi - END IF - - END DO ! --------------------------------- update states --------------------------------- - CALL MD_UpdateStates( t , & - nt , & - MD_Input , & - MD_InputTimes , & - MD_Parameter , & - MD_ContinuousState , & - MD_DiscreteState , & - MD_ConstraintState , & - MD_OtherState , & - MD_MiscVar , & - ErrStat , & - ErrMsg ) - IF ( ErrStat .NE. ErrID_None ) THEN - IF (ErrStat >=AbortErrLev) CALL ProgAbort(ErrMsg) - CALL WrScr( ErrMsg ) - EXIT - END IF + CALL MD_UpdateStates( t, nt, MD_u, MD_uTimes, MD_p, MD_x, MD_xd, MD_xc, MD_xo, MD_m, ErrStat2, ErrMsg2 ); call AbortIfFailed() + ! update the global time step by one delta t <<<< ??? why? t = t + dtC ! --------------------------------- calculate outputs --------------------------------- - CALL MD_CalcOutput( t , & - MD_Input(1) , & - MD_Parameter , & - MD_ContinuousState , & - MD_DiscreteState , & - MD_ConstraintState , & - MD_OtherState , & - MD_Output , & - MD_MiscVar , & - ErrStat , & - ErrMsg ) - IF ( ErrStat .NE. ErrID_None ) THEN - IF (ErrStat >=AbortErrLev) CALL ProgAbort(ErrMsg) - CALL WrScr( ErrMsg ) - END IF - - - WRITE(Un,100) t, MD_Input(1)%PtFairleadDisplacement%TranslationDisp(1,1), & - ((MD_Output%PtFairleadLoad%Force(k,j), k=1,3),j=1,3) + CALL MD_CalcOutput( t, MD_u(1), MD_p, MD_x, MD_xd, MD_xc, MD_xo, MD_y, MD_m, ErrStat2, ErrMsg2 ); call AbortIfFailed() + + + ! >>> should make output vector to hold and print outputs <<< + !WRITE(Un, *) t, MD_u(1)%CoupledKinematics(1)%TranslationDisp(1,1), ((MD_y%CoupledLoads(1)%Force(k,j), k=1,3),j=1,3) !WRITE(*,*) t_global + ! FORMAT(2(1X,F8.3),9(1X,E12.5)) + END DO @@ -383,35 +616,142 @@ PROGRAM MoorDyn_Driver ! END time marching ! ------------------------------------------------------------------------- + CALL RunTimes( ProgStrtTime, ProgStrtCPU, SimStrtTime, SimStrtCPU, t ) + ! Destroy all objects - CALL MD_End( MD_Input(1) , & - MD_Parameter , & - MD_ContinuousState , & - MD_DiscreteState , & - MD_ConstraintState , & - MD_OtherState , & - MD_Output , & - MD_MiscVar , & - ErrStat , & - ErrMsg ) - IF ( ErrStat .NE. ErrID_None ) THEN - IF (ErrStat >=AbortErrLev) CALL ProgAbort(ErrMsg) - CALL WrScr( ErrMsg ) - END IF + CALL MD_End( MD_u(1), MD_p, MD_x, MD_xd, MD_xc , MD_xo, MD_y, MD_m, ErrStat2, ErrMsg2 ); call AbortIfFailed() do j = 2,MD_interp_order+1 - call MD_DestroyInput( MD_Input(j), ErrStat, ErrMsg) + call MD_DestroyInput( MD_u(j), ErrStat, ErrMsg) end do - DEALLOCATE(MD_Input) - DEALLOCATE(MD_InputTimes) + DEALLOCATE(MD_u) + DEALLOCATE(MD_uTimes) - IF (ALLOCATED(PtfmMot) ) DEALLOCATE(PtfmMot ) + IF (ALLOCATED(r_in) ) DEALLOCATE(r_in ) IF (ALLOCATED(PtfmMotIn)) DEALLOCATE(PtfmMotIn) CALL WrScr( "Program has ended" ) close (un) -100 FORMAT(2(1X,F8.3),9(1X,E12.5)) - - END PROGRAM \ No newline at end of file + +CONTAINS + + SUBROUTINE AbortIfFailed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'MoorDyn_Driver') + IF ( ErrStat /= ErrID_None ) THEN + CALL WrScr( ErrMsg2 ) + CALL WrScr( 'hi1') + CALL WrScr( ErrMsg ) + CALL WrScr( 'hi1') + END IF + if (ErrStat >= AbortErrLev) then + call CleanUp() + STOP + endif + END SUBROUTINE AbortIfFailed + + LOGICAL FUNCTION Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'OutSummary') + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + END FUNCTION Failed + + SUBROUTINE CleanUp() + if(UnEcho>0) CLOSE(UnEcho) + if(UnEcho>0) CLOSE( UnIn) + if(allocated(MD_u)) deallocate(MD_u) + END SUBROUTINE CleanUp + + !------------------------------------------------------------------------------------------------------------------------------- + SUBROUTINE ReadDriverInputFile( inputFile, InitInp) + CHARACTER(*), INTENT( IN ) :: inputFile + TYPE(MD_Drvr_InitInput), INTENT( OUT ) :: InitInp + ! Local variables + INTEGER :: I ! generic integer for counting + INTEGER :: J ! generic integer for counting + CHARACTER( 2) :: strI ! string version of the loop counter + + CHARACTER(1024) :: EchoFile ! Name of MoorDyn echo file + CHARACTER(1024) :: Line ! String to temporarially hold value of read line + CHARACTER(1024) :: TmpPath ! Temporary storage for relative path name + CHARACTER(1024) :: TmpFmt ! Temporary storage for format statement + CHARACTER(1024) :: FileName ! Name of MoorDyn input file + CHARACTER(1024) :: FilePath ! Path Name of MoorDyn input file + + UnEcho=-1 + UnIn =-1 + + FileName = TRIM(inputFile) + + CALL GetNewUnit( UnIn ) + CALL OpenFInpFile( UnIn, FileName, ErrStat2, ErrMsg2); + call AbortIfFailed() + + CALL WrScr( 'Opening MoorDyn Driver input file: '//FileName ) + + ! Read until "echo" + CALL ReadCom( UnIn, FileName, 'MoorDyn Driver input file header line 1', ErrStat2, ErrMsg2); call AbortIfFailed() + CALL ReadCom( UnIn, FileName, 'MoorDyn Driver input file header line 2', ErrStat2, ErrMsg2); call AbortIfFailed() + CALL ReadVar ( UnIn, FileName, InitInp%Echo, 'Echo', 'Echo Input', ErrStat2, ErrMsg2); call AbortIfFailed() + ! If we echo, we rewind + IF ( InitInp%Echo ) THEN + EchoFile = TRIM(FileName)//'.echo' + CALL GetNewUnit( UnEcho ) + CALL OpenEcho ( UnEcho, EchoFile, ErrStat, ErrMsg ); call AbortIfFailed() + REWIND(UnIn) + CALL ReadCom( UnIn, FileName, 'MoorDyn Driver input file header line 1', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadCom( UnIn, FileName, 'MoorDyn Driver input file header line 2', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar ( UnIn, FileName, InitInp%Echo, 'Echo', 'Echo the input file data', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + END IF + !---------------------- ENVIRONMENTAL CONDITIONS ------------------------------------------------- + CALL ReadCom( UnIn, FileName, 'Environmental conditions header', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%Gravity, 'Gravity', 'Gravity', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%rhoW , 'rhoW', 'water density', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%WtrDepth, 'WtrDepth', 'water depth', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + !---------------------- MoorDyn ------------------------------------------------------------------- + CALL ReadCom( UnIn, FileName, 'MoorDyn header', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%MDInputFile, 'MDInputFile', 'MoorDyn input filename', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%OutRootName, 'OutRootName', 'MoorDyn output root filename', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%TMax , 'Tmax', 'Simulation time duration', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%dtC , 'dtC', 'Time step size for calling MoorDyn', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%InputsMod , 'InputsMode', 'Mode for the inputs - zero/steady/time-series', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%InputsFile , 'InputsFile', 'Filename for the MoorDyn inputs', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadVar( UnIn, FileName, InitInp%FarmSize , 'NumTurbines', 'number of turbines in FAST.Farm', ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + CALL ReadCom( UnIn, FileName, 'Initial positions header', ErrStat2, ErrMsg2); call AbortIfFailed() + CALL ReadCom( UnIn, FileName, 'Initial positions table header line 1', ErrStat2, ErrMsg2); call AbortIfFailed() + CALL ReadCom( UnIn, FileName, 'Initial positions table header line 2', ErrStat2, ErrMsg2); call AbortIfFailed() + do J=1,MAX(1,InitInp%FarmSize) + CALL ReadAry( UnIn, FileName, InitInp%FarmPositions(:,J), 8, "FarmPositions", "FAST.Farm position inputs", ErrStat2, ErrMsg2, UnEcho); call AbortIfFailed() + end do + + ! done reading + if(UnEcho>0) CLOSE( UnEcho ) + if(UnIn>0) CLOSE( UnIn ) + + ! Perform input checks and triggers + !CALL GetPath( FileName, FilePath ) + !IF ( PathIsRelative( InitInp%MDInputFile ) ) then + ! InitInp%MDInputFile = TRIM(FilePath)//TRIM(InitInp%MDInputFile) + !END IF + !IF ( PathIsRelative( InitInp%OutRootName ) ) then + ! InitInp%OutRootName = TRIM(FilePath)//TRIM(InitInp%OutRootName) + !endif + !IF ( PathIsRelative( InitInp%InputsFile ) ) then + ! InitInp%InputsFile = TRIM(FilePath)//TRIM(InitInp%InputsFile) + !endif + + END SUBROUTINE ReadDriverInputFile + + subroutine print_help() + print '(a)', 'usage: ' + print '(a)', '' + print '(a)', 'MoorDynDriver.exe driverfilename' + print '(a)', '' + print '(a)', 'Where driverfilename is the name of the MoorDyn driver input file.' + print '(a)', '' + end subroutine print_help +!---------------------------------------------------------------------------------------------------------------------------------- + + +END PROGRAM diff --git a/modules/moordyn/src/MoorDyn_IO.f90 b/modules/moordyn/src/MoorDyn_IO.f90 index 2eb3c9a67b..577e6117f2 100644 --- a/modules/moordyn/src/MoorDyn_IO.f90 +++ b/modules/moordyn/src/MoorDyn_IO.f90 @@ -1,6 +1,7 @@ !********************************************************************************************************************************** ! LICENSING -! Copyright (C) 2015 Matthew Hall +! Copyright (C) 2020-2021 Alliance for Sustainable Energy, LLC +! Copyright (C) 2015-2019 Matthew Hall ! ! This file is part of MoorDyn. ! @@ -28,6 +29,11 @@ MODULE MoorDyn_IO PRIVATE + INTEGER(IntKi), PARAMETER :: wordy = 0 ! verbosity level. >1 = more console output + + INTEGER, PARAMETER :: nCoef = 30 ! maximum number of entries to allow in nonlinear coefficient lookup tables + ! it would be nice if the above worked for everything, but I think it needs to also be matched in the Registry + ! --------------------------- Output definitions ----------------------------------------- ! The following are some definitions for use with the output options in MoorDyn. @@ -41,8 +47,7 @@ MODULE MoorDyn_IO ! QType - (int) the type of quantity to output. 0=tension, 1=x pos, etc. see the parameters below ! NodeID - (int) the ID number of the node of the output quantity - ! These are the "OTypes": 0=Connect object, 1=Line Object - ! (will just use 0 and 1 rather than parameter names) + ! These are the "OTypes": 1=Line, 2=Connect, 3=Rod, 4=Body ! Indices for computing output channels: - customized for the MD_OutParmType approach ! these are the "QTypes" @@ -56,17 +61,26 @@ MODULE MoorDyn_IO INTEGER, PARAMETER :: AccX = 7 INTEGER, PARAMETER :: AccY = 8 INTEGER, PARAMETER :: AccZ = 9 - INTEGER, PARAMETER :: Ten = 10 - INTEGER, PARAMETER :: FX = 11 - INTEGER, PARAMETER :: FY = 12 - INTEGER, PARAMETER :: FZ = 13 + INTEGER, PARAMETER :: Ten = 10 + INTEGER, PARAMETER :: FX = 11 + INTEGER, PARAMETER :: FY = 12 + INTEGER, PARAMETER :: FZ = 13 + INTEGER, PARAMETER :: MX = 14 + INTEGER, PARAMETER :: MY = 15 + INTEGER, PARAMETER :: MZ = 16 + INTEGER, PARAMETER :: Pitch = 17 + INTEGER, PARAMETER :: Roll = 18 + INTEGER, PARAMETER :: Yaw = 19 + INTEGER, PARAMETER :: Sub = 20 ! List of units corresponding to the quantities parameters for QTypes - CHARACTER(ChanLen), PARAMETER :: UnitList(0:13) = (/ & + CHARACTER(ChanLen), PARAMETER :: UnitList(0:20) = (/ & "(s) ","(m) ","(m) ","(m) ", & "(m/s) ","(m/s) ","(m/s) ", & "(m/s2) ","(m/s2) ","(m/s2) ", & - "(N) ","(N) ","(N) ","(N) " /) + "(N) ","(N) ","(N) ","(N) ", & + "(Nm) ","(Nm) ","(Nm) ", & + "(deg) ","(deg) ","(deg) ","(frac) "/) CHARACTER(28), PARAMETER :: OutPFmt = "( I4, 3X,A 10,1 X, A10 )" ! Output format parameter output list. CHARACTER(28), PARAMETER :: OutSFmt = "ES10.3E2" @@ -84,7 +98,11 @@ MODULE MoorDyn_IO - PUBLIC :: MDIO_ReadInput + ! PUBLIC :: MDIO_ReadInput + PUBLIC :: setupBathymetry + PUBLIC :: getCoefficientOrCurve + PUBLIC :: SplitByBars + PUBLIC :: DecomposeString PUBLIC :: MDIO_OpenOutput PUBLIC :: MDIO_CloseOutput PUBLIC :: MDIO_ProcessOutList @@ -94,525 +112,280 @@ MODULE MoorDyn_IO CONTAINS + SUBROUTINE setupBathymetry(inputString, defaultDepth, BathGrid, BathGrid_Xs, BathGrid_Ys, ErrStat3, ErrMsg3) + ! SUBROUTINE getBathymetry(inputString, BathGrid, BathGrid_Xs, BathGrid_Ys, BathGrid_npoints, ErrStat3, ErrMsg3) + CHARACTER(40), INTENT(IN ) :: inputString ! string describing water depth or bathymetry filename + REAL(ReKi), INTENT(IN ) :: defaultDepth ! depth to use if inputString is empty + REAL(DbKi), ALLOCATABLE, INTENT(INOUT) :: BathGrid (:,:) + REAL(DbKi), ALLOCATABLE, INTENT(INOUT) :: BathGrid_Xs (:) + REAL(DbKi), ALLOCATABLE, INTENT(INOUT) :: BathGrid_Ys (:) + INTEGER(IntKi), INTENT( OUT) :: ErrStat3 ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg3 ! Error message if ErrStat /= ErrID_None - !==================================================================================================== - SUBROUTINE MDIO_ReadInput( InitInp, p, m, ErrStat, ErrMsg ) - - ! This subroutine reads the input required for MoorDyn from the file whose name is an - ! input parameter. It sets the size of p%NTypes, NConnects, and NLines, - ! allocates LineTypeList, ConnectList, and LineList, and puts all the read contents of - ! the input file into the respective slots in those lists of types. - - - ! Passed variables - - TYPE(MD_InitInputType), INTENT( INOUT ) :: InitInp ! the MoorDyn data - TYPE(MD_ParameterType), INTENT(INOUT) :: p ! Parameters - TYPE(MD_MiscVarType), INTENT( OUT) :: m ! INTENT( OUT) : Initial misc/optimization vars - INTEGER, 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 :: I ! generic integer for counting - INTEGER :: J ! generic integer for counting - INTEGER :: UnIn ! Unit number for the input file - INTEGER :: UnEc ! The local unit number for this module's echo file - CHARACTER(1024) :: EchoFile ! Name of MoorDyn echo file - CHARACTER(1024) :: Line ! String to temporarially hold value of read line - CHARACTER(20) :: LineOutString ! String to temporarially hold characters specifying line output options - CHARACTER(20) :: OptString ! String to temporarially hold name of option variable - CHARACTER(20) :: OptValue ! String to temporarially hold value of options variable input - CHARACTER(1024) :: FileName ! - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MDIO_ReadInput' - - - ! - UnEc = -1 - - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - - !------------------------------------------------------------------------------------------------- - ! Open the file - !------------------------------------------------------------------------------------------------- - FileName = TRIM(InitInp%FileName) - - CALL GetNewUnit( UnIn ) - CALL OpenFInpFile( UnIn, FileName, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - CALL WrScr( ' MD_Init: Opening MoorDyn input file: '//FileName ) - - - !------------------------------------------------------------------------------------------------- - ! File header - !------------------------------------------------------------------------------------------------- - - CALL ReadCom( UnIn, FileName, 'MoorDyn input file header line 1', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - CALL ReadCom( UnIn, FileName, 'MoorDyn input file header line 2', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! Echo Input Files. - CALL ReadVar ( UnIn, FileName, InitInp%Echo, 'Echo', 'Echo Input', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! 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 ( InitInp%Echo ) THEN - - !print *, 'gonna try to open echo file' - - EchoFile = TRIM(p%RootName)//'.ech' ! open an echo file for writing - - !print *, 'name is ', EchoFile - - CALL GetNewUnit( UnEc ) - CALL OpenEcho ( UnEc, EchoFile, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - REWIND(UnIn) ! rewind to start of input file to re-read the first few lines - - - - - CALL ReadCom( UnIn, FileName, 'MoorDyn input file header line 1', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - CALL ReadCom( UnIn, FileName, 'MoorDyn input file header line 2', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! Echo Input Files. Note this line is prevented from being echoed by the ReadVar routine. - CALL ReadVar ( UnIn, FileName, InitInp%Echo, 'Echo', 'Echo the input file data', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - !print *, 'at end of echo if statement' - - END IF - - - !------------------------------------------------------------------------------------------------- - ! Line Types Properties Section - !------------------------------------------------------------------------------------------------- - - CALL ReadCom( UnIn, FileName, 'Line types header', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - CALL ReadVar ( UnIn, FileName, p%NTypes, 'NTypes', 'Number of line types', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! Table header - DO I = 1, 2 - CALL ReadCom( UnIn, FileName, 'Line types table header', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - END DO - - ! make sure NTypes isn't zero - IF ( p%NTypes < 1 ) THEN - CALL SetErrStat( ErrID_Fatal, 'NTypes parameter must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - CALL CleanUp() - RETURN - END IF - - ! Allocate memory for LineTypeList array to hold line type properties - ALLOCATE ( m%LineTypeList(p%NTypes), STAT = ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating space for LineTypeList array.', ErrStat, ErrMsg, RoutineName ) - CALL CleanUp() - RETURN - END IF - - ! read each line - DO I = 1,p%NTypes - ! read the table entries Name Diam MassDenInAir EA cIntDamp Can Cat Cdn Cdt in the MoorDyn input file - READ(UnIn,'(A)',IOSTAT=ErrStat2) Line !read into a line - - IF (ErrStat2 == 0) THEN - READ(Line,*,IOSTAT=ErrStat2) m%LineTypeList(I)%name, m%LineTypeList(I)%d, & - m%LineTypeList(I)%w, m%LineTypeList(I)%EA, m%LineTypeList(I)%BA, & - m%LineTypeList(I)%Can, m%LineTypeList(I)%Cat, m%LineTypeList(I)%Cdn, m%LineTypeList(I)%Cdt - END IF - - m%LineTypeList(I)%IdNum = I ! specify IdNum of line type for error checking - - - IF ( ErrStat2 /= ErrID_None ) THEN - CALL SetErrStat( ErrID_Fatal, 'Failed to read line type properties for line '//trim(Num2LStr(I)), ErrStat, ErrMsg, RoutineName ) - CALL CleanUp() - RETURN - END IF - - IF ( InitInp%Echo ) THEN - WRITE( UnEc, '(A)' ) TRIM(Line) - END IF - - END DO - - - - !------------------------------------------------------------------------------------------------- - ! Connections Section - !------------------------------------------------------------------------------------------------- - - CALL ReadCom( UnIn, FileName, 'Connections header', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - CALL ReadVar ( UnIn, FileName, p%NConnects, 'NConnects', 'Number of Connects', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - - ! Table header - DO I = 1, 2 - CALL ReadCom( UnIn, FileName, 'Connects header', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - END DO - - ! make sure NConnects is at least two - IF ( p%NConnects < 2 ) THEN - ErrMsg = ' NConnects parameter must be at least 2.' - CALL CleanUp() - RETURN - END IF - - ! allocate ConnectList - ALLOCATE ( m%ConnectList(p%NConnects), STAT = ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating space for ConnectList array.', ErrStat, ErrMsg, RoutineName ) - CALL CleanUp() - RETURN - END IF - - - ! read each line - DO I = 1,p%NConnects - ! read the table entries Node Type X Y Z M V FX FY FZ Cda Ca - READ(UnIn,'(A)',IOSTAT=ErrStat2) Line !read into a line - - IF (ErrStat2 == 0) THEN - READ(Line,*,IOSTAT=ErrStat2) m%ConnectList(I)%IdNum, m%ConnectList(I)%type, m%ConnectList(I)%conX, & - m%ConnectList(I)%conY, m%ConnectList(I)%conZ, m%ConnectList(I)%conM, & - m%ConnectList(I)%conV, m%ConnectList(I)%conFX, m%ConnectList(I)%conFY, & - m%ConnectList(I)%conFZ, m%ConnectList(I)%conCdA, m%ConnectList(I)%conCa - END IF - - IF ( ErrStat2 /= 0 ) THEN - CALL WrScr(' Unable to parse Connection '//trim(Num2LStr(I))//' row in input file.') ! Specific screen output because errors likely - CALL WrScr(' Ensure row has all 12 columns, including CdA and Ca.') ! to be caused by non-updated input file formats. - CALL SetErrStat( ErrID_Fatal, 'Failed to read connects.' , ErrStat, ErrMsg, RoutineName ) ! would be nice to specify which line <<<<<<<<< - CALL CleanUp() - RETURN - END IF - - ! check for sequential IdNums - IF ( m%ConnectList(I)%IdNum .NE. I ) THEN - CALL SetErrStat( ErrID_Fatal, 'Node numbers must be sequential starting from 1.', ErrStat, ErrMsg, RoutineName ) - CALL CleanUp() - RETURN - END IF - - - - - IF ( InitInp%Echo ) THEN - WRITE( UnEc, '(A)' ) TRIM(Line) - END IF - - END DO - - - !------------------------------------------------------------------------------------------------- - ! Lines Section - !------------------------------------------------------------------------------------------------- + INTEGER(IntKi) :: I + INTEGER(IntKi) :: UnCoef ! unit number for coefficient input file + + INTEGER(IntKi) :: ErrStat4 + CHARACTER(120) :: ErrMsg4 + CHARACTER(120) :: Line2 - CALL ReadCom( UnIn, FileName, 'Lines header', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + CHARACTER(20) :: nGridX_string ! string to temporarily hold the nGridX string from Line2 + CHARACTER(20) :: nGridY_string ! string to temporarily hold the nGridY string from Line3 + INTEGER(IntKi) :: nGridX ! integer of the size of BathGrid_Xs + INTEGER(IntKi) :: nGridY ! integer of the size of BathGrid_Ys - CALL ReadVar ( UnIn, FileName, p%NLines, 'NLines', 'Number of Lines', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + IF (LEN_TRIM(inputString) == 0) THEN + ! If the input is empty (not provided), make the 1x1 bathymetry grid using the default depth + ALLOCATE(BathGrid(1,1), STAT=ErrStat4) + BathGrid(1,1) = DBLE(defaultDepth) + + ALLOCATE(BathGrid_Xs(1), STAT=ErrStat4) + BathGrid_Xs(1) = 0.0_DbKi + + ALLOCATE(BathGrid_Ys(1), STAT=ErrStat4) + BathGrid_Ys(1) = 0.0_DbKi + + ELSE IF (SCAN(inputString, "abcdfghijklmnopqrstuvwxyzABCDFGHIJKLMNOPQRSTUVWXYZ") == 0) THEN + ! If the input does not have any of these string values, let's treat it as a number but store in a matrix + ALLOCATE(BathGrid(1,1), STAT=ErrStat4) + READ(inputString, *, IOSTAT=ErrStat4) BathGrid(1,1) + + ALLOCATE(BathGrid_Xs(1), STAT=ErrStat4) + BathGrid_Xs(1) = 0.0_DbKi + + ALLOCATE(BathGrid_Ys(1), STAT=ErrStat4) + BathGrid_Ys(1) = 0.0_DbKi + ELSE ! otherwise interpret the input as a file name to load the bathymetry lookup data from + CALL WrScr(" The depth input contains letters so will load a bathymetry file.") + + ! load lookup table data from file + CALL GetNewUnit( UnCoef ) ! unit number for coefficient input file + CALL OpenFInpFile( UnCoef, TRIM(inputString), ErrStat4, ErrMsg4 ) + cALL SetErrStat(ErrStat4, ErrMsg4, ErrStat3, ErrMsg3, 'MDIO_getBathymetry') + + READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 ! skip the first title line + READ(UnCoef,*,IOSTAT=ErrStat4) nGridX_string, nGridX ! read in the second line as the number of x values in the BathGrid + READ(UnCoef,*,IOSTAT=ErrStat4) nGridY_string, nGridY ! read in the third line as the number of y values in the BathGrid + + ! Allocate the bathymetry matrix and associated grid x and y values + ALLOCATE(BathGrid(nGridX, nGridY), STAT=ErrStat4) + ALLOCATE(BathGrid_Xs(nGridX), STAT=ErrStat4) + ALLOCATE(BathGrid_Ys(nGridY), STAT=ErrStat4) + + DO I = 1, nGridY+1 ! loop through each line in the rest of the bathymetry file + + READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 ! read into a line and call it Line2 + IF (ErrStat4 > 0) EXIT + + IF (I==1) THEN ! if it's the first line in the Bathymetry Grid, then it's a list of all the x values + READ(Line2, *,IOSTAT=ErrStat4) BathGrid_Xs + ELSE ! if it's not the first line, then the first value is a y value and the rest are the depth values + READ(Line2, *,IOSTAT=ErrStat4) BathGrid_Ys(I-1), BathGrid(I-1,:) + ENDIF + + END DO - ! Table header - DO I = 1, 2 - CALL ReadCom( UnIn, FileName, 'Lines header', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - END DO - - ! make sure NLines is at least one - IF ( p%NLines < 1 ) THEN - CALL SetErrStat( ErrID_Fatal, 'NLines parameter must be at least 1.', ErrStat, ErrMsg, RoutineName ) - CALL CleanUp() - RETURN - END IF - - ! allocate LineList - ALLOCATE ( m%LineList(p%NLines), STAT = ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error allocating space for LineList array.', ErrStat, ErrMsg, RoutineName ) - CALL CleanUp() - RETURN - END IF - - ! read each line - DO I = 1,p%NLines - ! read the table entries Line LineType UnstrLen NumSegs NodeAnch NodeFair Flags/Outputs - READ(UnIn,'(A)',IOSTAT=ErrStat2) Line !read into a line - - - IF (ErrStat2 == 0) THEN - READ(Line,*,IOSTAT=ErrStat2) m%LineList(I)%IdNum, m%LineList(I)%type, m%LineList(I)%UnstrLen, & - m%LineList(I)%N, m%LineList(I)%AnchConnect, m%LineList(I)%FairConnect, LineOutString, m%LineList(I)%CtrlChan - END IF - - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Failed to read line data for Line '//trim(Num2LStr(I)), ErrStat, ErrMsg, RoutineName ) - CALL CleanUp() - RETURN - END IF - - - ! check for sequential IdNums - IF ( m%LineList(I)%IdNum .NE. I ) THEN - CALL SetErrStat( ErrID_Fatal, 'Line numbers must be sequential starting from 1.', ErrStat, ErrMsg, RoutineName ) - CALL CleanUp() - RETURN - END IF - - ! identify index of line type - DO J = 1,p%NTypes - IF (trim(m%LineList(I)%type) == trim(m%LineTypeList(J)%name)) THEN - m%LineList(I)%PropsIdNum = J - EXIT - IF (J == p%NTypes) THEN ! call an error if there is no match - CALL SetErrStat( ErrID_Severe, 'Unable to find matching line type name for Line '//trim(Num2LStr(I)), ErrStat, ErrMsg, RoutineName ) - END IF + IF (I < 2) THEN + ErrStat3 = ErrID_Fatal + ErrMsg3 = "Less than the minimum of 2 data lines found in file "//TRIM(inputString) + CLOSE (UnCoef) + RETURN + ELSE + ! BathGrid_npoints = nGridX*nGridY ! save the number of points in the grid + CLOSE (UnCoef) END IF - END DO - - ! process output flag characters (LineOutString) and set line output flag array (OutFlagList) - m%LineList(I)%OutFlagList = 0 ! first set array all to zero - IF ( scan( LineOutString, 'p') > 0 ) m%LineList(I)%OutFlagList(2) = 1 - IF ( scan( LineOutString, 'v') > 0 ) m%LineList(I)%OutFlagList(3) = 1 - IF ( scan( LineOutString, 'U') > 0 ) m%LineList(I)%OutFlagList(4) = 1 - IF ( scan( LineOutString, 'D') > 0 ) m%LineList(I)%OutFlagList(5) = 1 - IF ( scan( LineOutString, 't') > 0 ) m%LineList(I)%OutFlagList(6) = 1 - IF ( scan( LineOutString, 'c') > 0 ) m%LineList(I)%OutFlagList(7) = 1 - IF ( scan( LineOutString, 's') > 0 ) m%LineList(I)%OutFlagList(8) = 1 - IF ( scan( LineOutString, 'd') > 0 ) m%LineList(I)%OutFlagList(9) = 1 - IF ( scan( LineOutString, 'l') > 0 ) m%LineList(I)%OutFlagList(10)= 1 - IF (SUM(m%LineList(I)%OutFlagList) > 0) m%LineList(I)%OutFlagList(1) = 1 ! this first entry signals whether to create any output file at all - ! the above letter-index combinations define which OutFlagList entry corresponds to which output type - - - ! check errors - IF ( ErrStat /= ErrID_None ) THEN - ErrMsg = ' Failed to read line data for Line '//trim(Num2LStr(I)) - CALL CleanUp() - RETURN - END IF - - - IF ( InitInp%Echo ) THEN - WRITE( UnEc, '(A)' ) TRIM(Line) - END IF - - END DO ! I - + + END IF - !------------------------------------------------------------------------------------------------- - ! Read any options lines - !------------------------------------------------------------------------------------------------- + END SUBROUTINE setupBathymetry + - CALL ReadCom( UnIn, FileName, 'Options header', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF + ! read in stiffness/damping coefficient or load nonlinear data file if applicable + SUBROUTINE getCoefficientOrCurve(inputString, LineProp_c, LineProp_npoints, LineProp_Xs, LineProp_Ys, ErrStat3, ErrMsg3) + + CHARACTER(40), INTENT(IN ) :: inputString + REAL(DbKi), INTENT(INOUT) :: LineProp_c + INTEGER(IntKi), INTENT( OUT) :: LineProp_nPoints + REAL(DbKi), INTENT( OUT) :: LineProp_Xs (nCoef) + REAL(DbKi), INTENT( OUT) :: LineProp_Ys (nCoef) + + INTEGER(IntKi), INTENT( OUT) :: ErrStat3 ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg3 ! Error message if ErrStat /= ErrID_None - ! loop through any remaining input lines, and use them to set options (overwriting default values in many cases). - ! doing this manually since I'm not sure that there is a built in subroutine for reading any input value on any line number. - DO - - READ(UnIn,'(A)',IOSTAT=ErrStat2) Line !read into a line - - IF (ErrStat2 == 0) THEN - IF (( Line(1:3) == '---' ) .OR. ( Line(1:3) == 'END' ) .OR. ( Line(1:3) == 'end' )) EXIT ! check if it's the end line - - READ(Line,*,IOSTAT=ErrStat2) OptValue, OptString ! look at first two entries, ignore remaining words in line, which should be comments - END IF - - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, 'Failed to read options.', ErrStat, ErrMsg, RoutineName ) ! would be nice to specify which line had the error - CALL CleanUp() - RETURN - END IF - - CALL Conv2UC(OptString) - - ! check all possible options types and see if OptString is one of them, in which case set the variable. - if ( OptString == 'DTM') THEN - read (OptValue,*) p%dtM0 ! InitInp%DTmooring - else if ( OptString == 'G') then - read (OptValue,*) p%G - else if ( OptString == 'RHOW') then - read (OptValue,*) p%rhoW - else if ( OptString == 'WTRDPTH') then - read (OptValue,*) p%WtrDpth - else if ( OptString == 'KBOT') then - read (OptValue,*) p%kBot - else if ( OptString == 'CBOT') then - read (OptValue,*) p%cBot - else if ( OptString == 'DTIC') then - read (OptValue,*) InitInp%dtIC - else if ( OptString == 'TMAXIC') then - read (OptValue,*) InitInp%TMaxIC - else if ( OptString == 'CDSCALEIC') then - read (OptValue,*) InitInp%CdScaleIC - else if ( OptString == 'THRESHIC') then - read (OptValue,*) InitInp%threshIC - else - CALL SetErrStat( ErrID_Warn, 'unable to interpret input '//trim(OptString), ErrStat, ErrMsg, RoutineName ) - end if - - IF ( InitInp%Echo ) THEN - WRITE( UnEc, '(A)' ) TRIM(Line) - END IF - - END DO - - - !------------------------------------------------------------------------------------------------- - ! Read the FAST-style outputs list in the final section, if there is one - !------------------------------------------------------------------------------------------------- - ! we don't read in the outputs header line because it's already been read in for detecting the end of the variable-length options section - ! CALL ReadCom( UnIn, FileName, 'Outputs header', ErrStat, ErrMsg, UnEc ) - - ! allocate InitInp%Outliest (to a really big number for now...) - CALL AllocAry( InitInp%OutList, 1000, "MoorDyn Input File's Outlist", ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() + INTEGER(IntKi) :: nC, I + INTEGER(IntKi) :: UnCoef ! unit number for coefficient input file + + + INTEGER(IntKi) :: ErrStat4 + CHARACTER(120) :: ErrMsg4 + CHARACTER(120) :: Line2 + + + if (SCAN(inputString, "abcdfghijklmnopqrstuvwxyzABCDFGHIJKLMNOPQRSTUVWXYZ") == 0) then ! "eE" are exluded as they're used for scientific notation! + + ! "found NO letter in the line coefficient value so treating it as a number." + READ(inputString, *, IOSTAT=ErrStat4) LineProp_c ! convert the entry string into a real number + LineProp_npoints = 0; + + else ! otherwise interpet the input as a file name to load stress-strain lookup data from + + CALL WrScr("found A letter in the line coefficient value so will try to load the filename.") + + LineProp_c = 0.0 + + ! load lookup table data from file + + CALL GetNewUnit( UnCoef ) + CALL OpenFInpFile( UnCoef, TRIM(inputString), ErrStat4, ErrMsg4 ) ! add error handling? + + READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 ! skip the first two lines (title, names, and units) then parse + READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 + READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 + + DO I = 1, nCoef + + READ(UnCoef,'(A)',IOSTAT=ErrStat4) Line2 !read into a line + + IF (ErrStat4 > 0) then + CALL WrScr("Error while reading lookup table file") + EXIT + ELSE IF (ErrStat4 < 0) then + CALL WrScr("Read "//trim(Int2LStr(I-1))//" data lines from lookup table file") + EXIT + ELSE + READ(Line2,*,IOSTAT=ErrStat4) LineProp_Xs(I), LineProp_Ys(I) + END IF + END DO + + if (I < 2) then + ErrStat3 = ErrID_Fatal + ErrMsg3 = "Less than the minimum of 2 data lines found in file "//TRIM(inputString)//" (first 3 lines are headers)." + LineProp_npoints = 0 + Close (UnCoef) RETURN + else + LineProp_npoints = I-1 + Close (UnCoef) + end if + + END IF + + END SUBROUTINE getCoefficientOrCurve + + + ! Split a string into separate strings by the bar (|) symbol + SUBROUTINE SplitByBars(instring, n, outstrings) + + CHARACTER(*), INTENT(INOUT) :: instring + INTEGER(IntKi), INTENT( OUT) :: n + CHARACTER(40), INTENT(INOUT) :: outstrings(6) ! array of output strings. Up to 6 strings can be read + + INTEGER :: pos1, pos2, i + + n = 0 + pos1=1 + + DO + pos2 = INDEX(instring(pos1:), "|") ! find index of next comma + IF (pos2 == 0) THEN ! if there isn't another comma, read the last entry and call it done (this could be the only entry if no commas) + n = n + 1 + outstrings(n) = instring(pos1:) + EXIT END IF + n = n + 1 + if (n > 6) then + CALL WrScr("ERROR - SplitByBars cannot do more than 6 entries") + end if + outstrings(n) = instring(pos1:pos1+pos2-2) + pos1 = pos2+pos1 + END DO + + END SUBROUTINE SplitByBars - ! OutList - List of user-requested output channels (-): - CALL ReadOutputList ( UnIn, FileName, InitInp%OutList, p%NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL CleanUp() - RETURN - END IF - - !print *, 'NumOuts is ', p%NumOuts - !print *, ' OutList is ', InitInp%OutList(1:p%NumOuts) - - - !------------------------------------------------------------------------------------------------- - ! This is the end of the input file - !------------------------------------------------------------------------------------------------- - - CALL CleanUp() - CONTAINS - ! subroutine to set ErrState and close the files if an error occurs - SUBROUTINE CleanUp() - - ! ErrStat = ErrID_Fatal - CLOSE( UnIn ) - IF (InitInp%Echo) CLOSE( UnEc ) + ! Split a string into separate letter strings and integers. Letters are converted to uppercase. + SUBROUTINE DecomposeString(outWord, let1, num1, let2, num2, let3) + + CHARACTER(*), INTENT(INOUT) :: outWord + CHARACTER(25), INTENT( OUT) :: let1 + ! INTEGER(IntKi), INTENT( OUT) :: num1 + CHARACTER(25), INTENT( OUT) :: num1 + CHARACTER(25), INTENT( OUT) :: let2 + CHARACTER(25), INTENT( OUT) :: num2 +! INTEGER(IntKi), INTENT( OUT) :: num2 + CHARACTER(25), INTENT( OUT) :: let3 + + INTEGER(IntKi) :: I ! Generic loop-counting index + + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I), the name of each output channel + CHARACTER(ChanLen) :: qVal ! quantity type string to match to list of valid options + + INTEGER :: oID ! ID number of connect or line object + INTEGER :: nID ! ID number of node object + INTEGER :: i1 = 0 ! indices of start of numbers or letters in OutListTmp string, for parsing + INTEGER :: i2 = 0 + INTEGER :: i3 = 0 + INTEGER :: i4 = 0 - END SUBROUTINE + + CALL Conv2UC(outWord) ! convert to all uppercase for string matching purposes - END SUBROUTINE MDIO_ReadInput - ! ==================================================================================================== + ! start these strings as empty, and fill in only if used + let1 = '' + num1 = '' + let2 = '' + num2 = '' + let3 = '' + ! find indicies of changes in number-vs-letter in characters of outWord and split into segments accordingly + + i1 = scan( outWord , '1234567890' ) ! find index of first number in the string + if (i1 > 0) then ! if there is a number + let1 = TRIM(outWord( 1:i1-1)) + i2 = i1+verify( outWord(i1+1:) , '1234567890' ) ! find starting index of second set of letters (if first character is a letter, i.e. i1>1), otherwise index of first letter + if (i2 > i1) then ! if there is a second letter/word + num1 = TRIM(outWord(i1:i2-1)) + i3 = i2+scan( outWord(i2+1:) , '1234567890' ) ! find starting index of second set of numbers <<<< + if (i3 > i2) then ! if there is a second number + let2 = TRIM(outWord(i2:i3-1)) + i4 = i3+verify( outWord(i3+1:) , '1234567890' ) ! third letter start + if (i4 > i3) then ! if there is a third letter/word + num2 = TRIM(outWord(i3:i4-1)) + let3 = TRIM(outWord(i4: )) + else + num2 = TRIM(outWord(i3:)) + end if + else + let2 = TRIM(outWord(i2:)) + end if + else + num1 = TRIM(outWord(i1:)) + end if + else + let1 = TRIM(outWord) + end if + + + !READ(outWord(i1:i2-1)) num1 + !READ(outWord(i3:i4-1)) num2 + + ! print *, "Decomposed string ", outWord, " into:" + ! print *, let1 + ! print *, num1 + ! print *, let2 + ! print *, num2 + ! print *, let3 + ! print *, "based on indices (i1-i4):" + ! print *, i1 + ! print *, i2 + ! print *, i3 + ! print *, i4 + + END SUBROUTINE DecomposeString + ! ==================================================================================================== @@ -645,7 +418,16 @@ SUBROUTINE MDIO_ProcessOutList(OutList, p, m, y, InitOut, ErrStat, ErrMsg ) INTEGER :: oID ! ID number of connect or line object INTEGER :: nID ! ID number of node object INTEGER :: i1,i2,i3,i4 ! indices of start of numbers or letters in OutListTmp string, for parsing - + + CHARACTER(25) :: let1 ! strings used for splitting and parsing identifiers + CHARACTER(25) :: num1 + CHARACTER(25) :: let2 + CHARACTER(25) :: num2 + CHARACTER(25) :: let3 + + INTEGER(IntKi) :: LineNumOuts ! number of entries in LineWrOutput for each line + INTEGER(IntKi) :: RodNumOuts ! same for Rods + ! see the top of the module for info on the output labelling types @@ -680,74 +462,114 @@ SUBROUTINE MDIO_ProcessOutList(OutList, p, m, y, InitOut, ErrStat, ErrMsg ) DO I = 1,p%NumOuts OutListTmp = OutList(I) ! current requested output name + + call DecomposeString(OutListTmp, let1, num1, let2, num2, let3) + + + !p%OutParam(I)%Name = OutListTmp CALL Conv2UC(OutListTmp) ! convert to all uppercase for string matching purposes - ! find indicies of changes in number-vs-letter in characters of OutListTmp - i1 = scan( OutListTmp , '1234567890' ) ! first number in the string - i2 = i1+verify( OutListTmp(i1+1:) , '1234567890' ) ! second letter start (assuming first character is a letter, i.e. i1>1) - i3 = i2+scan( OutListTmp(i2+1:) , '1234567890' ) ! second number start - i4 = i3+verify( OutListTmp(i3+1:) , '1234567890' ) ! third letter start - !i5 = scan( OutListTmp(i1:) , '1234567890' ) ! find first letter after first number - + ! ! find indicies of changes in number-vs-letter in characters of OutListTmp + ! i1 = scan( OutListTmp , '1234567890' ) ! first number in the string + ! i2 = i1+verify( OutListTmp(i1+1:) , '1234567890' ) ! second letter start (assuming first character is a letter, i.e. i1>1) + ! i3 = i2+scan( OutListTmp(i2+1:) , '1234567890' ) ! second number start + ! i4 = i3+verify( OutListTmp(i3+1:) , '1234567890' ) ! third letter start + ! error check - IF (i1 <= 1) THEN - CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid - CALL WrScr('Warning: invalid output specifier '//trim(OutListTmp)//'. Starting character must be C or L.') - CYCLE ! <<<<<<<<<<< check correct usage - END IF + ! IF (i1 <= 1) THEN + ! CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid + ! CALL WrScr('Warning: invalid output specifier '//trim(OutListTmp)//'. Starting character must be C or L.') + ! CYCLE ! <<<<<<<<<<< check correct usage + ! END IF p%OutParam(I)%Name = OutListTmp ! label channel with whatever name was inputted, for now ! figure out what type of output it is and process accordingly - ! fairlead tension case (updated) - IF (OutListTmp(1:i1-1) == 'FAIRTEN') THEN - p%OutParam(I)%OType = 2 ! connection object type + ! fairlead tension case (updated) <<<<<<<<<<<<<<<<<<<<<<<<<<< these are not currently working - need new way to find ObjID + IF (let1 == 'FAIRTEN') THEN + p%OutParam(I)%OType = 1 ! line object type p%OutParam(I)%QType = Ten ! tension quantity type p%OutParam(I)%Units = UnitList(Ten) ! set units according to QType - READ (OutListTmp(i1:),*) oID ! this is the line number - p%OutParam(I)%ObjID = m%LineList(oID)%FairConnect ! get the connection ID of the fairlead - p%OutParam(I)%NodeID = -1 ! not used. m%LineList(oID)%N ! specify node N (fairlead) - + READ (num1,*) oID ! this is the line number + p%OutParam(I)%ObjID = oID ! record the ID of the line + p%OutParam(I)%NodeID = m%LineList(oID)%N ! specify node N (end B, fairlead) + ! >>> should check validity of ObjID and NodeID <<< + ! achor tension case - ELSE IF (OutListTmp(1:i1-1) == 'ANCHTEN') THEN - p%OutParam(I)%OType = 2 ! connectoin object type + ELSE IF (let1 == 'ANCHTEN') THEN + p%OutParam(I)%OType = 1 ! line object type p%OutParam(I)%QType = Ten ! tension quantity type p%OutParam(I)%Units = UnitList(Ten) ! set units according to QType - READ (OutListTmp(i1:),*) oID ! this is the line number - p%OutParam(I)%ObjID = m%LineList(oID)%AnchConnect ! get the connection ID of the fairlead - p%OutParam(I)%NodeID = -1 ! not used. m%LineList(oID)%0 ! specify node 0 (anchor) + READ (num1,*) oID ! this is the line number + p%OutParam(I)%ObjID = oID ! record the ID of the line + p%OutParam(I)%NodeID = 0 ! specify node 0 (end A, anchor) ! more general case ELSE ! what object type? - ! Line case ... L?N?xxxx - IF (OutListTmp(1:i1-1) == 'L') THEN + + ! Line case + IF (let1(1:1) == 'L') THEN ! Look for L?N?xxxx p%OutParam(I)%OType = 1 ! Line object type - ! for now we'll just assume the next character(s) are "n" to represent node number: - READ (OutListTmp(i3:i4-1),*) nID - p%OutParam(I)%NodeID = nID - qVal = OutListTmp(i4:) ! isolate quantity type string - ! Connect case ... C?xxx or Con?xxx - ELSE IF (OutListTmp(1:1) == 'C') THEN + ! for now we'll just assume the next character(s) are "n" to represent node number or "s" to represent segment number + IF (num2/=" ") THEN + READ (num2,*) nID ! node or segment ID + p%OutParam(I)%NodeID = nID + ELSE + CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid + CALL WrScr('Warning: invalid output specifier '//trim(OutListTmp)//'. Line ID or Node ID missing.') + CYCLE + END IF + qVal = let3 ! quantity type string + + ! Connect case + ELSE IF (let1(1:1) == 'C') THEN ! Look for C?xxx or Con?xxx p%OutParam(I)%OType = 2 ! Connect object type - qVal = OutListTmp(i2:) ! isolate quantity type string + qVal = let2 ! quantity type string + + ! Rod case + ELSE IF (let1(1:1) == 'R') THEN ! Look for R?xxx or Rod?xxx + p%OutParam(I)%OType = 3 ! Rod object type + IF (LEN_TRIM(let3)== 0) THEN ! No third character cluster indicates this is a whole-rod channel + p%OutParam(I)%NodeID = 0 + qVal = let2 ! quantity type string + ELSE IF (num2/=" ") THEN + READ (num2,*) nID ! rod node ID + p%OutParam(I)%NodeID = nID + qVal = let3 ! quantity type string + ELSE + CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid + CALL WrScr('Warning: invalid output specifier '//trim(OutListTmp)//'. Rod ID or Node ID missing.') + CYCLE + END IF + + ! Body case + ELSE IF (Let1(1:1) == 'B') THEN ! Look for B?xxx or Body?xxx + p%OutParam(I)%OType = 4 ! Body object type + qVal = let2 ! quantity type string ! should do fairlead option also! ! error ELSE CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid - CALL WrScr('Warning: invalid output specifier '//trim(OutListTmp)//'. Type must be L or C.') + CALL WrScr('Warning: invalid output specifier '//trim(OutListTmp)//'. Must start with L, C, R, or B') CYCLE END IF ! object number - READ (OutListTmp(i1:i2-1),*) oID - p%OutParam(I)%ObjID = oID ! line or connect ID number + IF (num1/=" ") THEN + READ (num1,*) oID + p%OutParam(I)%ObjID = oID ! line or connect ID number + ELSE + CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid + CALL WrScr('Warning: invalid output specifier '//trim(OutListTmp)//'. Object ID missing.') + CYCLE + END IF ! which kind of quantity? IF (qVal == 'PX') THEN @@ -777,7 +599,7 @@ SUBROUTINE MDIO_ProcessOutList(OutList, p, m, y, InitOut, ErrStat, ErrMsg ) ELSE IF (qVal == 'AZ') THEN p%OutParam(I)%QType = AccZ p%OutParam(I)%Units = UnitList(AccZ) - ELSE IF ((qVal == 'T') .or. (qval == 'Ten')) THEN + ELSE IF ((qVal == 'T') .or. (qVal == 'TEN')) THEN p%OutParam(I)%QType = Ten p%OutParam(I)%Units = UnitList(Ten) ELSE IF (qVal == 'FX') THEN @@ -788,7 +610,19 @@ SUBROUTINE MDIO_ProcessOutList(OutList, p, m, y, InitOut, ErrStat, ErrMsg ) p%OutParam(I)%Units = UnitList(FY) ELSE IF (qVal == 'FZ') THEN p%OutParam(I)%QType = FZ - p%OutParam(I)%Units = UnitList(FZ) + p%OutParam(I)%Units = UnitList(FZ) ! <<<< should add moments as well <<<< + ELSE IF (qVal == 'ROLL') THEN + p%OutParam(I)%QType = Roll + p%OutParam(I)%Units = UnitList(Roll) + ELSE IF (qVal == 'PITCH') THEN + p%OutParam(I)%QType = Pitch + p%OutParam(I)%Units = UnitList(Pitch) + ELSE IF (qVal == 'YAW') THEN + p%OutParam(I)%QType = Yaw + p%OutParam(I)%Units = UnitList(Yaw) + ELSE IF (qVal == 'SUB') THEN + p%OutParam(I)%QType = Sub + p%OutParam(I)%Units = UnitList(Sub) ELSE CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid CALL WrScr('Warning: invalid output specifier '//trim(OutListTmp)//'. Quantity type not recognized.') @@ -798,23 +632,44 @@ SUBROUTINE MDIO_ProcessOutList(OutList, p, m, y, InitOut, ErrStat, ErrMsg ) END IF ! also check whether each object index and node index (if applicable) is in range - IF (p%OutParam(I)%OType==2) THEN + + IF (p%OutParam(I)%OType==1) THEN ! Line + IF (p%OutParam(I)%ObjID > p%NLines) THEN + CALL WrScr('Warning: output Line index excedes number of Lines in requested output '//trim(OutListTmp)//'.') + CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid + END IF + IF (p%OutParam(I)%NodeID > m%LineList(p%OutParam(I)%ObjID)%N) THEN + CALL WrScr('Warning: output node index excedes number of nodes in requested output '//trim(OutListTmp)//'.') + CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid + ELSE IF (p%OutParam(I)%NodeID < 0) THEN + CALL WrScr('Warning: output node index is less than zero in requested output '//trim(OutListTmp)//'.') + CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid + END IF + + ELSE IF (p%OutParam(I)%OType==2) THEN ! Connect IF (p%OutParam(I)%ObjID > p%NConnects) THEN CALL WrScr('Warning: output Connect index excedes number of Connects in requested output '//trim(OutListTmp)//'.') CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid END IF - ELSE IF (p%OutParam(I)%OType==1) THEN - IF (p%OutParam(I)%ObjID > p%NLines) THEN - CALL WrScr('Warning: output Line index excedes number of Lines in requested output '//trim(OutListTmp)//'.') + + ELSE IF (p%OutParam(I)%OType==3) THEN ! Rod + IF (p%OutParam(I)%ObjID > p%NRods) THEN + CALL WrScr('Warning: output Rod index excedes number of Rods in requested output '//trim(OutListTmp)//'.') CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid END IF - IF (p%OutParam(I)%NodeID > m%LineList(p%OutParam(I)%ObjID)%N) THEN + IF (p%OutParam(I)%NodeID > m%RodList(p%OutParam(I)%ObjID)%N) THEN CALL WrScr('Warning: output node index excedes number of nodes in requested output '//trim(OutListTmp)//'.') CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid ELSE IF (p%OutParam(I)%NodeID < 0) THEN CALL WrScr('Warning: output node index is less than zero in requested output '//trim(OutListTmp)//'.') CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid END IF + + ELSE IF (p%OutParam(I)%OType==4) THEN ! Body + IF (p%OutParam(I)%ObjID > p%NBodies) THEN + CALL WrScr('Warning: output Body index excedes number of Bodies in requested output '//trim(OutListTmp)//'.') + CALL DenoteInvalidOutput(p%OutParam(I)) ! flag as invalid + END IF END IF @@ -855,13 +710,36 @@ SUBROUTINE MDIO_ProcessOutList(OutList, p, m, y, InitOut, ErrStat, ErrMsg ) ! allocate output array in each Line DO I=1,p%NLines - ALLOCATE(m%LineList(I)%LineWrOutput( 1 + 3*(m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(2:5)) + m%LineList(I)%N*SUM(m%LineList(I)%OutFlagList(6:10)) ), STAT = ErrStat) + + + ! calculate number of output entries (excluding time) to write for this line + LineNumOuts = 3*(m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(2:6)) & + + (m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(7:9)) & + + m%LineList(I)%N*SUM(m%LineList(I)%OutFlagList(10:18)) + + ALLOCATE(m%LineList(I)%LineWrOutput( 1 + LineNumOuts), STAT = ErrStat) IF ( ErrStat /= ErrID_None ) THEN ErrMsg = ' Error allocating space for a LineWrOutput array' ErrStat = ErrID_Fatal RETURN END IF END DO ! I + + ! allocate output array in each Rod + DO I=1,p%NRods + + ! calculate number of output entries (excluding time) to write for this Rod + RodNumOuts = 3*(m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(2:9)) & + + (m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(10:11)) & + + m%RodList(I)%N*SUM(m%RodList(I)%OutFlagList(12:18)) + + ALLOCATE(m%RodList(I)%RodWrOutput( 1 + RodNumOuts), STAT = ErrStat) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating space for a RodWrOutput array' + ErrStat = ErrID_Fatal + RETURN + END IF + END DO ! I !print *, "y%WriteOutput allocated to size ", size(y%WriteOutput) @@ -888,17 +766,16 @@ SUBROUTINE DenoteInvalidOutput( OutParm ) END SUBROUTINE DenoteInvalidOutput END SUBROUTINE MDIO_ProcessOutList - !==================================================================================================== + !----------------------------------------------------------------------------------------============ - !==================================================================================================== - SUBROUTINE MDIO_OpenOutput( OutRootName, p, m, InitOut, ErrStat, ErrMsg ) + !----------------------------------------------------------------------------------------============ + SUBROUTINE MDIO_OpenOutput( p, m, InitOut, ErrStat, ErrMsg ) !---------------------------------------------------------------------------------------------------- - CHARACTER(*), INTENT( IN ) :: OutRootName ! Root name for the output file TYPE(MD_ParameterType), INTENT( INOUT ) :: p TYPE(MD_MiscVarType), INTENT( INOUT ) :: m TYPE(MD_InitOutPutType ), INTENT( IN ) :: InitOut ! @@ -908,8 +785,9 @@ SUBROUTINE MDIO_OpenOutput( OutRootName, p, m, InitOut, ErrStat, ErrMsg ) INTEGER :: I ! Generic loop counter INTEGER :: J ! Generic loop counter CHARACTER(1024) :: OutFileName ! The name of the output file including the full path. -! INTEGER :: L ! counter for index in LineWrOutput - INTEGER :: LineNumOuts ! number of entries in LineWrOutput for each line + INTEGER :: L ! counter for index in LineWrOutput + INTEGER :: LineNumOuts ! number of entries in LineWrOutput for each line + INTEGER :: RodNumOuts ! for Rods ... redundant <<< CHARACTER(200) :: Frmt ! a string to hold a format statement INTEGER :: ErrStat2 @@ -917,7 +795,7 @@ SUBROUTINE MDIO_OpenOutput( OutRootName, p, m, InitOut, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" - p%Delim = ' ' ! for now + p%Delim = ' ' ! for now !------------------------------------------------------------------------------------------------- ! Open the output file, if necessary, and write the header @@ -939,7 +817,7 @@ SUBROUTINE MDIO_OpenOutput( OutRootName, p, m, InitOut, ErrStat, ErrMsg ) !Write the names of the output parameters: - Frmt = '(A10,'//TRIM(Int2LStr(p%NumOuts))//'(A1,A10))' + Frmt = '(A10,'//TRIM(Int2LStr(p%NumOuts))//'(A1,A12))' WRITE(p%MDUnOut,Frmt, IOSTAT=ErrStat2) TRIM( 'Time' ), ( p%Delim, TRIM( p%OutParam(I)%Name), I=1,p%NumOuts ) @@ -975,90 +853,123 @@ SUBROUTINE MDIO_OpenOutput( OutRootName, p, m, InitOut, ErrStat, ErrMsg ) END IF - ! calculate number of output entries (including time) to write for this line - LineNumOuts = 1 + 3*(m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(2:5)) + m%LineList(I)%N*SUM(m%LineList(I)%OutFlagList(6:10)) - - Frmt = '(A10,'//TRIM(Int2LStr(LineNumOuts))//'(A1,A10))' ! should evenutally use user specified format? - !Frmt = '(A10,'//TRIM(Int2LStr(3+3*m%LineList(I)%N))//'(A1,A10))' + ! calculate number of output entries (excluding time) to write for this line + LineNumOuts = 3*(m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(2:6)) & + + (m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(7:9)) & + + m%LineList(I)%N*SUM(m%LineList(I)%OutFlagList(10:18)) + + if (wordy > 2) PRINT *, LineNumOuts, " output channels" + + Frmt = '(A10,'//TRIM(Int2LStr(1 + LineNumOuts))//'(A1,A12))' ! should evenutally use user specified format? + !Frmt = '(A10,'//TRIM(Int2LStr(3+3*m%LineList(I)%N))//'(A1,A12))' ! Write the names of the output parameters: (these use "implied DO" loops) WRITE(m%LineList(I)%LineUnOut,'(A10)', advance='no', IOSTAT=ErrStat2) TRIM( 'Time' ) IF (m%LineList(I)%OutFlagList(2) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'px', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'py', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'pz', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(3) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'vx', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'vy', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'vz', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(4) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Ux', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Uy', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Uz', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(5) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Dx', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Dy', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Dz', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(6) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & - ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'Ten', J=1,(m%LineList(I)%N) ) + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'bx', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'by', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'bz', J=0,(m%LineList(I)%N) ) END IF + IF (m%LineList(I)%OutFlagList(7) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & - ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'Dmp', J=1,(m%LineList(I)%N) ) + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Wz', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(8) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Kurv', J=0,(m%LineList(I)%N) ) + END IF + + IF (m%LineList(I)%OutFlagList(10) == 1) THEN + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'Ten', J=1,(m%LineList(I)%N) ) + END IF + IF (m%LineList(I)%OutFlagList(11) == 1) THEN + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'Dmp', J=1,(m%LineList(I)%N) ) + END IF + IF (m%LineList(I)%OutFlagList(12) == 1) THEN + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'Str', J=1,(m%LineList(I)%N) ) END IF - IF (m%LineList(I)%OutFlagList(9) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + IF (m%LineList(I)%OutFlagList(13) == 1) THEN + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'SRt', J=1,(m%LineList(I)%N) ) END IF - IF (m%LineList(I)%OutFlagList(10)== 1) THEN + IF (m%LineList(I)%OutFlagList(14)== 1) THEN WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'Lst', J=1,(m%LineList(I)%N) ) END IF WRITE(m%LineList(I)%LineUnOut,'(A1)', IOSTAT=ErrStat2) ' ' ! make line break at the end + ! Now write the units line WRITE(m%LineList(I)%LineUnOut,'(A10)', advance='no', IOSTAT=ErrStat2) TRIM( '(s)' ) IF (m%LineList(I)%OutFlagList(2) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, '(m)', p%Delim, '(m)', p%Delim, '(m)', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(3) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, '(m/s)', p%Delim, '(m/s)', p%Delim, '(m/s)', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(4) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, '(m/s)', p%Delim, '(m/s)', p%Delim, '(m/s)', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(5) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, '(N)', p%Delim, '(N)', p%Delim, '(N)', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(6) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & - ( p%Delim, '(N)', J=1,(m%LineList(I)%N) ) + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((3+3*m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', p%Delim, '(N)', p%Delim, '(N)', J=0,(m%LineList(I)%N) ) END IF + IF (m%LineList(I)%OutFlagList(7) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & - ( p%Delim, '(N)', J=1,(m%LineList(I)%N) ) + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(Nup)', J=0,(m%LineList(I)%N) ) END IF IF (m%LineList(I)%OutFlagList(8) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(1/m)', J=0,(m%LineList(I)%N) ) + END IF + + IF (m%LineList(I)%OutFlagList(10) == 1) THEN + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', J=1,(m%LineList(I)%N) ) + END IF + IF (m%LineList(I)%OutFlagList(11) == 1) THEN + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', J=1,(m%LineList(I)%N) ) + END IF + IF (m%LineList(I)%OutFlagList(12) == 1) THEN + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, '(-)', J=1,(m%LineList(I)%N) ) END IF - IF (m%LineList(I)%OutFlagList(9) == 1) THEN - WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & + IF (m%LineList(I)%OutFlagList(13) == 1) THEN + WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, '(1/s)', J=1,(m%LineList(I)%N) ) END IF - IF (m%LineList(I)%OutFlagList(10)== 1) THEN + IF (m%LineList(I)%OutFlagList(14)== 1) THEN WRITE(m%LineList(I)%LineUnOut,'('//TRIM(Int2LStr((m%LineList(I)%N)))//'(A1,A10))', advance='no', IOSTAT=ErrStat2) & ( p%Delim, '(m)', J=1,(m%LineList(I)%N) ) END IF @@ -1070,13 +981,185 @@ SUBROUTINE MDIO_OpenOutput( OutRootName, p, m, InitOut, ErrStat, ErrMsg ) END DO ! I - line number + + + !-------------------------------------------------------------------------- + ! now do the same for rod output files + !-------------------------------------------------------------------------- + + !! allocate UnLineOuts + !ALLOCATE(UnLineOuts(p%NLines)) ! should add error checking + + DO I = 1,p%NRods + + + IF (m%RodList(I)%OutFlagList(1) == 1) THEN ! only proceed if the Rod is flagged to output a file + + ! Open the file for output + OutFileName = TRIM(p%RootName)//'.Rod'//TRIM(Int2LStr(I))//'.out' + CALL GetNewUnit( m%RodList(I)%RodUnOut ) + + CALL OpenFOutFile ( m%RodList(I)%RodUnOut, OutFileName, ErrStat, ErrMsg ) + IF ( ErrStat > ErrID_None ) THEN + ErrMsg = ' Error opening Rod output file '//TRIM(ErrMsg) + ErrStat = ErrID_Fatal + RETURN + END IF + + + ! calculate number of output entries (excluding time) to write for this Rod + RodNumOuts = 3*(m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(2:9)) & + + (m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(10:11)) & + + m%RodList(I)%N*SUM(m%RodList(I)%OutFlagList(12:18)) + + if (wordy > 2) PRINT *, RodNumOuts, " output channels" + + Frmt = '(A10,'//TRIM(Int2LStr(1 + RodNumOuts))//'(A1,A12))' ! should evenutally use user specified format? + !Frmt = '(A10,'//TRIM(Int2LStr(3+3*m%RodList(I)%N))//'(A1,A12))' + + ! >>> should functionalize the below <<< + + + ! Write the names of the output parameters: (these use "implied DO" loops) + + WRITE(m%RodList(I)%RodUnOut,'(A10)', advance='no', IOSTAT=ErrStat2) TRIM( 'Time' ) + IF (m%RodList(I)%OutFlagList(2) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'px', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'py', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'pz', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(3) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'vx', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'vy', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'vz', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(4) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Ux', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Uy', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Uz', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(5) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Box', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Boy', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Boz', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(6) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Dx', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Dy', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Dz', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(7) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Fix', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Fiy', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Fiz', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(8) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Pdx', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Pdy', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Pdz', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(9) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'bx', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'by', p%Delim, 'Node'//TRIM(Int2Lstr(J))//'bz', J=0,(m%RodList(I)%N) ) + END IF + + IF (m%RodList(I)%OutFlagList(10) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Wz', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(11) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Node'//TRIM(Int2Lstr(J))//'Kurv', J=0,(m%RodList(I)%N) ) + END IF + + IF (m%RodList(I)%OutFlagList(12) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'Ten', J=1,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(13) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'Dmp', J=1,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(14) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'Str', J=1,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(15) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, 'Seg'//TRIM(Int2Lstr(J))//'SRt', J=1,(m%RodList(I)%N) ) + END IF + + WRITE(m%RodList(I)%RodUnOut,'(A1)', IOSTAT=ErrStat2) ' ' ! make line break at the end + + + ! Now write the units line + + WRITE(m%RodList(I)%RodUnOut,'(A10)', advance='no', IOSTAT=ErrStat2) TRIM( '(s)' ) + IF (m%RodList(I)%OutFlagList(2) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(m)', p%Delim, '(m)', p%Delim, '(m)', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(3) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(m/s)', p%Delim, '(m/s)', p%Delim, '(m/s)', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(4) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(m/s)', p%Delim, '(m/s)', p%Delim, '(m/s)', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(5) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', p%Delim, '(N)', p%Delim, '(N)', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(6) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', p%Delim, '(N)', p%Delim, '(N)', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(7) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', p%Delim, '(N)', p%Delim, '(N)', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(8) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', p%Delim, '(N)', p%Delim, '(N)', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(9) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((3+3*m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', p%Delim, '(N)', p%Delim, '(N)', J=0,(m%RodList(I)%N) ) + END IF + + IF (m%RodList(I)%OutFlagList(10) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(Nup)', J=0,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(11) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(1/m)', J=0,(m%RodList(I)%N) ) + END IF + + IF (m%RodList(I)%OutFlagList(12) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', J=1,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(13) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(N)', J=1,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(14) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(-)', J=1,(m%RodList(I)%N) ) + END IF + IF (m%RodList(I)%OutFlagList(15) == 1) THEN + WRITE(m%RodList(I)%RodUnOut,'('//TRIM(Int2LStr((m%RodList(I)%N)))//'(A1,A12))', advance='no', IOSTAT=ErrStat2) & + ( p%Delim, '(1/s)', J=1,(m%RodList(I)%N) ) + END IF + + WRITE(m%RodList(I)%RodUnOut,'(A1)', IOSTAT=ErrStat2) ' ' ! make Rod break at the end + + END IF ! if rod is flagged for output file + + END DO ! I - rod number + ! need to fix error handling in this sub END SUBROUTINE MDIO_OpenOutput - !==================================================================================================== + !----------------------------------------------------------------------------------------============ - !==================================================================================================== + !----------------------------------------------------------------------------------------============ SUBROUTINE MDIO_CloseOutput ( p, m, ErrStat, ErrMsg ) ! This function cleans up after running the MoorDyn output module. ! It closes the output files and releases memory. @@ -1093,26 +1176,41 @@ SUBROUTINE MDIO_CloseOutput ( p, m, ErrStat, ErrMsg ) ErrMsg = "" +!FIXME: make sure thes are actually open before trying to close them. Segfault will occur otherwise!!!! +! This bug can be triggered by an early failure of the parsing routines, before these files were ever opened +! which returns MD to OpenFAST as ErrID_Fatal, then OpenFAST calls MD_End, which calls this. + ! close main MoorDyn output file if (p%MDUnOut > 0) then CLOSE( p%MDUnOut, IOSTAT = ErrStat ) - IF ( ErrStat /= 0 ) THEN - ErrMsg = 'Error closing output file' - END IF - endif - + IF ( ErrStat /= 0 ) THEN + ErrMsg = 'Error closing output file' + END IF + end if + + ! close individual rod output files + DO I=1,p%NRods + if (allocated(m%RodList)) then + if (m%RodList(I)%RodUnOut > 0) then + CLOSE( m%RodList(I)%RodUnOut, IOSTAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrMsg = 'Error closing rod output file' + END IF + end if + end if + END DO + ! close individual line output files - if (allocated(m%LineList)) then - DO I=1,p%NLines + DO I=1,p%NLines + if (allocated(m%LineList)) then if (m%LineList(I)%LineUnOut > 0) then CLOSE( m%LineList(I)%LineUnOut, IOSTAT = ErrStat ) - IF ( ErrStat /= 0 ) THEN - ErrMsg = 'Error closing line output file' - exit ! exit this loop - END IF - endif - END DO - endif + IF ( ErrStat /= 0 ) THEN + ErrMsg = 'Error closing line output file' + END IF + end if + end if + END DO ! deallocate output arrays IF (ALLOCATED(m%MDWrOutput)) THEN @@ -1125,10 +1223,10 @@ SUBROUTINE MDIO_CloseOutput ( p, m, ErrStat, ErrMsg ) END DO END SUBROUTINE MDIO_CloseOutput - !==================================================================================================== + !----------------------------------------------------------------------------------------============ - !==================================================================================================== + !----------------------------------------------------------------------------------------============ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) ! This subroutine gathers the output data defined by the OutParams list and ! writes it to the output file opened in MDIO_OutInit() @@ -1145,6 +1243,7 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) INTEGER :: K ! Generic loop counter INTEGER :: L ! counter for index in LineWrOutput INTEGER :: LineNumOuts ! number of entries in LineWrOutput for each line + INTEGER :: RodNumOuts ! same for Rods CHARACTER(200) :: Frmt ! a string to hold a format statement @@ -1156,80 +1255,177 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = '' END IF + + ! -------------------------------- main output file -------------------------------- + + if ( p%NumOuts > 0_IntKi ) then + + ! gather the required output quantities (INCOMPLETE!) + DO I = 1,p%NumOuts + + + IF (p%OutParam(I)%OType == 1) THEN ! if dealing with a Line output + + SELECT CASE (p%OutParam(I)%QType) + CASE (PosX) + y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%r(1,p%OutParam(I)%NodeID) ! x position + CASE (PosY) + y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%r(2,p%OutParam(I)%NodeID) ! y position + CASE (PosZ) + y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%r(3,p%OutParam(I)%NodeID) ! z position + CASE (VelX) + y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%rd(1,p%OutParam(I)%NodeID) ! x velocity + CASE (VelY) + y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%rd(2,p%OutParam(I)%NodeID) ! y velocity + CASE (VelZ) + y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%rd(3,p%OutParam(I)%NodeID) ! z velocity + CASE (Ten) + y%WriteOutput(I) = Line_GetNodeTen(m%LineList(p%OutParam(I)%ObjID), p%OutParam(I)%NodeID, p) ! this is actually the segment tension ( 1 < NodeID < N ) Should deal with properly! + + CASE DEFAULT + y%WriteOutput(I) = 0.0_ReKi + ErrStat = ErrID_Warn + ErrMsg = ' Unsupported output quantity '//TRIM(p%OutParam(I)%Name)//' requested from Line '//TRIM(Num2Lstr(p%OutParam(I)%ObjID))//'.' + END SELECT + + ELSE IF (p%OutParam(I)%OType == 2) THEN ! if dealing with a Connect output + SELECT CASE (p%OutParam(I)%QType) + CASE (PosX) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%r(1) ! x position + CASE (PosY) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%r(2) ! y position + CASE (PosZ) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%r(3) ! z position + CASE (VelX) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%rd(1) ! x velocity + CASE (VelY) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%rd(2) ! y velocity + CASE (VelZ) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%rd(3) ! z velocity + CASE (AccX) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%a(1) ! x acceleration + CASE (AccY) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%a(2) ! y acceleration + CASE (AccZ) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%a(3) ! z acceleration + CASE (Ten) + y%WriteOutput(I) = TwoNorm(m%ConnectList(p%OutParam(I)%ObjID)%Fnet) ! total force magnitude on a connect (used eg. for fairlead and anchor tensions) + CASE (FX) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%Fnet(1) ! total force in x - added Nov 24 + CASE (FY) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%Fnet(2) ! total force in y + CASE (FZ) + y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%Fnet(3) ! total force in z + CASE DEFAULT + y%WriteOutput(I) = 0.0_ReKi + ErrStat = ErrID_Warn + ErrMsg = ' Unsupported output quantity '//TRIM(p%OutParam(I)%Name)//' requested from Connection '//TRIM(Num2Lstr(p%OutParam(I)%ObjID))//'.' + END SELECT + + ELSE IF (p%OutParam(I)%OType == 3) THEN ! if dealing with a Rod output + + SELECT CASE (p%OutParam(I)%QType) + CASE (PosX) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%r(1,p%OutParam(I)%NodeID) ! x position + CASE (PosY) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%r(2,p%OutParam(I)%NodeID) ! y position + CASE (PosZ) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%r(3,p%OutParam(I)%NodeID) ! z position + CASE (VelX) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%rd(1,p%OutParam(I)%NodeID) ! x velocity + CASE (VelY) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%rd(2,p%OutParam(I)%NodeID) ! y velocity + CASE (VelZ) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%rd(3,p%OutParam(I)%NodeID) ! z velocity + CASE (AccX) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%a6(1) ! x acceleration <<< should this become distributed for each node? + CASE (AccY) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%a6(2) ! y acceleration + CASE (AccZ) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%a6(3) ! z acceleration + CASE (FX) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%F6net(1) ! total force in x - added Nov 24 + CASE (FY) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%F6net(2) ! total force in y + CASE (FZ) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%F6net(3) ! total force in z + CASE (Roll) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%roll*180.0/pi ! rod roll + CASE (Pitch) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%pitch*180.0/pi ! rod pitch + CASE (Sub) + y%WriteOutput(I) = m%RodList(p%OutParam(I)%ObjID)%h0 / m%RodList(p%OutParam(I)%ObjID)%UnstrLen ! rod submergence + CASE DEFAULT + y%WriteOutput(I) = 0.0_ReKi + ErrStat = ErrID_Warn + ErrMsg = ' Unsupported output quantity '//TRIM(p%OutParam(I)%Name)//' requested from Rod '//TRIM(Num2Lstr(p%OutParam(I)%ObjID))//'.' + END SELECT + + ELSE IF (p%OutParam(I)%OType == 4) THEN ! if dealing with a Body output + SELECT CASE (p%OutParam(I)%QType) + CASE (PosX) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%r6(1) ! x position + CASE (PosY) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%r6(2) ! y position + CASE (PosZ) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%r6(3) ! z position + CASE (VelX) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%v6(1) ! x velocity + CASE (VelY) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%v6(2) ! y velocity + CASE (VelZ) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%v6(3) ! z velocity + CASE (FX) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%F6net(1) ! total force in x - added Nov 24 + CASE (FY) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%F6net(2) ! total force in y + CASE (FZ) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%F6net(3) ! total force in z + CASE (Roll) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%r6(4)*180.0/pi ! roll + CASE (Pitch) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%r6(5)*180.0/pi ! pitch + CASE (Yaw) + y%WriteOutput(I) = m%BodyList(p%OutParam(I)%ObjID)%r6(6)*180.0/pi ! yaw + CASE DEFAULT + y%WriteOutput(I) = 0.0_ReKi + ErrStat = ErrID_Warn + ErrMsg = ' Unsupported output quantity '//TRIM(p%OutParam(I)%Name)//' requested from Body '//TRIM(Num2Lstr(p%OutParam(I)%ObjID))//'.' + END SELECT + + + ELSE ! it must be an invalid output, so write zero + y%WriteOutput(I) = 0.0_ReKi - ! Return if there are no outputs - if ( p%NumOuts < 1_IntKi ) return - - - ! gather the required output quantities (INCOMPLETE!) - DO I = 1,p%NumOuts - - IF (p%OutParam(I)%OType == 2) THEN ! if dealing with a Connect output - SELECT CASE (p%OutParam(I)%QType) - CASE (PosX) - y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%r(1) ! x position - CASE (PosY) - y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%r(2) ! y position - CASE (PosZ) - y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%r(3) ! z position - CASE (VelX) - y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%rd(1) ! x velocity - CASE (VelY) - y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%rd(2) ! y velocity - CASE (VelZ) - y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%rd(3) ! z velocity - CASE (Ten) - y%WriteOutput(I) = TwoNorm(m%ConnectList(p%OutParam(I)%ObjID)%Ftot) ! total force magnitude on a connect (used eg. for fairlead and anchor tensions) - CASE (FX) - y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%Ftot(1) ! total force in x - added Nov 24 - CASE (FY) - y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%Ftot(2) ! total force in y - CASE (FZ) - y%WriteOutput(I) = m%ConnectList(p%OutParam(I)%ObjID)%Ftot(3) ! total force in z - CASE DEFAULT - y%WriteOutput(I) = 0.0_DbKi - ErrStat = ErrID_Warn - ErrMsg = ' Unsupported output quantity '//TRIM(Num2Lstr(p%OutParam(I)%QType))//' requested from Connection '//TRIM(Num2Lstr(p%OutParam(I)%ObjID))//'.' - END SELECT - - ELSE IF (p%OutParam(I)%OType == 1) THEN ! if dealing with a Line output - - SELECT CASE (p%OutParam(I)%QType) - CASE (PosX) - y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%r(1,p%OutParam(I)%NodeID) ! x position - CASE (PosY) - y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%r(2,p%OutParam(I)%NodeID) ! y position - CASE (PosZ) - y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%r(3,p%OutParam(I)%NodeID) ! z position - CASE (VelX) - y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%rd(1,p%OutParam(I)%NodeID) ! x velocity - CASE (VelY) - y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%rd(2,p%OutParam(I)%NodeID) ! y velocity - CASE (VelZ) - y%WriteOutput(I) = m%LineList(p%OutParam(I)%ObjID)%rd(3,p%OutParam(I)%NodeID) ! z velocity - CASE (Ten) - y%WriteOutput(I) = TwoNorm(m%LineList(p%OutParam(I)%ObjID)%T(:,p%OutParam(I)%NodeID)) ! this is actually the segment tension ( 1 < NodeID < N ) Should deal with properly! - CASE DEFAULT - y%WriteOutput(I) = 0.0_DbKi - ErrStat = ErrID_Warn - ErrMsg = ' Unsupported output quantity '//TRIM(Num2Lstr(p%OutParam(I)%QType))//' requested from Line '//TRIM(Num2Lstr(p%OutParam(I)%ObjID))//'.' - END SELECT - - ELSE ! it must be an invalid output, so write zero - y%WriteOutput(I) = 0.0_DbKi - - END IF - - END DO ! I, loop through OutParam - - - ! Write the output parameters to the file - - Frmt = '(F10.4,'//TRIM(Int2LStr(p%NumOuts))//'(A1,e12.6))' ! should evenutally use user specified format? + END IF - WRITE(p%MDUnOut,Frmt) Time, ( p%Delim, y%WriteOutput(I), I=1,p%NumOuts ) + END DO ! I, loop through OutParam + END IF + ! check if this is a repeated time step, in which case exit instead of writing a duplicate line to the output files + if (Time <= m%LastOutTime) then + return + else + m%LastOutTime = Time + end if + + ! if using a certain output time step, check whether we should output, and exit the subroutine if not + if (p%dtOut > 0) then + !if (Time < (floor((Time-p%dtCoupling)/p%dtOut) + 1.0)*p%dtOut) then + if ( abs(MOD( Time - 0.5*p%dtOut, p%dtOut) - 0.5*p%dtOut) >= 0.5*p%dtCoupling) then + return + end if + end if + ! What the above does is say if ((dtOut==0) || (t >= (floor((t-dtC)/dtOut) + 1.0)*dtOut)), continue to writing files + + if ( p%NumOuts > 0_IntKi ) then + + ! Write the output parameters to the file + Frmt = '(F10.4,'//TRIM(Int2LStr(p%NumOuts))//'(A1,e12.5))' ! should evenutally use user specified format? + + WRITE(p%MDUnOut,Frmt) Time, ( p%Delim, y%WriteOutput(I), I=1,p%NumOuts ) + END IF @@ -1241,12 +1437,19 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) IF (m%LineList(I)%OutFlagList(1) == 1) THEN ! only proceed if the line is flagged to output a file ! calculate number of output entries to write for this line - LineNumOuts = 3*(m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(2:5)) + m%LineList(I)%N*SUM(m%LineList(I)%OutFlagList(6:10)) + !LineNumOuts = 3*(m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(2:5)) + m%LineList(I)%N*SUM(m%LineList(I)%OutFlagList(6:9)) + LineNumOuts = 3*(m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(2:6)) & + + (m%LineList(I)%N + 1)*SUM(m%LineList(I)%OutFlagList(7:9)) & + + m%LineList(I)%N*SUM(m%LineList(I)%OutFlagList(10:18)) - Frmt = '(F10.4,'//TRIM(Int2LStr(LineNumOuts))//'(A1,e12.6))' ! should evenutally use user specified format? - - L = 1 ! start of index of line output file at first entry + if (m%LineList(I)%OutFlagList(2) == 1) THEN ! if node positions are included, make them using a float format for higher precision + Frmt = '(F10.4,'//TRIM(Int2LStr(3*(m%LineList(I)%N + 1)))//'(A1,F12.4),'//TRIM(Int2LStr(LineNumOuts - 3*(m%LineList(I)%N - 1)))//'(A1,e12.5))' + else + Frmt = '(F10.4,'//TRIM(Int2LStr(LineNumOuts))//'(A1,e12.5))' ! should evenutally use user specified format? + end if + + L = 1 ! start of index of line output file at first entry 12345.7890 ! Time ! m%LineList(I)%LineWrOutput(L) = Time @@ -1277,7 +1480,7 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) IF (m%LineList(I)%OutFlagList(4) == 1) THEN DO J = 0,m%LineList(I)%N ! note index starts at zero because these are nodes DO K = 1,3 - m%LineList(I)%LineWrOutput(L) = 0.0 + m%LineList(I)%LineWrOutput(L) = m%LineList(I)%U(K,J) L = L+1 END DO END DO @@ -1295,8 +1498,36 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) END IF - ! Segment tension force (excludes damping term, just EA) + ! Node seabed contact force IF (m%LineList(I)%OutFlagList(6) == 1) THEN + DO J = 0,m%LineList(I)%N + DO K = 1,3 + m%LineList(I)%LineWrOutput(L) = m%LineList(I)%B(K,J) + L = L+1 + END DO + END DO + END IF + + + ! Node weights + IF (m%LineList(I)%OutFlagList(7) == 1) THEN + DO J = 0,m%LineList(I)%N + m%LineList(I)%LineWrOutput(L) = m%LineList(I)%W(3,J) + L = L+1 + END DO + END IF + + ! ! Node curvatures + ! IF (m%LineList(I)%OutFlagList(8) == 1) THEN + ! DO J = 0,m%LineList(I)%N + ! m%LineList(I)%LineWrOutput(L) = m%LineList(I)%W(3,J) + ! L = L+1 + ! END DO + ! END IF + + + ! Segment tension force (excludes damping term, just EA) + IF (m%LineList(I)%OutFlagList(10) == 1) THEN DO J = 1,m%LineList(I)%N m%LineList(I)%LineWrOutput(L) = TwoNorm(m%LineList(I)%T(:,J) ) L = L+1 @@ -1304,7 +1535,7 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) END IF ! Segment internal damping force - IF (m%LineList(I)%OutFlagList(7) == 1) THEN + IF (m%LineList(I)%OutFlagList(11) == 1) THEN DO J = 1,m%LineList(I)%N IF (( m%LineList(I)%Td(3,J)*m%LineList(I)%T(3,J) ) > 0) THEN ! if statement for handling sign (positive = tension) m%LineList(I)%LineWrOutput(L) = TwoNorm(m%LineList(I)%Td(:,J) ) @@ -1316,7 +1547,7 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) END IF ! Segment strain - IF (m%LineList(I)%OutFlagList(8) == 1) THEN + IF (m%LineList(I)%OutFlagList(12) == 1) THEN DO J = 1,m%LineList(I)%N m%LineList(I)%LineWrOutput(L) = m%LineList(I)%lstr(J)/m%LineList(I)%l(J) - 1.0 L = L+1 @@ -1324,7 +1555,7 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) END IF ! Segment strain rate - IF (m%LineList(I)%OutFlagList(9) == 1) THEN + IF (m%LineList(I)%OutFlagList(13) == 1) THEN DO J = 1,m%LineList(I)%N m%LineList(I)%LineWrOutput(L) = m%LineList(I)%lstrd(J)/m%LineList(I)%l(J) L = L+1 @@ -1332,13 +1563,14 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) END IF ! Segment length - IF (m%LineList(I)%OutFlagList(10) == 1) THEN + IF (m%LineList(I)%OutFlagList(14) == 1) THEN DO J = 1,m%LineList(I)%N m%LineList(I)%LineWrOutput(L) = m%LineList(I)%lstr(J) L = L+1 END DO END IF + WRITE(m%LineList(I)%LineUnOut,Frmt) Time, ( p%Delim, m%LineList(I)%LineWrOutput(J), J=1,(LineNumOuts) ) !WRITE(m%LineList(I)%LineUnOut,Frmt) Time, ( p%Delim, m%LineList(I)%LineWrOutput(J), J=1,(3+3*m%LineList(I)%N) ) @@ -1346,9 +1578,178 @@ SUBROUTINE MDIO_WriteOutputs( Time, p, m, y, ErrStat, ErrMsg ) END IF ! if line output file flag is on END DO ! I + + + + !------------------------------------------------------------------------ + ! now do the outputs for each Rod! + + DO I=1,p%NRods + + IF (m%RodList(I)%OutFlagList(1) == 1) THEN ! only proceed if the line is flagged to output a file + + ! calculate number of output entries to write for this Rod + RodNumOuts = 3*(m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(2:9)) & + + (m%RodList(I)%N + 1)*SUM(m%RodList(I)%OutFlagList(10:11)) & + + m%RodList(I)%N*SUM(m%RodList(I)%OutFlagList(12:18)) + + + Frmt = '(F10.4,'//TRIM(Int2LStr(RodNumOuts))//'(A1,e12.5))' ! should evenutally use user specified format? + + L = 1 ! start of index of line output file at first entry + + ! Time + ! m%RodList(I)%RodWrOutput(L) = Time + ! L = L+1 + + ! Node positions + IF (m%RodList(I)%OutFlagList(2) == 1) THEN + DO J = 0,m%RodList(I)%N ! note index starts at zero because these are nodes + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%r(K,J) + L = L+1 + END DO + END DO + END IF + + ! Node velocities + IF (m%RodList(I)%OutFlagList(3) == 1) THEN + DO J = 0,m%RodList(I)%N ! note index starts at zero because these are nodes + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%rd(K,J) + L = L+1 + END DO + END DO + END IF + + + ! Node wave velocities (not implemented yet) + IF (m%RodList(I)%OutFlagList(4) == 1) THEN + DO J = 0,m%RodList(I)%N ! note index starts at zero because these are nodes + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%U(K,J) + L = L+1 + END DO + END DO + END IF + + ! Node buoyancy forces + IF (m%RodList(I)%OutFlagList(5) == 1) THEN + DO J = 0,m%RodList(I)%N ! note index starts at zero because these are nodes + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%Bo(K,J) + L = L+1 + END DO + END DO + END IF + + ! Node drag forces + IF (m%RodList(I)%OutFlagList(6) == 1) THEN + DO J = 0,m%RodList(I)%N ! note index starts at zero because these are nodes + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%Dp(K,J) + m%RodList(I)%Dq(K,J) + L = L+1 + END DO + END DO + END IF + + ! Node inertia forces + IF (m%RodList(I)%OutFlagList(7) == 1) THEN + DO J = 0,m%RodList(I)%N ! note index starts at zero because these are nodes + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%Ap(K,J) + m%RodList(I)%Aq(K,J) + L = L+1 + END DO + END DO + END IF + + ! Node dynamic pressure forces + IF (m%RodList(I)%OutFlagList(8) == 1) THEN + DO J = 0,m%RodList(I)%N ! note index starts at zero because these are nodes + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%Pd(K,J) + L = L+1 + END DO + END DO + END IF + + ! Node seabed contact force + IF (m%RodList(I)%OutFlagList(9) == 1) THEN + DO J = 0,m%RodList(I)%N + DO K = 1,3 + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%B(K,J) + L = L+1 + END DO + END DO + END IF + + + ! Node weights + IF (m%RodList(I)%OutFlagList(10) == 1) THEN + DO J = 0,m%RodList(I)%N + m%RodList(I)%RodWrOutput(L) = m%RodList(I)%W(3,J) + L = L+1 + END DO + END IF + + ! ! Node curvatures + ! IF (m%RodList(I)%OutFlagList(8) == 1) THEN + ! DO J = 0,m%RodList(I)%N + ! m%RodList(I)%RodWrOutput(L) = m%RodList(I)%W(3,J) + ! L = L+1 + ! END DO + ! END IF + + + ! Segment tension force (excludes damping term, just EA) + ! N/A + + ! Segment internal damping force + ! N/A + + ! Segment strain + ! N/A + + ! Segment strain rate + ! N/A + + + WRITE(m%RodList(I)%RodUnOut,Frmt) Time, ( p%Delim, m%RodList(I)%RodWrOutput(J), J=1,(RodNumOuts) ) + + END IF ! if line output file flag is on + + END DO ! I END SUBROUTINE MDIO_WriteOutputs - !==================================================================================================== + !----------------------------------------------------------------------------------------============ + + + ! get tension at any node including fairlead or anchor (accounting for weight in these latter cases) + !-------------------------------------------------------------- + FUNCTION Line_GetNodeTen(Line, i, p) result(NodeTen) + + TYPE(MD_Line), INTENT(IN ) :: Line ! label for the current line, for convenience + INTEGER(IntKi), INTENT(IN ) :: i ! node index to get tension at + TYPE(MD_ParameterType), INTENT(IN ) :: p ! Parameters + REAL(DbKi) :: NodeTen ! returned calculation of tension at node + + INTEGER(IntKi) :: J + REAL(DbKi) :: Tmag_squared + + if (i==0) then + NodeTen = sqrt( Line%Fnet(1,i)**2 + Line%Fnet(2,i)**2 + Line%Fnet(3,i)**2 ) ! if an end node, use Fnet which already includes weight + else if (i==Line%N) then + NodeTen = sqrt( Line%Fnet(1,i)**2 + Line%Fnet(2,i)**2 + Line%Fnet(3,i)**2 ) + else + Tmag_squared = 0.0_DbKi + DO J=1,3 + Tmag_squared = Tmag_squared + 0.25*(Line%T(J,i) + Line%Td(J,i) + Line%T(J,i+1) + Line%Td(J,i+1))**2 ! take average of tension in adjacent segments + END DO + NodeTen = sqrt(Tmag_squared) + end if + + END FUNCTION Line_GetNodeTen + !-------------------------------------------------------------- END MODULE MoorDyn_IO diff --git a/modules/moordyn/src/MoorDyn_Line.f90 b/modules/moordyn/src/MoorDyn_Line.f90 new file mode 100644 index 0000000000..0974a2c092 --- /dev/null +++ b/modules/moordyn/src/MoorDyn_Line.f90 @@ -0,0 +1,1634 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2020-2021 Alliance for Sustainable Energy, LLC +! Copyright (C) 2015-2019 Matthew Hall +! +! This file is part of MoorDyn. +! +! 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 MoorDyn_Line + + USE MoorDyn_Types + USE MoorDyn_IO + USE NWTC_Library + USE MoorDyn_Misc + + IMPLICIT NONE + + PRIVATE + + INTEGER(IntKi), PARAMETER :: wordy = 0 ! verbosity level. >1 = more console output + + PUBLIC :: SetupLine + PUBLIC :: Line_Initialize + PUBLIC :: Line_SetState + PUBLIC :: Line_GetStateDeriv + PUBLIC :: Line_SetEndKinematics + PUBLIC :: Line_GetEndStuff + PUBLIC :: Line_GetEndSegmentInfo + PUBLIC :: Line_SetEndOrientation + + + +CONTAINS + + + !----------------------------------------------------------------------- + ! >>>>>>>>>>>>>> rename/reorganize this subroutine >>>>>>>>>>>>> + SUBROUTINE SetupLine (Line, LineProp, p, ErrStat, ErrMsg) + ! allocate arrays in line object + + TYPE(MD_Line), INTENT(INOUT) :: Line ! the single line object of interest + TYPE(MD_LineProp), INTENT(INOUT) :: LineProp ! the single line property set for the line of interest + TYPE(MD_ParameterType), INTENT(IN ) :: p ! Parameters + INTEGER, INTENT( INOUT ) :: ErrStat ! returns a non-zero value when an error occurs + CHARACTER(*), INTENT( INOUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + INTEGER(4) :: I, J, K ! Generic index + INTEGER(IntKi) :: N + REAL(DbKi) :: temp + + + N = Line%N ! number of segments in this line (for code readability) + + ! -------------- save some section properties to the line object itself ----------------- + + Line%d = LineProp%d + Line%rho = LineProp%w/(Pi/4.0 * Line%d * Line%d) + + Line%EA = LineProp%EA + ! note: Line%BA is set later + Line%EA_D = LineProp%EA_D + Line%BA_D = LineProp%BA_D + Line%EI = LineProp%EI !<<< for bending stiffness + + Line%Can = LineProp%Can + Line%Cat = LineProp%Cat + Line%Cdn = LineProp%Cdn + Line%Cdt = LineProp%Cdt + + ! copy over elasticity data + Line%ElasticMod = LineProp%ElasticMod + + Line%nEApoints = LineProp%nEApoints + DO I = 1,Line%nEApoints + Line%stiffXs(I) = LineProp%stiffXs(I) + Line%stiffYs(I) = LineProp%stiffYs(I) ! note: this does not convert to E (not EA) like done in C version + END DO + + Line%nBApoints = LineProp%nBApoints + DO I = 1,Line%nBApoints + Line%dampXs(I) = LineProp%dampXs(I) + Line%dampYs(I) = LineProp%dampYs(I) + END DO + + Line%nEIpoints = LineProp%nEIpoints + DO I = 1,Line%nEIpoints + Line%bstiffXs(I) = LineProp%bstiffXs(I) + Line%bstiffYs(I) = LineProp%bstiffYs(I) ! copy over + END DO + + + + ! Specify specific internal damping coefficient (BA) for this line. + ! Will be equal to inputted BA of LineType if input value is positive. + ! If input value is negative, it is considered to be desired damping ratio (zeta) + ! from which the line's BA can be calculated based on the segment natural frequency. + IF (LineProp%BA < 0) THEN + ! - we assume desired damping coefficient is zeta = -LineProp%BA + ! - highest axial vibration mode of a segment is wn = sqrt(k/m) = 2N/UnstrLen*sqrt(EA/w) + Line%BA = -LineProp%BA * Line%UnstrLen / Line%N * SQRT(LineProp%EA * LineProp%w) + IF (wordy > 1) print *, 'Based on zeta, BA set to ', Line%BA + + IF (wordy > 1) print *, 'Negative BA input detected, treating as -zeta. For zeta = ', -LineProp%BA, ', setting BA to ', Line%BA + + ELSE + Line%BA = LineProp%BA + IF (wordy > 1) temp = Line%N * Line%BA / Line%UnstrLen * SQRT(1.0/(LineProp%EA * LineProp%w)) + IF (wordy > 1) print *, 'BA set as input to ', Line%BA, '. Corresponding zeta is ', temp + END IF + + !temp = 2*Line%N / Line%UnstrLen * sqrt( LineProp%EA / LineProp%w) / TwoPi + !print *, 'Segment natural frequency is ', temp, ' Hz' + + + !print *, "Line ElasticMod is ", Line%ElasticMod + !print *, "EA (static value) is", Line%EA + !print *, "EA_D is", Line%EA_D + !print *, "BA is", Line%BA + !print *, "BA_D is", Line%BA_D + + + ! allocate node positions and velocities (NOTE: these arrays start at ZERO) + ALLOCATE ( Line%r(3, 0:N), Line%rd(3, 0:N), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating r and rd arrays.' + !CALL CleanUp() + RETURN + END IF + + ! if using viscoelastic model, allocate additional state quantities + if (Line%ElasticMod == 2) then + ALLOCATE ( Line%dl_1(N), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating dl_1 array.' + !CALL CleanUp() + RETURN + END IF + ! initialize to zero + Line%dl_1 = 0.0_DbKi + end if + + ! allocate node and segment tangent vectors + ALLOCATE ( Line%q(3, 0:N), Line%qs(3, N), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating q or qs array.' + !CALL CleanUp() + RETURN + END IF + + ! allocate segment scalar quantities + ALLOCATE ( Line%l(N), Line%ld(N), Line%lstr(N), Line%lstrd(N), Line%Kurv(0:N), Line%V(N), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating segment scalar quantity arrays.' + !CALL CleanUp() + RETURN + END IF + Line%Kurv = 0.0_DbKi + + ! assign values for l, ld, and V + DO J=1,N + Line%l(J) = Line%UnstrLen/REAL(N, DbKi) + Line%ld(J)= 0.0_DbKi + Line%V(J) = Line%l(J)*0.25*Pi*LineProp%d*LineProp%d + END DO + + ! allocate water related vectors + ALLOCATE ( Line%U(3, 0:N), Line%Ud(3, 0:N), Line%zeta(0:N), Line%PDyn(0:N), STAT = ErrStat ) + ! set to zero initially (important of wave kinematics are not being used) + Line%U = 0.0_DbKi + Line%Ud = 0.0_DbKi + Line%zeta = 0.0_DbKi + Line%PDyn = 0.0_DbKi + + ! allocate segment tension and internal damping force vectors + ALLOCATE ( Line%T(3, N), Line%Td(3, N), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating T and Td arrays.' + !CALL CleanUp() + RETURN + END IF + + ! allocate node force vectors + ALLOCATE ( Line%W(3, 0:N), Line%Dp(3, 0:N), Line%Dq(3, 0:N), Line%Ap(3, 0:N), & + Line%Aq(3, 0:N), Line%B(3, 0:N), Line%Bs(3, 0:N), Line%Fnet(3, 0:N), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating node force arrays.' + !CALL CleanUp() + RETURN + END IF + + ! set gravity and bottom contact forces to zero initially (because the horizontal components should remain at zero) + Line%W = 0.0_DbKi + Line%B = 0.0_DbKi + + ! allocate mass and inverse mass matrices for each node (including ends) + ALLOCATE ( Line%S(3, 3, 0:N), Line%M(3, 3, 0:N), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating T and Td arrays.' + !CALL CleanUp() + RETURN + END IF + + + if (p%writeLog > 1) then + write(p%UnLog, '(A)') " - Line"//trim(num2lstr(Line%IdNum)) + write(p%UnLog, '(A)') " ID: "//trim(num2lstr(Line%IdNum)) + write(p%UnLog, '(A)') " UnstrLen: "//trim(num2lstr(Line%UnstrLen)) + write(p%UnLog, '(A)') " N : "//trim(num2lstr(Line%N )) + write(p%UnLog, '(A)') " d : "//trim(num2lstr(Line%d )) + write(p%UnLog, '(A)') " rho : "//trim(num2lstr(Line%rho )) + write(p%UnLog, '(A)') " E : "//trim(num2lstr(Line%EA )) + write(p%UnLog, '(A)') " EI : "//trim(num2lstr(Line%EI )) + !write(p%UnLog, '(A)') " BAin: "//trim(num2lstr(Line%BAin)) + write(p%UnLog, '(A)') " Can : "//trim(num2lstr(Line%Can )) + write(p%UnLog, '(A)') " Cat : "//trim(num2lstr(Line%Cat )) + write(p%UnLog, '(A)') " Cdn : "//trim(num2lstr(Line%Cdn )) + write(p%UnLog, '(A)') " Cdt : "//trim(num2lstr(Line%Cdt )) + !write(p%UnLog, '(A)') " ww_l: " << ( (rho - env->rho_w)*(pi/4.*d*d) )*9.81 << endl; + end if + + + ! need to add cleanup sub <<< + + + END SUBROUTINE SetupLine + !-------------------------------------------------------------- + + + + + + !----------------------------------------------------------------------------------------======= + SUBROUTINE Line_Initialize (Line, LineProp, rhoW, ErrStat, ErrMsg) + ! calculate initial profile of the line using quasi-static model + + TYPE(MD_Line), INTENT(INOUT) :: Line ! the single line object of interest + TYPE(MD_LineProp), INTENT(INOUT) :: LineProp ! the single line property set for the line of interest + REAL(DbKi), INTENT(IN) :: rhoW + INTEGER, INTENT( INOUT ) :: ErrStat ! returns a non-zero value when an error occurs + CHARACTER(*), INTENT( INOUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + REAL(DbKi) :: COSPhi ! Cosine of the angle between the xi-axis of the inertia frame and the X-axis of the local coordinate system of the current mooring line (-) + REAL(DbKi) :: SINPhi ! Sine of the angle between the xi-axis of the inertia frame and the X-axis of the local coordinate system of the current mooring line (-) + REAL(DbKi) :: XF ! Horizontal distance between anchor and fairlead of the current mooring line (meters) + REAL(DbKi) :: ZF ! Vertical distance between anchor and fairlead of the current mooring line (meters) + INTEGER(4) :: I ! Generic index + INTEGER(4) :: J ! Generic index + + + INTEGER(IntKi) :: ErrStat2 ! Error status of the operation + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None + REAL(DbKi) :: WetWeight + REAL(DbKi) :: SeabedCD = 0.0_DbKi + REAL(DbKi) :: TenTol = 0.0001_DbKi + REAL(DbKi), ALLOCATABLE :: LSNodes(:) + REAL(DbKi), ALLOCATABLE :: LNodesX(:) + REAL(DbKi), ALLOCATABLE :: LNodesZ(:) + INTEGER(IntKi) :: N + + + N = Line%N ! for convenience + + ! try to calculate initial line profile using catenary routine (from FAST v.7) + ! note: much of this function is adapted from the FAST source code + + ! Transform the fairlead location from the inertial frame coordinate system + ! to the local coordinate system of the current line (this coordinate + ! system lies at the current anchor, Z being vertical, and X directed from + ! current anchor to the current fairlead). Also, compute the orientation + ! of this local coordinate system: + + XF = SQRT( ( Line%r(1,N) - Line%r(1,0) )**2.0 + ( Line%r(2,N) - Line%r(2,0) )**2.0 ) + ZF = Line%r(3,N) - Line%r(3,0) + + IF ( XF == 0.0 ) THEN ! .TRUE. if the current mooring line is exactly vertical; thus, the solution below is ill-conditioned because the orientation is undefined; so set it such that the tensions and nodal positions are only vertical + COSPhi = 0.0_DbKi + SINPhi = 0.0_DbKi + ELSE ! The current mooring line must not be vertical; use simple trigonometry + COSPhi = ( Line%r(1,N) - Line%r(1,0) )/XF + SINPhi = ( Line%r(2,N) - Line%r(2,0) )/XF + ENDIF + + WetWeight = LineProp%w - 0.25*Pi*LineProp%d*LineProp%d*rhoW + + !LineNodes = Line%N + 1 ! number of nodes in line for catenary model to worry about + + ! allocate temporary arrays for catenary routine + ALLOCATE ( LSNodes(N+1), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating LSNodes array.' + CALL CleanUp() + RETURN + END IF + + ALLOCATE ( LNodesX(N+1), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating LNodesX array.' + CALL CleanUp() + RETURN + END IF + + ALLOCATE ( LNodesZ(N+1), STAT = ErrStat ) + IF ( ErrStat /= ErrID_None ) THEN + ErrMsg = ' Error allocating LNodesZ array.' + CALL CleanUp() + RETURN + END IF + + ! Assign node arc length locations + LSNodes(1) = 0.0_DbKi + DO I=2,N + LSNodes(I) = LSNodes(I-1) + Line%l(I-1) ! note: l index is because line segment indices start at 1 + END DO + LSNodes(N+1) = Line%UnstrLen ! ensure the last node length isn't longer than the line due to numerical error + + ! Solve the analytical, static equilibrium equations for a catenary (or + ! taut) mooring line with seabed interaction in order to find the + ! horizontal and vertical tensions at the fairlead in the local coordinate + ! system of the current line: + ! NOTE: The values for the horizontal and vertical tensions at the fairlead + ! from the previous time step are used as the initial guess values at + ! at this time step (because the LAnchHTe(:) and LAnchVTe(:) arrays + ! are stored in a module and thus their values are saved from CALL to + ! CALL). + + + CALL Catenary ( XF , ZF , Line%UnstrLen, LineProp%EA , & + WetWeight , SeabedCD, TenTol, (N+1) , & + LSNodes, LNodesX, LNodesZ , ErrStat2, ErrMsg2) + + IF (ErrStat2 == ErrID_None) THEN ! if it worked, use it + ! Transform the positions of each node on the current line from the local + ! coordinate system of the current line to the inertial frame coordinate + ! system: + + DO J = 0,N ! Loop through all nodes per line where the line position and tension can be output + Line%r(1,J) = Line%r(1,0) + LNodesX(J+1)*COSPhi + Line%r(2,J) = Line%r(2,0) + LNodesX(J+1)*SINPhi + Line%r(3,J) = Line%r(3,0) + LNodesZ(J+1) + ENDDO ! J - All nodes per line where the line position and tension can be output + + + ELSE ! if there is a problem with the catenary approach, just stretch the nodes linearly between fairlead and anchor + + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'Line_Initialize') + +! print *, "Node positions: " + + DO J = 0,N ! Loop through all nodes per line where the line position and tension can be output + Line%r(1,J) = Line%r(1,0) + (Line%r(1,N) - Line%r(1,0))*REAL(J, DbKi)/REAL(N, DbKi) + Line%r(2,J) = Line%r(2,0) + (Line%r(2,N) - Line%r(2,0))*REAL(J, DbKi)/REAL(N, DbKi) + Line%r(3,J) = Line%r(3,0) + (Line%r(3,N) - Line%r(3,0))*REAL(J, DbKi)/REAL(N, DbKi) + +! print*, Line%r(:,J) + ENDDO + +! print*,"FYI line end A and B node coords are" +! print*, Line%r(:,0) +! print*, Line%r(:,N) + ENDIF + + + + CALL CleanUp() ! deallocate temporary arrays + + + + CONTAINS + + + !----------------------------------------------------------------------- + SUBROUTINE CleanUp() + ! deallocate temporary arrays + + IF (ALLOCATED(LSNodes)) DEALLOCATE(LSNodes) + IF (ALLOCATED(LNodesX)) DEALLOCATE(LNodesX) + IF (ALLOCATED(LNodesZ)) DEALLOCATE(LNodesZ) + + END SUBROUTINE CleanUp + !----------------------------------------------------------------------- + + + !----------------------------------------------------------------------- + SUBROUTINE Catenary ( XF_In, ZF_In, L_In , EA_In, & + W_In , CB_In, Tol_In, N , & + s_In , X_In , Z_In , ErrStat, ErrMsg ) + + ! This subroutine is copied from FAST v7 with minor modifications + + ! This routine solves the analytical, static equilibrium equations + ! for a catenary (or taut) mooring line with seabed interaction. + ! Stretching of the line is accounted for, but bending stiffness + ! is not. Given the mooring line properties and the fairlead + ! position relative to the anchor, this routine finds the line + ! configuration and tensions. Since the analytical solution + ! involves two nonlinear equations (XF and ZF) in two unknowns + ! (HF and VF), a Newton-Raphson iteration scheme is implemented in + ! order to solve for the solution. The values of HF and VF that + ! are passed into this routine are used as the initial guess in + ! the iteration. The Newton-Raphson iteration is only accurate in + ! double precision, so all of the input/output arguments are + ! converteds to/from double precision from/to default precision. + + ! >>>> TO DO: streamline this function, if it's still to be used at all <<<< + + ! USE Precision + + + IMPLICIT NONE + + + ! Passed Variables: + + INTEGER(4), INTENT(IN ) :: N ! Number of nodes where the line position and tension can be output (-) + + REAL(DbKi), INTENT(IN ) :: CB_In ! Coefficient of seabed static friction drag (a negative value indicates no seabed) (-) + REAL(DbKi), INTENT(IN ) :: EA_In ! Extensional stiffness of line (N) + ! REAL(DbKi), INTENT( OUT) :: HA_In ! Effective horizontal tension in line at the anchor (N) + ! REAL(DbKi), INTENT(INOUT) :: HF_In ! Effective horizontal tension in line at the fairlead (N) + REAL(DbKi), INTENT(IN ) :: L_In ! Unstretched length of line (meters) + REAL(DbKi), INTENT(IN ) :: s_In (N) ! Unstretched arc distance along line from anchor to each node where the line position and tension can be output (meters) + ! REAL(DbKi), INTENT( OUT) :: Te_In (N) ! Effective line tensions at each node (N) + REAL(DbKi), INTENT(IN ) :: Tol_In ! Convergence tolerance within Newton-Raphson iteration specified as a fraction of tension (-) + ! REAL(DbKi), INTENT( OUT) :: VA_In ! Effective vertical tension in line at the anchor (N) + ! REAL(DbKi), INTENT(INOUT) :: VF_In ! Effective vertical tension in line at the fairlead (N) + REAL(DbKi), INTENT(IN ) :: W_In ! Weight of line in fluid per unit length (N/m) + REAL(DbKi), INTENT( OUT) :: X_In (N) ! Horizontal locations of each line node relative to the anchor (meters) + REAL(DbKi), INTENT(IN ) :: XF_In ! Horizontal distance between anchor and fairlead (meters) + REAL(DbKi), INTENT( OUT) :: Z_In (N) ! Vertical locations of each line node relative to the anchor (meters) + REAL(DbKi), INTENT(IN ) :: ZF_In ! Vertical distance between anchor and fairlead (meters) + INTEGER, INTENT( OUT ) :: ErrStat ! returns a non-zero value when an error occurs + CHARACTER(*), INTENT( OUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + + ! Local Variables: + + REAL(DbKi) :: CB ! Coefficient of seabed static friction (a negative value indicates no seabed) (-) + REAL(DbKi) :: CBOvrEA ! = CB/EA + REAL(DbKi) :: DET ! Determinant of the Jacobian matrix (m^2/N^2) + REAL(DbKi) :: dHF ! Increment in HF predicted by Newton-Raphson (N) + REAL(DbKi) :: dVF ! Increment in VF predicted by Newton-Raphson (N) + REAL(DbKi) :: dXFdHF ! Partial derivative of the calculated horizontal distance with respect to the horizontal fairlead tension (m/N): dXF(HF,VF)/dHF + REAL(DbKi) :: dXFdVF ! Partial derivative of the calculated horizontal distance with respect to the vertical fairlead tension (m/N): dXF(HF,VF)/dVF + REAL(DbKi) :: dZFdHF ! Partial derivative of the calculated vertical distance with respect to the horizontal fairlead tension (m/N): dZF(HF,VF)/dHF + REAL(DbKi) :: dZFdVF ! Partial derivative of the calculated vertical distance with respect to the vertical fairlead tension (m/N): dZF(HF,VF)/dVF + REAL(DbKi) :: EA ! Extensional stiffness of line (N) + REAL(DbKi) :: EXF ! Error function between calculated and known horizontal distance (meters): XF(HF,VF) - XF + REAL(DbKi) :: EZF ! Error function between calculated and known vertical distance (meters): ZF(HF,VF) - ZF + REAL(DbKi) :: HA ! Effective horizontal tension in line at the anchor (N) + REAL(DbKi) :: HF ! Effective horizontal tension in line at the fairlead (N) + REAL(DbKi) :: HFOvrW ! = HF/W + REAL(DbKi) :: HFOvrWEA ! = HF/WEA + REAL(DbKi) :: L ! Unstretched length of line (meters) + REAL(DbKi) :: Lamda0 ! Catenary parameter used to generate the initial guesses of the horizontal and vertical tensions at the fairlead for the Newton-Raphson iteration (-) + REAL(DbKi) :: LMax ! Maximum stretched length of the line with seabed interaction beyond which the line would have to double-back on itself; here the line forms an "L" between the anchor and fairlead (i.e. it is horizontal along the seabed from the anchor, then vertical to the fairlead) (meters) + REAL(DbKi) :: LMinVFOvrW ! = L - VF/W + REAL(DbKi) :: LOvrEA ! = L/EA + REAL(DbKi) :: s (N) ! Unstretched arc distance along line from anchor to each node where the line position and tension can be output (meters) + REAL(DbKi) :: sOvrEA ! = s(I)/EA + REAL(DbKi) :: SQRT1VFOvrHF2 ! = SQRT( 1.0_DbKi + VFOvrHF2 ) + REAL(DbKi) :: SQRT1VFMinWLOvrHF2 ! = SQRT( 1.0_DbKi + VFMinWLOvrHF2 ) + REAL(DbKi) :: SQRT1VFMinWLsOvrHF2 ! = SQRT( 1.0_DbKi + VFMinWLsOvrHF*VFMinWLsOvrHF ) + REAL(DbKi) :: Te (N) ! Effective line tensions at each node (N) + REAL(DbKi) :: Tol ! Convergence tolerance within Newton-Raphson iteration specified as a fraction of tension (-) + REAL(DbKi) :: VA ! Effective vertical tension in line at the anchor (N) + REAL(DbKi) :: VF ! Effective vertical tension in line at the fairlead (N) + REAL(DbKi) :: VFMinWL ! = VF - WL + REAL(DbKi) :: VFMinWLOvrHF ! = VFMinWL/HF + REAL(DbKi) :: VFMinWLOvrHF2 ! = VFMinWLOvrHF*VFMinWLOvrHF + REAL(DbKi) :: VFMinWLs ! = VFMinWL + Ws + REAL(DbKi) :: VFMinWLsOvrHF ! = VFMinWLs/HF + REAL(DbKi) :: VFOvrHF ! = VF/HF + REAL(DbKi) :: VFOvrHF2 ! = VFOvrHF*VFOvrHF + REAL(DbKi) :: VFOvrWEA ! = VF/WEA + REAL(DbKi) :: W ! Weight of line in fluid per unit length (N/m) + REAL(DbKi) :: WEA ! = W*EA + REAL(DbKi) :: WL ! Total weight of line in fluid (N): W*L + REAL(DbKi) :: Ws ! = W*s(I) + REAL(DbKi) :: X (N) ! Horizontal locations of each line node relative to the anchor (meters) + REAL(DbKi) :: XF ! Horizontal distance between anchor and fairlead (meters) + REAL(DbKi) :: XF2 ! = XF*XF + REAL(DbKi) :: Z (N) ! Vertical locations of each line node relative to the anchor (meters) + REAL(DbKi) :: ZF ! Vertical distance between anchor and fairlead (meters) + REAL(DbKi) :: ZF2 ! = ZF*ZF + + INTEGER(4) :: I ! Index for counting iterations or looping through line nodes (-) + INTEGER(4) :: MaxIter ! Maximum number of Newton-Raphson iterations possible before giving up (-) + + LOGICAL :: FirstIter ! Flag to determine whether or not this is the first time through the Newton-Raphson interation (flag) + + + ErrStat = ERrId_None + + + ! The Newton-Raphson iteration is only accurate in double precision, so + ! convert the input arguments into double precision: + + CB = REAL( CB_In , DbKi ) + EA = REAL( EA_In , DbKi ) + HF = 0.0_DbKi ! = REAL( HF_In , DbKi ) + L = REAL( L_In , DbKi ) + s (:) = REAL( s_In (:), DbKi ) + Tol = REAL( Tol_In , DbKi ) + VF = 0.0_DbKi ! keeping this for some error catching functionality? (at first glance) ! VF = REAL( VF_In , DbKi ) + W = REAL( W_In , DbKi ) + XF = REAL( XF_In , DbKi ) + ZF = REAL( ZF_In , DbKi ) + + + + ! HF and VF cannot be initialized to zero when a portion of the line rests on the seabed and the anchor tension is nonzero + + ! Generate the initial guess values for the horizontal and vertical tensions + ! at the fairlead in the Newton-Raphson iteration for the catenary mooring + ! line solution. Use starting values documented in: Peyrot, Alain H. and + ! Goulois, A. M., "Analysis Of Cable Structures," Computers & Structures, + ! Vol. 10, 1979, pp. 805-813: + XF2 = XF*XF + ZF2 = ZF*ZF + + IF ( XF == 0.0_DbKi ) THEN ! .TRUE. if the current mooring line is exactly vertical + Lamda0 = 1.0D+06 + ELSEIF ( L <= SQRT( XF2 + ZF2 ) ) THEN ! .TRUE. if the current mooring line is taut + Lamda0 = 0.2_DbKi + ELSE ! The current mooring line must be slack and not vertical + Lamda0 = SQRT( 3.0_DbKi*( ( L**2 - ZF2 )/XF2 - 1.0_DbKi ) ) + ENDIF + + HF = ABS( 0.5_DbKi*W* XF/ Lamda0 ) + VF = 0.5_DbKi*W*( ZF/TANH(Lamda0) + L ) + + + ! Abort when there is no solution or when the only possible solution is + ! illogical: + + IF ( Tol <= EPSILON(TOL) ) THEN ! .TRUE. when the convergence tolerance is specified incorrectly + ErrStat = ErrID_Warn + ErrMsg = ' Convergence tolerance must be greater than zero in routine Catenary().' + return + ELSEIF ( XF < 0.0_DbKi ) THEN ! .TRUE. only when the local coordinate system is not computed correctly + ErrStat = ErrID_Warn + ErrMsg = ' The horizontal distance between an anchor and its'// & + ' fairlead must not be less than zero in routine Catenary().' + return + + ELSEIF ( ZF < 0.0_DbKi ) THEN ! .TRUE. if the fairlead has passed below its anchor + ErrStat = ErrID_Warn + ErrMsg = " A line's fairlead is defined as below its anchor. You may need to swap a line's fairlead and anchor end nodes." + return + + ELSEIF ( L <= 0.0_DbKi ) THEN ! .TRUE. when the unstretched line length is specified incorrectly + ErrStat = ErrID_Warn + ErrMsg = ' Unstretched length of line must be greater than zero in routine Catenary().' + return + + ELSEIF ( EA <= 0.0_DbKi ) THEN ! .TRUE. when the unstretched line length is specified incorrectly + ErrStat = ErrID_Warn + ErrMsg = ' Extensional stiffness of line must be greater than zero in routine Catenary().' + return + + ELSEIF ( W == 0.0_DbKi ) THEN ! .TRUE. when the weight of the line in fluid is zero so that catenary solution is ill-conditioned + ErrStat = ErrID_Warn + ErrMsg = ' The weight of the line in fluid must not be zero. '// & + ' Routine Catenary() cannot solve quasi-static mooring line solution.' + return + + + ELSEIF ( W > 0.0_DbKi ) THEN ! .TRUE. when the line will sink in fluid + + LMax = XF - EA/W + SQRT( (EA/W)*(EA/W) + 2.0_DbKi*ZF*EA/W ) ! Compute the maximum stretched length of the line with seabed interaction beyond which the line would have to double-back on itself; here the line forms an "L" between the anchor and fairlead (i.e. it is horizontal along the seabed from the anchor, then vertical to the fairlead) + + IF ( ( L >= LMax ) .AND. ( CB >= 0.0_DbKi ) ) then ! .TRUE. if the line is as long or longer than its maximum possible value with seabed interaction + ErrStat = ErrID_Warn + ErrMsg = ' Unstretched mooring line length too large. '// & + ' Routine Catenary() cannot solve quasi-static mooring line solution.' + return + END IF + + ENDIF + + + ! Initialize some commonly used terms that don't depend on the iteration: + + WL = W *L + WEA = W *EA + LOvrEA = L /EA + CBOvrEA = CB /EA + MaxIter = INT(1.0_DbKi/Tol) ! Smaller tolerances may take more iterations, so choose a maximum inversely proportional to the tolerance + + + + ! To avoid an ill-conditioned situation, ensure that the initial guess for + ! HF is not less than or equal to zero. Similarly, avoid the problems + ! associated with having exactly vertical (so that HF is zero) or exactly + ! horizontal (so that VF is zero) lines by setting the minimum values + ! equal to the tolerance. This prevents us from needing to implement + ! the known limiting solutions for vertical or horizontal lines (and thus + ! complicating this routine): + + HF = MAX( HF, Tol ) + XF = MAX( XF, Tol ) + ZF = MAX( ZF, TOl ) + + + + ! Solve the analytical, static equilibrium equations for a catenary (or + ! taut) mooring line with seabed interaction: + + ! Begin Newton-Raphson iteration: + + I = 1 ! Initialize iteration counter + FirstIter = .TRUE. ! Initialize iteration flag + + DO + + + ! Initialize some commonly used terms that depend on HF and VF: + + VFMinWL = VF - WL + LMinVFOvrW = L - VF/W + HFOvrW = HF/W + HFOvrWEA = HF/WEA + VFOvrWEA = VF/WEA + VFOvrHF = VF/HF + VFMinWLOvrHF = VFMinWL/HF + VFOvrHF2 = VFOvrHF *VFOvrHF + VFMinWLOvrHF2 = VFMinWLOvrHF*VFMinWLOvrHF + SQRT1VFOvrHF2 = SQRT( 1.0_DbKi + VFOvrHF2 ) + SQRT1VFMinWLOvrHF2 = SQRT( 1.0_DbKi + VFMinWLOvrHF2 ) + + + ! Compute the error functions (to be zeroed) and the Jacobian matrix + ! (these depend on the anticipated configuration of the mooring line): + + IF ( ( CB < 0.0_DbKi ) .OR. ( W < 0.0_DbKi ) .OR. ( VFMinWL > 0.0_DbKi ) ) THEN ! .TRUE. when no portion of the line rests on the seabed + + EXF = ( LOG( VFOvrHF + SQRT1VFOvrHF2 ) & + - LOG( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )*HFOvrW & + + LOvrEA* HF - XF + EZF = ( SQRT1VFOvrHF2 & + - SQRT1VFMinWLOvrHF2 )*HFOvrW & + + LOvrEA*( VF - 0.5_DbKi*WL ) - ZF + + dXFdHF = ( LOG( VFOvrHF + SQRT1VFOvrHF2 ) & + - LOG( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )/ W & + - ( ( VFOvrHF + VFOvrHF2 /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) & + - ( VFMinWLOvrHF + VFMinWLOvrHF2/SQRT1VFMinWLOvrHF2 )/( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )/ W & + + LOvrEA + dXFdVF = ( ( 1.0_DbKi + VFOvrHF /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) & + - ( 1.0_DbKi + VFMinWLOvrHF /SQRT1VFMinWLOvrHF2 )/( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )/ W + dZFdHF = ( SQRT1VFOvrHF2 & + - SQRT1VFMinWLOvrHF2 )/ W & + - ( VFOvrHF2 /SQRT1VFOvrHF2 & + - VFMinWLOvrHF2/SQRT1VFMinWLOvrHF2 )/ W + dZFdVF = ( VFOvrHF /SQRT1VFOvrHF2 & + - VFMinWLOvrHF /SQRT1VFMinWLOvrHF2 )/ W & + + LOvrEA + + + ELSEIF ( -CB*VFMinWL < HF ) THEN ! .TRUE. when a portion of the line rests on the seabed and the anchor tension is nonzero + + EXF = LOG( VFOvrHF + SQRT1VFOvrHF2 ) *HFOvrW & + - 0.5_DbKi*CBOvrEA*W* LMinVFOvrW*LMinVFOvrW & + + LOvrEA* HF + LMinVFOvrW - XF + EZF = ( SQRT1VFOvrHF2 - 1.0_DbKi )*HFOvrW & + + 0.5_DbKi*VF*VFOvrWEA - ZF + + dXFdHF = LOG( VFOvrHF + SQRT1VFOvrHF2 ) / W & + - ( ( VFOvrHF + VFOvrHF2 /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) )/ W & + + LOvrEA + dXFdVF = ( ( 1.0_DbKi + VFOvrHF /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) )/ W & + + CBOvrEA*LMinVFOvrW - 1.0_DbKi/W + dZFdHF = ( SQRT1VFOvrHF2 - 1.0_DbKi & + - VFOvrHF2 /SQRT1VFOvrHF2 )/ W + dZFdVF = ( VFOvrHF /SQRT1VFOvrHF2 )/ W & + + VFOvrWEA + + + ELSE ! 0.0_DbKi < HF <= -CB*VFMinWL ! A portion of the line must rest on the seabed and the anchor tension is zero + + EXF = LOG( VFOvrHF + SQRT1VFOvrHF2 ) *HFOvrW & + - 0.5_DbKi*CBOvrEA*W*( LMinVFOvrW*LMinVFOvrW - ( LMinVFOvrW - HFOvrW/CB )*( LMinVFOvrW - HFOvrW/CB ) ) & + + LOvrEA* HF + LMinVFOvrW - XF + EZF = ( SQRT1VFOvrHF2 - 1.0_DbKi )*HFOvrW & + + 0.5_DbKi*VF*VFOvrWEA - ZF + + dXFdHF = LOG( VFOvrHF + SQRT1VFOvrHF2 ) / W & + - ( ( VFOvrHF + VFOvrHF2 /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) )/ W & + + LOvrEA - ( LMinVFOvrW - HFOvrW/CB )/EA + dXFdVF = ( ( 1.0_DbKi + VFOvrHF /SQRT1VFOvrHF2 )/( VFOvrHF + SQRT1VFOvrHF2 ) )/ W & + + HFOvrWEA - 1.0_DbKi/W + dZFdHF = ( SQRT1VFOvrHF2 - 1.0_DbKi & + - VFOvrHF2 /SQRT1VFOvrHF2 )/ W + dZFdVF = ( VFOvrHF /SQRT1VFOvrHF2 )/ W & + + VFOvrWEA + + + ENDIF + + + ! Compute the determinant of the Jacobian matrix and the incremental + ! tensions predicted by Newton-Raphson: + + + DET = dXFdHF*dZFdVF - dXFdVF*dZFdHF + + if ( EqualRealNos( DET, 0.0_DbKi ) ) then +!bjj: there is a serious problem with the debugger here when DET = 0 + ErrStat = ErrID_Warn + ErrMsg = ' Iteration not convergent (DET is 0). '// & + ' Routine Catenary() cannot solve quasi-static mooring line solution.' + return + endif + + + dHF = ( -dZFdVF*EXF + dXFdVF*EZF )/DET ! This is the incremental change in horizontal tension at the fairlead as predicted by Newton-Raphson + dVF = ( dZFdHF*EXF - dXFdHF*EZF )/DET ! This is the incremental change in vertical tension at the fairlead as predicted by Newton-Raphson + + dHF = dHF*( 1.0_DbKi - Tol*I ) ! Reduce dHF by factor (between 1 at I = 1 and 0 at I = MaxIter) that reduces linearly with iteration count to ensure that we converge on a solution even in the case were we obtain a nonconvergent cycle about the correct solution (this happens, for example, if we jump to quickly between a taut and slack catenary) + dVF = dVF*( 1.0_DbKi - Tol*I ) ! Reduce dHF by factor (between 1 at I = 1 and 0 at I = MaxIter) that reduces linearly with iteration count to ensure that we converge on a solution even in the case were we obtain a nonconvergent cycle about the correct solution (this happens, for example, if we jump to quickly between a taut and slack catenary) + + dHF = MAX( dHF, ( Tol - 1.0_DbKi )*HF ) ! To avoid an ill-conditioned situation, make sure HF does not go less than or equal to zero by having a lower limit of Tol*HF [NOTE: the value of dHF = ( Tol - 1.0_DbKi )*HF comes from: HF = HF + dHF = Tol*HF when dHF = ( Tol - 1.0_DbKi )*HF] + + ! Check if we have converged on a solution, or restart the iteration, or + ! Abort if we cannot find a solution: + + IF ( ( ABS(dHF) <= ABS(Tol*HF) ) .AND. ( ABS(dVF) <= ABS(Tol*VF) ) ) THEN ! .TRUE. if we have converged; stop iterating! [The converge tolerance, Tol, is a fraction of tension] + + EXIT + + + ELSEIF ( ( I == MaxIter ) .AND. ( FirstIter ) ) THEN ! .TRUE. if we've iterated MaxIter-times for the first time; + + ! Perhaps we failed to converge because our initial guess was too far off. + ! (This could happen, for example, while linearizing a model via large + ! pertubations in the DOFs.) Instead, use starting values documented in: + ! Peyrot, Alain H. and Goulois, A. M., "Analysis Of Cable Structures," + ! Computers & Structures, Vol. 10, 1979, pp. 805-813: + ! NOTE: We don't need to check if the current mooring line is exactly + ! vertical (i.e., we don't need to check if XF == 0.0), because XF is + ! limited by the tolerance above. + + XF2 = XF*XF + ZF2 = ZF*ZF + + IF ( L <= SQRT( XF2 + ZF2 ) ) THEN ! .TRUE. if the current mooring line is taut + Lamda0 = 0.2_DbKi + ELSE ! The current mooring line must be slack and not vertical + Lamda0 = SQRT( 3.0_DbKi*( ( L*L - ZF2 )/XF2 - 1.0_DbKi ) ) + ENDIF + + HF = MAX( ABS( 0.5_DbKi*W* XF/ Lamda0 ), Tol ) ! As above, set the lower limit of the guess value of HF to the tolerance + VF = 0.5_DbKi*W*( ZF/TANH(Lamda0) + L ) + + + ! Restart Newton-Raphson iteration: + + I = 0 + FirstIter = .FALSE. + dHF = 0.0_DbKi + dVF = 0.0_DbKi + + + ELSEIF ( ( I == MaxIter ) .AND. ( .NOT. FirstIter ) ) THEN ! .TRUE. if we've iterated as much as we can take without finding a solution; Abort + ErrStat = ErrID_Warn + ErrMsg = ' Iteration not convergent. '// & + ' Routine Catenary() cannot solve quasi-static mooring line solution.' + RETURN + + + ENDIF + + + ! Increment fairlead tensions and iteration counter so we can try again: + + HF = HF + dHF + VF = VF + dVF + + I = I + 1 + + + ENDDO + + + + ! We have found a solution for the tensions at the fairlead! + + ! Now compute the tensions at the anchor and the line position and tension + ! at each node (again, these depend on the configuration of the mooring + ! line): + + IF ( ( CB < 0.0_DbKi ) .OR. ( W < 0.0_DbKi ) .OR. ( VFMinWL > 0.0_DbKi ) ) THEN ! .TRUE. when no portion of the line rests on the seabed + + ! Anchor tensions: + + HA = HF + VA = VFMinWL + + + ! Line position and tension at each node: + + DO I = 1,N ! Loop through all nodes where the line position and tension are to be computed + + IF ( ( s(I) < 0.0_DbKi ) .OR. ( s(I) > L ) ) THEN + ErrStat = ErrID_Warn + ErrMsg = ' All line nodes must be located between the anchor ' & + //'and fairlead (inclusive) in routine Catenary().' + RETURN + END IF + + Ws = W *s(I) ! Initialize + VFMinWLs = VFMinWL + Ws ! some commonly + VFMinWLsOvrHF = VFMinWLs/HF ! used terms + sOvrEA = s(I) /EA ! that depend + SQRT1VFMinWLsOvrHF2 = SQRT( 1.0_DbKi + VFMinWLsOvrHF*VFMinWLsOvrHF ) ! on s(I) + + X (I) = ( LOG( VFMinWLsOvrHF + SQRT1VFMinWLsOvrHF2 ) & + - LOG( VFMinWLOvrHF + SQRT1VFMinWLOvrHF2 ) )*HFOvrW & + + sOvrEA* HF + Z (I) = ( SQRT1VFMinWLsOvrHF2 & + - SQRT1VFMinWLOvrHF2 )*HFOvrW & + + sOvrEA*( VFMinWL + 0.5_DbKi*Ws ) + Te(I) = SQRT( HF*HF + VFMinWLs*VFMinWLs ) + + ENDDO ! I - All nodes where the line position and tension are to be computed + + + ELSEIF ( -CB*VFMinWL < HF ) THEN ! .TRUE. when a portion of the line rests on the seabed and the anchor tension is nonzero + + ! Anchor tensions: + + HA = HF + CB*VFMinWL + VA = 0.0_DbKi + + + ! Line position and tension at each node: + + DO I = 1,N ! Loop through all nodes where the line position and tension are to be computed + + IF ( ( s(I) < 0.0_DbKi ) .OR. ( s(I) > L ) ) THEN + ErrStat = ErrID_Warn + ErrMsg = ' All line nodes must be located between the anchor ' & + //'and fairlead (inclusive) in routine Catenary().' + RETURN + END IF + + Ws = W *s(I) ! Initialize + VFMinWLs = VFMinWL + Ws ! some commonly + VFMinWLsOvrHF = VFMinWLs/HF ! used terms + sOvrEA = s(I) /EA ! that depend + SQRT1VFMinWLsOvrHF2 = SQRT( 1.0_DbKi + VFMinWLsOvrHF*VFMinWLsOvrHF ) ! on s(I) + + IF ( s(I) <= LMinVFOvrW ) THEN ! .TRUE. if this node rests on the seabed and the tension is nonzero + + X (I) = s(I) & + + sOvrEA*( HF + CB*VFMinWL + 0.5_DbKi*Ws*CB ) + Z (I) = 0.0_DbKi + Te(I) = HF + CB*VFMinWLs + + ELSE ! LMinVFOvrW < s <= L ! This node must be above the seabed + + X (I) = LOG( VFMinWLsOvrHF + SQRT1VFMinWLsOvrHF2 ) *HFOvrW & + + sOvrEA* HF + LMinVFOvrW - 0.5_DbKi*CB*VFMinWL*VFMinWL/WEA + Z (I) = ( - 1.0_DbKi + SQRT1VFMinWLsOvrHF2 )*HFOvrW & + + sOvrEA*( VFMinWL + 0.5_DbKi*Ws ) + 0.5_DbKi* VFMinWL*VFMinWL/WEA + Te(I) = SQRT( HF*HF + VFMinWLs*VFMinWLs ) + + ENDIF + + ENDDO ! I - All nodes where the line position and tension are to be computed + + + ELSE ! 0.0_DbKi < HF <= -CB*VFMinWL ! A portion of the line must rest on the seabed and the anchor tension is zero + + ! Anchor tensions: + + HA = 0.0_DbKi + VA = 0.0_DbKi + + + ! Line position and tension at each node: + + DO I = 1,N ! Loop through all nodes where the line position and tension are to be computed + + IF ( ( s(I) < 0.0_DbKi ) .OR. ( s(I) > L ) ) THEN + ErrStat = ErrID_Warn + ErrMsg = ' All line nodes must be located between the anchor ' & + //'and fairlead (inclusive) in routine Catenary().' + RETURN + END IF + + Ws = W *s(I) ! Initialize + VFMinWLs = VFMinWL + Ws ! some commonly + VFMinWLsOvrHF = VFMinWLs/HF ! used terms + sOvrEA = s(I) /EA ! that depend + SQRT1VFMinWLsOvrHF2 = SQRT( 1.0_DbKi + VFMinWLsOvrHF*VFMinWLsOvrHF ) ! on s(I) + + IF ( s(I) <= LMinVFOvrW - HFOvrW/CB ) THEN ! .TRUE. if this node rests on the seabed and the tension is zero + + X (I) = s(I) + Z (I) = 0.0_DbKi + Te(I) = 0.0_DbKi + + ELSEIF ( s(I) <= LMinVFOvrW ) THEN ! .TRUE. if this node rests on the seabed and the tension is nonzero + + X (I) = s(I) - ( LMinVFOvrW - 0.5_DbKi*HFOvrW/CB )*HF/EA & + + sOvrEA*( HF + CB*VFMinWL + 0.5_DbKi*Ws*CB ) + 0.5_DbKi*CB*VFMinWL*VFMinWL/WEA + Z (I) = 0.0_DbKi + Te(I) = HF + CB*VFMinWLs + + ELSE ! LMinVFOvrW < s <= L ! This node must be above the seabed + + X (I) = LOG( VFMinWLsOvrHF + SQRT1VFMinWLsOvrHF2 ) *HFOvrW & + + sOvrEA* HF + LMinVFOvrW - ( LMinVFOvrW - 0.5_DbKi*HFOvrW/CB )*HF/EA + Z (I) = ( - 1.0_DbKi + SQRT1VFMinWLsOvrHF2 )*HFOvrW & + + sOvrEA*( VFMinWL + 0.5_DbKi*Ws ) + 0.5_DbKi* VFMinWL*VFMinWL/WEA + Te(I) = SQRT( HF*HF + VFMinWLs*VFMinWLs ) + + ENDIF + + ENDDO ! I - All nodes where the line position and tension are to be computed + + + ENDIF + + + + ! The Newton-Raphson iteration is only accurate in double precision, so + ! convert the output arguments back into the default precision for real + ! numbers: + + !HA_In = REAL( HA , DbKi ) !mth: for this I only care about returning node positions + !HF_In = REAL( HF , DbKi ) + !Te_In(:) = REAL( Te(:), DbKi ) + !VA_In = REAL( VA , DbKi ) + !VF_In = REAL( VF , DbKi ) + X_In (:) = REAL( X (:), DbKi ) + Z_In (:) = REAL( Z (:), DbKi ) + + END SUBROUTINE Catenary + !----------------------------------------------------------------------- + + + END SUBROUTINE Line_Initialize + !-------------------------------------------------------------- + + + !-------------------------------------------------------------- + SUBROUTINE Line_SetState(Line, X, t) + + TYPE(MD_Line), INTENT(INOUT) :: Line ! the current Line object + Real(DbKi), INTENT(IN ) :: X(:) ! state vector section for this line + Real(DbKi), INTENT(IN ) :: t ! instantaneous time + + INTEGER(IntKi) :: i ! index of segments or nodes along line + INTEGER(IntKi) :: J ! index + + + ! store current time + Line%time = t + + ! set interior node positions and velocities based on state vector + DO I=1,Line%N-1 + DO J=1,3 + + Line%r( J,I) = X( 3*Line%N-3 + 3*I-3 + J) ! get positions + Line%rd(J,I) = X( 3*I-3 + J) ! get velocities + + END DO + END DO + + ! if using viscoelastic model, also set the static stiffness stretch + if (Line%ElasticMod == 2) then + do I=1,Line%N + Line%dl_1(I) = X( 6*Line%N-6 + I) ! these will be the last N entries in the state vector + end do + end if + + END SUBROUTINE Line_SetState + !-------------------------------------------------------------- + + !-------------------------------------------------------------- + SUBROUTINE Line_GetStateDeriv(Line, Xd, m, p) !, FairFtot, FairMtot, AnchFtot, AnchMtot) + + TYPE(MD_Line), INTENT(INOUT) :: Line ! the current Line object + Real(DbKi), INTENT(INOUT) :: Xd(:) ! state derivative vector section for this line + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + TYPE(MD_ParameterType), INTENT(IN ) :: p ! Parameters + + ! Real(DbKi), INTENT( IN ) :: X(:) ! state vector, provided + ! Real(DbKi), INTENT( INOUT ) :: Xd(:) ! derivative of state vector, returned ! cahnged to INOUT + ! Real(DbKi), INTENT (IN) :: t ! instantaneous time + ! TYPE(MD_Line), INTENT (INOUT) :: Line ! label for the current line, for convenience + ! TYPE(MD_LineProp), INTENT(IN) :: LineProp ! the single line property set for the line of interest + ! Real(DbKi), INTENT(INOUT) :: FairFtot(:) ! total force on Connect top of line is attached to + ! Real(DbKi), INTENT(INOUT) :: FairMtot(:,:) ! total mass of Connect top of line is attached to + ! Real(DbKi), INTENT(INOUT) :: AnchFtot(:) ! total force on Connect bottom of line is attached to + ! Real(DbKi), INTENT(INOUT) :: AnchMtot(:,:) ! total mass of Connect bottom of line is attached to + + + INTEGER(IntKi) :: i ! index of segments or nodes along line + INTEGER(IntKi) :: J ! index + INTEGER(IntKi) :: K ! index + INTEGER(IntKi) :: N ! number of segments in line + Real(DbKi) :: d ! line diameter + Real(DbKi) :: rho ! line material density [kg/m^3] + Real(DbKi) :: Sum1 ! for summing squares + Real(DbKi) :: dummyLength ! + Real(DbKi) :: m_i ! node mass + Real(DbKi) :: v_i ! node submerged volume + Real(DbKi) :: Vi(3) ! relative water velocity at a given node + Real(DbKi) :: Vp(3) ! transverse relative water velocity component at a given node + Real(DbKi) :: Vq(3) ! tangential relative water velocity component at a given node + Real(DbKi) :: SumSqVp ! + Real(DbKi) :: SumSqVq ! + Real(DbKi) :: MagVp ! + Real(DbKi) :: MagVq ! + Real(DbKi) :: MagT ! tension stiffness force magnitude + Real(DbKi) :: MagTd ! tension damping force magnitude + Real(DbKi) :: Xi ! used in interpolating from lookup table + Real(DbKi) :: Yi ! used in interpolating from lookup table + Real(DbKi) :: dl ! stretch of a segment [m] + Real(DbKi) :: ld_1 ! rate of change of static stiffness portion of segment [m/s] + Real(DbKi) :: EA_1 ! stiffness of 'static stiffness' portion of segment, combines with dynamic stiffness to give static stiffnes [m/s] + + Real(DbKi) :: Kurvi ! temporary curvature value [1/m] + Real(DbKi) :: pvec(3) ! the p vector used in bending stiffness calcs + Real(DbKi) :: Mforce_im1(3) ! force vector for a contributor to the effect of a bending moment [N] + Real(DbKi) :: Mforce_ip1(3) ! force vector for a contributor to the effect of a bending moment [N] + Real(DbKi) :: Mforce_i( 3) ! force vector for a contributor to the effect of a bending moment [N] + + Real(DbKi) :: depth ! local water depth interpolated from bathymetry grid [m] + Real(DbKi) :: nvec(3) ! local seabed surface normal vector (positive out) + Real(DbKi) :: Fn(3) ! seabed contact normal force vector + Real(DbKi) :: Vn(3) ! normal velocity of a line node relative to the seabed slope [m/s] + Real(DbKi) :: Vsb(3) ! tangent velocity of a line node relative to the seabed slope [m/s] + Real(DbKi) :: Va(3) ! velocity of a line node in the axial or "in-line" direction [m/s] + Real(DbKi) :: Vt(3) ! velocity of a line node in the transverse direction [m/s] + Real(DbKi) :: VtMag ! magnitude of the transverse velocity of a line node [m/s] + Real(DbKi) :: VaMag ! magnitude of the axial velocity of a line node [m/s] + Real(DbKi) :: FkTmax ! maximum kinetic friction force in the transverse direction (scalar) + Real(DbKi) :: FkAmax ! maximum kinetic friction force in the axial direction (scalar) + Real(DbKi) :: FkT(3) ! kinetic friction force in the transverse direction (vector) + Real(DbKi) :: FkA(3) ! kinetic friction force in the axial direction (vector) + !Real(DbKi) :: mc_T ! ratio of the transverse static friction coefficient to the transverse kinetic friction coefficient + !Real(DbKi) :: mc_A ! ratio of the axial static friction coefficient to the axial kinetic friction coefficient + Real(DbKi) :: FfT(3) ! total friction force in the transverse direction + Real(DbKi) :: FfA(3) ! total friction force in the axial direction + Real(DbKi) :: Ff(3) ! total friction force on the line node + + + N = Line%N ! for convenience + d = Line%d + rho = Line%rho + + ! note that end node kinematics should have already been set by attached objects + + ! ! set end node positions and velocities from connect objects' states + ! DO J = 1, 3 + ! Line%r( J,N) = m%ConnectList(Line%FairConnect)%r(J) + ! Line%r( J,0) = m%ConnectList(Line%AnchConnect)%r(J) + ! Line%rd(J,N) = m%ConnectList(Line%FairConnect)%rd(J) + ! Line%rd(J,0) = m%ConnectList(Line%AnchConnect)%rd(J) + ! END DO + + + + ! -------------------- calculate various kinematic quantities --------------------------- + DO I = 1, N + + + ! calculate current (Stretched) segment lengths and unit tangent vectors (qs) for each segment (this is used for bending calculations) + CALL UnitVector(Line%r(:,I-1), Line%r(:,I), Line%qs(:,I), Line%lstr(I)) + + ! should add catch here for if lstr is ever zero + + Sum1 = 0.0_DbKi + DO J = 1, 3 + Sum1 = Sum1 + (Line%r(J,I) - Line%r(J,I-1))*(Line%rd(J,I) - Line%rd(J,I-1)) + END DO + Line%lstrd(I) = Sum1/Line%lstr(I) ! segment stretched length rate of change + + ! Line%V(I) = Pi/4.0 * d*d*Line%l(I) !volume attributed to segment + END DO + + !calculate unit tangent vectors (q) for each internal node based on adjacent node positions + DO I = 1, N-1 + CALL UnitVector(Line%r(:,I-1), Line%r(:,I+1), Line%q(:,I), dummyLength) + END DO + + ! calculate unit tangent vectors for either end node if the line has no bending stiffness of if either end is pinned (otherwise it's already been set via setEndStateFromRod) + if ((Line%endTypeA==0) .or. (Line%EI==0.0)) then + CALL UnitVector(Line%r(:,0), Line%r(:,1), Line%q(:,0), dummyLength) + end if + if ((Line%endTypeB==0) .or. (Line%EI==0.0)) then + CALL UnitVector(Line%r(:,N-1), Line%r(:,N), Line%q(:,N), dummyLength) + end if + + ! apply wave kinematics (if there are any) + DO i=0,N + CALL getWaterKin(p, Line%r(1,i), Line%r(2,i), Line%r(3,i), Line%time, m%WaveTi, Line%U(:,i), Line%Ud(:,i), Line%zeta(i), Line%PDyn(i)) + END DO + + + ! --------------- calculate mass (including added mass) matrix for each node ----------------- + DO I = 0, N + IF (I==0) THEN + m_i = Pi/8.0 *d*d*Line%l(1)*rho + v_i = 0.5 *Line%V(1) + ELSE IF (I==N) THEN + m_i = pi/8.0 *d*d*Line%l(N)*rho; + v_i = 0.5*Line%V(N) + ELSE + m_i = pi/8.0 * d*d*rho*(Line%l(I) + Line%l(I+1)) + v_i = 0.5 *(Line%V(I) + Line%V(I+1)) + END IF + + DO J=1,3 + DO K=1,3 + IF (J==K) THEN + Line%M(K,J,I) = m_i + p%rhoW*v_i*( Line%Can*(1 - Line%q(J,I)*Line%q(K,I)) + Line%Cat*Line%q(J,I)*Line%q(K,I) ) + ELSE + Line%M(K,J,I) = p%rhoW*v_i*( Line%Can*(-Line%q(J,I)*Line%q(K,I)) + Line%Cat*Line%q(J,I)*Line%q(K,I) ) + END IF + END DO + END DO + + CALL Inverse3by3(Line%S(:,:,I), Line%M(:,:,I)) ! invert mass matrix + END DO + + + ! ------------------ CALCULATE FORCES ON EACH NODE ---------------------------- + + ! loop through the segments + DO I = 1, N + + ! handle nonlinear stiffness if needed + if (Line%nEApoints > 0) then + + Xi = Line%lstr(I)/Line%l(I) - 1.0 ! strain rate based on inputs + Yi = 0.0_DbKi + + ! find stress based on strain + if (Xi < 0.0) then ! if negative strain (compression), zero stress + Yi = 0.0_DbKi + else if (Xi < Line%stiffXs(1)) then ! if strain below first data point, interpolate from zero + Yi = Xi * Line%stiffYs(1)/Line%stiffXs(1) + else if (Xi >= Line%stiffXs(Line%nEApoints)) then ! if strain exceeds last data point, use last data point + Yi = Line%stiffYs(Line%nEApoints) + else ! otherwise we're in range of the table so interpolate! + do J=1, Line%nEApoints-1 ! go through lookup table until next entry exceeds inputted strain rate + if (Line%stiffXs(J+1) > Xi) then + Yi = Line%stiffYs(J) + (Xi-Line%stiffXs(J)) * (Line%stiffYs(J+1)-Line%stiffYs(J))/(Line%stiffXs(J+1)-Line%stiffXs(J)) + exit + end if + end do + end if + + ! calculate a young's modulus equivalent value based on stress/strain + Line%EA = Yi/Xi + end if + + + ! >>>> could do similar as above for nonlinear damping or bending stiffness <<<< + if (Line%nBApoints > 0) print *, 'Nonlinear elastic damping not yet implemented' + if (Line%nEIpoints > 0) print *, 'Nonlinear bending stiffness not yet implemented' + + + ! basic elasticity model + if (Line%ElasticMod == 1) then + ! line tension, inherently including possibility of dynamic length changes in l term + if (Line%lstr(I)/Line%l(I) > 1.0) then + MagT = Line%EA *( Line%lstr(I)/Line%l(I) - 1.0 ) + else + MagT = 0.0_DbKi ! cable can't "push" + end if + ! line internal damping force based on line-specific BA value, including possibility of dynamic length changes in l and ld terms + MagTd = Line%BA* ( Line%lstrd(I) - Line%lstr(I)*Line%ld(I)/Line%l(I) )/Line%l(I) + + ! viscoelastic model + else if (Line%ElasticMod == 2) then + + EA_1 = Line%EA_D*Line%EA/(Line%EA_D - Line%EA)! calculated EA_1 which is the stiffness in series with EA_D that will result in the desired static stiffness of EA_S + + dl = Line%lstr(I) - Line%l(I) ! delta l of this segment + + ld_1 = (Line%EA_D*dl - (Line%EA_D + EA_1)*Line%dl_1(I) + Line%BA_D*Line%lstrd(I)) /( Line%BA_D + Line%BA) ! rate of change of static stiffness portion [m/s] + + !MagT = (Line%EA*Line%dl_S(I) + Line%BA*ld_S)/ Line%l(I) ! compute tension based on static portion (dynamic portion would give same) + MagT = EA_1*Line%dl_1(I)/ Line%l(I) + MagTd = Line%BA*ld_1 / Line%l(I) + + ! update state derivative for static stiffness stretch (last N entries in the state vector) + Xd( 6*N-6 + I) = ld_1 + + end if + + + do J = 1, 3 + !Line%T(J,I) = Line%EA *( 1.0/Line%l(I) - 1.0/Line%lstr(I) ) * (Line%r(J,I)-Line%r(J,I-1)) + Line%T(J,I) = MagT * Line%qs(J,I) + !Line%Td(J,I) = Line%BA* ( Line%lstrd(I) / Line%l(I) ) * (Line%r(J,I)-Line%r(J,I-1)) / Line%lstr(I) ! note new form of damping coefficient, BA rather than Cint + Line%Td(J,I) = MagTd * Line%qs(J,I) + end do + end do + + + ! Bending loads + Line%Bs = 0.0_DbKi ! zero bending forces + + if (Line%EI > 0) then + ! loop through all nodes to calculate bending forces due to bending stiffness + do i=0,N + + ! end node A case (only if attached to a Rod, i.e. a cantilever rather than pinned connection) + if (i==0) then + + if (Line%endTypeA > 0) then ! if attached to Rod i.e. cantilever connection + + Kurvi = GetCurvature(Line%lstr(1), Line%q(:,0), Line%qs(:,1)) ! curvature (assuming rod angle is node angle which is middle of if there was a segment -1/2) + + pvec = cross_product(Line%q(:,0), Line%qs(:,1)) ! get direction of bending radius axis + + Mforce_ip1 = cross_product(Line%qs(:,1), pvec) ! get direction of resulting force from bending to apply on node i+1 + + call scalevector(pvec, Kurvi*Line%EI, Line%endMomentA) ! record bending moment at end for potential application to attached object + + call scalevector(Mforce_ip1, Kurvi*Line%EI/Line%lstr(1), Mforce_ip1) ! scale force direction vectors by desired moment force magnitudes to get resulting forces on adjacent nodes + + Mforce_i = -Mforce_ip1 ! set force on node i to cancel out forces on adjacent nodes + + ! apply these forces to the node forces + Line%Bs(:,i ) = Line%Bs(:,i ) + Mforce_i + Line%Bs(:,i+1) = Line%Bs(:,i+1) + Mforce_ip1 + + end if + + ! end node A case (only if attached to a Rod, i.e. a cantilever rather than pinned connection) + else if (i==N) then + + if (Line%endTypeB > 0) then ! if attached to Rod i.e. cantilever connection + + Kurvi = GetCurvature(Line%lstr(N), Line%qs(:,N), Line%q(:,N)) ! curvature (assuming rod angle is node angle which is middle of if there was a segment -1/2 + + pvec = cross_product(Line%qs(:,N), Line%q(:,N)) ! get direction of bending radius axis + + Mforce_im1 = cross_product(Line%qs(:,N), pvec) ! get direction of resulting force from bending to apply on node i-1 + + call scalevector(pvec, -Kurvi*Line%EI, Line%endMomentB ) ! record bending moment at end (note end B is oposite sign as end A) + + call scalevector(Mforce_im1, Kurvi*Line%EI/Line%lstr(N), Mforce_im1) ! scale force direction vectors by desired moment force magnitudes to get resulting forces on adjacent nodes + + Mforce_i = Mforce_im1 ! set force on node i to cancel out forces on adjacent nodes + + ! apply these forces to the node forces + Line%Bs(:,i-1) = Line%Bs(:,i-1) + Mforce_im1 + Line%Bs(:,i ) = Line%Bs(:,i ) + Mforce_i + + end if + + else ! internal node + + Kurvi = GetCurvature(Line%lstr(i)+Line%lstr(i+1), Line%qs(:,i), Line%qs(:,i+1)) ! curvature + + pvec = cross_product(Line%qs(:,i), Line%qs(:,i+1)) ! get direction of bending radius axis + + Mforce_im1 = cross_product(Line%qs(:,i ), pvec) ! get direction of resulting force from bending to apply on node i-1 + Mforce_ip1 = cross_product(Line%qs(:,i+1), pvec) ! get direction of resulting force from bending to apply on node i+1 + + ! scale force direction vectors by desired moment force magnitudes to get resulting forces on adjacent nodes + call scalevector(Mforce_im1, Kurvi*Line%EI/Line%lstr(i ), Mforce_im1) + call scalevector(Mforce_ip1, Kurvi*Line%EI/Line%lstr(i+1), Mforce_ip1) + + Mforce_i = -Mforce_im1 - Mforce_ip1 ! set force on node i to cancel out forces on adjacent nodes + + ! apply these forces to the node forces + Line%Bs(:,i-1) = Line%Bs(:,i-1) + Mforce_im1 + Line%Bs(:,i ) = Line%Bs(:,i ) + Mforce_i + Line%Bs(:,i+1) = Line%Bs(:,i+1) + Mforce_ip1 + + end if + + ! record curvature at node + Line%Kurv(i) = Kurvi + + end do ! for i=0,N (looping through nodes) + end if ! if EI > 0 + + + + + ! loop through the nodes + DO I = 0, N + + !submerged weight (including buoyancy) + IF (I==0) THEN + Line%W(3,I) = Pi/8.0*d*d* Line%l(1)*(rho - p%rhoW) *(-p%g) ! assuming g is positive + ELSE IF (i==N) THEN + Line%W(3,I) = pi/8.0*d*d* Line%l(N)*(rho - p%rhoW) *(-p%g) + ELSE + Line%W(3,I) = pi/8.0*d*d* (Line%l(I)*(rho - p%rhoW) + Line%l(I+1)*(rho - p%rhoW) )*(-p%g) ! left in this form for future free surface handling + END IF + + ! relative flow velocities + DO J = 1, 3 + Vi(J) = Line%U(J,I) - Line%rd(J,I) ! relative flow velocity over node -- this is where wave velicites would be added + END DO + + ! decomponse relative flow into components + SumSqVp = 0.0_DbKi ! start sums of squares at zero + SumSqVq = 0.0_DbKi + DO J = 1, 3 + Vq(J) = DOT_PRODUCT( Vi , Line%q(:,I) ) * Line%q(J,I); ! tangential relative flow component + Vp(J) = Vi(J) - Vq(J) ! transverse relative flow component + SumSqVq = SumSqVq + Vq(J)*Vq(J) + SumSqVp = SumSqVp + Vp(J)*Vp(J) + END DO + MagVp = sqrt(SumSqVp) ! get magnitudes of flow components + MagVq = sqrt(SumSqVq) + + ! transverse and tangenential drag + IF (I==0) THEN + Line%Dp(:,I) = 0.25*p%rhoW*Line%Cdn* d*Line%l(1) * MagVp * Vp + Line%Dq(:,I) = 0.25*p%rhoW*Line%Cdt* Pi*d*Line%l(1) * MagVq * Vq + ELSE IF (I==N) THEN + Line%Dp(:,I) = 0.25*p%rhoW*Line%Cdn* d*Line%l(N) * MagVp * Vp + Line%Dq(:,I) = 0.25*p%rhoW*Line%Cdt* Pi*d*Line%l(N) * MagVq * Vq + ELSE + Line%Dp(:,I) = 0.25*p%rhoW*Line%Cdn* d*(Line%l(I) + Line%l(I+1)) * MagVp * vp + Line%Dq(:,I) = 0.25*p%rhoW*Line%Cdt* Pi*d*(Line%l(I) + Line%l(I+1)) * MagVq * vq + END IF + + ! F-K force from fluid acceleration not implemented yet + + ! bottom contact (stiffness and damping, vertical-only for now) - updated Nov 24 for general case where anchor and fairlead ends may deal with bottom contact forces + ! bottom contact - updated throughout October 2021 for seabed bathymetry and friction models + + ! interpolate the local depth from the bathymetry grid and return the vector normal to the seabed slope + CALL getDepthFromBathymetry(m%BathymetryGrid, m%BathGrid_Xs, m%BathGrid_Ys, Line%r(1,I), Line%r(2,I), depth, nvec) + + IF (Line%r(3,I) < -depth) THEN ! for every line node at or below the seabed + + ! calculate the velocity components of the node relative to the seabed + Vn = DOT_PRODUCT( Line%rd(:,I), nvec) * nvec ! velocity component normal to the local seabed slope + Vsb = Line%rd(:,I) - Vn ! velocity component along (tangent to) the seabed + + ! calculate the normal contact force on the line node + IF (I==0) THEN + Fn = ( (-depth - Line%r(3,I))*nvec(3)*nvec*p%kBot - Vn*p%cBot) * 0.5*d*( Line%l(I+1) ) + ELSE IF (I==N) THEN + Fn = ( (-depth - Line%r(3,I))*nvec(3)*nvec*p%kBot - Vn*p%cBot) * 0.5*d*(Line%l(I) ) + ELSE + Fn = ( (-depth - Line%r(3,I))*nvec(3)*nvec*p%kBot - Vn*p%cBot) * 0.5*d*(Line%l(I) + Line%l(I+1) ) + END IF + + ! calculate the axial and transverse components of the node velocity vector along the seabed + Va = DOT_PRODUCT( Vsb , Line%q(:,I) ) * Line%q(:,I) + Vt = Vsb - Va + + ! calculate the magnitudes of each velocity + VaMag = SQRT(Va(1)**2+Va(2)**2+Va(3)**2) + VtMag = SQRT(Vt(1)**2+Vt(2)**2+Vt(3)**2) + + ! find the maximum possible kinetic friction force using transverse and axial kinetic friction coefficients + FkTmax = p%mu_kT*SQRT(Fn(1)**2+Fn(2)**2+Fn(3)**2) + FkAmax = p%mu_kA*SQRT(Fn(1)**2+Fn(2)**2+Fn(3)**2) + ! turn the maximum kinetic friction forces into vectors in the direction of their velocities + DO J = 1, 3 + IF (VtMag==0) THEN + FkT(J) = 0.0_DbKi + ELSE + FkT(J) = FkTmax*Vt(J)/VtMag + END IF + IF (VaMag==0) THEN + FkA(J) = 0.0_DbKi + ELSE + FkA(J) = FkAmax*Va(J)/VaMag + END IF + END DO + ! calculate the ratio between the static and kinetic coefficients of friction + !mc_T = p%mu_sT/p%mu_kT + !mc_A = p%mu_sA/p%mu_kA + + ! calculate the transverse friction force + IF (p%mu_kT*p%cv*VtMag > p%mc*FkTmax) THEN ! if the friction force of the linear curve is greater than the maximum friction force allowed adjusted for static friction, + FfT = -FkT ! then the friction force is the maximum kinetic friction force vector (constant part of the curve) + ELSE ! if the friction force of the linear curve is less than the maximum friction force allowed adjusted for static friction, + FfT = -p%mu_kT*p%cv*Vt ! then the friction force is the calculated value of the linear line + END IF + ! calculate the axial friction force + IF (p%mu_kA*p%cv*VaMag > p%mc*FkAmax) THEN ! if the friction force of the linear curve is greater than the maximum friction force allowed adjusted for static friction, + FfA = -FkA ! then the friction force is the maximum kinetic friction force vector (constant part of the curve) + ELSE ! if the friction force of the linear curve is less than the maximum friction force allowed adjusted for static friction, + FfA = -p%mu_kA*p%cv*Va ! then the friction force is the calculated value of the linear line + END IF + ! NOTE: these friction forces have a negative sign here to indicate a force in the opposite direction of motion + + ! the total friction force is along the plane of the seabed slope, which is just the vector sum of the transverse and axial components + Ff = FfT + FfA + + ELSE + Fn = 0.0_DbKi + Ff = 0.0_DbKi + END IF + + + ! the total force from bottom contact on the line node is the sum of the normal contact force and the friction force + Line%B(:,I) = Fn + Ff + + ! total forces + IF (I==0) THEN + Line%Fnet(:,I) = Line%T(:,1) + Line%Td(:,1) + Line%W(:,I) + Line%Dp(:,I) + Line%Dq(:,I) + Line%B(:,I) + Line%Bs(:,I) + ELSE IF (I==N) THEN + Line%Fnet(:,I) = -Line%T(:,N) - Line%Td(:,N) + Line%W(:,I) + Line%Dp(:,I) + Line%Dq(:,I) + Line%B(:,I) + Line%Bs(:,I) + ELSE + Line%Fnet(:,I) = Line%T(:,I+1) - Line%T(:,I) + Line%Td(:,I+1) - Line%Td(:,I) + Line%W(:,I) + Line%Dp(:,I) + Line%Dq(:,I) + Line%B(:,I) + Line%Bs(:,I) + END IF + + END DO ! I - done looping through nodes + + ! loop through internal nodes and update their states <<< should/could convert to matrix operations instead of all these loops + DO I=1, N-1 + DO J=1,3 + + ! calculate RHS constant (premultiplying force vector by inverse of mass matrix ... i.e. rhs = S*Forces) + Sum1 = 0.0_DbKi ! reset temporary accumulator <<< could turn this into a Line%a array to save and output node accelerations + DO K = 1, 3 + Sum1 = Sum1 + Line%S(K,J,I) * Line%Fnet(K,I) ! matrix-vector multiplication [S i]{Forces i} << double check indices + END DO ! K + + ! update states + Xd(3*N-3 + 3*I-3 + J) = Line%rd(J,I); ! dxdt = V (velocities) + Xd( 3*I-3 + J) = Sum1 ! dVdt = RHS * A (accelerations) + + END DO ! J + END DO ! I + + + ! check for NaNs + DO J = 1, 6*(N-1) + IF (Is_NaN(Xd(J))) THEN + print *, "NaN detected at time ", Line%time, " in Line ", Line%IdNum, " in MoorDyn." + IF (wordy > 1) THEN + print *, "state derivatives:" + print *, Xd + + + + print *, "m_i p%rhoW v_i Line%Can Line%Cat" + print *, m_i + print *, p%rhoW + print *, v_i + print *, Line%Can + print *, Line%Cat + + print *, "Line%q" + print *, Line%q + + print *, "Line%r" + print *, Line%r + + + print *, "Here is the mass matrix set" + print *, Line%M + + print *, "Here is the inverted mass matrix set" + print *, Line%S + + print *, "Here is the net force set" + print *, Line%Fnet + END IF + + EXIT + END IF + END DO + + + ! ! add force and mass of end nodes to the Connects they correspond to <<<<<<<<<<<< do this from Connection instead now! + ! DO J = 1,3 + ! FairFtot(J) = FairFtot(J) + Line%F(J,N) + ! AnchFtot(J) = AnchFtot(J) + Line%F(J,0) + ! DO K = 1,3 + ! FairMtot(K,J) = FairMtot(K,J) + Line%M(K,J,N) + ! AnchMtot(K,J) = AnchMtot(K,J) + Line%M(K,J,0) + ! END DO + ! END DO + + END SUBROUTINE Line_GetStateDeriv + !===================================================================== + + + !-------------------------------------------------------------- + SUBROUTINE Line_SetEndKinematics(Line, r_in, rd_in, t, topOfLine) + + TYPE(MD_Line), INTENT(INOUT) :: Line ! the current Line object + Real(DbKi), INTENT(IN ) :: r_in( 3) ! state vector section for this line + Real(DbKi), INTENT(IN ) :: rd_in(3) ! state vector section for this line + Real(DbKi), INTENT(IN ) :: t ! instantaneous time + INTEGER(IntKi), INTENT(IN ) :: topOfLine ! 0 for end A (Node 0), 1 for end B (node N) + + Integer(IntKi) :: I,J + INTEGER(IntKi) :: inode + + IF (topOfLine==1) THEN + inode = Line%N + Line%endTypeB = 0 ! set as ball rather than rigid connection (unless changed later by SetEndOrientation) + ELSE + inode = 0 + Line%endTypeA = 0 ! set as ball rather than rigid connection (unless changed later by SetEndOrientation) + END IF + + !Line%r( :,inode) = r_in + !Line%rd(:,inode) = rd_in + + DO J = 1,3 + Line%r( :,inode) = r_in + Line%rd(:,inode) = rd_in + END DO + + ! print *, "SetEndKinematics of line ", Line%idNum, " top?:", topOfLine + ! print *, r_in + ! print *, Line%r( :,inode), " - confirming, node ", inode + ! print *, rd_in + + Line%time = t + + END SUBROUTINE Line_SetEndKinematics + !-------------------------------------------------------------- + + + ! get force, moment, and mass of line at line end node + !-------------------------------------------------------------- + SUBROUTINE Line_GetEndStuff(Line, Fnet_out, Moment_out, M_out, topOfLine) + + TYPE(MD_Line), INTENT(INOUT) :: Line ! label for the current line, for convenience + REAL(DbKi), INTENT( OUT) :: Fnet_out(3) ! net force on end node + REAL(DbKi), INTENT( OUT) :: Moment_out(3) ! moment on end node (future capability) + REAL(DbKi), INTENT( OUT) :: M_out(3,3) ! mass matrix of end node + INTEGER(IntKi), INTENT(IN ) :: topOfLine ! 0 for end A (Node 0), 1 for end B (node N) + + Integer(IntKi) :: I,J + INTEGER(IntKi) :: inode + + IF (topOfLine==1) THEN ! end B of line + Fnet_out = Line%Fnet(:, Line%N) + Moment_out = Line%endMomentB + M_out = Line%M(:,:, Line%N) + ELSE ! end A of line + Fnet_out = Line%Fnet(:, 0) + Moment_out = Line%endMomentA + M_out = Line%M(:,:, 0) + END IF + + END SUBROUTINE Line_GetEndStuff + !-------------------------------------------------------------- + + ! Get bending stiffness vector from line end for use in computing orientation of zero-length rods + !-------------------------------------------------------------- + SUBROUTINE Line_GetEndSegmentInfo(Line, q_EI_dl, topOfLine, rodEndB) + + TYPE(MD_Line), INTENT(INOUT) :: Line ! label for the current line, for convenience + REAL(DbKi), INTENT( OUT) :: q_EI_dl(3) ! EI/dl of the line end segment multiplied by the axis unit vector with the correct sign + INTEGER(IntKi), INTENT(IN ) :: topOfLine ! 0 for end A (Node 0), 1 for end B (node N) + INTEGER(IntKi), INTENT(IN ) :: rodEndB ! rodEndB=0 means the line is attached to Rod end A, =1 means attached to Rod end B (implication for unit vector sign) + + REAL(DbKi) :: qEnd(3) + REAL(DbKi) :: dlEnd + + if (topOfLine==1) then + CALL UnitVector(Line%r(:,Line%N-1), Line%r(:,Line%N), qEnd, dlEnd) ! unit vector of last line segment + if (rodEndB == 0) then + q_EI_dl = qEnd*Line%EI/dlEnd ! -----line----->[A==ROD==>B] + else + q_EI_dl = -qEnd*Line%EI/dlEnd ! -----line----->[B==ROD==>A] + end if + else + CALL UnitVector(Line%r(:,0 ), Line%r(:,1 ), qEnd, dlEnd) ! unit vector of first line segment + if (rodEndB == 0) then + q_EI_dl = -qEnd*Line%EI/dlEnd ! <----line-----[A==ROD==>B] + else + q_EI_dl = qEnd*Line%EI/dlEnd ! <----line-----[B==ROD==>A] + end if + end if + + END SUBROUTINE Line_GetEndSegmentInfo + !-------------------------------------------------------------- + + + ! set end node unit vector of a line (this is called when attached to a Rod, only applicable for bending stiffness) + !-------------------------------------------------------------- + SUBROUTINE Line_SetEndOrientation(Line, qin, topOfLine, rodEndB) + + TYPE(MD_Line), INTENT(INOUT) :: Line ! label for the current line, for convenience + REAL(DbKi), INTENT(IN ) :: qin(3) ! the rod's axis unit vector + INTEGER(IntKi), INTENT(IN ) :: topOfLine ! 0 for end A (Node 0), 1 for end B (node N) + INTEGER(IntKi), INTENT(IN ) :: rodEndB ! =0 means the line is attached to Rod end A, =1 means attached to Rod end B (implication for unit vector sign) + + if (topOfLine==1) then + + Line%endTypeB = 1 ! indicate attached to Rod (at every time step, just in case line gets detached) + + if (rodEndB==1) then + Line%q(:,Line%N) = -qin ! -----line----->[B<==ROD==A] + else + Line%q(:,Line%N) = qin ! -----line----->[A==ROD==>B] + end if + else + + Line%endTypeA = 1 ! indicate attached to Rod (at every time step, just in case line gets detached) ! indicate attached to Rod + + if (rodEndB==1) then + Line%q(:,0 ) = qin ! [A==ROD==>B]-----line-----> + else + Line%q(:,0 ) = -qin ! [B<==ROD==A]-----line-----> + end if + end if + + END SUBROUTINE Line_SetEndOrientation + !-------------------------------------------------------------- + + +END MODULE MoorDyn_Line diff --git a/modules/moordyn/src/MoorDyn_Misc.f90 b/modules/moordyn/src/MoorDyn_Misc.f90 new file mode 100644 index 0000000000..a9d66a6516 --- /dev/null +++ b/modules/moordyn/src/MoorDyn_Misc.f90 @@ -0,0 +1,2110 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2020-2021 Alliance for Sustainable Energy, LLC +! Copyright (C) 2015-2019 Matthew Hall +! +! This file is part of MoorDyn. +! +! 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 MoorDyn_Misc + + USE MoorDyn_Types + USE NWTC_Library + USE NWTC_FFTPACK + + IMPLICIT NONE + + PRIVATE + + INTEGER(IntKi), PARAMETER :: wordy = 0 ! verbosity level. >1 = more console output + + PUBLIC :: UnitVector + PUBLIC :: ScaleVector + PUBLIC :: GetCurvature + PUBLIC :: GetOrientationAngles + PUBLIC :: TransformKinematics + PUBLIC :: TransformKinematicsA + PUBLIC :: TransformKinematicsAtoB + PUBLIC :: TranslateForce3to6DOF + PUBLIC :: TranslateMass3to6DOF + PUBLIC :: TranslateMass6to6DOF + PUBLIC :: GetH + PUBLIC :: RotateM6 + PUBLIC :: RotateM3 + PUBLIC :: CalcOrientation + PUBLIC :: Inverse3by3 + PUBLIC :: LUsolve + + PUBLIC :: getInterpNums + PUBLIC :: calculate4Dinterpolation + PUBLIC :: calculate3Dinterpolation + PUBLIC :: calculate2Dinterpolation + + PUBLIC :: getDepthFromBathymetry + + PUBLIC :: getWaterKin + PUBLIC :: setupWaterKin + +CONTAINS + + + ! ::::::::::::::::::::::::::::::::: math convenience functions :::::::::::::::::::::::::::::::::: + ! should add error checking if I keep these, but hopefully there are existing NWTCLib functions to replace them + + ! return unit vector (u) and in direction from r1 to r2 and distance between points + !----------------------------------------------------------------------- + SUBROUTINE UnitVector( r1, r2, u, Length ) ! note: order of parameters chagned in this function + + REAL(DbKi), INTENT(IN ) :: r1(:) + REAL(DbKi), INTENT(IN ) :: r2(:) + REAL(DbKi), INTENT( OUT) :: u(:) + REAL(DbKi), INTENT( OUT) :: length + + u = r2 - r1 + length = TwoNorm(u) + + if ( .NOT. EqualRealNos(length, 0.0_DbKi ) ) THEN + u = u / Length + END IF + + END SUBROUTINE UnitVector + !----------------------------------------------------------------------- + + ! scale vector to desired length + !----------------------------------------------------------------------- + SUBROUTINE ScaleVector( u_in, newlength, u_out ) + REAL(DbKi), INTENT(IN ) :: u_in(3) ! input vector + REAL(DbKi), INTENT(IN ) :: newlength ! desired length of output vector + REAL(DbKi), INTENT(INOUT) :: u_out(3) ! output vector (hopefully can be the same as u_in without issue) + + REAL(DbKi) :: length_squared + REAL(DbKi) :: scaler + INTEGER(IntKi) :: J + + length_squared = 0.0; + DO J=1,3 + length_squared = length_squared + u_in(J)*u_in(J) + END DO + + if (length_squared > 0) then + scaler = newlength/sqrt(length_squared) + else ! if original vector is zero, return zero + scaler = 0.0_DbKi + end if + + DO J=1,3 + u_out(J) = u_in(J) * scaler + END DO + + END SUBROUTINE ScaleVector + !----------------------------------------------------------------------- + + + ! convenience function to calculate curvature based on adjacent segments' direction vectors and their combined length + function GetCurvature(length, q1, q2) + + real(DbKi), intent(in ) :: length + real(DbKi), intent(in ) :: q1(3) + real(DbKi), intent(in ) :: q2(3) + real(DbKi) :: GetCurvature + + + real(DbKi) :: q1_dot_q2 + + ! note "length" here is combined from both segments + + q1_dot_q2 = dot_product( q1, q2 ) + + if (q1_dot_q2 > 1.0) then ! this is just a small numerical error, so set q1_dot_q2 to 1 + GetCurvature = 0.0_DbKi ! this occurs when there's no curvature, so return zero curvature + + !else if (q1_dot_q2 < 0) ! this is a bend of more than 90 degrees, too much, call an error! + + else ! normal case + GetCurvature = 4.0/length * sqrt(0.5*(1.0 - q1_dot_q2)) ! this is the normal curvature calculation + end if + + return + end function GetCurvature + + + ! calculate orientation angles of a direction vector + !----------------------------------------------------------------------- + subroutine GetOrientationAngles(vec, phi, sinPhi, cosPhi, tanPhi, beta, sinBeta, cosBeta, k_hat) + real(DbKi), intent(in ) :: vec(3) !p1(3),p2(3) + real(DbKi), intent( out) :: phi, sinPhi, cosPhi, tanPhi, beta, sinBeta, cosBeta, k_hat(3) + + real(DbKi) :: vecLen, vecLen2D + + vecLen = SQRT(Dot_Product(vec,vec)) + vecLen2D = SQRT(vec(1)**2+vec(2)**2) + if ( vecLen < 0.000001 ) then + print *, "ERROR in GetOrientationAngles in MoorDyn. Supplied vector is near zero" + print *, vec + k_hat = NaN ! 1.0/0.0 + else + k_hat = vec / vecLen + phi = atan2(vecLen2D, vec(3)) ! incline angle + end if + if ( phi < 0.000001) then + beta = 0.0_ReKi + else + beta = atan2(vec(2), vec(1)) ! heading of incline + endif + sinPhi = sin(phi) + cosPhi = cos(phi) + tanPhi = tan(phi) + sinBeta = sin(beta) + cosBeta = cos(beta) + + end subroutine GetOrientationAngles + !----------------------------------------------------------------------- + + + ! calculate position and velocity of point based on its position relative to moving 6DOF body + !----------------------------------------------------------------------- + SUBROUTINE TransformKinematics(rRelBody, r_in, TransMat, rd_in, r_out, rd_out) + REAL(DbKi), INTENT(IN ) :: rRelBody(:) ! coordinate of end A + REAL(DbKi), INTENT(IN ) :: r_in(3) ! Rod unit vector + REAL(DbKi), INTENT(IN ) :: TransMat(3,3)! + REAL(DbKi), INTENT(IN ) :: rd_in(6) ! 6DOF velecity vector about Rod end A, in global orientation frame + REAL(DbKi), INTENT( OUT) :: r_out(3) ! coordinates of end B + REAL(DbKi), INTENT( OUT) :: rd_out(3) ! velocity of end B + + REAL(DbKi) :: rRel(3) + + ! rd_in should be in global orientation frame + ! note: it's okay if r_out and rd_out are 6-size. Only the first 3 will be written, and 4-6 will + ! already be correct or can be assigned seperately from r_in and rd_in (assuming orientation frames are identical) + + + ! locations (unrotated reference frame) about platform reference point (2021-01-05: just transposed TransMat, it was incorrect before) + rRel(1) = TransMat(1,1)*rRelBody(1) + TransMat(1,2)*rRelBody(2) + TransMat(1,3)*rRelBody(3) ! x + rRel(2) = TransMat(2,1)*rRelBody(1) + TransMat(2,2)*rRelBody(2) + TransMat(2,3)*rRelBody(3) ! y + rRel(3) = TransMat(3,1)*rRelBody(1) + TransMat(3,2)*rRelBody(2) + TransMat(3,3)*rRelBody(3) ! z + + ! absolute locations + r_out = rRel + r_in + + ! absolute velocities + rd_out(1) = - rd_in(6)*rRel(2) + rd_in(5)*rRel(3) + rd_in(1) ! x + rd_out(2) = rd_in(6)*rRel(1) - rd_in(4)*rRel(3) + rd_in(2) ! y + rd_out(3) = -rd_in(5)*rRel(1) + rd_in(4)*rRel(2) + rd_in(3) ! z + + ! absolute accelerations + rd_out(1) = - rd_in(6)*rRel(2) + rd_in(5)*rRel(3) + rd_in(1) ! x + rd_out(2) = rd_in(6)*rRel(1) - rd_in(4)*rRel(3) + rd_in(2) ! y + rd_out(3) = -rd_in(5)*rRel(1) + rd_in(4)*rRel(2) + rd_in(3) ! z + + + + !rRel = MATMUL(TransMat, rRelBody) + !H = getH(rRel) + !! absolute locations + !r_out = rRel + r_in + !! absolute velocities + !rd_out = MATMUL( H, rd_in(4:6)) + rd_in(1:3) + + + END SUBROUTINE TransformKinematics + !----------------------------------------------------------------------- + + + + ! calculate position, velocity, and acceleration of point based on its position relative to moving 6DOF body + !----------------------------------------------------------------------- + SUBROUTINE TransformKinematicsA(rRelBody, r_in, TransMat, v_in, a_in, r_out, v_out, a_out) + REAL(DbKi), INTENT(IN ) :: rRelBody(:) ! relative location of point about reference point, in local/reference coordinate system + REAL(DbKi), INTENT(IN ) :: r_in(3) ! translation applied to reference point + REAL(DbKi), INTENT(IN ) :: TransMat(3,3)! rotation matrix describing rotation about reference point + REAL(DbKi), INTENT(IN ) :: v_in(6) ! 6DOF velecity vector about ref point in global orientation frame + REAL(DbKi), INTENT(IN ) :: a_in(6) ! 6DOF acceleration vector + REAL(DbKi), INTENT( OUT) :: r_out(3) ! coordinates of point of interest + REAL(DbKi), INTENT( OUT) :: v_out(3) ! velocity of point + REAL(DbKi), INTENT( OUT) :: a_out(3) ! acceleration of point + + REAL(DbKi) :: rRel(3) + REAL(DbKi) :: rRel2(3) + + REAL(DbKi) :: r_out2(3) + REAL(DbKi) :: rd_out2(3) + REAL(DbKi) :: H(3,3) + + ! rd_in should be in global orientation frame + ! note: it's okay if r_out and rd_out are 6-size. Only the first 3 will be written, and 4-6 will + ! already be correct or can be assigned seperately from r_in and rd_in (assuming orientation frames are identical) + + + ! locations about ref point in *unrotated* reference frame + !rRel2(1) = TransMat(1,1)*rRelBody(1) + TransMat(2,1)*rRelBody(2) + TransMat(3,1)*rRelBody(3) ! x + !rRel2(2) = TransMat(1,2)*rRelBody(1) + TransMat(2,2)*rRelBody(2) + TransMat(3,2)*rRelBody(3) ! y + !rRel2(3) = TransMat(1,3)*rRelBody(1) + TransMat(2,3)*rRelBody(2) + TransMat(3,3)*rRelBody(3) ! z + + rRel = MATMUL(TransMat, rRelBody) + + H = getH(rRel) + + ! absolute locations + r_out = rRel + r_in + + ! absolute velocities + !rd_out2(1) = - v_in(6)*rRel(2) + v_in(5)*rRel(3) + v_in(1) ! x + !rd_out2(2) = v_in(6)*rRel(1) - v_in(4)*rRel(3) + v_in(2) ! y + !rd_out2(3) = -v_in(5)*rRel(1) + v_in(4)*rRel(2) + v_in(3) ! z + + v_out = MATMUL( H, v_in(4:6)) + v_in(1:3) + + ! absolute accelerations + a_out = MATMUL( H, a_in(4:6)) + a_in(1:3) ! << should add second order terms! + + + END SUBROUTINE TransformKinematicsA + !----------------------------------------------------------------------- + + ! calculate position and velocity of point along rod (distance L along direction u) + !----------------------------------------------------------------------- + SUBROUTINE TransformKinematicsAtoB(rA, u, L, rd_in, r_out, rd_out) + REAL(DbKi), INTENT(IN ) :: rA(3) ! coordinate of end A + REAL(DbKi), INTENT(IN ) :: u(3) ! Rod unit vector + REAL(DbKi), INTENT(IN ) :: L ! Rod length from end A to B + REAL(DbKi), INTENT(IN ) :: rd_in(6) ! 6DOF velecity vector about Rod end A, in global orientation frame + REAL(DbKi), INTENT( OUT) :: r_out(3) ! coordinates of end B + REAL(DbKi), INTENT( OUT) :: rd_out(3) ! velocity of end B + + REAL(DbKi) :: rRel(3) + + + ! locations (unrotated reference frame) + rRel = L*u ! relative location of point B from point A + r_out = rRel + rA ! absolute location of point B + + ! absolute velocities + rd_out(1) = - rd_in(6)*rRel(2) + rd_in(5)*rRel(3) + rd_in(1) ! x + rd_out(2) = rd_in(6)*rRel(1) - rd_in(4)*rRel(3) + rd_in(2) ! y + rd_out(3) = -rd_in(5)*rRel(1) + rd_in(4)*rRel(2) + rd_in(3) ! z + + + END SUBROUTINE TransformKinematicsAtoB + !----------------------------------------------------------------------- + + ! + !----------------------------------------------------------------------- + SUBROUTINE TranslateForce3to6DOF(dx, F, Fout) + REAL(DbKi), INTENT(IN ) :: dx(3) ! displacement vector from ref point to point of force (F) application + REAL(DbKi), INTENT(IN ) :: F(3) ! applied force + REAL(DbKi), INTENT( OUT) :: Fout(6) ! resultant applied force and moment about ref point + + Fout(1:3) = F + + Fout(4:6) = CROSS_PRODUCT(dx, F) + + END SUBROUTINE TranslateForce3to6DOF + !----------------------------------------------------------------------- + + + ! + !----------------------------------------------------------------------- + SUBROUTINE TranslateMass3to6DOF(dx, Min, Mout) + REAL(DbKi), INTENT(IN ) :: dx(3) ! displacement vector from ref point to point of mass matrix (Min) + REAL(DbKi), INTENT(IN ) :: Min( 3,3) ! original mass matrix (assumed at center of mass, or a point mass) + REAL(DbKi), INTENT( OUT) :: Mout(6,6) ! resultant mass and inertia matrix about ref point + + REAL(DbKi) :: H( 3,3) ! "anti-symmetric tensor components" from Sadeghi and Incecik + REAL(DbKi) :: tempM( 3,3) + REAL(DbKi) :: tempM2(3,3) + REAL(DbKi) :: Htrans(3,3) + Integer(IntKi) :: I,J + + ! sub-matrix definitions are accordint to | m J | + ! | J^T I | + + H = getH(dx); + + ! mass matrix [m'] = [m] + Mout(1:3,1:3) = Min + + ! product of inertia matrix [J'] = [m][H] + [J] + Mout(1:3,4:6) = MATMUL(Min, H) + Mout(4:6,1:3) = TRANSPOSE(Mout(1:3,4:6)) + + !moment of inertia matrix [I'] = [H][m][H]^T + [J]^T [H] + [H]^T [J] + [I] + Mout(4:6,4:6) = MATMUL(MATMUL(H, Min), TRANSPOSE(H)) + + END SUBROUTINE TranslateMass3to6DOF + !----------------------------------------------------------------------- + + ! + !----------------------------------------------------------------------- + SUBROUTINE TranslateMass6to6DOF(dx, Min, Mout) + REAL(DbKi), INTENT(IN ) :: dx(3) ! displacement vector from ref point to point of mass matrix (Min) + REAL(DbKi), INTENT(IN ) :: Min( 6,6) ! original mass matrix + REAL(DbKi), INTENT( OUT) :: Mout(6,6) ! resultant mass and inertia matrix about ref point + + REAL(DbKi) :: H( 3,3) ! "anti-symmetric tensor components" from Sadeghi and Incecik + + H = getH(dx); + + ! mass matrix [m'] = [m] + Mout(1:3,1:3) = Min(1:3,1:3) + + ! product of inertia matrix [J'] = [m][H] + [J] + Mout(1:3,4:6) = MATMUL(Min(1:3,1:3), H) + Min(1:3,4:6) + Mout(4:6,1:3) = TRANSPOSE(Mout(1:3,4:6)) + + !moment of inertia matrix [I'] = [H][m][H]^T + [J]^T [H] + [H]^T [J] + [I] + Mout(4:6,4:6) = MATMUL(MATMUL(H, Min(1:3,1:3)), TRANSPOSE(H)) + MATMUL(Min(4:6,1:3),H) + MATMUL(TRANSPOSE(H),Min(1:3,4:6)) + Min(4:6,4:6) + + END SUBROUTINE TranslateMass6to6DOF + !----------------------------------------------------------------------- + + ! produce alternator matrix + !----------------------------------------------------------------------- + FUNCTION GetH(r) + Real(DbKi), INTENT(IN) :: r(3) ! inputted vector + Real(DbKi) :: GetH(3,3) ! outputted matrix + + GetH(2,1) = -r(3) + GetH(1,2) = r(3) + GetH(3,1) = r(2) + GetH(1,3) = -r(2) + GetH(3,2) = -r(1) + GetH(2,3) = r(1) + + GetH(1,1) = 0.0_DbKi + GetH(2,2) = 0.0_DbKi + GetH(3,3) = 0.0_DbKi + + END FUNCTION GetH + !----------------------------------------------------------------------- + + + + ! apply a rotation to a 6-by-6 mass/inertia tensor (see Sadeghi and Incecik 2005 for theory) + !----------------------------------------------------------------------- + FUNCTION RotateM6(Min, rotMat) result(outMat) + + Real(DbKi), INTENT(IN) :: Min(6,6) ! inputted matrix to be rotated + Real(DbKi), INTENT(IN) :: rotMat(3,3) ! rotation matrix (DCM) + Real(DbKi) :: outMat(6,6) ! rotated matrix + + ! the process for each of the following is to + ! 1. copy out the relevant 3x3 matrix section, + ! 2. rotate it, and + ! 3. paste it into the output 6x6 matrix + + ! mass matrix + outMat(1:3,1:3) = rotateM3(Min(1:3,1:3), rotMat) + + ! product of inertia matrix + outMat(1:3,4:6) = rotateM3(Min(1:3,4:6), rotMat) + outMat(4:6,1:3) = TRANSPOSE(outMat(1:3,4:6)) + + ! moment of inertia matrix + outMat(4:6,4:6) = rotateM3(Min(4:6,4:6), rotMat) + + END FUNCTION RotateM6 + + + ! apply a rotation to a 3-by-3 mass matrix or any other second order tensor + !----------------------------------------------------------------------- + FUNCTION RotateM3(Min, rotMat) result(outMat) + + Real(DbKi), INTENT(IN) :: Min(3,3) ! inputted matrix to be rotated + Real(DbKi), INTENT(IN) :: rotMat(3,3) ! rotation matrix (DCM) + Real(DbKi) :: outMat(3,3) ! rotated matrix + + ! overall operation is [m'] = [a]*[m]*[a]^T + + outMat = MATMUL( MATMUL(rotMat, Min), TRANSPOSE(rotMat) ) + + END FUNCTION RotateM3 + + + + + + ! calculates rotation matrix R to rotate from global axes to a member's local axes + !----------------------------------------------------------------------- + FUNCTION CalcOrientation(phi, beta, gamma) result(R) + + REAL(DbKi), INTENT ( IN ) :: phi ! member incline angle + REAL(DbKi), INTENT ( IN ) :: beta ! member incline heading + REAL(DbKi), INTENT ( IN ) :: gamma ! member twist angle + REAL(DbKi) :: R(3,3) ! rotation matrix + + INTEGER(IntKi) :: errStat + CHARACTER(100) :: errMsg + + REAL(DbKi) :: s1, c1, s2, c2, s3, c3 + + + ! trig terms for Euler angles rotation based on beta, phi, and gamma + s1 = sin(beta) + c1 = cos(beta) + s2 = sin(phi) + c2 = cos(phi) + s3 = sin(gamma) + c3 = cos(gamma) + + ! calculate rotation matrix based on Z1Y2Z3 Euler rotation sequence from https:!en.wikipedia.org/wiki/Euler_angles#Rotation_matrix + + R(1,1) = c1*c2*c3-s1*s3 + R(1,2) = -c3*s1-c1*c2*s3 + R(1,3) = c1*s2 + R(2,1) = c1*s3+c2*c3*s1 + R(2,2) = c1*c3-c2*s1*s3 + R(2,3) = s1*s2 + R(3,1) = -c3*s2 + R(3,2) = s2*s3 + R(3,3) = c2 + + ! could also calculate unit normals p1 and p2 for rectangular cross sections + !p1 = matmul( R, [1,0,0] ) ! unit vector that is perpendicular to the 'beta' plane if gamma is zero + !p2 = cross( q, p1 ) ! unit vector orthogonal to both p1 and q + + END FUNCTION CalcOrientation + + + !compute the inverse of a 3-by-3 matrix m + !----------------------------------------------------------------------- + SUBROUTINE Inverse3by3( Minv, M ) + Real(DbKi), INTENT(OUT) :: Minv(3,3) ! returned inverse matrix + Real(DbKi), INTENT(IN) :: M(3,3) ! inputted matrix + + Real(DbKi) :: det ! the determinant + Real(DbKi) :: invdet ! inverse of the determinant + + det = M(1, 1) * (M(2, 2) * M(3, 3) - M(3, 2) * M(2, 3)) - & + M(1, 2) * (M(2, 1) * M(3, 3) - M(2, 3) * M(3, 1)) + & + M(1, 3) * (M(2, 1) * M(3, 2) - M(2, 2) * M(3, 1)); + + invdet = 1.0 / det ! because multiplying is faster than dividing + + Minv(1, 1) = (M(2, 2) * M(3, 3) - M(3, 2) * M(2, 3)) * invdet + Minv(1, 2) = (M(1, 3) * M(3, 2) - M(1, 2) * M(3, 3)) * invdet + Minv(1, 3) = (M(1, 2) * M(2, 3) - M(1, 3) * M(2, 2)) * invdet + Minv(2, 1) = (M(2, 3) * M(3, 1) - M(2, 1) * M(3, 3)) * invdet + Minv(2, 2) = (M(1, 1) * M(3, 3) - M(1, 3) * M(3, 1)) * invdet + Minv(2, 3) = (M(2, 1) * M(1, 3) - M(1, 1) * M(2, 3)) * invdet + Minv(3, 1) = (M(2, 1) * M(3, 2) - M(3, 1) * M(2, 2)) * invdet + Minv(3, 2) = (M(3, 1) * M(1, 2) - M(1, 1) * M(3, 2)) * invdet + Minv(3, 3) = (M(1, 1) * M(2, 2) - M(2, 1) * M(1, 2)) * invdet + + END SUBROUTINE Inverse3by3 + !----------------------------------------------------------------------- + + + ! One-function implementation of Crout LU Decomposition. Solves Ax=b for x + SUBROUTINE LUsolve(n, A, LU, b, y, x) + + INTEGER(intKi), INTENT(IN ) :: n ! size of matrices and vectors + Real(DbKi), INTENT(IN ) :: A( n,n) ! LHS matrix (e.g. mass matrix) + Real(DbKi), INTENT(INOUT) :: LU(n,n) ! stores LU matrix data + Real(DbKi), INTENT(IN ) :: b(n) ! RHS vector + Real(DbKi), INTENT(INOUT) :: y(n) ! temporary vector + Real(DbKi), INTENT( OUT) :: x(n) ! LHS vector to solve for + + INTEGER(intKi) :: i,j,k,p + Real(DbKi) :: sum + + DO k = 1,n + DO i = k,n + + sum = 0.0_DbKi + + DO p=1,k-1 !for(int p=0; p=0; --i) + + sum = 0.0_DbKi + + DO k=i+1, n + sum = sum + LU(i,k)*x(k) + END DO + + x(i) = (y(i)-sum) + + END DO !j (actually decrementing i) + + END SUBROUTINE LUsolve + + + + ! :::::::::::::::::::::::::: interpolation subroutines ::::::::::::::::::::::::::::::: + + + SUBROUTINE getInterpNums(xlist, xin, istart, i, fout) + + Real(DbKi), INTENT (IN ) :: xlist(:) ! list of x values + Real(DbKi), INTENT (IN ) :: xin ! x value to be interpolated + Integer(IntKi),INTENT (IN ) :: istart ! first lower index to try + Integer(IntKi),INTENT ( OUT) :: i ! lower index to interpolate from + Real(DbKi), INTENT ( OUT) :: fout ! fraction to return such that y* = y[i] + fout*(y[i+1]-y[i]) + + Integer(IntKi) :: i1 + Integer(IntKi) :: nx + + i1 = 1 ! Setting in declaration causes an implied save, which would never allow this routine to find anything at the start of the array. + + nx = SIZE(xlist) + + if (xin <= xlist(1)) THEN ! below lowest data point + i = 1_IntKi + fout = 0.0_DbKi + + else if (xlist(nx) <= xin) THEN ! above highest data point + i = nx + fout = 0.0_DbKi + + else ! within the data range + + IF (xlist(min(istart,nx)) < xin) i1 = istart ! if istart is below the actual value, start with it instead of starting at 1 to save time, but make sure it doesn't overstep the array + + DO i = i1, nx-1 + IF (xlist(i+1) > xin) THEN + fout = (xin - xlist(i) )/( xlist(i+1) - xlist(i) ) + exit + END IF + END DO + END IF + + END SUBROUTINE getInterpNums + + + SUBROUTINE getInterpNumsSiKi(xlist, xin, istart, i, fout) + + Real(SiKi), INTENT (IN ) :: xlist(:) ! list of x values + Real(SiKi), INTENT (IN ) :: xin ! x value to be interpolated + Integer(IntKi),INTENT (IN ) :: istart ! first lower index to try + Integer(IntKi),INTENT ( OUT) :: i ! lower index to interpolate from + Real(SiKi), INTENT ( OUT) :: fout ! fraction to return such that y* = y[i] + fout*(y[i+1]-y[i]) + + Integer(IntKi) :: i1 + Integer(IntKi) :: nx + + i1 = 1 ! Setting in declaration causes an implied save, which would never allow this routine to find anything at the start of the array. + + nx = SIZE(xlist) + + if (xin <= xlist(1)) THEN ! below lowest data point + i = 1_IntKi + fout = 0.0_SiKi + + else if (xlist(nx) <= xin) THEN ! above highest data point + i = nx + fout = 0.0_SiKi + + else ! within the data range + + IF (xlist(min(istart,nx)) < xin) i1 = istart ! if istart is below the actual value, start with it instead of starting at 1 to save time, but make sure it doesn't overstep the array + + DO i = i1, nx-1 + IF (xlist(i+1) > xin) THEN + fout = (xin - xlist(i) )/( xlist(i+1) - xlist(i) ) + exit + END IF + END DO + END IF + + END SUBROUTINE getInterpNumsSiKi + + SUBROUTINE calculate4Dinterpolation(f, ix0, iy0, iz0, it0, fx, fy, fz, ft, c) + + Real(SiKi), INTENT (IN ) :: f(:,:,:,:) ! data array + INTEGER(IntKi), INTENT (IN ) :: ix0, iy0, iz0, it0 ! indices for interpolation + Real(SiKi), INTENT (IN ) :: fx, fy, fz, ft ! interpolation fractions + Real(DbKi), INTENT ( OUT) :: c ! the output value + + INTEGER(IntKi) :: ix1, iy1, iz1, it1 ! second indices + REAL(SiKi) :: c000, c001, c010, c011, c100, c101, c110, c111 + REAL(SiKi) :: c00, c01, c10, c11, c0, c1 + + ! handle end case conditions + if (fx == 0) then + ix1 = ix0 + else + ix1 = min(ix0+1,size(f,4)) ! don't overstep bounds + end if + + if (fy == 0) then + iy1 = iy0 + else + iy1 = min(iy0+1,size(f,3)) ! don't overstep bounds + end if + + if (fz == 0) then + iz1 = iz0 + else + iz1 = min(iz0+1,size(f,2)) ! don't overstep bounds + end if + + if (ft == 0) then + it1 = it0 + else + it1 = min(it0+1,size(f,1)) ! don't overstep bounds + end if + + c000 = f(it0,iz0,iy0,ix0)*(1.0-ft) + f(it1,iz0,iy0,ix0)*ft + c001 = f(it0,iz1,iy0,ix0)*(1.0-ft) + f(it1,iz1,iy0,ix0)*ft + c010 = f(it0,iz0,iy1,ix0)*(1.0-ft) + f(it1,iz0,iy1,ix0)*ft + c011 = f(it0,iz1,iy1,ix0)*(1.0-ft) + f(it1,iz1,iy1,ix0)*ft + c100 = f(it0,iz0,iy0,ix1)*(1.0-ft) + f(it1,iz0,iy0,ix1)*ft + c101 = f(it0,iz1,iy0,ix1)*(1.0-ft) + f(it1,iz1,iy0,ix1)*ft + c110 = f(it0,iz0,iy1,ix1)*(1.0-ft) + f(it1,iz0,iy1,ix1)*ft + c111 = f(it0,iz1,iy1,ix1)*(1.0-ft) + f(it1,iz1,iy1,ix1)*ft + + c00 = c000*(1.0-fx) + c100*fx + c01 = c001*(1.0-fx) + c101*fx + c10 = c010*(1.0-fx) + c110*fx + c11 = c011*(1.0-fx) + c111*fx + + c0 = c00 *(1.0-fy) + c10 *fy + c1 = c01 *(1.0-fy) + c11 *fy + + c = c0 *(1.0-fz) + c1 *fz + + END SUBROUTINE + + + SUBROUTINE calculate3Dinterpolation(f, ix0, iy0, iz0, fx, fy, fz, c) + + Real(SiKi), INTENT (IN ) :: f(:,:,:) ! data array + INTEGER(IntKi), INTENT (IN ) :: ix0, iy0, iz0 ! indices for interpolation + Real(SiKi), INTENT (IN ) :: fx, fy, fz ! interpolation fractions + Real(DbKi), INTENT ( OUT) :: c ! the output value + + INTEGER(IntKi) :: ix1, iy1, iz1 ! second indices + REAL(SiKi) :: c000, c001, c010, c011, c100, c101, c110, c111 + REAL(SiKi) :: c00, c01, c10, c11, c0, c1 + + ! note that "z" could also be "t" - dimension names are arbitrary + + ! handle end case conditions + if (fx == 0) then + ix1 = ix0 + else + ix1 = min(ix0+1,size(f,3)) ! don't overstep bounds + end if + + if (fy == 0) then + iy1 = iy0 + else + iy1 = min(iy0+1,size(f,2)) ! don't overstep bounds + end if + + if (fz == 0) then + iz1 = iz0 + else + iz1 = min(iz0+1,size(f,1)) ! don't overstep bounds + end if + + c000 = f(iz0,iy0,ix0) + c001 = f(iz1,iy0,ix0) + c010 = f(iz0,iy1,ix0) + c011 = f(iz1,iy1,ix0) + c100 = f(iz0,iy0,ix1) + c101 = f(iz1,iy0,ix1) + c110 = f(iz0,iy1,ix1) + c111 = f(iz1,iy1,ix1) + + c00 = c000*(1.0-fx) + c100*fx + c01 = c001*(1.0-fx) + c101*fx + c10 = c010*(1.0-fx) + c110*fx + c11 = c011*(1.0-fx) + c111*fx + + c0 = c00 *(1.0-fy) + c10 *fy + c1 = c01 *(1.0-fy) + c11 *fy + + c = c0 *(1.0-fz) + c1 *fz + + END SUBROUTINE + + SUBROUTINE calculate2Dinterpolation(f, ix0, iy0, fx, fy, c) + REAL(DbKi), INTENT (IN ) :: f(:,:) ! data array + INTEGER(IntKi), INTENT (IN ) :: ix0, iy0 ! indices for interpolation + REAL(DbKi), INTENT (IN ) :: fx, fy ! interpolation fractions + REAL(DbKi), INTENT ( OUT) :: c ! the output value + + INTEGER(IntKi) :: ix1, iy1 ! second indices + REAL(DbKi) :: c00, c01, c10, c11, c0, c1 + + ! handle end case conditions + IF (fx == 0) THEN + ix1 = ix0 + ELSE + ix1 = min(ix0+1,size(f,2)) ! don't overstep bounds + END IF + IF (fy == 0) THEN + iy1 = iy0 + ELSE + iy1 = min(iy0+1,size(f,1)) ! don't overstep bounds + END IF + c00 = f(iy0, ix0) + c01 = f(iy1, ix0) + c10 = f(iy0, ix1) + c11 = f(iy1, ix1) + c0 = c00 *(1.0-fx) + c10 *fx + c1 = c01 *(1.0-fx) + c11 *fx + c = c0 *(1.0-fy) + c1 *fy + END SUBROUTINE calculate2Dinterpolation + + + SUBROUTINE calculate1Dinterpolation(f, ix0, fx, c) + REAL(DbKi), INTENT (IN ) :: f(:) ! data array + INTEGER(IntKi), INTENT (IN ) :: ix0 ! indices for interpolation + REAL(DbKi), INTENT (IN ) :: fx ! interpolation fractions + REAL(DbKi), INTENT ( OUT) :: c ! the output value + + INTEGER(IntKi) :: ix1 ! second index + REAL(DbKi) :: c0, c1 + + ! handle end case conditions + IF (fx == 0) THEN + ix1 = ix0 + ELSE + ix1 = min(ix0+1,size(f,1)) ! don't overstep bounds + END IF + + c0 = f(ix0) + c1 = f(ix1) + c = c0*(1.0-fx) + c1*fx + END SUBROUTINE calculate1Dinterpolation + + + + + ! :::::::::::::::::::::::::: bathymetry subroutines ::::::::::::::::::::::::::::::: + + ! interpolates local seabed depth and normal vector + SUBROUTINE getDepthFromBathymetry(BathymetryGrid, BathGrid_Xs, BathGrid_Ys, LineX, LineY, depth, nvec) + + REAL(DbKi), INTENT(IN ) :: BathymetryGrid(:,:) ! need colons or some sort of dimension setting + REAL(DbKi), INTENT(IN ) :: BathGrid_Xs(:) + REAL(DbKi), INTENT(IN ) :: BathGrid_Ys(:) + REAL(DbKi), INTENT(IN ) :: LineX + REAL(DbKi), INTENT(IN ) :: LineY + REAL(DbKi), INTENT( OUT) :: depth ! local seabed depth (positive down) [m] + REAL(DbKi), INTENT( OUT) :: nvec(3) ! local seabed surface normal vector (positive out) + + INTEGER(IntKi) :: ix0, iy0 ! indeces for interpolation + INTEGER(IntKi) :: ix1, iy1 ! second indices + Real(DbKi) :: fx, fy ! interpolation fractions + REAL(DbKi) :: c00, c01, c10, c11, cx0, cx1, c0y, c1y ! temporary depth values + Real(DbKi) :: dx, dy ! x and y spacing of local grid panel [m] + Real(DbKi) :: dc_dx, dc_dy ! local slope + Real(DbKi) :: tempVector(3) ! normal vector before scaling to unit + + ! get interpolation indices and fractions for the relevant grid panel + CALL getInterpNums(BathGrid_Xs, LineX, 1, ix0, fx) + CALL getInterpNums(BathGrid_Ys, LineY, 1, iy0, fy) + + !CALL calculate2Dinterpolation(BathymetryGrid, ix, iy, fx, fy, depth) + + ! handle end case conditions + IF (fx == 0) THEN + ix1 = ix0 + ELSE + ix1 = min(ix0+1,size(BathymetryGrid,2)) ! don't overstep bounds + END IF + IF (fy == 0) THEN + iy1 = iy0 + ELSE + iy1 = min(iy0+1,size(BathymetryGrid,1)) ! don't overstep bounds + END IF + + ! get corner points of the panel + c00 = BathymetryGrid(iy0, ix0) + c01 = BathymetryGrid(iy1, ix0) + c10 = BathymetryGrid(iy0, ix1) + c11 = BathymetryGrid(iy1, ix1) + + ! get interpolated points and local value + cx0 = c00 *(1.0-fx) + c10 *fx + cx1 = c01 *(1.0-fx) + c11 *fx + c0y = c00 *(1.0-fy) + c01 *fy + c1y = c10 *(1.0-fy) + c11 *fy + depth = cx0 *(1.0-fy) + cx1 *fy + + ! get local slope + dx = BathGrid_Xs(ix1) - BathGrid_Xs(ix0) + dy = BathGrid_Ys(iy1) - BathGrid_Ys(iy0) + if ( dx > 0.0 ) then + dc_dx = (c1y-c0y)/dx + else + dc_dx = 0.0_DbKi ! maybe this should raise an error + end if + if ( dx > 0.0 ) then + dc_dy = (cx1-cx0)/dy + else + dc_dy = 0.0_DbKi ! maybe this should raise an error + end if + + tempVector(1) = dc_dx + tempVector(2) = dc_dy + tempVector(3) = 1.0_DbKi + CALL ScaleVector( tempVector, 1.0_DbKi, nvec ) ! compute unit vector + + END SUBROUTINE getDepthFromBathymetry + + + ! :::::::::::::::::::::::::: wave and current subroutines ::::::::::::::::::::::::::::::: + + + ! master function to get wave/water kinematics at a given point -- called by each object from grid-based data + SUBROUTINE getWaterKin(p, x, y, z, t, tindex, U, Ud, zeta, PDyn) + + ! This whole approach assuems that px, py, and pz are in increasing order. + ! Wheeler stretching is now built in. + + TYPE(MD_ParameterType),INTENT (IN ) :: p ! MoorDyn parameters (contains the wave info for now) + Real(DbKi), INTENT (IN ) :: x + Real(DbKi), INTENT (IN ) :: y + Real(DbKi), INTENT (IN ) :: z + Real(DbKi), INTENT (IN ) :: t + INTEGER(IntKi), INTENT (INOUT) :: tindex ! pass time index to try starting from, returns identified time index + Real(DbKi), INTENT (INOUT) :: U(3) + Real(DbKi), INTENT (INOUT) :: Ud(3) + Real(DbKi), INTENT (INOUT) :: zeta + Real(DbKi), INTENT (INOUT) :: PDyn + + + INTEGER(IntKi) :: ix, iy, iz, it ! indices for interpolation + INTEGER(IntKi) :: iz0, iz1 ! special indices for currrent interpolation + INTEGER(IntKi) :: N ! number of rod elements for convenience + Real(SiKi) :: fx, fy, fz, ft ! interpolation fractions + Real(DbKi) :: zp ! zprime coordinate used for Wheeler stretching + + + ! if wave kinematics enabled, get interpolated values from grid + if (p%WaveKin > 0) then + + ! find time interpolation indices and coefficients + !CALL getInterpNums(p%tWave, t, tindex, it, ft) + it = floor(t/ p%dtWave) + 1 ! add 1 because Fortran indexing starts at 1 + ft = (t - (it-1)*p%dtWave)/p%dtWave + tindex = it + + ! find x-y interpolation indices and coefficients + CALL getInterpNumsSiKi(p%pxWave , REAL(x,SiKi), 1, ix, fx) + CALL getInterpNumsSiKi(p%pyWave , REAL(y,SiKi), 1, iy, fy) + + ! 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 ) + + CALL getInterpNumsSiKi(p%pzWave , REAL(zp,SiKi), 1, iz, fz) + + ! 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 + U = 0.0_DbKi + Ud = 0.0_DbKi + zeta = 0.0_DbKi + PDyn = 0.0_DbKi + end if + + + ! if current kinematics enabled, add interpolated current values from profile + if (p%Current > 0) then + + CALL getInterpNumsSiKi(p%pzCurrent, REAL(z,SiKi), 1, iz0, fz) + + IF (fz == 0) THEN ! handle end case conditions + iz1 = iz0 + ELSE + iz1 = min(iz0+1,size(p%pzCurrent)) ! don't overstep bounds + END IF + + 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 SUBROUTINE getWaterKin + + + ! unused routine with old code for taking wave kinematic grid inputs from HydroDyn + SUBROUTINE CopyWaterKinFromHydroDyn(p, InitInp) + + TYPE(MD_InitInputType), INTENT(IN ) :: InitInp ! INTENT(INOUT) : Input data for initialization routine + TYPE(MD_ParameterType), INTENT( OUT) :: p ! INTENT( OUT) : Parameters + + INTEGER(IntKi) :: I, J, K, Itemp + + + ! ----------------------------- Arrays for wave kinematics ----------------------------- + + + ! :::::::::::::: BELOW WILL BE USED EVENTUALLY WHEN WAVE INFO IS AN INPUT :::::::::::::::::: + ! ! The rAll array contains all nodes or reference points in the system + ! ! (x,y,z global coordinates for each) in the order of bodies, rods, points, internal line nodes. + ! + ! ! count the number of nodes to use for passing wave kinematics + ! J=0 + ! ! Body reference point coordinates + ! J = J + p%nBodies + ! ! Rod node coordinates (including ends) + ! DO l = 1, p%nRods + ! J = J + (m%RodList(l)%N + 1) + ! END DO + ! ! Point reference point coordinates + ! J = J + p%nConnects + ! ! Line internal node coordinates + ! DO l = 1, p%nLines + ! J = J + (m%LineList(l)%N - 1) + ! END DO + ! + ! ! allocate all relevant arrays + ! ! allocate state vector and temporary state vectors based on size just calculated + ! ALLOCATE ( y%rAll(3,J), u%U(3,J), u%Ud(3,J), u%zeta(J), u%PDyn(J), STAT = ErrStat ) + ! IF ( ErrStat /= ErrID_None ) THEN + ! ErrMsg = ' Error allocating wave kinematics vectors.' + ! RETURN + ! END IF + ! + ! + ! ! go through the nodes and fill in the data (this should maybe be turned into a global function) + ! J=0 + ! ! Body reference point coordinates + ! DO I = 1, p%nBodies + ! J = J + 1 + ! y%rAll(:,J) = m%BodyList(I)%r6(1:3) + ! END DO + ! ! Rod node coordinates + ! DO I = 1, p%nRods + ! DO K = 0,m%RodList(I)%N + ! J = J + 1 + ! y%rAll(:,J) = m%RodList(I)%r(:,K) + ! END DO + ! END DO + ! ! Point reference point coordinates + ! DO I = 1, p%nConnects + ! J = J + 1 + ! y%rAll(:,J) = m%ConnectList(I)%r + ! END DO + ! ! Line internal node coordinates + ! DO I = 1, p%nLines + ! DO K = 1,m%LineList(I)%N-1 + ! J = J + 1 + ! y%rAll(:,J) = m%LineList(I)%r(:,K) + ! END DO + ! END DO + ! :::::::::::::::: the above might be used eventually. For now, let's store wave info grids within this module ::::::::::::::::: + + + ! ----- copy wave grid data over from HydroDyn (as was done in USFLOWT branch) ----- + + ! get grid and time info (currently this is hard-coded to match what's in HydroDyn_Input + ! DO I=1,p%nzWave + ! p%pz(I) = 1.0 - 2.0**(p%nzWave-I) ! -127, -63, -31, -15, -7, -3, -1, 0 + ! END DO + ! DO J = 1,p%nyWave + ! p%py(J) = WaveGrid_y0 + WaveGrid_dy*(J-1) + ! END DO + ! DO K = 1,p%nxWave + ! p%px(K) = WaveGrid_x0 + WaveGrid_dx*(K-1) + ! END DO + ! + ! p%tWave = InitInp%WaveTime + + DO I=1,p%nzWave + DO J = 1,p%nyWave + DO K = 1,p%nxWave + Itemp = (I-1)*p%nxWave*p%nyWave + (J-1)*p%nxWave + K ! index of actual node on 3D grid + + p%uxWave (:,I,J,K) = InitInp%WaveVel( :,Itemp,1) ! note: indices are t, z, y, x + p%uyWave (:,I,J,K) = InitInp%WaveVel( :,Itemp,2) + p%uzWave (:,I,J,K) = InitInp%WaveVel( :,Itemp,3) + p%axWave (:,I,J,K) = InitInp%WaveAcc( :,Itemp,1) + p%ayWave (:,I,J,K) = InitInp%WaveAcc( :,Itemp,2) + p%azWave (:,I,J,K) = InitInp%WaveAcc( :,Itemp,3) + p%PDyn( :,I,J,K) = InitInp%WavePDyn(:,Itemp) + END DO + END DO + END DO + + DO J = 1,p%nyWave + DO K = 1,p%nxWave + Itemp = (J-1)*p%nxWave + K ! index of actual node on surface 2D grid + p%zeta(:,J,K) = InitInp%WaveElev(:,Itemp) + END DO + END DO + + END SUBROUTINE CopyWaterKinFromHydroDyn + + + ! ----- write wave grid spacing to output file ----- + SUBROUTINE WriteWaveGrid(p, ErrStat, ErrMsg) + + TYPE(MD_ParameterType), INTENT(INOUT) :: p ! Parameters + + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(120) :: ErrMsg2 + + CHARACTER(120) :: Frmt + INTEGER(IntKi) :: UnOut ! for outputing wave kinematics data + INTEGER(IntKi) :: I + + + CALL GetNewUnit( UnOut) + + CALL OpenFOutFile ( UnOut, "waves.txt", ErrStat, ErrMsg ) + IF ( ErrStat > ErrID_None ) THEN + ErrMsg = ' Error opening wave grid file: '//TRIM(ErrMsg) + ErrStat = ErrID_Fatal + RETURN + END IF + + WRITE(UnOut, *, IOSTAT=ErrStat2) TRIM( 'MoorDyn v2 wave/current kinematics grid file' ) + WRITE(UnOut, *, IOSTAT=ErrStat2) TRIM( '---------------------------------------------' ) + WRITE(UnOut, *, IOSTAT=ErrStat2) TRIM( 'The following 6 lines (4-9) specify the input type then the inputs for x, then, y, then z coordinates.' ) + + WRITE(UnOut,*, IOSTAT=ErrStat2) TRIM( '1 - X input type (0: not used; 1: list values in ascending order; 2: uniform specified by -xlim, xlim, num)' ) + Frmt = '('//TRIM(Int2LStr(5))//'(A1,e10.4))' + WRITE(UnOut,*, IOSTAT=ErrStat2) ( " ", TRIM(Num2LStr(p%pxWave(I))), I=1,p%nxWave ) + + WRITE(UnOut,*, IOSTAT=ErrStat2) TRIM( '1 - Y input type (0: not used; 1: list values in ascending order; 2: uniform specified by -xlim, xlim, num)' ) + Frmt = '('//TRIM(Int2LStr(5))//'(A1,e10.4))' + WRITE(UnOut,*, IOSTAT=ErrStat2) ( " ", TRIM(Num2LStr(p%pyWave(I))), I=1,p%nyWave ) + + WRITE(UnOut,*, IOSTAT=ErrStat2) TRIM( '1 - Z input type (0: not used; 1: list values in ascending order; 2: uniform specified by -xlim, xlim, num)' ) + Frmt = '('//TRIM(Int2LStr(8))//'(A1,e10.4))' + WRITE(UnOut,*, IOSTAT=ErrStat2) ( " ", TRIM(Num2LStr(p%pzWave(I))), I=1,p%nzWave ) + + CLOSE(UnOut, IOSTAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrMsg = 'Error closing wave grid file' + END IF + + END SUBROUTINE WriteWaveGrid + + + ! ----- write wave kinematics grid data to output file ----- + SUBROUTINE WriteWaveData(p, ErrStat, ErrMsg) + + TYPE(MD_ParameterType), INTENT(INOUT) :: p ! Parameters + + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(120) :: ErrMsg2 + + INTEGER(IntKi) :: UnOut ! for outputing wave kinematics data + INTEGER(IntKi) :: I,J,K, l, Itemp + + CALL GetNewUnit( UnOut) + + CALL OpenFOutFile ( UnOut, "wave data.txt", ErrStat, ErrMsg ) + IF ( ErrStat > ErrID_None ) THEN + ErrMsg = ' Error opening wave grid file: '//TRIM(ErrMsg) + ErrStat = ErrID_Fatal + RETURN + END IF + + ! write channel labels + + + ! time + WRITE(UnOut,"(A10)", IOSTAT=ErrStat2, advance="no") "Time" + + DO J = 1,p%nyWave !y + DO K = 1,p%nxWave !x + WRITE(UnOut,"(A3,A8)", IOSTAT=ErrStat2, advance="no") " ze0", Num2Lstr(J+10*K) + END DO + END DO + DO I=1,p%nzWave !z + DO J = 1,p%nyWave !y + DO K = 1,p%nxWave !x + WRITE(UnOut,"(A3,A8)", IOSTAT=ErrStat2, advance="no") " ux", Num2Lstr(I+10*J+100*K) + WRITE(UnOut,"(A3,A8)", IOSTAT=ErrStat2, advance="no") " uy", Num2Lstr(I+10*J+100*K) + WRITE(UnOut,"(A3,A8)", IOSTAT=ErrStat2, advance="no") " uz", Num2Lstr(I+10*J+100*K) + END DO + END DO + END DO + DO I=1,p%nzWave !z + DO J = 1,p%nyWave !y + DO K = 1,p%nxWave !x + WRITE(UnOut,"(A3,A8)", IOSTAT=ErrStat2, advance="no") " ax", Num2Lstr(I+10*J+100*K) + WRITE(UnOut,"(A3,A8)", IOSTAT=ErrStat2, advance="no") " ay", Num2Lstr(I+10*J+100*K) + WRITE(UnOut,"(A3,A8)", IOSTAT=ErrStat2, advance="no") " az", Num2Lstr(I+10*J+100*K) + END DO + END DO + END DO + DO I=1,p%nzWave !z + DO J = 1,p%nyWave !y + DO K = 1,p%nxWave !x + WRITE(UnOut,"(A3,A8)", IOSTAT=ErrStat2, advance="no") " pd", Num2Lstr(I+10*J+100*K) + END DO + END DO + END DO + + ! end the line + WRITE(UnOut, "(A1)", IOSTAT=ErrStat2) " " + + + + DO l=1, p%ntWave ! loop through all time steps + + ! time + WRITE(UnOut,"(F10.4)", IOSTAT=ErrStat2, advance="no") p%dtWave*(l-1) + !WRITE(UnOut,"(F10.4)", IOSTAT=ErrStat2, advance="no") InitInp%WaveTime(l) + + ! wave elevation (all slices for now, to check) + DO J = 1,p%nyWave !y + DO K = 1,p%nxWave !x + Itemp = (J-1)*p%nxWave + K ! index of actual node + + WRITE(UnOut,"(A1,e10.3)", IOSTAT=ErrStat2, advance="no") " ", p%zeta(l,J,K) + END DO + END DO + + ! wave velocities + DO I=1,p%nzWave !z + DO J = 1,p%nyWave !y + DO K = 1,p%nxWave !x + Itemp = (I-1)*p%nxWave*p%nyWave + (J-1)*p%nxWave + K ! index of actual node + + WRITE(UnOut,"(A1,e10.3)", IOSTAT=ErrStat2, advance="no") " ", p%uxWave(l,I,J,K) + WRITE(UnOut,"(A1,e10.3)", IOSTAT=ErrStat2, advance="no") " ", p%uyWave(l,I,J,K) + WRITE(UnOut,"(A1,e10.3)", IOSTAT=ErrStat2, advance="no") " ", p%uzWave(l,I,J,K) + END DO + END DO + END DO + + ! wave accelerations + DO I=1,p%nzWave !z + DO J = 1,p%nyWave !y + DO K = 1,p%nxWave !x + Itemp = (I-1)*p%nxWave*p%nyWave + (J-1)*p%nxWave + K ! index of actual node + + WRITE(UnOut,"(A1,e10.3)", IOSTAT=ErrStat2, advance="no") " ", p%axWave(l,I,J,K) + WRITE(UnOut,"(A1,e10.3)", IOSTAT=ErrStat2, advance="no") " ", p%ayWave(l,I,J,K) + WRITE(UnOut,"(A1,e10.3)", IOSTAT=ErrStat2, advance="no") " ", p%azWave(l,I,J,K) + END DO + END DO + END DO + + ! dynamic pressure + DO I=1,p%nzWave !z + DO J = 1,p%nyWave !y + DO K = 1,p%nxWave !x + Itemp = (I-1)*p%nxWave*p%nyWave + (J-1)*p%nxWave + K ! index of actual node + + WRITE(UnOut,"(A1,e10.3)", IOSTAT=ErrStat2, advance="no") " ", p%PDyn(l,I,J,K) + END DO + END DO + END DO + + ! end the line + WRITE(UnOut, "(A1)", IOSTAT=ErrStat2) " " + + + END DO + + + CLOSE(UnOut, IOSTAT = ErrStat ) + IF ( ErrStat /= 0 ) THEN + ErrMsg = 'Error closing wave grid file' + END IF + + END SUBROUTINE WriteWaveData + + + ! ----- process WaterKin input value, potentially reading wave inputs and generating wave field ----- + SUBROUTINE setupWaterKin(WaterKinString, p, Tmax, ErrStat, ErrMsg) + + CHARACTER(40), INTENT(IN ) :: WaterKinString ! string describing water kinematics filename + TYPE(MD_ParameterType), INTENT(INOUT) :: p ! Parameters + REAL(ReKi), INTENT(IN ) :: Tmax + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + INTEGER(IntKi) :: I, iIn, ix, iy, iz + INTEGER(IntKi) :: ntIn ! number of time series inputs from file + INTEGER(IntKi) :: UnIn ! unit number for coefficient input file + INTEGER(IntKi) :: UnEcho + REAL(SiKi) :: pzCurrentTemp(100) ! current depth increments read in from input file (positive-down at this stage) + REAL(SiKi) :: uxCurrentTemp(100) + REAL(SiKi) :: uyCurrentTemp(100) + + CHARACTER(120) :: WaveKinFile + INTEGER(IntKi) :: UnElev ! unit number for coefficient input file + REAL(SiKi), ALLOCATABLE :: WaveTimeIn(:) ! temporarily holds wave input time series + REAL(SiKi), ALLOCATABLE :: WaveElevIn(:) + REAL(SiKi), ALLOCATABLE :: WaveElev0(:) ! interpolated reference wave elevation time series + REAL(SiKi) :: WaveDir + REAL(SiKi) :: t, Frac + CHARACTER(1024) :: FileName ! Name of MoorDyn input file + CHARACTER(120) :: Line + CHARACTER(120) :: Line2 + CHARACTER(120) :: entries2 + INTEGER(IntKi) :: coordtype + + INTEGER(IntKi) :: NStepWave ! + INTEGER(IntKi) :: NStepWave2 ! + REAL(SiKi) :: WaveTMax ! max wave elevation time series duration after optimizing lenght for FFT + REAL(SiKi) :: WaveDOmega + REAL(SiKi) :: SinWaveDir ! SIN( WaveDirArr(I) ) -- Each wave frequency has a unique wave direction. + REAL(SiKi) :: CosWaveDir ! COS( WaveDirArr(I) ) -- Each wave frequency has a unique wave direction. + + REAL(SiKi), ALLOCATABLE :: TmpFFTWaveElev(:) ! Data for the FFT calculation + TYPE(FFT_DataType) :: FFT_Data ! the instance of the FFT module we're using + + + COMPLEX(SiKi),ALLOCATABLE :: tmpComplex(:) ! A temporary array (0:NStepWave2-1) for FFT use. + + REAL(SiKi) :: Omega ! Wave frequency (rad/s) + COMPLEX(SiKi), PARAMETER :: ImagNmbr = (0.0,1.0) ! The imaginary number, SQRT(-1.0) + COMPLEX(SiKi) :: ImagOmega ! = ImagNmbr*Omega (rad/s) + REAL(DbKi), ALLOCATABLE :: WaveNmbr(:) ! wave number for frequency array + REAL(SiKi), ALLOCATABLE :: WaveElevC0(:,:) ! Discrete Fourier transform of the instantaneous elevation of incident waves at the ref point (meters) + COMPLEX(SiKi), ALLOCATABLE :: WaveElevC( :) ! Discrete Fourier transform of the instantaneous elevation of incident waves at the ref point (meters) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccCHx(:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccCHy(:) ! Discrete Fourier transform of the instantaneous horizontal acceleration in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveAccCV( :) ! Discrete Fourier transform of the instantaneous vertical acceleration of incident waves before applying stretching at the zi-coordinates for points (m/s^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveDynPC( :) ! Discrete Fourier transform of the instantaneous dynamic pressure of incident waves before applying stretching at the zi-coordinates for points (N/m^2) + COMPLEX(SiKi), ALLOCATABLE :: WaveVelCHx(:) ! Discrete Fourier transform of the instantaneous horizontal velocity of incident waves before applying stretching at the zi-coordinates for points (m/s) + COMPLEX(SiKi), ALLOCATABLE :: WaveVelCHy(:) ! Discrete Fourier transform of the instantaneous horizontal velocity in x-direction of incident waves before applying stretching at the zi-coordinates for points (m/s) + COMPLEX(SiKi), ALLOCATABLE :: WaveVelCV( :) ! Discrete Fourier transform of the instantaneous vertical velocity in y-direction of incident waves before applying stretching at the zi-coordinates for points (m/s) + COMPLEX(SiKi) :: WGNC ! Discrete Fourier transform of the realization of a White Gaussian Noise (WGN) time series process with unit variance for the current frequency component (-) + + INTEGER(IntKi) :: ErrStatTmp + INTEGER(IntKi) :: ErrStat2 + CHARACTER(120) :: ErrMsg2 + CHARACTER(120) :: RoutineName = 'SetupWaveKin' + + + ErrStatTmp = ErrID_None ! TODO: get rid of redundancy <<< + ErrStat2 = ErrID_None + ErrMsg2 = "" + + IF (LEN_TRIM(WaterKinString) == 0) THEN + ! If the input is empty (not provided), there are no water kinematics to be included + p%WaveKin = 0 + p%Current = 0 + return + + ELSE IF (SCAN(WaterKinString, "abcdfghijklmnopqrstuvwxyzABCDFGHIJKLMNOPQRSTUVWXYZ") == 0) THEN + ! If the input has no letters, let's assume it's a number + print *, "ERROR WaveKin option does not currently support numeric entries. It must be a filename." + p%WaveKin = 0 + p%Current = 0 + return + END IF + + + ! otherwise interpret the input as a file name to load the bathymetry lookup data from + print *, " The waterKin input contains letters so will load a water kinematics input file" + + + ! -------- load water kinematics input file ------------- + + IF ( PathIsRelative( WaterKinString ) ) THEN ! properly handle relative path <<< + !CALL GetPath( TRIM(InitInp%InputFile), TmpPath ) + FileName = TRIM(p%PriPath)//TRIM(WaterKinString) + ELSE + FileName = trim(WaterKinString) + END IF + + + + UnEcho=-1 + CALL GetNewUnit( UnIn ) + CALL OpenFInpFile( UnIn, FileName, ErrStat2, ErrMsg2); if(Failed()) return + + + CALL ReadCom( UnIn, FileName, 'MoorDyn water kinematics input file header', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + CALL ReadCom( UnIn, FileName, 'MoorDyn water kinematics input file header', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + ! ----- waves ----- + CALL ReadCom( UnIn, FileName, 'waves header', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + CALL ReadVar( UnIn, FileName, p%WaveKin , 'WaveKinMod' , 'WaveKinMod' , ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + CALL ReadVar( UnIn, FileName, WaveKinFile, 'WaveKinFile', 'WaveKinFile' , ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + CALL ReadVar( UnIn, FileName, p%dtWave , 'dtWave', 'time step for waves', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + CALL ReadVar( UnIn, FileName, WaveDir , 'WaveDir' , 'wave direction', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + ! X grid points + READ(UnIn,*, IOSTAT=ErrStat2) coordtype ! get the entry type + READ(UnIn,'(A)', IOSTAT=ErrStat2) entries2 ! get entries as string to be processed + CALL gridAxisCoords(coordtype, entries2, p%pxWave, p%nxWave, ErrStat2, ErrMsg2) + ! Y grid points + READ(UnIn,*, IOSTAT=ErrStat2) coordtype ! get the entry type + READ(UnIn,'(A)', IOSTAT=ErrStat2) entries2 ! get entries as string to be processed + CALL gridAxisCoords(coordtype, entries2, p%pyWave, p%nyWave, ErrStat2, ErrMsg2) + ! Z grid points + READ(UnIn,*, IOSTAT=ErrStat2) coordtype ! get the entry type + READ(UnIn,'(A)', IOSTAT=ErrStat2) entries2 ! get entries as string to be processed + CALL gridAxisCoords(coordtype, entries2, p%pzWave, p%nzWave, ErrStat2, ErrMsg2) + ! ----- current ----- + CALL ReadCom( UnIn, FileName, 'current header', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + CALL ReadVar( UnIn, FileName, p%Current, 'CurrentMod', 'CurrentMod', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + CALL ReadCom( UnIn, FileName, 'current profile header', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + CALL ReadCom( UnIn, FileName, 'current profile header', ErrStat2, ErrMsg2, UnEcho); if(Failed()) return + ! current profile table... (read through to end of file or ---) + DO I=1,100 + READ(UnIn, *, IOSTAT=ErrStat2) pzCurrentTemp(i), uxCurrentTemp(i), uyCurrentTemp(i) ! read into a line + if (ErrStat2 /= 0) then + p%nzCurrent = i-1 ! save number of valid current depth points in profile + EXIT ! break out of the loop if it couldn't read the line (i.e. if at end of file) + end if + if (i == 100) then + print*,"WARNING: MD can handle a maximum of 100 current profile points" + exit + end if + END DO + + + CLOSE(UnIn) + + + ! ------------------- start with wave kinematics ----------------------- + + ! WaveKin options: 0 - none or set externally during the sim (Waves object not needed unless there's current) [default] + ! 1 - set externally for each node in each object (Waves object not needed unless there's current) (TBD) + ! 2 - set from inputted wave elevation FFT, grid approach* (TBD) + ! 3 - set from inputted wave elevation time series, grid approach* [supported] + ! 4 - set from inputted wave elevation FFT, node approach (TBD) + ! 5 - set from inputted wave elevation time series, node approach (TBD) + ! 6 - set from inputted velocity, acceleration, and wave elevation grid data (TBD)** + + ! Current options: 0 - no currents or set externally (as part of WaveKin =0 or 1 approach) [default] + ! 1 - read in steady current profile, grid approach (current_profile.txt)** [supported] + ! 2 - read in dynamic current profile, grid approach (current_profile_dynamic.txt)** (TBD) + ! 3 - read in steady current profile, node approach (current_profile.txt) (TBD) + ! 4 - read in dynamic current profile, node approach (current_profile_dynamic.txt) (TBD) + + ! * the first call to any of these will attempt to load water_grid.txt to define the grid to put things on + ! ** if a grid has already been set, these will interpolate onto it, otherwise they'll make a new grid based on their provided coordinates + + ! NOTE: lots of partial code is available from MD-C for supporting various wave kinematics input options + + ! WaveKin and Current compatibility check could go here in future + + + ! --------------------- set from inputted wave elevation time series, grid approach ------------------- + if (p%WaveKin == 3) then + + print *, 'Setting up WaveKin 3 option: read wave elevation time series from file' + + IF ( LEN_TRIM( WaveKinFile ) == 0 ) THEN + CALL SetErrStat( ErrID_Fatal,'WaveKinFile must not be an empty string.',ErrStat, ErrMsg, RoutineName); return + RETURN + END IF + + IF ( PathIsRelative( WaveKinFile ) ) THEN ! properly handle relative path <<< + !CALL GetPath( TRIM(InitInp%InputFile), TmpPath ) + WaveKinFile = TRIM(p%PriPath)//TRIM(WaveKinFile) + END IF + + ! note: following is adapted from MoorDyn_Driver + + CALL GetNewUnit( UnElev ) + + CALL OpenFInpFile ( UnElev, WaveKinFile, ErrStat2, ErrMsg2 ); if(Failed()) return + + print *, 'Reading wave elevation data from ', trim(WaveKinFile) + + ! Read through length of file to find its length + i = 1 ! start counter + DO + READ(UnElev,'(A)',IOSTAT=ErrStat2) Line !read into a line + IF (ErrStat2 /= 0) EXIT ! break out of the loop if it couldn't read the line (i.e. if at end of file) + i = i+1 + END DO + + ! rewind to start of input file to re-read things now that we know how long it is + REWIND(UnElev) + + ntIn = i-3 ! save number of lines of file + + + ! allocate space for input wave elevation array (including time column) + CALL AllocAry(WaveTimeIn, ntIn, 'WaveTimeIn', ErrStat2, ErrMsg2 ); if(Failed()) return + CALL AllocAry(WaveElevIn, ntIn, 'WaveElevIn', ErrStat2, ErrMsg2 ); if(Failed()) return + + ! read the data in from the file + READ(UnElev,'(A)',IOSTAT=ErrStat2) Line ! skip the first two lines as headers + READ(UnElev,'(A)',IOSTAT=ErrStat2) Line ! + + DO i = 1, ntIn + READ (UnElev, *, IOSTAT=ErrStat2) WaveTimeIn(i), WaveElevIn(i) + + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal,'Error reading WaveElev input file.',ErrStat, ErrMsg, RoutineName); return + END IF + END DO + + ! Close the inputs file + CLOSE ( UnElev ) + + print *, "Read ", ntIn, " time steps from input file." + + ! if (WaveTimeIn(ntIn) < TMax) then <<<< need to handle if time series is too short? + + ! specify stepping details + p%ntWave = CEILING(Tmax/p%dtWave) ! number of wave time steps + + + ! allocate space for processed reference wave elevation time series + ALLOCATE ( WaveElev0( 0:p%ntWave ), STAT=ErrStatTmp ) ! this has an extra entry of zero in case it needs to be padded to be even + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveElev0.',ErrStat,ErrMsg,RoutineName) + WaveElev0 = 0.0_SiKi + + ! go through and interpolate (should replace with standard function) + DO i = 1, p%ntWave + t = p%dtWave*(i-1) + + ! interpolation routine + DO iIn = 1,ntIn-1 + IF (WaveTimeIn(iIn+1) > t) THEN ! find the right two points to interpolate between (remember that the first column of PtfmMotIn is time) + frac = (t - WaveTimeIn(iIn) )/( WaveTimeIn(iIn+1) - WaveTimeIn(iIn) ) ! interpolation fraction (0-1) between two interpolation points + WaveElev0(i-1) = WaveElevIn(iIn) + frac*(WaveElevIn(iIn+1) - WaveElevIn(iIn)) ! get interpolated wave elevation + EXIT ! break out of the loop for this time step once we've done its interpolation + END IF + END DO + END DO + + ! note: following is adapted from UserWaves.v90 UserWaveElevations_Init + + + + ! Set new value for NStepWave so that the FFT algorithms are efficient. We will use the values passed in rather than what is read from the file + + IF ( MOD(p%ntWave,2) == 1 ) p%ntWave = p%ntWave + 1 ! Set NStepWave to an even integer + NStepWave2 = MAX( p%ntWave/2, 1 ) ! Make sure that NStepWave is an even product of small factors (PSF) that is + NStepWave = 2*PSF ( NStepWave2, 9 ) ! greater or equal to WaveTMax/WaveDT to ensure that the FFT is efficient. + NStepWave2 = NStepWave/2 ! Update the value of NStepWave2 based on the value needed for NStepWave. + WaveTMax = NStepWave*p%dtWave ! Update the value of WaveTMax based on the value needed for NStepWave. + WaveDOmega = TwoPi/TMax ! Compute the frequency step for incident wave calculations. + p%ntWave = NStepWave + + + + + ! Allocate array to hold the wave elevations for calculation of FFT. + ALLOCATE ( TmpFFTWaveElev( 0:NStepWave-1 ), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array TmpFFTWaveElev.',ErrStat,ErrMsg,RoutineName) + + ! Allocate frequency array for the wave elevation information in frequency space + ALLOCATE ( WaveElevC0(2, 0:NStepWave2 ), STAT=ErrStatTmp ) + IF (ErrStatTmp /= 0) CALL SetErrStat(ErrID_Fatal,'Cannot allocate array WaveElevC0.',ErrStat,ErrMsg,RoutineName) + + + ! Now check if all the allocations worked properly + IF ( ErrStat >= AbortErrLev ) THEN + CALL CleanUp() + RETURN + END IF + + ! Set the values + TmpFFTWaveElev = 0.0_DbKi + WaveElevC0(:,:) = 0.0_DbKi + + + ! Copy values over + DO I=0, MIN(SIZE(WaveElev0), NStepWave)-1 + TmpFFTWaveElev(I) = WaveElev0(I) + ENDDO + + ! Initialize the FFT + CALL InitFFT ( NStepWave, FFT_Data, .FALSE., ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.',ErrStat,ErrMsg,RoutineName); if(Failed()) return + + ! Apply the forward FFT to get the real and imaginary parts of the frequency information. + CALL ApplyFFT_f ( TmpFFTWaveElev(:), FFT_Data, ErrStatTmp ) ! Note that the TmpFFTWaveElev now contains the real and imaginary bits. + CALL SetErrStat(ErrStatTmp,'Error occured while applying the forwards FFT to TmpFFTWaveElev array.',ErrStat,ErrMsg,RoutineName); if(Failed()) return + + ! Copy the resulting TmpFFTWaveElev(:) data over to the WaveElevC0 array + DO I=1,NStepWave2-1 + WaveElevC0 (1,I) = TmpFFTWaveElev(2*I-1) + WaveElevC0 (2,I) = TmpFFTWaveElev(2*I) + ENDDO + WaveElevC0(:,NStepWave2) = 0.0_SiKi + + CALL ExitFFT(FFT_Data, ErrStatTmp) + CALL SetErrStat(ErrStatTmp,'Error occured while cleaning up after the FFTs.', ErrStat,ErrMsg,RoutineName); if(Failed()) return + + + IF (ALLOCATED( WaveElev0 )) DEALLOCATE( WaveElev0 , STAT=ErrStatTmp) + IF (ALLOCATED( TmpFFTWaveElev )) DEALLOCATE( TmpFFTWaveElev, STAT=ErrStatTmp) + + + + ! note: following is a very streamlined adaptation from from Waves.v90 VariousWaves_Init + + ! allocate all the wave kinematics FFT arrays + ALLOCATE( WaveNmbr (0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate WaveNmbr. ',ErrStat,ErrMsg,RoutineName) + ALLOCATE( tmpComplex(0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate tmpComplex.',ErrStat,ErrMsg,RoutineName) + ALLOCATE( WaveElevC (0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate WaveElevC .',ErrStat,ErrMsg,RoutineName) + ALLOCATE( WaveDynPC (0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate WaveDynPC .',ErrStat,ErrMsg,RoutineName) + ALLOCATE( WaveVelCHx(0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate WaveVelCHx.',ErrStat,ErrMsg,RoutineName) + ALLOCATE( WaveVelCHy(0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate WaveVelCHy.',ErrStat,ErrMsg,RoutineName) + ALLOCATE( WaveVelCV (0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate WaveVelCV .',ErrStat,ErrMsg,RoutineName) + ALLOCATE( WaveAccCHx(0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate WaveAccCHx.',ErrStat,ErrMsg,RoutineName) + ALLOCATE( WaveAccCHy(0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate WaveAccCHy.',ErrStat,ErrMsg,RoutineName) + ALLOCATE( WaveAccCV (0:NStepWave2), STAT=ErrStatTmp); CALL SetErrStat(ErrStatTmp,'Cannot allocate WaveAccCV .',ErrStat,ErrMsg,RoutineName) + + ! allocate time series grid data arrays (now that we know the number of time steps coming from the IFFTs) + CALL allocateKinematicsArrays() + + + ! Set the CosWaveDir and SinWaveDir values + CosWaveDir=COS(D2R*WaveDir) + SinWaveDir=SIN(D2R*WaveDir) + + ! get wave number array once + DO I = 0, NStepWave2 + WaveNmbr(i) = WaveNumber ( dble(I*WaveDOmega), p%g, p%WtrDpth ) + tmpComplex(I) = CMPLX(WaveElevC0(1,I), WaveElevC0(2,I)) + END DO + + ! set up FFTer for doing IFFTs + CALL InitFFT ( NStepWave, FFT_Data, .TRUE., ErrStatTmp ) + CALL SetErrStat(ErrStatTmp,'Error occured while initializing the FFT.', ErrStat, ErrMsg, routineName); if(Failed()) return + + ! Loop through all points where the incident wave kinematics will be computed + do ix = 1,p%nxWave + do iy = 1,p%nyWave + do iz = 1,p%nzWave + + ! Compute the discrete Fourier transform of the incident wave kinematics + do i = 0, NStepWave2 ! Loop through the positive frequency components (including zero) of the discrete Fourier transforms + + Omega = i*WaveDOmega + ImagOmega = ImagNmbr*Omega + + WaveElevC (i) = tmpComplex(i) * EXP( -ImagNmbr*WaveNmbr(i)*( p%pxWave(ix)*CosWaveDir + p%pyWave(iy)*SinWaveDir )) + WaveDynPC (i) = p%rhoW*p%g* WaveElevC(i) * COSHNumOvrCOSHDen( WaveNmbr(i), p%WtrDpth, DBLE(p%pzWave(iz)) ) + WaveVelCHx(i) = Omega*WaveElevC(i) * COSHNumOvrSINHDen( WaveNmbr(i), p%WtrDpth, DBLE(p%pzWave(iz)) ) *CosWaveDir + WaveVelCHy(i) = Omega*WaveElevC(i) * COSHNumOvrSINHDen( WaveNmbr(i), p%WtrDpth, DBLE(p%pzWave(iz)) ) *SinWaveDir + WaveVelCV (i) = ImagOmega*WaveElevC(i) * SINHNumOvrSINHDen( WaveNmbr(i), p%WtrDpth, DBLE(p%pzWave(iz)) ) + WaveAccCHx(i) = ImagOmega*WaveVelCHx(i) + WaveAccCHy(i) = ImagOmega*WaveVelCHy(i) + WaveAccCV (i) = ImagOmega*WaveVelCV (i) + end do ! I, frequencies + + ! now IFFT all the wave kinematics except surface elevation and save it into the grid of data + CALL ApplyFFT_cx( p%PDyn (:,iz,iy,ix), WaveDynPC , FFT_Data, ErrStatTmp ); CALL SetErrStat(ErrStatTmp,'Error IFFTing WaveDynP.', ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( p%uxWave(:,iz,iy,ix), WaveVelCHx, FFT_Data, ErrStatTmp ); CALL SetErrStat(ErrStatTmp,'Error IFFTing WaveVelHx.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( p%uyWave(:,iz,iy,ix), WaveVelCHy, FFT_Data, ErrStatTmp ); CALL SetErrStat(ErrStatTmp,'Error IFFTing WaveVelHy.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( p%uzWave(:,iz,iy,ix), WaveVelCV , FFT_Data, ErrStatTmp ); CALL SetErrStat(ErrStatTmp,'Error IFFTing WaveVelV.', ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( p%axWave(:,iz,iy,ix), WaveAccCHx, FFT_Data, ErrStatTmp ); CALL SetErrStat(ErrStatTmp,'Error IFFTing WaveAccHx.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( p%ayWave(:,iz,iy,ix), WaveAccCHy, FFT_Data, ErrStatTmp ); CALL SetErrStat(ErrStatTmp,'Error IFFTing WaveAccHy.',ErrStat,ErrMsg,RoutineName) + CALL ApplyFFT_cx( p%azWave(:,iz,iy,ix), WaveAccCV , FFT_Data, ErrStatTmp ); CALL SetErrStat(ErrStatTmp,'Error IFFTing WaveAccV.', ErrStat,ErrMsg,RoutineName) + + end do ! iz + + ! IFFT wave elevation here because it's only at the surface + CALL ApplyFFT_cx( p%zeta(:,iy,ix) , WaveElevC , FFT_Data, ErrStatTmp ); CALL SetErrStat(ErrStatTmp,'Error IFFTing WaveElev.', ErrStat,ErrMsg,RoutineName) + end do ! iy + end do ! ix + + ! could also reproduce the wave elevation at 0,0,0 on a separate channel for verification... + + CALL ExitFFT(FFT_Data, ErrStatTmp) + CALL SetErrStat(ErrStatTmp,'Error occured while cleaning up after the IFFTs.', ErrStat,ErrMsg,RoutineName); if(Failed()) return + + end if ! p%WaveKin == 3 + + + ! --------------------------------- now do currents -------------------------------- + if (p%Current == 1) then + + ! allocate current profile arrays to correct size + CALL AllocAry( p%pzCurrent, p%nzCurrent, 'pzCurrent', ErrStat2, ErrMsg2 ); if(Failed()) return + CALL AllocAry( p%uxCurrent, p%nzCurrent, 'uxCurrent', ErrStat2, ErrMsg2 ); if(Failed()) return + CALL AllocAry( p%uyCurrent, p%nzCurrent, 'uyCurrent', ErrStat2, ErrMsg2 ); if(Failed()) return + + ! copy over data, flipping sign of depth values (to be positive-up) and reversing order + do i = 1,p%nzCurrent + p%pzCurrent(i) = -pzCurrentTemp(p%nzCurrent + 1 - i) ! flip sign so depth is positive-up + p%uxCurrent(i) = uxCurrentTemp(p%nzCurrent + 1 - i) + p%uyCurrent(i) = uyCurrentTemp(p%nzCurrent + 1 - i) + end do + + end if ! p%Current == 1 + + + ! ------------------------------ clean up and finished --------------------------- + CALL cleanup() + + + CONTAINS + + + ! get grid axis coordinates, initialize/record in array, and return size + SUBROUTINE gridAxisCoords(coordtype, entries, coordarray, n, ErrStat, ErrMsg) + + INTEGER(IntKi), INTENT(IN ) :: coordtype + CHARACTER(*), INTENT(INOUT) :: entries + REAL(SiKi), ALLOCATABLE, INTENT(INOUT) :: coordarray(:) + INTEGER(IntKi), INTENT( OUT) :: n + + + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + REAL(ReKi) :: tempArray (100) + REAL(ReKi) :: dx + INTEGER(IntKi) :: nEntries, I + + ! get array of coordinate entries + CALL stringToArray(entries, nEntries, tempArray) + + ! set number of coordinates + if ( coordtype==0) then ! 0: not used - make one grid point at zero + n = 1; + else if (coordtype==1) then ! 1: list values in ascending order + n = nEntries + else if (coordtype==2) then ! 2: uniform specified by -xlim, xlim, num + n = int(tempArray(3)) + else + print *, "Error: invalid coordinate type specified to gridAxisCoords" + end if + + ! allocate coordinate array + CALL AllocAry(coordarray, n, 'x,y, or z grid points' , ErrStat, ErrMsg) + !ALLOCATE ( coordarray(n), STAT=ErrStat) + + ! fill in coordinates + if ( coordtype==0) then + coordarray(1) = 0.0_ReKi + + else if (coordtype==1) then + coordarray(1:n) = tempArray(1:n) + + else if (coordtype==2) then + coordarray(1) = tempArray(1) + coordarray(n) = tempArray(2) + dx = (coordarray(n)-coordarray(0))/REAL(n-1) + do i=2,n-1 + coordarray(i) = coordarray(1) + REAL(i)*dx + end do + + else + print *, "Error: invalid coordinate type specified to gridAxisCoords" + end if + + print *, "Set water grid coordinates to :" + DO i=1,n + print *, " ", coordarray(i) + end do + + END SUBROUTINE gridAxisCoords + + + ! Extract an array of numbers out of a string with comma-separated numbers (this could go in a more general location) + SUBROUTINE stringToArray(instring, n, outarray) + + CHARACTER(*), INTENT(INOUT) :: instring + INTEGER(IntKi), INTENT( OUT) :: n + REAL(ReKi), INTENT( OUT) :: outarray(100) ! array of output numbers (100 maximum) + + CHARACTER(40) :: tempstring + INTEGER :: pos1, pos2, i + + outarray = 0.0_ReKi + + n = 0 + pos1=1 + + DO + pos2 = INDEX(instring(pos1:), ",") ! find index of next comma + IF (pos2 == 0) THEN ! if there isn't another comma, read the last entry and call it done (this could be the only entry if no commas) + n = n + 1 + READ(instring(pos1:), *) outarray(n) + EXIT + END IF + n = n + 1 + if (n > 100) then + print *, "ERROR - stringToArray cannot do more than 100 entries" + end if + READ(instring(pos1:pos1+pos2-2), *) outarray(n) + + pos1 = pos2+pos1 + END DO + + END SUBROUTINE stringToArray + + + ! allocate water kinematics arrays + SUBROUTINE allocateKinematicsArrays() + ! error check print *, "Error in Waves::makeGrid, a time or space array is size zero." << endl; + + ALLOCATE ( p%uxWave( p%ntWave,p%nzWave,p%nyWave,p%nxWave), STAT=ErrStatTmp) + ALLOCATE ( p%uyWave( p%ntWave,p%nzWave,p%nyWave,p%nxWave), STAT=ErrStatTmp) + ALLOCATE ( p%uzWave( p%ntWave,p%nzWave,p%nyWave,p%nxWave), STAT=ErrStatTmp) + ALLOCATE ( p%axWave( p%ntWave,p%nzWave,p%nyWave,p%nxWave), STAT=ErrStatTmp) + ALLOCATE ( p%ayWave( p%ntWave,p%nzWave,p%nyWave,p%nxWave), STAT=ErrStatTmp) + ALLOCATE ( p%azWave( p%ntWave,p%nzWave,p%nyWave,p%nxWave), STAT=ErrStatTmp) + ALLOCATE ( p%PDyn ( p%ntWave,p%nzWave,p%nyWave,p%nxWave), STAT=ErrStatTmp) + ALLOCATE ( p%zeta ( p%ntWave,p%nyWave,p%nxWave), STAT = ErrStatTmp ) ! 2D grid over x and y only + + END SUBROUTINE allocateKinematicsArrays + + + ! compact way to set the right error status and check if an abort is needed (and do cleanup if so) + LOGICAL FUNCTION Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SetupWaterKin') + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + END FUNCTION Failed + + + SUBROUTINE CleanUp + + !IF (ALLOCATED( WaveElev )) DEALLOCATE( WaveElev, STAT=ErrStatTmp) + !IF (ALLOCATED( WaveTime )) DEALLOCATE( WaveTime, STAT=ErrStatTmp) + IF (ALLOCATED( TmpFFTWaveElev )) DEALLOCATE( TmpFFTWaveElev, STAT=ErrStatTmp) + IF (ALLOCATED( WaveElevC0 )) DEALLOCATE( WaveElevC0, STAT=ErrStatTmp) + + ! >>> missing some things <<< + + IF (ALLOCATED( WaveNmbr )) DEALLOCATE( WaveNmbr , STAT=ErrStatTmp) + IF (ALLOCATED( tmpComplex )) DEALLOCATE( tmpComplex , STAT=ErrStatTmp) + IF (ALLOCATED( WaveElevC )) DEALLOCATE( WaveElevC , STAT=ErrStatTmp) + IF (ALLOCATED( WaveDynPC )) DEALLOCATE( WaveDynPC , STAT=ErrStatTmp) + IF (ALLOCATED( WaveVelCHx )) DEALLOCATE( WaveVelCHx , STAT=ErrStatTmp) + IF (ALLOCATED( WaveVelCHy )) DEALLOCATE( WaveVelCHy , STAT=ErrStatTmp) + IF (ALLOCATED( WaveVelCV )) DEALLOCATE( WaveVelCV , STAT=ErrStatTmp) + IF (ALLOCATED( WaveAccCHx )) DEALLOCATE( WaveAccCHx , STAT=ErrStatTmp) + IF (ALLOCATED( WaveAccCHy )) DEALLOCATE( WaveAccCHy , STAT=ErrStatTmp) + IF (ALLOCATED( WaveAccCV )) DEALLOCATE( WaveAccCV , STAT=ErrStatTmp) + + END SUBROUTINE CleanUp + + + !======================================================================= + FUNCTION WaveNumber ( Omega, g, h ) + + + ! This FUNCTION solves the finite depth dispersion relationship: + ! + ! k*tanh(k*h)=(Omega^2)/g + ! + ! for k, the wavenumber (WaveNumber) given the frequency, Omega, + ! gravitational constant, g, and water depth, h, as inputs. A + ! high order initial guess is used in conjunction with a quadratic + ! Newton's method for the solution with seven significant digits + ! accuracy using only one iteration pass. The method is due to + ! Professor J.N. Newman of M.I.T. as found in routine EIGVAL of + ! the SWIM-MOTION-LINES (SML) software package in source file + ! Solve.f of the SWIM module. + + + + IMPLICIT NONE + + + ! Passed Variables: + + REAL(DbKi), INTENT(IN ) :: g ! Gravitational acceleration (m/s^2) + REAL(DbKi), INTENT(IN ) :: h ! Water depth (meters) + REAL(DbKi), INTENT(IN ) :: Omega ! Wave frequency (rad/s) + REAL(DbKi) :: WaveNumber ! This function = wavenumber, k (1/m) + + + ! Local Variables: + + REAL(DbKi) :: A ! A temporary variable used in the solution. + REAL(DbKi) :: B ! A temporary variable used in the solution. + REAL(DbKi) :: C ! A temporary variable used in the solution. + REAL(DbKi) :: C2 ! A temporary variable used in the solution. + REAL(DbKi) :: CC ! A temporary variable used in the solution. + REAL(DbKi) :: E2 ! A temporary variable used in the solution. + REAL(DbKi) :: X0 ! A temporary variable used in the solution. + + + + ! Compute the wavenumber, unless Omega is zero, in which case, return + ! zero: + + IF ( Omega == 0.0 ) THEN ! When .TRUE., the formulation below is ill-conditioned; thus, the known value of zero is returned. + + + WaveNumber = 0.0 + + + ELSE ! Omega > 0.0; solve for the wavenumber as usual. + + + C = Omega*Omega*h/REAL(g,DbKi) + CC = C*C + + + ! Find X0: + + IF ( C <= 2.0 ) THEN + + X0 = SQRT(C)*( 1.0 + C*( 0.169 + (0.031*C) ) ) + + ELSE + + E2 = EXP(-2.0*C) + + X0 = C*( 1.0 + ( E2*( 2.0 - (12.0*E2) ) ) ) + + END IF + + + ! Find the WaveNumber: + + IF ( C <= 4.8 ) THEN + + C2 = CC - X0*X0 + A = 1.0/( C - C2 ) + B = A*( ( 0.5*LOG( ( X0 + C )/( X0 - C ) ) ) - X0 ) + + WaveNumber = ( X0 - ( B*C2*( 1.0 + (A*B*C*X0) ) ) )/h + + ELSE + + WaveNumber = X0/h + + END IF + + + END IF + + + + RETURN + END FUNCTION WaveNumber + + !======================================================================= + FUNCTION COSHNumOvrCOSHDen ( k, h, z ) + + + ! This FUNCTION computes the shallow water hyperbolic numerator + ! over denominator term in the wave kinematics expressions: + ! + ! COSH( k*( z + h ) )/COSH( k*h ) + ! + ! given the wave number, k, water depth, h, and elevation z, as + ! inputs. + + IMPLICIT NONE + + + ! Passed Variables: + + REAL(SiKi) :: COSHNumOvrCOSHDen ! This function = COSH( k*( z + h ) )/COSH( k*h ) (-) + REAL(DbKi), INTENT(IN ) :: h ! Water depth ( h > 0 ) (meters) + REAL(DbKi), INTENT(IN ) :: k ! Wave number ( k >= 0 ) (1/m) + REAL(DbKi), INTENT(IN ) :: z ! Elevation (-h <= z <= 0 ) (meters) + + + + ! Compute the hyperbolic numerator over denominator: + + IF ( k*h > 89.4_DbKi ) THEN ! When .TRUE., the shallow water formulation will trigger a floating point overflow error; however, COSH( k*( z + h ) )/COSH( k*h ) = EXP( k*z ) + EXP( -k*( z + 2*h ) ) for large k*h. This equals the deep water formulation, EXP( k*z ), except near z = -h, because h > 14.23*wavelength (since k = 2*Pi/wavelength) in this case. + + COSHNumOvrCOSHDen = REAL(EXP( k*z ) + EXP( -k*( z + 2.0_DbKi*h ) )) + + ELSE ! 0 < k*h <= 89.4; use the shallow water formulation. + + COSHNumOvrCOSHDen =REAL( COSH( k*( z + h ) ),R8Ki)/COSH( k*h ) + + END IF + + + + RETURN + END FUNCTION COSHNumOvrCOSHDen +!======================================================================= + FUNCTION COSHNumOvrSINHDen ( k, h, z ) + + + ! This FUNCTION computes the shallow water hyperbolic numerator + ! over denominator term in the wave kinematics expressions: + ! + ! COSH( k*( z + h ) )/SINH( k*h ) + ! + ! given the wave number, k, water depth, h, and elevation z, as + ! inputs. + + + + IMPLICIT NONE + + + ! Passed Variables: + + REAL(SiKi) :: COSHNumOvrSINHDen ! This function = COSH( k*( z + h ) )/SINH( k*h ) (-) + REAL(DbKi), INTENT(IN ) :: h ! Water depth ( h > 0 ) (meters) + REAL(DbKi), INTENT(IN ) :: k ! Wave number ( k >= 0 ) (1/m) + REAL(DbKi), INTENT(IN ) :: z ! Elevation (-h <= z <= 0 ) (meters) + + + + ! Compute the hyperbolic numerator over denominator: + + + IF ( k < EPSILON(0.0_DbKi) ) THEN ! When .TRUE., the shallow water formulation is ill-conditioned; thus, HUGE(k) is returned to approximate the known value of infinity. + + COSHNumOvrSINHDen = 1.0E20 ! HUGE( k ) + + ELSEIF ( k*h > 89.4_DbKi ) THEN ! When .TRUE., the shallow water formulation will trigger a floating point overflow error; however, COSH( k*( z + h ) )/SINH( k*h ) = EXP( k*z ) + EXP( -k*( z + 2*h ) ) for large k*h. This equals the deep water formulation, EXP( k*z ), except near z = -h, because h > 14.23*wavelength (since k = 2*Pi/wavelength) in this case. + + COSHNumOvrSINHDen = EXP( k*z ) + EXP( -k*( z + 2*h ) ) + + ELSE ! 0 < k*h <= 89.4; use the shallow water formulation. + + COSHNumOvrSINHDen = COSH( k*( z + h ) )/SINH( k*h ) + + END IF + + + + RETURN + END FUNCTION COSHNumOvrSINHDen +!======================================================================= + FUNCTION COTH ( X ) + + + ! This FUNCTION computes the hyperbolic cotangent, + ! COSH(X)/SINH(X). + + + USE Precision + + + IMPLICIT NONE + + + ! Passed Variables: + + REAL(DbKi) :: COTH ! This function = COSH( X )/SINH( X ) (-) + REAL(DbKi), INTENT(IN ) :: X ! The argument (-) + + + + ! Compute the hyperbolic cotangent: + + IF ( X == 0.0_DbKi ) THEN ! When .TRUE., the formulation below is ill-conditioned; thus, HUGE(X) is returned to approximate the known value of infinity. + + COTH = HUGE( X ) + + ELSE ! X /= 0.0; use the numerically-stable computation of COTH(X) by means of TANH(X). + + COTH = 1.0_DbKi/TANH( X ) ! = COSH( X )/SINH( X ) + + END IF + + + + RETURN + END FUNCTION COTH + + !======================================================================= + FUNCTION SINHNumOvrSINHDen ( k, h, z ) + + + ! This FUNCTION computes the shallow water hyperbolic numerator + ! over denominator term in the wave kinematics expressions: + ! + ! SINH( k*( z + h ) )/SINH( k*h ) + ! + ! given the wave number, k, water depth, h, and elevation z, as + ! inputs. + + + IMPLICIT NONE + + + ! Passed Variables: + + REAL(SiKi) :: SINHNumOvrSINHDen ! This function = SINH( k*( z + h ) )/SINH( k*h ) (-) + REAL(DbKi), INTENT(IN ) :: h ! Water depth ( h > 0 ) (meters) + REAL(DbKi), INTENT(IN ) :: k ! Wave number ( k >= 0 ) (1/m) + REAL(DbKi), INTENT(IN ) :: z ! Elevation (-h <= z <= 0 ) (meters) + + + + ! Compute the hyperbolic numerator over denominator: + + IF ( k == 0.0_DbKi ) THEN ! When .TRUE., the shallow water formulation is ill-conditioned; thus, the known value of unity is returned. + + SINHNumOvrSINHDen = 1.0 + + ELSEIF ( k*h > 89.4_DbKi ) THEN ! When .TRUE., the shallow water formulation will trigger a floating point overflow error; however, SINH( k*( z + h ) )/SINH( k*h ) = EXP( k*z ) - EXP( -k*( z + 2*h ) ) for large k*h. This equals the deep water formulation, EXP( k*z ), except near z = -h, because h > 14.23*wavelength (since k = 2*Pi/wavelength) in this case. + + SINHNumOvrSINHDen = EXP( k*z ) - EXP( -k*( z + 2.0_DbKi*h ) ) + + ELSE ! 0 < k*h <= 89.4; use the shallow water formulation. + + SINHNumOvrSINHDen = SINH( k*( z + h ) )/SINH( k*h ) + + END IF + + + + RETURN + END FUNCTION SINHNumOvrSINHDen + + END SUBROUTINE setupWaterKin + + + + + +END MODULE MoorDyn_Misc diff --git a/modules/moordyn/src/MoorDyn_Point.f90 b/modules/moordyn/src/MoorDyn_Point.f90 new file mode 100644 index 0000000000..fce8aab12f --- /dev/null +++ b/modules/moordyn/src/MoorDyn_Point.f90 @@ -0,0 +1,419 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2020-2021 Alliance for Sustainable Energy, LLC +! Copyright (C) 2015-2019 Matthew Hall +! +! This file is part of MoorDyn. +! +! 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 MoorDyn_Point + + USE MoorDyn_Types + USE MoorDyn_IO + USE NWTC_Library + USE MoorDyn_Misc + USE MoorDyn_Line, only : Line_SetEndKinematics, Line_GetEndStuff + + IMPLICIT NONE + + PRIVATE + + INTEGER(IntKi), PARAMETER :: wordy = 0 ! verbosity level. >1 = more console output + + PUBLIC :: Connect_Initialize + PUBLIC :: Connect_SetKinematics + PUBLIC :: Connect_SetState + PUBLIC :: Connect_GetStateDeriv + PUBLIC :: Connect_DoRHS + PUBLIC :: Connect_GetCoupledForce + PUBLIC :: Connect_GetNetForceAndMass + PUBLIC :: Connect_AddLine + PUBLIC :: Connect_RemoveLine + + +CONTAINS + + + !-------------------------------------------------------------- + SUBROUTINE Connect_Initialize(Connect, states, m) + + Type(MD_Connect), INTENT(INOUT) :: Connect ! the Connection object + Real(DbKi), INTENT(INOUT) :: states(6) ! state vector section for this Connection + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + + INTEGER(IntKi) :: l + + + if (Connect%typeNum == 0) then ! error check + + ! pass kinematics to any attached lines so they have initial positions at this initialization stage + DO l=1,Connect%nAttached + IF (wordy > 1) print *, "Connect ", Connect%IdNum, " setting end kinematics of line ", Connect%attached(l), " to ", Connect%r + CALL Line_SetEndKinematics(m%LineList(Connect%attached(l)), Connect%r, Connect%rd, 0.0_DbKi, Connect%Top(l)) + END DO + + + ! assign initial node kinematics to state vector + states(4:6) = Connect%r + states(1:3) = Connect%rd + + + IF (wordy > 0) print *, "Initialized Connection ", Connect%IdNum + + else + CALL WrScr(" Error: wrong Point type given to Connect_Initialize for number "//trim(Int2Lstr(Connect%idNum))) + end if + + END SUBROUTINE Connect_Initialize + !-------------------------------------------------------------- + + + !-------------------------------------------------------------- + SUBROUTINE Connect_SetKinematics(Connect, r_in, rd_in, a_in, t, m) + + Type(MD_Connect), INTENT(INOUT) :: Connect ! the Connection object + Real(DbKi), INTENT(IN ) :: r_in( 3) ! position + Real(DbKi), INTENT(IN ) :: rd_in(3) ! velocity + Real(DbKi), INTENT(IN ) :: a_in(3) ! acceleration (only used for coupled connects) + Real(DbKi), INTENT(IN ) :: t ! instantaneous time + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + + + INTEGER(IntKi) :: l + + ! store current time + Connect%time = t + + + ! if (Connect%typeNum==0) THEN ! anchor ( <<< to be changed/expanded) ... in MoorDyn F also used for coupled connections + + ! set position and velocity + Connect%r = r_in + Connect%rd = rd_in + Connect%a = a_in + + ! pass latest kinematics to any attached lines + DO l=1,Connect%nAttached + CALL Line_SetEndKinematics(m%LineList(Connect%attached(l)), Connect%r, Connect%rd, t, Connect%Top(l)) + END DO + + ! else + ! + ! PRINT*,"Error: setKinematics called for wrong Connection type. Connection ", Connect%IdNum, " type ", Connect%typeNum + + ! END IF + + + END SUBROUTINE Connect_SetKinematics + !-------------------------------------------------------------- + + !-------------------------------------------------------------- + SUBROUTINE Connect_SetState(Connect, X, t, m) + + Type(MD_Connect), INTENT(INOUT) :: Connect ! the Connection object + Real(DbKi), INTENT(IN ) :: X(:) ! state vector section for this line + Real(DbKi), INTENT(IN ) :: t ! instantaneous time + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + + INTEGER(IntKi) :: l ! index of segments or nodes along line + INTEGER(IntKi) :: J ! index + + + ! store current time + Connect%time = t + + ! from state values, get r and rdot values + DO J=1,3 + Connect%r( J) = X(3 + J) ! get positions + Connect%rd(J) = X( J) ! get velocities + END DO + + ! pass latest kinematics to any attached lines + DO l=1,Connect%nAttached + CALL Line_SetEndKinematics(m%LineList(Connect%attached(l)), Connect%r, Connect%rd, t, Connect%Top(l)) + END DO + + END SUBROUTINE Connect_SetState + !-------------------------------------------------------------- + + !-------------------------------------------------------------- + SUBROUTINE Connect_GetStateDeriv(Connect, Xd, m, p) + + Type(MD_Connect), INTENT(INOUT) :: Connect ! the Connection object + Real(DbKi), INTENT(INOUT) :: Xd(:) ! state derivative vector section for this line + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + + TYPE(MD_ParameterType),INTENT(IN ) :: p ! Parameters + + !TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! misc/optimization variables + + !INTEGER(IntKi) :: l ! index of attached lines + INTEGER(IntKi) :: J ! index + INTEGER(IntKi) :: K ! index + Real(DbKi) :: Sum1 ! for adding things + + Real(DbKi) :: S(3,3) ! inverse mass matrix + + + CALL Connect_DoRHS(Connect, m, p) + +! // solve for accelerations in [M]{a}={f} using LU decomposition +! double M_tot[9]; // serialize total mass matrix for easy processing +! for (int I=0; I<3; I++) for (int J=0; J<3; J++) M_tot[3*I+J]=M[I][J]; +! double LU[9]; // serialized matrix that will hold LU matrices combined +! Crout(3, M_tot, LU); // perform LU decomposition on mass matrix +! double acc[3]; // acceleration vector to solve for +! solveCrout(3, LU, Fnet, acc); // solve for acceleration vector + + ! solve for accelerations in [M]{a}={f} using LU decomposition +! CALL LUsolve(6, M_out, LU_temp, Fnet_out, y_temp, acc) + + + ! invert node mass matrix + CALL Inverse3by3(S, Connect%M) + + ! accelerations + Connect%a = MATMUL(S, Connect%Fnet) + + ! fill in state derivatives + Xd(4:6) = Connect%rd ! dxdt = V (velocities) + Xd(1:3) = Connect%a ! dVdt = RHS * A (accelerations) + + + ! check for NaNs + DO J = 1, 6 + IF (Is_NaN(Xd(J))) THEN + CALL WrScr("NaN detected at time "//trim(Num2LStr(Connect%time))//" in Point "//trim(Int2LStr(Connect%IdNum))//" in MoorDyn.") + IF (wordy > 1) print *, "state derivatives:" + IF (wordy > 1) print *, Xd + EXIT + END IF + END DO + + END SUBROUTINE Connect_GetStateDeriv + !-------------------------------------------------------------- + + !-------------------------------------------------------------- + SUBROUTINE Connect_DoRHS(Connect, m, p) + + Type(MD_Connect), INTENT(INOUT) :: Connect ! the Connection object + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + TYPE(MD_ParameterType),INTENT(IN ) :: p ! Parameters + + !TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! misc/optimization variables + + INTEGER(IntKi) :: l ! index of attached lines + INTEGER(IntKi) :: I ! index + INTEGER(IntKi) :: J ! index + INTEGER(IntKi) :: K ! index + + Real(DbKi) :: Fnet_i(3) ! force from an attached line + Real(DbKi) :: Moment_dummy(3) ! dummy vector to hold unused line end moments + Real(DbKi) :: M_i(3,3) ! mass from an attached line + + + ! start with the Connection's own forces including buoyancy and weight, and its own mass + Connect%Fnet(1) = Connect%conFX + Connect%Fnet(2) = Connect%conFY + Connect%Fnet(3) = Connect%conFZ + Connect%conV*p%rhoW*p%g - Connect%conM*p%g + + Connect%M = 0.0_DbKi ! clear (zero) the connect mass matrix + + DO J = 1,3 + Connect%M (J,J) = Connect%conM ! set the diagonals to the self-mass (to start with) + END DO + + + ! print *, "connection number", Connect%IdNum + ! print *, "attached lines: ", Connect%attached + ! print *, "size of line list" , size(m%LineList) + + ! loop through attached lines, adding force and mass contributions + DO l=1,Connect%nAttached + + ! print *, " l", l + ! print *, Connect%attached(l) + ! print *, m%LineList(Connect%attached(l))%Fnet + ! + ! + ! print *, " attached line ID", m%LineList(Connect%attached(l))%IdNum + + CALL Line_GetEndStuff(m%LineList(Connect%attached(l)), Fnet_i, Moment_dummy, M_i, Connect%Top(l)) + + ! sum quantitites + Connect%Fnet = Connect%Fnet + Fnet_i + Connect%M = Connect%M + M_i + + END DO + + + ! XXXWhen this sub is called, any self weight, buoyancy, or external forcing should have already been + ! added by the calling subroutine. The only thing left is any added mass or drag forces from the connection (e.g. float) + ! itself, which will be added below.XXX + + + ! IF (EqualRealNos(t, 0.0_DbKi)) THEN ! this is old: with current IC gen approach, we skip the first call to the line objects, because they're set AFTER the call to the connects + ! + ! DO J = 1,3 + ! Xd(3+J) = X(J) ! velocities - these are unused in integration + ! Xd(J) = 0.0_DbKi ! accelerations - these are unused in integration + ! END DO + ! ELSE + ! ! from state values, get r and rdot values + ! DO J = 1,3 + ! Connect%r(J) = X(3 + J) ! get positions + ! Connect%rd(J) = X(J) ! get velocities + ! END DO + ! END IF + + + ! add any added mass and drag forces from the Connect body itself + DO J = 1,3 + Connect%Fnet(J) = Connect%Fnet(J) - 0.5 * p%rhoW * Connect%rd(J) * abs(Connect%rd(J)) * Connect%conCdA; ! add drag forces - corrected Nov 24 + Connect%M (J,J) = Connect%M (J,J) + Connect%conV*p%rhoW*Connect%conCa; ! add added mass + + END DO + + ! would this sub ever need to include the m*a inertial term? Is it ever called for coupled connects? <<< + + END SUBROUTINE Connect_DoRHS + !===================================================================== + + + ! calculate the force including inertial loads on connect that is coupled + !-------------------------------------------------------------- + SUBROUTINE Connect_GetCoupledForce(Connect, Fnet_out, m, p) + + Type(MD_Connect), INTENT(INOUT) :: Connect ! the Connect object + Real(DbKi), INTENT( OUT) :: Fnet_out(3) ! force and moment vector about rRef + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + TYPE(MD_ParameterType),INTENT(IN ) :: p ! Parameters + + Real(DbKi) :: F_iner(3) ! inertial force + + IF (Connect%typeNum == -1) then + ! calculate forces and masses of connect + CALL Connect_DoRHS(Connect, m, p) + + ! add inertial loads as appropriate + F_iner = -MATMUL(Connect%M, Connect%a) ! inertial loads + Fnet_out = Connect%Fnet + F_iner ! add inertial loads + + ELSE + CALL WrScr("Connect_GetCoupledForce called for wrong (uncoupled) Point type in MoorDyn!") + END IF + + END SUBROUTINE Connect_GetCoupledForce + + + ! calculate the force and mass contributions of the connect on the parent body (only for type 3 connects?) + !-------------------------------------------------------------- + SUBROUTINE Connect_GetNetForceAndMass(Connect, rRef, Fnet_out, M_out, m, p) + + Type(MD_Connect), INTENT(INOUT) :: Connect ! the Connect object + Real(DbKi), INTENT(IN ) :: rRef(3) ! global coordinates of reference point (i.e. the parent body) + Real(DbKi), INTENT( OUT) :: Fnet_out(6) ! force and moment vector about rRef + Real(DbKi), INTENT( OUT) :: M_out(6,6) ! mass and inertia matrix about rRef + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + TYPE(MD_ParameterType),INTENT(IN ) :: p ! Parameters + + Real(DbKi) :: rRel( 3) ! position of connection relative to the body reference point (global orientation frame) + + + CALL Connect_DoRHS(Connect, m, p) + + rRel = Connect%r - rRef ! vector from body reference point to node + + ! convert net force into 6dof force about body ref point + CALL translateForce3to6DOF(rRel, Connect%Fnet, Fnet_out) + + ! convert mass matrix to 6by6 mass matrix about body ref point + CALL translateMass3to6DOF(rRel, Connect%M, M_out) + + END SUBROUTINE Connect_GetNetForceAndMass + + + + + ! this function handles assigning a line to a connection node + !-------------------------------------------------------------- + SUBROUTINE Connect_AddLine(Connect, lineID, TopOfLine) + + Type(MD_Connect), INTENT (INOUT) :: Connect ! the Connection object + Integer(IntKi), INTENT( IN ) :: lineID + Integer(IntKi), INTENT( IN ) :: TopOfLine + + IF (wordy > 0) Print*, "L", lineID, "->C", Connect%IdNum + + IF (Connect%nAttached <10) THEN ! this is currently just a maximum imposed by a fixed array size. could be improved. + Connect%nAttached = Connect%nAttached + 1 ! add the line to the number connected + Connect%Attached(Connect%nAttached) = lineID + Connect%Top(Connect%nAttached) = TopOfLine ! attached to line ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) + ELSE + Print*, "Too many lines connected to Point ", Connect%IdNum, " in MoorDyn!" + END IF + + END SUBROUTINE Connect_AddLine + + + ! this function handles removing a line from a connection node + !-------------------------------------------------------------- + SUBROUTINE Connect_RemoveLine(Connect, lineID, TopOfLine, rEnd, rdEnd) + + Type(MD_Connect), INTENT (INOUT) :: Connect ! the Connection object + Integer(IntKi), INTENT( IN ) :: lineID + Integer(IntKi), INTENT( OUT) :: TopOfLine + REAL(DbKi), INTENT(INOUT) :: rEnd(3) + REAL(DbKi), INTENT(INOUT) :: rdEnd(3) + + Integer(IntKi) :: l,m,J + + DO l = 1,Connect%nAttached ! look through attached lines + + IF (Connect%Attached(l) == lineID) THEN ! if this is the line's entry in the attachment list + + TopOfLine = Connect%Top(l); ! record which end of the line was attached + + DO m = l,Connect%nAttached-1 + + Connect%Attached(m) = Connect%Attached(m+1) ! move subsequent line links forward one spot in the list to eliminate this line link + Connect%Top( m) = Connect%Top(m+1) + + Connect%nAttached = Connect%nAttached - 1 ! reduce attached line counter by 1 + + ! also pass back the kinematics at the end + DO J = 1,3 + rEnd( J) = Connect%r( J) + rdEnd(J) = Connect%rd(J) + END DO + + print*, "Detached line ", lineID, " from Connection ", Connect%IdNum + + EXIT + END DO + + IF (l == Connect%nAttached) THEN ! detect if line not found + print *, "Error: failed to find line to remove during removeLineFromConnect call to connection ", Connect%IdNum, ". Line ", lineID + END IF + + END IF + + END DO + + END SUBROUTINE Connect_RemoveLine + + + +END MODULE MoorDyn_Point diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index 636bfc9dbf..a3ed6ef2b9 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -13,44 +13,118 @@ include Registry_NWTC_Library.txt +## ====== some data read from the input file, but not needed after init ====== +typedef MoorDyn/MD MD_InputFileType DbKi DTIC - 0.5 - "convergence check time step for IC generation" "[s]" +typedef ^ ^ DbKi TMaxIC - 120 - "maximum time to allow for getting converged ICs" "[s]" +typedef ^ ^ ReKi CdScaleIC - 1 - "factor to scale drag coefficients by during dynamic relaxation" "[]" +typedef ^ ^ ReKi threshIC - 0.01 - "convergence tolerance for ICs (0.01 means 1%)" "[]" -## ============================== Define input types here: ============================================================================================================================================ +## ============================== Define initialization input types here: ============================================================================================================================= typedef MoorDyn/MD InitInputType ReKi g - -999.9 - "gravity constant" "[m/s^2]" typedef ^ ^ ReKi rhoW - -999.9 - "sea density" "[kg/m^3]" typedef ^ ^ ReKi WtrDepth - -999.9 - "depth of water" "[m]" -typedef ^ ^ ReKi PtfmInit {6} - - "initial position of platform" - +typedef ^ ^ ReKi PtfmInit {:}{:} - - "initial position of platform(s) shape: 6, nTurbines" - +typedef ^ ^ IntKi FarmSize - 0 - "Indicates normal FAST module mode if 0, FAST.Farm coupled mode and =nTurbines if >0" - +typedef ^ ^ ReKi TurbineRefPos {:}{:} - - "reference position of turbines in farm, shape: 3, nTurbines" - +typedef ^ ^ ReKi Tmax - - - "simulation duration" "[s]" typedef ^ ^ CHARACTER(1024) FileName - "" - "MoorDyn input file" typedef ^ ^ CHARACTER(1024) RootName - - - "RootName for writing output files" - +typedef ^ ^ LOGICAL UsePrimaryInputFile - .TRUE. - "Read input file instead of passed data" - +typedef ^ ^ FileInfoType PassedPrimaryInputData - - - "Primary input file as FileInfoType (set by driver/glue code) -- String array with metadata" - typedef ^ ^ LOGICAL Echo - "" - "echo parameter - do we want to echo the header line describing the input file?" -typedef ^ ^ ReKi DTIC - - - "convergence check time step for IC generation" "[s]" -typedef ^ ^ ReKi TMaxIC - 120 - "maximum time to allow for getting converged ICs" "[s]" -typedef ^ ^ ReKi CdScaleIC - 1 - "factor to scale drag coefficients by during dynamic relaxation" "[]" -typedef ^ ^ ReKi threshIC - 0.01 - "convergence tolerance for ICs (0.01 means 1%)" "[]" -typedef ^ ^ CHARACTER(ChanLen) OutList {:} "" - "string containing list of output channels requested in input file" +typedef ^ ^ CHARACTER(ChanLen) OutList {:} "" - "string containing list of output channels requested in input file" +typedef ^ ^ Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - + +#typedef ^ ^ DbKi UGrid {:}{:}{:} - - "water velocities time series at each grid point" - +#typedef ^ ^ DbKi UdGrid {:}{:}{:} - - "water accelerations time series at each grid point" - +#typedef ^ ^ DbKi zetaGrid {:}{:} - - "water surface elevations time series at each grid point" - +#typedef ^ ^ DbKi PDynGrid {:}{:} - - "water dynamic pressure time series at each grid point" - +typedef ^ ^ ReKi WaveVel {:}{:}{:} - - "" - +typedef ^ ^ ReKi WaveAcc {:}{:}{:} - - "" - +typedef ^ ^ ReKi WavePDyn {:}{:} - - "" - +typedef ^ ^ ReKi WaveElev {:}{:} - - "" - +typedef ^ ^ DbKi WaveTime {:} - - "Should this be double precision?" - + +# nvm # Farm-level simulation inputs - these are passed by FAST.Farm - the arrays are populated from the individual turbine-level MoorDyn instances +# nvm typedef ^ ^ MeshType FarmCoupledKinematics {:} - - "array of input kinematics meshes from each of the turbine-level MoorDyn instances" "[m, m/s]" +# nvm typedef ^ ^ IntKi FarmNCpldBodies {:} - - "" "" +# nvm typedef ^ ^ IntKi FarmNCpldRods {:} - - "" "" +# nvm typedef ^ ^ IntKi FarmNCpldCons {:} - - "number of Fairlead Connections" "" # ====================================== Internal data types ======================================================================== # line properties from line dictionary input typedef ^ MD_LineProp IntKi IdNum - - - "integer identifier of this set of line properties" -typedef ^ ^ CHARACTER(10) name - - - "name/identifier of this set of line properties" +typedef ^ ^ CHARACTER(20) name - - - "name/identifier of this set of line properties" typedef ^ ^ DbKi d - - - "volume-equivalent diameter" "[m]" typedef ^ ^ DbKi w - - - "per-length weight in air" "[kg/m]" -typedef ^ ^ DbKi EA - - - "stiffness" "[N]" +typedef ^ ^ DbKi EA - - - "axial stiffness" "[N]" +typedef ^ ^ DbKi EA_D - - - "axial stiffness" "[N]" typedef ^ ^ DbKi BA - - - "internal damping coefficient times area" "[N-s]" +typedef ^ ^ DbKi BA_D - - - "internal damping coefficient times area" "[N-s]" +typedef ^ ^ DbKi EI - - - "bending stiffness" "[N-m]" typedef ^ ^ DbKi Can - - - "transverse added mass coefficient" typedef ^ ^ DbKi Cat - - - "tangential added mass coefficient" typedef ^ ^ DbKi Cdn - - - "transverse drag coefficient" typedef ^ ^ DbKi Cdt - - - "tangential drag coefficient" +typedef ^ ^ IntKi ElasticMod - - - "Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} " - +typedef ^ ^ IntKi nEApoints - 0 - "number of values in stress-strain lookup table (0 means using constant E)" +typedef ^ ^ DbKi stiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" +typedef ^ ^ DbKi stiffYs {30} - - "y array for stress-strain lookup table" +typedef ^ ^ IntKi nBApoints - 0 - "number of values in stress-strainrate lookup table (0 means using constant c)" +typedef ^ ^ DbKi dampXs {30} - - "x array for stress-strainrate lookup table (up to nCoef)" +typedef ^ ^ DbKi dampYs {30} - - "y array for stress-strainrate lookup table " +typedef ^ ^ IntKi nEIpoints - 0 - "number of values in bending stress-strain lookup table (0 means using constant E)" +typedef ^ ^ DbKi bstiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" +typedef ^ ^ DbKi bstiffYs {30} - - "y array for stress-strain lookup table" + +# rod properties from rod dictionary input +typedef ^ MD_RodProp IntKi IdNum - - - "integer identifier of this set of rod properties" +typedef ^ ^ CHARACTER(10) name - - - "name/identifier of this set of rod properties" +typedef ^ ^ DbKi d - - - "volume-equivalent diameter" "[m]" +typedef ^ ^ DbKi w - - - "per-length weight in air" "[kg/m]" +typedef ^ ^ DbKi Can - - - "transverse added mass coefficient" +typedef ^ ^ DbKi Cat - - - "tangential added mass coefficient" +typedef ^ ^ DbKi Cdn - - - "transverse drag coefficient" +typedef ^ ^ DbKi Cdt - - - "tangential drag coefficient" +typedef ^ ^ DbKi CdEnd - - - "drag coefficient for rod end" "[-]" +typedef ^ ^ DbKi CaEnd - - - "added mass coefficient for rod end" "[-]" + +# this is the Body type, which holds data for each body object +typedef ^ MD_Body IntKi IdNum - - - "integer identifier of this Connection" +typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 0=fixed, 1=vessel, 2=connect" +typedef ^ ^ IntKi AttachedC {30} - - "list of IdNums of connections attached to this body" +typedef ^ ^ IntKi AttachedR {30} - - "list of IdNums of rods attached to this body" +typedef ^ ^ IntKi nAttachedC - 0 - "number of attached connections" +typedef ^ ^ IntKi nAttachedR - 0 - "number of attached rods" +typedef ^ ^ DbKi rConnectRel {3}{30} - - "relative position of connection on body" +typedef ^ ^ DbKi r6RodRel {6}{30} - - "relative position and orientation of rod on body" +typedef ^ ^ DbKi bodyM - - - "" +typedef ^ ^ DbKi bodyV - - - "" +typedef ^ ^ DbKi bodyI {3} - - "" +typedef ^ ^ DbKi bodyCdA {6} - - "product of drag force and frontal area of connection point" "[m^2]" +typedef ^ ^ DbKi bodyCa {6} - - "added mass coefficient of connection point" "-" +typedef ^ ^ DbKi time - - - "current time" "[s]" +typedef ^ ^ DbKi r6 {6} - - "position" +typedef ^ ^ DbKi v6 {6} - - "velocity" +typedef ^ ^ DbKi a6 {6} - - "acceleration (only used for coupled bodies)" +typedef ^ ^ DbKi U {3} - - "water velocity at ref point" "[m/s]" +typedef ^ ^ DbKi Ud {3} - - "water acceleration at ref point" "[m/s^2]" +typedef ^ ^ DbKi zeta - - - "water surface elevation above ref point" "[m]" +typedef ^ ^ DbKi F6net {6} - - "total force and moment on body (excluding inertial loads)" +typedef ^ ^ DbKi M6net {6}{6} - - "total mass matrix of Body and any attached objects" +typedef ^ ^ DbKi M {6}{6} - - "rotated body 6-dof mass and inertia matrix in global orientation" +typedef ^ ^ DbKi M0 {6}{6} - - "body 6-dof mass and inertia matrix in its own frame" +typedef ^ ^ DbKi OrMat {3}{3} - - "DCM for body orientation" +typedef ^ ^ DbKi rCG {3} - - "vector in body frame from ref point to CG (before rods etc..)" # this is the Connection type, which holds data for each connection object typedef ^ MD_Connect IntKi IdNum - - - "integer identifier of this Connection" typedef ^ ^ CHARACTER(10) type - - - "type of Connect: fix, vessel, connect" -typedef ^ ^ IntKi TypeNum - - - "integer identifying the type. 0=fixed, 1=vessel, 2=connect" -typedef ^ ^ IntKi AttachedFairs {:} - - "list of IdNums of connected Line tops" -typedef ^ ^ IntKi AttachedAnchs {:} - - "list of IdNums of connected Line bottoms" -typedef ^ ^ DbKi conX - - - "" -typedef ^ ^ DbKi conY - - - "" -typedef ^ ^ DbKi conZ - - - "" +typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 0=fixed, 1=vessel, 2=connect" +typedef ^ ^ IntKi Attached {10} - - "list of IdNums of lines attached to this connection node" +typedef ^ ^ IntKi Top {10} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" +typedef ^ ^ IntKi nAttached - 0 - "number of attached lines" typedef ^ ^ DbKi conM - - - "" typedef ^ ^ DbKi conV - - - "" typedef ^ ^ DbKi conFX - - - "" @@ -58,31 +132,127 @@ typedef ^ ^ DbKi conFY - typedef ^ ^ DbKi conFZ - - - "" typedef ^ ^ DbKi conCa - - - "added mass coefficient of connection point" "-" typedef ^ ^ DbKi conCdA - - - "product of drag force and frontal area of connection point" "[m^2]" -typedef ^ ^ DbKi Ftot {3} - - "total force on node" -typedef ^ ^ DbKi Mtot {3}{3} - - "node mass matrix, from attached lines" -typedef ^ ^ DbKi S {3}{3} - - "inverse mass matrix" "[kg]" +typedef ^ ^ DbKi time - - - "current time" "[s]" typedef ^ ^ DbKi r {3} - - "position" typedef ^ ^ DbKi rd {3} - - "velocity" +typedef ^ ^ DbKi a {3} - - "acceleration (only used for coupled points)" +typedef ^ ^ DbKi U {3} - - "water velocity at node" "[m/s]" +typedef ^ ^ DbKi Ud {3} - - "water acceleration at node" "[m/s^2]" +typedef ^ ^ DbKi zeta - - - "water surface elevation above node" "[m]" +typedef ^ ^ DbKi PDyn {:} - - "water dynamic pressure at node" "[Pa]" +typedef ^ ^ DbKi Fnet {3} - - "total force on node (excluding inertial loads)" +typedef ^ ^ DbKi M {3}{3} - - "node mass matrix, from attached lines" + +# this is the Rod type, which holds data for each Rod object +typedef ^ MD_Rod IntKi IdNum - - - "integer identifier of this Line" +typedef ^ ^ CHARACTER(10) type - - - "type of Rod. should match one of RodProp names" +typedef ^ ^ IntKi PropsIdNum - - - "the IdNum of the associated rod properties" - +typedef ^ ^ IntKi typeNum - - - "integer identifying the type. 0=fixed, 1=vessel, 2=connect" +typedef ^ ^ IntKi AttachedA {10} - - "list of IdNums of lines attached to end A" +typedef ^ ^ IntKi AttachedB {10} - - "list of IdNums of lines attached to end B" +typedef ^ ^ IntKi TopA {10} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" +typedef ^ ^ IntKi TopB {10} - - "list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A)" +typedef ^ ^ IntKi nAttachedA - 0 - "number of attached lines to Rod end A" +typedef ^ ^ IntKi nAttachedB - 0 - "number of attached lines to Rod end B" +typedef ^ ^ IntKi OutFlagList {20} - - "array specifying what line quantities should be output (1 vs 0)" - +typedef ^ ^ IntKi N - - - "The number of elements in the line" - +typedef ^ ^ IntKi endTypeA - - - "type of connection at end A: 0=pinned to Connection, 1=cantilevered to Rod." - +typedef ^ ^ IntKi endTypeB - - - "type of connection at end B: 0=pinned to Connection, 1=cantilevered to Rod." - +typedef ^ ^ DbKi UnstrLen - - - "length of the rod" "[m]" +typedef ^ ^ DbKi mass - - - "mass of the rod" "[kg]" +typedef ^ ^ DbKi rho - - - "density" "[kg/m3]" +typedef ^ ^ DbKi d - - - "volume-equivalent diameter" "[m]" +typedef ^ ^ DbKi Can - - - "" "[-]" +typedef ^ ^ DbKi Cat - - - "" "[-]" +typedef ^ ^ DbKi Cdn - - - "" "[-]" +typedef ^ ^ DbKi Cdt - - - "" "[-]" +typedef ^ ^ DbKi CdEnd - - - "drag coefficient for rod end" "[-]" +typedef ^ ^ DbKi CaEnd - - - "added mass coefficient for rod end" "[-]" +typedef ^ ^ DbKi time - - - "current time" "[s]" +typedef ^ ^ DbKi roll - - - "roll relative to vertical" "deg" +typedef ^ ^ DbKi pitch - - - "pitch relative to vertical" "deg" +typedef ^ ^ DbKi h0 - - - "submerged length of rod axis, distance along rod centerline from end A to the waterplane (0 <= h0 <= L)" "m" +typedef ^ ^ DbKi r {:}{:} - - "node positions" - +typedef ^ ^ DbKi rd {:}{:} - - "node velocities" - +typedef ^ ^ DbKi q {3} - - "tangent vector for rod as a whole" - +typedef ^ ^ DbKi l {:} - - "segment unstretched length" "[m]" +typedef ^ ^ DbKi V {:} - - "segment volume" "[m^3]" +typedef ^ ^ DbKi U {:}{:} - - "water velocity at node" "[m/s]" +typedef ^ ^ DbKi Ud {:}{:} - - "water acceleration at node" "[m/s^2]" +typedef ^ ^ DbKi zeta {:} - - "water surface elevation above node" "[m]" +typedef ^ ^ DbKi PDyn {:} - - "water dynamic pressure at node" "[Pa]" +typedef ^ ^ DbKi W {:}{:} - - "weight vectors" "[N]" +typedef ^ ^ DbKi Bo {:}{:} - - "buoyancy force vectors" "[N]" +typedef ^ ^ DbKi Pd {:}{:} - - "dynamic pressure force vectors" "[N]" +typedef ^ ^ DbKi Dp {:}{:} - - "node drag (transverse)" "[N]" +typedef ^ ^ DbKi Dq {:}{:} - - "node drag (axial)" "[N]" +typedef ^ ^ DbKi Ap {:}{:} - - "node added mass forcing (transverse)" "[N]" +typedef ^ ^ DbKi Aq {:}{:} - - "node added mass forcing (axial)" "[N]" +typedef ^ ^ DbKi B {:}{:} - - "node bottom contact force" "[N]" +typedef ^ ^ DbKi Fnet {:}{:} - - "total force on node" "[N]" +typedef ^ ^ DbKi M {:}{:}{:} - - "node mass matrix" "[kg]" +typedef ^ ^ DbKi FextA {3} - - "external forces from attached lines on/about end A " - +typedef ^ ^ DbKi FextB {3} - - "external forces from attached lines on/about end A " - +typedef ^ ^ DbKi Mext {3} - - "external moment vector holding sum of any externally applied moments i.e. bending lines" - +typedef ^ ^ DbKi r6 {6} - - "6 DOF position vector" - +typedef ^ ^ DbKi v6 {6} - - "6 DOF velocity vector" - +typedef ^ ^ DbKi a6 {6} - - "6 DOF acceleration vector (only used for coupled Rods)" - +typedef ^ ^ DbKi F6net {6} - - "total force and moment about end A (excluding inertial loads) that Rod may exert on whatever it's attached to" +typedef ^ ^ DbKi M6net {6}{6} - - "total mass matrix about end A of Rod and any attached Points" +typedef ^ ^ DbKi OrMat {3}{3} - - "DCM for body orientation" +typedef ^ ^ IntKi RodUnOut - - - "unit number of rod output file" +typedef ^ ^ DbKi RodWrOutput {:} - - "one row of output data for this rod" + # this is the Line type, which holds data for each line object typedef ^ MD_Line IntKi IdNum - - - "integer identifier of this Line" -typedef ^ ^ CHARACTER(10) type - - - "type of line. should match one of LineProp names" +#typedef ^ ^ CHARACTER(10) type - - - "type of line. should match one of LineProp names" +typedef ^ ^ IntKi PropsIdNum - - - "the IdNum of the associated line properties" - +typedef ^ ^ IntKi ElasticMod - - - "Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} " - typedef ^ ^ IntKi OutFlagList {20} - - "array specifying what line quantities should be output (1 vs 0)" - -typedef ^ ^ IntKi CtrlChan - - - "index of control channel that will drive line active tensioning (0 for none)" - +typedef ^ ^ IntKi CtrlChan - 0 - "index of control channel that will drive line active tensioning (0 for none)" - typedef ^ ^ IntKi FairConnect - - - "IdNum of Connection at fairlead" typedef ^ ^ IntKi AnchConnect - - - "IdNum of Connection at anchor" -typedef ^ ^ IntKi PropsIdNum - - - "the IdNum of the associated line properties" - typedef ^ ^ IntKi N - - - "The number of elements in the line" - +typedef ^ ^ IntKi endTypeA - - - "type of connection at end A: 0=pinned to Connection, 1=cantilevered to Rod." - +typedef ^ ^ IntKi endTypeB - - - "type of connection at end B: 0=pinned to Connection, 1=cantilevered to Rod." - typedef ^ ^ DbKi UnstrLen - - - "unstretched length of the line" - -typedef ^ ^ DbKi BA - - - "internal damping coefficient times area for this line only" "[N-s]" +typedef ^ ^ DbKi rho - - - "density" "[kg/m3]" +typedef ^ ^ DbKi d - - - "volume-equivalent diameter" "[m]" +typedef ^ ^ DbKi EA - 0 - "stiffness" "[N]" +typedef ^ ^ DbKi EA_D - 0 - "dynamic stiffness when using viscoelastic model" "[N]" +typedef ^ ^ DbKi BA - 0 - "internal damping coefficient times area for this line only" "[N-s]" +typedef ^ ^ DbKi BA_D - 0 - "dynamic internal damping coefficient times area when using viscoelastic model" "[N-s]" +typedef ^ ^ DbKi EI - 0 - "bending stiffness" "[N-m]" +typedef ^ ^ DbKi Can - - - "" "[-]" +typedef ^ ^ DbKi Cat - - - "" "[-]" +typedef ^ ^ DbKi Cdn - - - "" "[-]" +typedef ^ ^ DbKi Cdt - - - "" "[-]" +typedef ^ ^ IntKi nEApoints - 0 - "number of values in stress-strain lookup table (0 means using constant E)" +typedef ^ ^ DbKi stiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" +typedef ^ ^ DbKi stiffYs {30} - - "y array for stress-strain lookup table" +typedef ^ ^ IntKi nBApoints - 0 - "number of values in stress-strainrate lookup table (0 means using constant c)" +typedef ^ ^ DbKi dampXs {30} - - "x array for stress-strainrate lookup table (up to nCoef)" +typedef ^ ^ DbKi dampYs {30} - - "y array for stress-strainrate lookup table " +typedef ^ ^ IntKi nEIpoints - 0 - "number of values in bending stress-strain lookup table (0 means using constant E)" +typedef ^ ^ DbKi bstiffXs {30} - - "x array for stress-strain lookup table (up to nCoef)" +typedef ^ ^ DbKi bstiffYs {30} - - "y array for stress-strain lookup table" +typedef ^ ^ DbKi time - - - "current time" "[s]" typedef ^ ^ DbKi r {:}{:} - - "node positions" - typedef ^ ^ DbKi rd {:}{:} - - "node velocities" - typedef ^ ^ DbKi q {:}{:} - - "node tangent vectors" - +typedef ^ ^ DbKi qs {:}{:} - - "segment tangent vectors" - typedef ^ ^ DbKi l {:} - - "segment unstretched length" "[m]" typedef ^ ^ DbKi ld {:} - - "segment unstretched length rate of change (used in active tensioning)" "[m]" typedef ^ ^ DbKi lstr {:} - - "segment stretched length" "[m]" typedef ^ ^ DbKi lstrd {:} - - "segment change in stretched length" "[m/s]" +typedef ^ ^ DbKi Kurv {:} - - "curvature at each node point" "[1/m]" +typedef ^ ^ DbKi dl_1 {:} - - "segment stretch attributed to static stiffness portion" "[m]" typedef ^ ^ DbKi V {:} - - "segment volume" "[m^3]" +typedef ^ ^ DbKi U {:}{:} - - "water velocity at node" "[m/s]" +typedef ^ ^ DbKi Ud {:}{:} - - "water acceleration at node" "[m/s^2]" +typedef ^ ^ DbKi zeta {:} - - "water surface elevation above node" "[m]" +typedef ^ ^ DbKi PDyn {:} - - "water dynamic pressure at node" "[Pa]" typedef ^ ^ DbKi T {:}{:} - - "segment tension vectors" "[N]" typedef ^ ^ DbKi Td {:}{:} - - "segment internal damping force vectors" "[N]" typedef ^ ^ DbKi W {:}{:} - - "weight/buoyancy vectors" "[N]" @@ -91,17 +261,22 @@ typedef ^ ^ DbKi Dq {:}{:} typedef ^ ^ DbKi Ap {:}{:} - - "node added mass forcing (transverse)" "[N]" typedef ^ ^ DbKi Aq {:}{:} - - "node added mass forcing (axial)" "[N]" typedef ^ ^ DbKi B {:}{:} - - "node bottom contact force" "[N]" -typedef ^ ^ DbKi F {:}{:} - - "total force on node" "[N]" +typedef ^ ^ DbKi Bs {:}{:} - - "node force due to bending moments" "[N]" +typedef ^ ^ DbKi Fnet {:}{:} - - "total force on node" "[N]" typedef ^ ^ DbKi S {:}{:}{:} - - "node inverse mass matrix" "[kg]" typedef ^ ^ DbKi M {:}{:}{:} - - "node mass matrix" "[kg]" +typedef ^ ^ DbKi EndMomentA {3} - - "vector of end moments due to bending at line end A" "[N-m]" +typedef ^ ^ DbKi EndMomentB {3} - - "vector of end moments due to bending at line end B" "[N-m]" typedef ^ ^ IntKi LineUnOut - - - "unit number of line output file" -typedef ^ ^ ReKi LineWrOutput {:} - - "one row of output data for this line" +typedef ^ ^ DbKi LineWrOutput {:} - - "one row of output data for this line" +# this is the Fail type, which holds data for possible line failure descriptors TO BE FILLED IN LATER +typedef ^ MD_Fail IntKi IdNum - - - "integer identifier of this failure" # this is the MDOutParmType - a less literal alternative of the NWTC OutParmType for MoorDyn (to avoid huge lists of possible output channel permutations) -typedef ^ MD_OutParmType CHARACTER(ChanLen) Name - - - "name of output channel" -typedef ^ ^ CHARACTER(ChanLen) Units - - - "units string" +typedef ^ MD_OutParmType CHARACTER(10) Name - - - "name of output channel" +typedef ^ ^ CHARACTER(10) Units - - - "units string" typedef ^ ^ IntKi QType - - - "type of quantity - 0=tension, 1=x, 2=y, 3=z..." typedef ^ ^ IntKi OType - - - "type of object - 0=line, 1=connect" typedef ^ ^ IntKi NodeID - - - "node number if OType=0. 0=anchor, -1=N=Fairlead" @@ -113,63 +288,154 @@ typedef ^ InitOutputType CHARACTER(ChanLen) writeOutputHdr {:} " typedef ^ ^ CHARACTER(ChanLen) writeOutputUnt {:} "" - "second line of output file contents: units" typedef ^ ^ ProgDesc Ver - "" - "this module's name, version, and date" typedef ^ ^ LOGICAL CableCChanRqst {:} .FALSE. - "flag indicating control channel for drive line active tensioning is requested" - +# --- InitOutputs for linearization --- +typedef ^ ^ CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - +typedef ^ ^ CHARACTER(LinChanLen) LinNames_x {:} - - "Names of the continuous states used in linearization" - +typedef ^ ^ CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - +typedef ^ ^ LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - +typedef ^ ^ LOGICAL RotFrame_x {:} - - "Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame (not used for glue)" - +typedef ^ ^ LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - +typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - +typedef ^ ^ IntKi DerivOrder_x {:} - - "Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization" - ## ============================== Define Continuous states here: ===================================================================================================================================== -typedef ^ ContinuousStateType DbKi states {:} "" - "full list of node coordinates and velocities" "[m] or [m/s]" - +typedef ^ ContinuousStateType DbKi states {:} "" - "state vector of mooring system, e.g. node coordinates and velocities" "" ## ============================== Define Discrete states here: ===================================================================================================================================== typedef ^ DiscreteStateType SiKi dummy - - - "Remove this variable if you have discrete states" - - ## ============================== Define constraint states here: ===================================================================================================================================== typedef ^ ConstraintStateType SiKi dummy - - - "Remove this variable if you have constraint states" - - ## ============================== Define Other states here: ===================================================================================================================================== typedef ^ OtherStateType SiKi dummy - - - "Remove this variable if you have other states" - ## ============================== Define Misc variables here: ===================================================================================================================================== typedef ^ MiscVarType MD_LineProp LineTypeList {:} - - "array of properties for each line type" - -typedef ^ ^ MD_Connect ConnectList {:} - - "array of connection properties" - -typedef ^ ^ MD_Line LineList {:} - - "array of line properties" - -typedef ^ ^ IntKi FairIdList {:} - - "array of size NFairs listing the ID of each fairlead (index of ConnectList)" "" -typedef ^ ^ IntKi ConnIdList {:} - - "array of size NConnss listing the ID of each connect type connection (index of ConnectList)" "" -typedef ^ ^ IntKi LineStateIndList {:} - - "starting index of each line's states in state vector" "" -typedef ^ ^ ReKi MDWrOutput {:} - - "Data from time step to be written to a MoorDyn output file" +typedef ^ ^ MD_RodProp RodTypeList {:} - - "array of properties for each rod type" - +typedef ^ ^ MD_Body GroundBody - - - "the single ground body which is the parent of all stationary connections" - +typedef ^ ^ MD_Body BodyList {:} - - "array of body objects" - +typedef ^ ^ MD_Rod RodList {:} - - "array of rod objects" - +typedef ^ ^ MD_Connect ConnectList {:} - - "array of connection objects" - +typedef ^ ^ MD_Line LineList {:} - - "array of line objects" - +typedef ^ ^ MD_Fail FailList {:} - - "array of line objects" - +typedef ^ ^ IntKi FreeConIs {:} - - "array of free connection indices in ConnectList vector" "" +typedef ^ ^ IntKi CpldConIs {:}{:} - - "array of coupled/fairlead connection indices in ConnectList vector" "" +typedef ^ ^ IntKi FreeRodIs {:} - - "array of free rod indices in RodList vector" "" +typedef ^ ^ IntKi CpldRodIs {:}{:} - - "array of coupled/fairlead rod indices in RodList vector" "" +typedef ^ ^ IntKi FreeBodyIs {:} - - "array of free body indices in BodyList vector" "" +typedef ^ ^ IntKi CpldBodyIs {:}{:} - - "array of coupled body indices in BodyList vector" "" +typedef ^ ^ IntKi LineStateIs1 {:} - - "starting index of each line's states in state vector" "" +typedef ^ ^ IntKi LineStateIsN {:} - - "ending index of each line's states in state vector" "" +typedef ^ ^ IntKi ConStateIs1 {:} - - "starting index of each line's states in state vector" "" +typedef ^ ^ IntKi ConStateIsN {:} - - "ending index of each line's states in state vector" "" +typedef ^ ^ IntKi RodStateIs1 {:} - - "starting index of each rod's states in state vector" "" +typedef ^ ^ IntKi RodStateIsN {:} - - "ending index of each rod's states in state vector" "" +typedef ^ ^ IntKi BodyStateIs1 {:} - - "starting index of each body's states in state vector" "" +typedef ^ ^ IntKi BodyStateIsN {:} - - "ending index of each body's states in state vector" "" +typedef ^ ^ IntKi Nx - - - "number of states and size of state vector" "" +typedef ^ ^ IntKi WaveTi - - - "current interpolation index for wave time series data" "" +typedef ^ ^ MD_ContinuousStateType xTemp - - - "contains temporary state vector used in integration (put here so it's only allocated once)" +typedef ^ ^ MD_ContinuousStateType xdTemp - - - "contains temporary state derivative vector used in integration (put here so it's only allocated once)" +typedef ^ ^ DbKi zeros6 {6} - - "array of zeros for convenience" +typedef ^ ^ DbKi MDWrOutput {:} - - "Data from time step to be written to a MoorDyn output file" +typedef ^ ^ DbKi LastOutTime - - - "Time of last writing to MD output files" +typedef ^ ^ ReKi PtfmInit {6} - - "initial position of platform for an individual (non-farm) MD instance" - +typedef ^ ^ DbKi BathymetryGrid {:}{:} - - "matrix describing the bathymetry in a grid of x's and y's" +typedef ^ ^ DbKi BathGrid_Xs {:} - - "array of x-coordinates in the bathymetry grid" +typedef ^ ^ DbKi BathGrid_Ys {:} - - "array of y-coordinates in the bathymetry grid" +typedef ^ ^ IntKi BathGrid_npoints {:} - - "number of grid points to describe the bathymetry grid" ## ============================== Parameters ============================================================================================================================================ -typedef ^ ParameterType IntKi NTypes - - - "number of line types" "" -typedef ^ ^ IntKi NConnects - - - "number of Connection objects" "" -typedef ^ ^ IntKi NFairs - - - "number of Fairlead Connections" "" -typedef ^ ^ IntKi NConns - - - "number of Connect type Connections - not to be confused with NConnects" "" -typedef ^ ^ IntKi NAnchs - - - "number of Anchor type Connections" "" -typedef ^ ^ IntKi NLines - - - "number of Line objects" "" -typedef ^ ^ ReKi g - 9.81 - "gravitational constant" "[kg/m^2]" -typedef ^ ^ ReKi rhoW - - - "density of seawater" "[m]" -typedef ^ ^ ReKi WtrDpth - - - "water depth" "[m]" -typedef ^ ^ ReKi kBot - - - "bottom stiffness" "[Pa/m]" -typedef ^ ^ ReKi cBot - - - "bottom damping" "[Pa-s/m]" -typedef ^ ^ ReKi dtM0 - - - "desired mooring model time step" "[s]" -typedef ^ ^ ReKi dtCoupling - - - "coupling time step that MoorDyn should expect" "[s]" +typedef ^ ParameterType IntKi nLineTypes - 0 - "number of line types" "" +typedef ^ ^ IntKi nRodTypes - 0 - "number of rod types" "" +typedef ^ ^ IntKi nConnects - 0 - "number of Connection objects" "" +typedef ^ ^ IntKi nConnectsExtra - 0 - "number of Connection objects including space for extra ones that could arise from line failures" "" +typedef ^ ^ IntKi nBodies - 0 - "number of Body objects" "" +typedef ^ ^ IntKi nRods - 0 - "number of Rod objects" "" +typedef ^ ^ IntKi nLines - 0 - "number of Line objects" "" +typedef ^ ^ IntKi nCtrlChans - 0 - "number of distinct control channels specified for use as inputs" "" +typedef ^ ^ IntKi nFails - 0 - "number of failure conditions" "" +typedef ^ ^ IntKi nFreeBodies - 0 - "" "" +typedef ^ ^ IntKi nFreeRods - 0 - "" "" +typedef ^ ^ IntKi nFreeCons - 0 - "" "" +typedef ^ ^ IntKi nCpldBodies {:} - - "number of coupled bodies (for FAST.Farm, size>1 with an entry for each turbine)" "" +typedef ^ ^ IntKi nCpldRods {:} - - "number of coupled rods (for FAST.Farm, size>1 with an entry for each turbine)" "" +typedef ^ ^ IntKi nCpldCons {:} - - "number of coupled points (for FAST.Farm, size>1 with an entry for each turbine)" "" +typedef ^ ^ IntKi NConns - 0 - "number of Connect type Connections - not to be confused with NConnects" "" +typedef ^ ^ IntKi NAnchs - 0 - "number of Anchor type Connections" "" +typedef ^ ^ DbKi Tmax - - - "simulation duration" "[s]" +typedef ^ ^ DbKi g - 9.81 - "gravitational constant (positive)" "[m/s^2]" +typedef ^ ^ DbKi rhoW - 1025 - "density of seawater" "[kg/m^3]" +typedef ^ ^ DbKi WtrDpth - - - "water depth" "[m]" +typedef ^ ^ DbKi kBot - - - "bottom stiffness" "[Pa/m]" +typedef ^ ^ DbKi cBot - - - "bottom damping" "[Pa-s/m]" +typedef ^ ^ DbKi dtM0 - - - "desired mooring model time step" "[s]" +typedef ^ ^ DbKi dtCoupling - - - "coupling time step that MoorDyn should expect" "[s]" typedef ^ ^ IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - +typedef ^ ^ DbKi dtOut - - - "interval for writing output file lines" "[s]" typedef ^ ^ CHARACTER(1024) RootName - - - "RootName for writing output files" - typedef ^ ^ MD_OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - typedef ^ ^ CHARACTER(1) Delim - - - "Column delimiter for output text files" - typedef ^ ^ IntKi MDUnOut - - - "Unit number of main output file" +typedef ^ ^ CHARACTER(1024) PriPath - - - "The path to the primary MoorDyn input file, used if looking for additional input files" +typedef ^ ^ IntKi writeLog - -1 - "Switch for level of log file output" +#NOTE: there may be an issue with start/restart with the UnLog stored in parameters. We'll ignore this for now -- ADP +typedef ^ ^ IntKi UnLog - -1 - "Unit number of log file" +typedef ^ ^ IntKi WaveKin - - - "Flag for whether or how to consider water kinematics" +typedef ^ ^ IntKi Current - - - "Flag for whether or how to consider water kinematics" +typedef ^ ^ IntKi nTurbines - - - "Number of turbines if MoorDyn is performing an array-level simulation with FAST.Farm, otherwise 0" +typedef ^ ^ ReKi TurbineRefPos {:}{:} - - "reference position of turbines in farm, shape: 3, nTurbines" - +typedef ^ ^ DbKi mu_kT - - - "transverse kinetic friction coefficient" "(-)" +typedef ^ ^ DbKi mu_kA - - - "axial kinetic friction coefficient" "(-)" +typedef ^ ^ DbKi mc - - - "ratio of the static friction coefficient to the kinetic friction coefficient" "(-)" +typedef ^ ^ DbKi cv - - - "saturated damping coefficient" "(-)" +# --- parameters for wave and current --- +typedef ^ ^ IntKi nxWave - - - "number of x wave grid points" - +typedef ^ ^ IntKi nyWave - - - "number of y wave grid points" - +typedef ^ ^ IntKi nzWave - - - "number of z wave grid points" - +typedef ^ ^ IntKi ntWave - - - "number of wave time steps" - +typedef ^ ^ SiKi pxWave {:} - - "x location of wave grid points" - +typedef ^ ^ SiKi pyWave {:} - - "y location of wave grid points" - +typedef ^ ^ SiKi pzWave {:} - - "z location of wave grid points" - +typedef ^ ^ SiKi dtWave - - - "wave data time step" - +typedef ^ ^ SiKi uxWave {:}{:}{:}{:} - - "wave velocities time series at each grid point" - +typedef ^ ^ SiKi uyWave {:}{:}{:}{:} - - "wave velocities time series at each grid point" - +typedef ^ ^ SiKi uzWave {:}{:}{:}{:} - - "wave velocities time series at each grid point" - +typedef ^ ^ SiKi axWave {:}{:}{:}{:} - - "wave accelerations time series at each grid point" - +typedef ^ ^ SiKi ayWave {:}{:}{:}{:} - - "wave accelerations time series at each grid point" - +typedef ^ ^ SiKi azWave {:}{:}{:}{:} - - "wave accelerations time series at each grid point" - +typedef ^ ^ SiKi PDyn {:}{:}{:}{:} - - "wave dynamic pressure time series at each grid point" - +typedef ^ ^ SiKi zeta {:}{:}{:} - - "wave surface elevations time series at each surface grid point" - +typedef ^ ^ IntKi nzCurrent - - - "number of z current grid points" - +typedef ^ ^ SiKi pzCurrent {:} - - "z location of current grid points" - +typedef ^ ^ SiKi uxCurrent {:} - - "current velocities time series at each grid point" - +typedef ^ ^ SiKi uyCurrent {:} - - "current velocities time series at each grid point" - +# --- Parameters for linearization --- +typedef ^ ^ Integer Nx0 - - - "copy of initial size of system state vector, for linearization routines" - +typedef ^ ^ Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - +typedef ^ ^ R8Ki du {:} - - "vector that determines size of perturbation for u (inputs)" +typedef ^ ^ R8Ki dx {:} - - "vector that determines size of perturbation for x (continuous states)" +typedef ^ ^ Integer Jac_ny - - - "number of outputs in jacobian matrix" - +typedef ^ ^ Integer Jac_nx - - - "number of continuous states in jacobian matrix" - +typedef ^ ^ Integer dxIdx_map2_xStateIdx {:} - - "Mapping array from index of dX array to corresponding state index" - # ============================== Inputs ============================================================================================================================================ -typedef ^ InputType MeshType PtFairleadDisplacement - - - "mesh for position AND VELOCITY of each fairlead in X,Y,Z" "[m, m/s]" -# typedef ^ ^ MeshType HydroForceLineMesh - - - "Meshed input data" - -typedef ^ ^ ReKi DeltaL {:} - - "change in line length command for each channel" "[m]" -typedef ^ ^ ReKi DeltaLdot {:} - - "rate of change of line length command for each channel" "[m]" +typedef ^ InputType MeshType CoupledKinematics {:} - - "array of meshes for each coupling point (6 DOF info used for rods and bodies)" "[m, m/s]" <<<< will use this eventually! +typedef ^ ^ ReKi DeltaL {:} - - "change in line length command for each channel" "[m]" +typedef ^ ^ ReKi DeltaLdot {:} - - "rate of change of line length command for each channel" "[m]" +#typedef ^ ^ DbKi U {:}{:} - - "water velocities at each node" - +#typedef ^ ^ DbKi Ud {:}{:} - - "water accelerations at each node" - +#typedef ^ ^ DbKi zeta {:} - - "water surface elevations above each node" - +#typedef ^ ^ DbKi PDyn {:} - - "water dynamic pressure at each node" - ## ============================== Outputs ============================================================================================================================================ -typedef ^ OutputType MeshType PtFairleadLoad - - - "point mesh for fairlead forces in X,Y,Z" "[N]" +typedef ^ OutputType MeshType CoupledLoads {:} - - "array of point meshes for mooring reaction forces (and moments) at coupling points" "[N]" typedef ^ ^ ReKi WriteOutput {:} - - "output vector returned to glue code" "" -# typedef ^ ^ MeshType LineMeshPosition - - - "Meshed output data" - +# should CoupledLoads be an array? +#typedef ^ ^ DbKi rAll {:}{:} - - "Mesh of all point positions: bodies, rods, points, line internal nodes" - diff --git a/modules/moordyn/src/MoorDyn_Rod.f90 b/modules/moordyn/src/MoorDyn_Rod.f90 new file mode 100644 index 0000000000..26bd00c96b --- /dev/null +++ b/modules/moordyn/src/MoorDyn_Rod.f90 @@ -0,0 +1,1194 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2020-2021 Alliance for Sustainable Energy, LLC +! Copyright (C) 2015-2019 Matthew Hall +! +! This file is part of MoorDyn. +! +! 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 MoorDyn_Rod + + USE MoorDyn_Types + USE MoorDyn_IO + USE NWTC_Library + USE MoorDyn_Misc + USE MoorDyn_Line, only : Line_SetEndKinematics, Line_GetEndStuff, Line_SetEndOrientation, Line_GetEndSegmentInfo + + IMPLICIT NONE + + PRIVATE + + INTEGER(IntKi), PARAMETER :: wordy = 0 ! verbosity level. >1 = more console output + + PUBLIC :: Rod_Setup + PUBLIC :: Rod_Initialize + PUBLIC :: Rod_SetKinematics + PUBLIC :: Rod_SetState + PUBLIC :: Rod_GetStateDeriv + PUBLIC :: Rod_DoRHS + PUBLIC :: Rod_GetCoupledForce + PUBLIC :: Rod_GetNetForceAndMass + PUBLIC :: Rod_AddLine + PUBLIC :: Rod_RemoveLine + + + +CONTAINS + + + !----------------------------------------------------------------------- + SUBROUTINE Rod_Setup(Rod, RodProp, endCoords, p, ErrStat, ErrMsg) + + TYPE(MD_Rod), INTENT(INOUT) :: Rod ! the single rod object of interest + TYPE(MD_RodProp), INTENT(INOUT) :: RodProp ! the single rod property set for the line of interest + REAL(DbKi), INTENT(IN) :: endCoords(6) + TYPE(MD_ParameterType), INTENT(IN ) :: p ! Parameters + INTEGER, INTENT( INOUT ) :: ErrStat ! returns a non-zero value when an error occurs + CHARACTER(*), INTENT( INOUT ) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + INTEGER(4) :: i ! Generic index + INTEGER(4) :: K ! Generic index + INTEGER(IntKi) :: N + + Real(DbKi) :: phi, beta, sinPhi, cosPhi, tanPhi, sinBeta, cosBeta ! various orientation things + Real(DbKi) :: k_hat(3) ! unit vector (redundant, not used) <<<< + + INTEGER :: ErrStat2 + + N = Rod%N ! number of segments in this line (for code readability) + + ! -------------- save some section properties to the line object itself ----------------- + + Rod%d = RodProp%d + Rod%rho = RodProp%w/(Pi/4.0 * Rod%d * Rod%d) + + Rod%Can = RodProp%Can + Rod%Cat = RodProp%Cat + Rod%Cdn = RodProp%Cdn + Rod%Cdt = RodProp%Cdt + Rod%CaEnd = RodProp%CaEnd + Rod%CdEnd = RodProp%CdEnd + + + ! allocate node positions and velocities (NOTE: these arrays start at ZERO) + ALLOCATE(Rod%r(3, 0:N), Rod%rd(3, 0:N), STAT=ErrStat2); if(AllocateFailed("")) return + + ! allocate segment scalar quantities + if (Rod%N == 0) then ! special case of zero-length Rod + ALLOCATE(Rod%l(1), Rod%V(N), STAT=ErrStat2); if(AllocateFailed("Rod: l and V")) return + else ! normal case + ALLOCATE(Rod%l(N), Rod%V(N), STAT=ErrStat2); if(AllocateFailed("Rod: l and V")) return + end if + + ! allocate water related vectors + ALLOCATE(Rod%U(3, 0:N), Rod%Ud(3, 0:N), Rod%zeta(0:N), Rod%PDyn(0:N), STAT=ErrStat2) + if(AllocateFailed("Rod: U Ud zeta PDyn")) return + + ! allocate node force vectors + ALLOCATE(Rod%W(3, 0:N), Rod%Bo(3, 0:N), Rod%Dp(3, 0:N), Rod%Dq(3, 0:N), Rod%Ap(3, 0:N), & + Rod%Aq(3, 0:N), Rod%Pd(3, 0:N), Rod%B(3, 0:N), Rod%Fnet(3, 0:N), STAT=ErrStat2) + if(AllocateFailed("Rod: force arrays")) return + + ! allocate mass and inverse mass matrices for each node (including ends) + ALLOCATE(Rod%M(3, 3, 0:N), STAT=ErrStat2); if(AllocateFailed("Rod: M")) return + + + ! set to zero initially (important of wave kinematics are not being used) + Rod%U = 0.0_DbKi + Rod%Ud = 0.0_DbKi + Rod%zeta = 0.0_DbKi + Rod%PDyn = 0.0_DbKi + + ! ------------------------- set some geometric properties and the starting kinematics ------------------------- + + CALL UnitVector(endCoords(1:3), endCoords(4:6), Rod%q, Rod%UnstrLen) ! get Rod axis direction vector and Rod length + + ! set Rod positions (some or all may be overwritten depending on if the Rod is coupled or attached to a Body) + Rod%r6(1:3) = endCoords(1:3) ! (end A coordinates) + Rod%v6(1:3) = 0.0_DbKi ! (end A velocity, unrotated axes) + + Rod%r6(4:6) = Rod%q ! (Rod direction unit vector) + Rod%v6(4:6) = 0.0_DbKi ! (rotational velocities about unrotated axes) + + ! save mass for future calculations >>>> should calculate I_l and I_r here in future <<<< + Rod%mass = Rod%UnstrLen*RodProp%w + + + ! assign values for l and V + if (Rod%N == 0) then + Rod%l(1) = 0.0_DbKi + Rod%V(1) = 0.0_DbKi + else + DO i=1,N + Rod%l(i) = Rod%UnstrLen/REAL(N, DbKi) + Rod%V(i) = Rod%l(i)*0.25*Pi*RodProp%d*RodProp%d + END DO + end if + + + ! set gravity and bottom contact forces to zero initially (because the horizontal components should remain at zero) + Rod%W = 0.0_DbKi + Rod%B = 0.0_DbKi + + ! calculate some orientation items to be used for mesh setup + call GetOrientationAngles(Rod%q, phi, sinPhi, cosPhi, tanPhi, beta, sinBeta, cosBeta, k_hat) ! calculate some orientation information for the Rod as a whole + Rod%OrMat = CalcOrientation(phi, beta, 0.0_DbKi) ! get rotation matrix to put things in global rather than rod-axis orientations + + + IF (wordy > 0) print *, "Set up Rod ",Rod%IdNum, ", type ", Rod%typeNum + + + if (p%writeLog > 1) then + write(p%UnLog, '(A)') " - Rod "//trim(num2lstr(Rod%IdNum)) + write(p%UnLog, '(A)') " ID: "//trim(num2lstr(Rod%IdNum)) + write(p%UnLog, '(A)') " UnstrLen: "//trim(num2lstr(Rod%UnstrLen)) + write(p%UnLog, '(A)') " N : "//trim(num2lstr(Rod%N )) + write(p%UnLog, '(A)') " d : "//trim(num2lstr(Rod%d )) + write(p%UnLog, '(A)') " rho : "//trim(num2lstr(Rod%rho )) + write(p%UnLog, '(A)') " Can : "//trim(num2lstr(Rod%Can )) + write(p%UnLog, '(A)') " Cat : "//trim(num2lstr(Rod%Cat )) + write(p%UnLog, '(A)') " CaEnd: "//trim(num2lstr(Rod%CaEnd )) + write(p%UnLog, '(A)') " Cdn : "//trim(num2lstr(Rod%Cdn )) + write(p%UnLog, '(A)') " Cdt : "//trim(num2lstr(Rod%Cdt )) + write(p%UnLog, '(A)') " CdEnd: "//trim(num2lstr(Rod%CdEnd )) + !write(p%UnLog, '(A)') " ww_l: " << ( (rho - env->rho_w)*(pi/4.*d*d) )*9.81 << endl; + end if + + + ! need to add cleanup sub <<< + + + CONTAINS + + LOGICAL FUNCTION AllocateFailed(arrayName) + CHARACTER(*), INTENT(IN ) :: arrayName ! The array name + call SetErrStat(ErrStat2, "Error allocating space for "//trim(arrayName)//" array.", ErrStat, ErrMsg, 'Rod_Setup') + AllocateFailed = ErrStat2 >= AbortErrLev + !if (AllocateFailed) call CleanUp() + END FUNCTION AllocateFailed + + END SUBROUTINE Rod_Setup + !-------------------------------------------------------------- + + + + + ! Make output file for Rod and set end kinematics of any attached lines. + ! For free Rods, fill in the initial states into the state vector. + ! Notes: r6 and v6 must already be set. + ! ground- or body-pinned rods have already had setKinematics called to set first 3 elements of r6, v6. + !-------------------------------------------------------------- + SUBROUTINE Rod_Initialize(Rod, states, m) + + TYPE(MD_Rod), INTENT(INOUT) :: Rod ! the rod object + Real(DbKi), INTENT(INOUT) :: states(:) ! state vector section for this line + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + + + INTEGER(IntKi) :: l ! index of segments or nodes along line + REAL(DbKi) :: rRef(3) ! reference position of mesh node + REAL(DbKi) :: OrMat(3,3) ! DCM for body orientation based on r6_in + + IF (wordy > 0) print *, "initializing Rod ", Rod%idNum + + ! the r6 and v6 vectors should have already been set + ! r and rd of ends have already been set by setup function or by parent object <<<<< right? <<<<< + + + ! Pass kinematics to any attached lines (this is just like what a Connection does, except for both ends) + ! so that they have the correct initial positions at this initialization stage. + + if (Rod%typeNum >- 2) CALL Rod_SetDependentKin(Rod, 0.0_DbKi, m, .TRUE.) ! don't call this for type -2 coupled Rods as it's already been called + + + ! assign the resulting kinematics to its part of the state vector (only matters if it's an independent Rod) + + if (Rod%typeNum == 0) then ! free Rod type + + states(1:6) = 0.0_DbKi ! zero velocities for initialization + states(7:9) = Rod%r(:,0) ! end A position + states(10:12) = Rod%q ! rod direction unit vector + + else if (abs(Rod%typeNum) ==1 ) then ! pinned rod type (coupled or attached to something previously via setPinKin) + + states(1:3) = 0.0_DbKi ! zero velocities for initialization + states(4:6) = Rod%q ! rod direction unit vector + + end if + + ! note: this may also be called by a coupled rod (type = -1) in which case states will be empty + + + END SUBROUTINE Rod_Initialize + !-------------------------------------------------------------- + + + + + ! set kinematics for Rods ONLY if they are attached to a body (including a coupled body) or coupled (otherwise shouldn't be called) + !-------------------------------------------------------------- + SUBROUTINE Rod_SetKinematics(Rod, r6_in, v6_in, a6_in, t, m) + + Type(MD_Rod), INTENT(INOUT) :: Rod ! the Rod object + Real(DbKi), INTENT(IN ) :: r6_in(6) ! 6-DOF position + Real(DbKi), INTENT(IN ) :: v6_in(6) ! 6-DOF velocity + Real(DbKi), INTENT(IN ) :: a6_in(6) ! 6-DOF acceleration (only used for coupled rods) + Real(DbKi), INTENT(IN ) :: t ! instantaneous time + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + + INTEGER(IntKi) :: l + + Rod%time = t ! store current time + + + if (abs(Rod%typeNum) == 2) then ! rod rigidly coupled to a body, or ground, or coupling point + Rod%r6 = r6_in + Rod%v6 = v6_in + Rod%a6 = a6_in + + call ScaleVector(Rod%r6(4:6), 1.0_DbKi, Rod%r6(4:6)); ! enforce direction vector to be a unit vector + + ! since this rod has no states and all DOFs have been set, pass its kinematics to dependent Lines + CALL Rod_SetDependentKin(Rod, t, m, .FALSE.) + + else if (abs(Rod%typeNum) == 1) then ! rod end A pinned to a body, or ground, or coupling point + + ! set Rod *end A only* kinematics based on BCs (linear model for now) + Rod%r6(1:3) = r6_in(1:3) + Rod%v6(1:3) = v6_in(1:3) + Rod%a6(1:3) = a6_in(1:3) + + + ! Rod is pinned so only end A is specified, rotations are left alone and will be + ! handled, along with passing kinematics to dependent lines, by separate call to setState + + else + print *, "Error: Rod_SetKinematics called for a free Rod in MoorDyn." ! <<< + end if + + + ! update Rod direction unit vector (simply equal to last three entries of r6, presumably these were set elsewhere for pinned Rods) + Rod%q = Rod%r6(4:6) + + + + END SUBROUTINE Rod_SetKinematics + !-------------------------------------------------------------- + + ! pass the latest states to the rod if it has any DOFs/states (then update rod end kinematics including attached lines) + !-------------------------------------------------------------- + SUBROUTINE Rod_SetState(Rod, X, t, m) + + Type(MD_Rod), INTENT(INOUT) :: Rod ! the Rod object + Real(DbKi), INTENT(IN ) :: X(:) ! state vector section for this line + Real(DbKi), INTENT(IN ) :: t ! instantaneous time + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + + INTEGER(IntKi) :: J ! index + + + ! for a free Rod, there are 12 states: + ! [ x, y, z velocity of end A, then rate of change of u/v/w coordinates of unit vector pointing toward end B, + ! then x, y, z coordinate of end A, u/v/w coordinates of unit vector pointing toward end B] + + ! for a pinned Rod, there are 6 states (rotational only): + ! [ rate of change of u/v/w coordinates of unit vector pointing toward end B, + ! then u/v/w coordinates of unit vector pointing toward end B] + + + ! store current time + Rod%time = t + + + ! copy over state values for potential use during derivative calculations + if (Rod%typeNum == 0) then ! free Rod type + + ! CALL ScaleVector(X(10:12), 1.0, X(10:12)) ! enforce direction vector to be a unit vector <<<< can't do this with FAST frameowrk, could be a problem!! + + ! TODO: add "controller" adjusting state derivatives of X(10:12) to artificially force X(10:12) to remain a unit vector <<<<<<<<<<< + + + Rod%r6(1:3) = X(7:9) ! (end A coordinates) + Rod%v6(1:3) = X(1:3) ! (end A velocity, unrotated axes) + CALL ScaleVector(X(10:12), 1.0_DbKi, Rod%r6(4:6)) !Rod%r6(4:6) = X(10:12) ! (Rod direction unit vector) + Rod%v6(4:6) = X(4:6) ! (rotational velocities about unrotated axes) + + + CALL Rod_SetDependentKin(Rod, t, m, .FALSE.) + + else if (abs(Rod%typeNum) == 1) then ! pinned rod type (coupled or attached to something)t previously via setPinKin) + + !CALL ScaleVector(X(4:6), 1.0, X(4:6)) ! enforce direction vector to be a unit vector + + + CALL ScaleVector(X(4:6), 1.0_DbKi, Rod%r6(4:6)) !Rod%r6(3+J) = X(3+J) ! (Rod direction unit vector) + Rod%v6(4:6) = X(1:3) ! (rotational velocities about unrotated axes) + + + CALL Rod_SetDependentKin(Rod, t, m, .FALSE.) + + else + print *, "Error: Rod::setState called for a non-free rod type in MoorDyn" ! <<< + end if + + ! update Rod direction unit vector (simply equal to last three entries of r6) + Rod%q = Rod%r6(4:6) + + END SUBROUTINE Rod_SetState + !-------------------------------------------------------------- + + + ! Set the Rod end kinematics then set the kinematics of dependent objects (any attached lines). + ! This also determines the orientation of zero-length rods. + !-------------------------------------------------------------- + SUBROUTINE Rod_SetDependentKin(Rod, t, m, initial) + + Type(MD_Rod), INTENT(INOUT) :: Rod ! the Rod object + Real(DbKi), INTENT(IN ) :: t ! instantaneous time + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects (for simplicity, since Bodies deal with Rods and Connections) + LOGICAL, INTENT(IN ) :: initial ! true if this is the call during initialization (in which case avoid calling any Lines yet) + + INTEGER(IntKi) :: l ! index of segments or nodes along line + INTEGER(IntKi) :: J ! index + INTEGER(IntKi) :: N ! number of segments + + REAL(DbKi) :: qEnd(3) ! unit vector of attached line end segment, following same direction convention as Rod's q vector + REAL(DbKi) :: q_EI_dl(3) ! <<<< add description + REAL(DbKi) :: EIend ! bending stiffness of attached line end segment + REAL(DbKi) :: dlEnd ! stretched length of attached line end segment + REAL(DbKi) :: qMomentSum(3) ! summation of qEnd*EI/dl_stretched (with correct sign) for each attached line + + + ! Initialize variables + qMomentSum = 0.0_DbKi + + ! in future pass accelerations here too? <<<< + + N = Rod%N + + ! from state values, set positions of end nodes + ! end A + Rod%r(:,0) = Rod%r6(1:3) ! positions + Rod%rd(:,0) = Rod%v6(1:3) ! velocities + + !print *, Rod%r6(1:3) + !print *, Rod%r(:,0) + + if (Rod%N > 0) then ! set end B nodes only if the rod isn't zero length + CALL transformKinematicsAtoB(Rod%r6(1:3), Rod%r6(4:6), Rod%UnstrLen, Rod%v6, Rod%r(:,N), Rod%rd(:,N)) ! end B + end if + + ! pass end node kinematics to any attached lines (this is just like what a Connection does, except for both ends) + DO l=1,Rod%nAttachedA + CALL Line_SetEndKinematics(m%LineList(Rod%attachedA(l)), Rod%r(:,0), Rod%rd(:,0), t, Rod%TopA(l)) + END DO + DO l=1,Rod%nAttachedB + CALL Line_SetEndKinematics(m%LineList(Rod%attachedB(l)), Rod%r(:,N), Rod%rd(:,N), t, Rod%TopB(l)) + END DO + + + ! if this is a zero-length Rod and we're passed initialization, get bending moment-related information from attached lines and compute Rod's equilibrium orientation + if ((N==0) .and. (.not. initial)) then + + DO l=1,Rod%nAttachedA + + CALL Line_GetEndSegmentInfo(m%LineList(Rod%attachedA(l)), q_EI_dl, Rod%TopA(l), 0) + + qMomentSum = qMomentSum + q_EI_dl ! add each component to the summation vector + + END DO + + DO l=1,Rod%nAttachedB + + CALL Line_GetEndSegmentInfo(m%LineList(Rod%attachedB(l)), q_EI_dl, Rod%TopB(l), 1) + + qMomentSum = qMomentSum + q_EI_dl ! add each component to the summation vector + + END DO + + ! solve for line unit vector that balances all moments (unit vector of summation of qEnd*EI/dl_stretched over each line) + CALL ScaleVector(qMomentSum, 1.0_DbKi, Rod%q) + + Rod%r6(4:6) = Rod%q ! set orientation angles + END IF + + ! pass Rod orientation to any attached lines (this is just like what a Connection does, except for both ends) + DO l=1,Rod%nAttachedA + CALL Line_SetEndOrientation(m%LineList(Rod%attachedA(l)), Rod%q, Rod%TopA(l), 0) + END DO + DO l=1,Rod%nAttachedB + CALL Line_SetEndOrientation(m%LineList(Rod%attachedB(l)), Rod%q, Rod%TopB(l), 1) + END DO + + END SUBROUTINE Rod_SetDependentKin + !-------------------------------------------------------------- + + !-------------------------------------------------------------- + SUBROUTINE Rod_GetStateDeriv(Rod, Xd, m, p) + + Type(MD_Rod), INTENT(INOUT) :: Rod ! the Rod object + Real(DbKi), INTENT(INOUT) :: Xd(:) ! state derivative vector section for this line + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects (for simplicity, since Bodies deal with Rods and Connections) + TYPE(MD_ParameterType),INTENT(IN ) :: p ! Parameters + + !TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! misc/optimization variables + + INTEGER(IntKi) :: J ! index + + Real(DbKi) :: Fnet (6) ! net force and moment about reference point + Real(DbKi) :: M_out (6,6) ! mass matrix about reference point + + Real(DbKi) :: acc(6) ! 6DOF acceleration vector about reference point + + Real(DbKi) :: Mcpl(3) ! moment in response to end A acceleration due to inertial coupling + + Real(DbKi) :: y_temp (6) ! temporary vector for LU decomposition + Real(DbKi) :: LU_temp(6,6) ! temporary matrix for LU decomposition + + ! Initialize some things to zero + y_temp = 0.0_DbKi +! FIXME: should LU_temp be set to M_out before calling LUsolve????? + LU_temp = 0.0_DbKi + + CALL Rod_GetNetForceAndMass(Rod, Rod%r(:,0), Fnet, M_out, m, p) + + + + ! TODO: add "controller" adjusting state derivatives of X(10:12) to artificially force X(10:12) to remain a unit vector <<<<<<<<<<< + + ! fill in state derivatives + IF (Rod%typeNum == 0) THEN ! free Rod type, 12 states + + ! solve for accelerations in [M]{a}={f} using LU decomposition + CALL LUsolve(6, M_out, LU_temp, Fnet, y_temp, acc) + + Xd(7:9) = Rod%v6(1:3) !Xd[6 + I] = v6[ I]; ! dxdt = V (velocities) + Xd(1:6) = acc !Xd[ I] = acc[ I]; ! dVdt = a (accelerations) + !Xd[3 + I] = acc[3+I]; ! rotational accelerations + + ! rate of change of unit vector components!! CHECK! <<<<< + Xd(10) = - Rod%v6(6)*Rod%r6(5) + Rod%v6(5)*Rod%r6(6) ! i.e. u_dot_x = -omega_z*u_y + omega_y*u_z + Xd(11) = Rod%v6(6)*Rod%r6(4) - Rod%v6(4)*Rod%r6(6) ! i.e. u_dot_y = omega_z*u_x - omega_x*u_z + Xd(12) = -Rod%v6(5)*Rod%r6(4) + Rod%v6(4)*Rod%r6(5) ! i.e. u_dot_z = -omega_y*u_x - omega_x*u_y + + ! store accelerations in case they're useful as output + Rod%a6 = acc + + ELSE ! pinned rod, 6 states (rotational only) + + ! account for moment in response to end A acceleration due to inertial coupling (off-diagonal sub-matrix terms) + !Fnet(4:6) = Fnet(4:6) - MATMUL(M_out(4:6,1:3), Rod%a6(1:3)) ! << 1) THEN + print *, " state derivatives:" + print *, Xd + + print *, "r0" + print *, Rod%r(:,0) + print *, "F" + print *, Fnet + print *, "M" + print *, M_out + print *, "acc" + print *, acc + END IF + + EXIT + END IF + END DO + + END SUBROUTINE Rod_GetStateDeriv + !-------------------------------------------------------------- + + + ! calculate the forces on the rod, including from attached lines + !-------------------------------------------------------------- + SUBROUTINE Rod_DoRHS(Rod, m, p) + + Type(MD_Rod), INTENT(INOUT) :: Rod ! the Rodion object + TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! passing along all mooring objects + TYPE(MD_ParameterType),INTENT(IN ) :: p ! Parameters + + !TYPE(MD_MiscVarType), INTENT(INOUT) :: m ! misc/optimization variables + + INTEGER(IntKi) :: l ! index of attached lines + INTEGER(IntKi) :: I,J,K ! index + + + INTEGER(IntKi) :: N ! number of rod elements for convenience + + Real(DbKi) :: phi, beta, sinPhi, cosPhi, tanPhi, sinBeta, cosBeta ! various orientation things + Real(DbKi) :: k_hat(3) ! unit vector (redundant, not used) <<<< + Real(DbKi) :: Ftemp ! temporary force component + Real(DbKi) :: Mtemp ! temporary moment component + + Real(DbKi) :: m_i, v_i ! + Real(DbKi) :: zeta ! wave elevation above/below a given node + !Real(DbKi) :: h0 ! distance along rod centerline from end A to the waterplane + Real(DbKi) :: deltaL ! submerged length of a given segment + Real(DbKi) :: Lsum ! cumulative length along rod axis from bottom + Real(DbKi) :: dL ! length attributed to node + Real(DbKi) :: VOF ! fraction of volume associated with node that is submerged + + Real(DbKi) :: VOF0 ! original VOF based only on axis before refinement + Real(DbKi) :: z1hi ! highest elevation of cross section at node [m] + Real(DbKi) :: z1lo ! lowest elevation of cross section at node [m] + Real(DbKi) :: G ! distance normal to axis from bottom edge of cross section to waterplane [m] + Real(DbKi) :: al ! angle involved in circular segment buoyancy calc [rad] + Real(DbKi) :: A ! area of cross section at node that is below the waterline [m2] + Real(DbKi) :: zA ! crude approximation to z value of centroid of submerged cross section at node [m] + + + Real(DbKi) :: Vi(3) ! relative flow velocity over a node + Real(DbKi) :: SumSqVp, SumSqVq, MagVp, MagVq + Real(DbKi) :: Vp(3), Vq(3) ! transverse and axial components of water velocity at a given node + Real(DbKi) :: ap(3), aq(3) ! transverse and axial components of water acceleration at a given node + Real(DbKi) :: Fnet_i(3) ! force from an attached line + Real(DbKi) :: Mnet_i(3) ! moment from an attached line + Real(DbKi) :: Mass_i(3,3) ! mass from an attached line + + ! used in lumped 6DOF calculations: + Real(DbKi) :: rRel( 3) ! relative position of each node i from rRef + !Real(DbKi) :: OrMat(3,3) ! rotation matrix to rotate global z to rod's axis + Real(DbKi) :: F6_i(6) ! a node's contribution to the total force vector + Real(DbKi) :: M6_i(6,6) ! a node's contribution to the total mass matrix + Real(DbKi) :: I_l ! axial inertia of rod + Real(DbKi) :: I_r ! radial inertia of rod about CG + Real(DbKi) :: Imat_l(3,3) ! inertia about CG aligned with Rod axis + Real(DbKi) :: Imat(3,3) ! inertia about CG in global frame + Real(DbKi) :: h_c ! location of CG along axis + Real(DbKi) :: r_c(3) ! 3d location of CG relative to node A + Real(DbKi) :: Fcentripetal(3) ! centripetal force + Real(DbKi) :: Mcentripetal(3) ! centripetal moment + + Real(DbKi) :: depth ! local interpolated depth from bathymetry grid [m] + Real(DbKi) :: nvec(3) ! local seabed surface normal vector (positive out) + + + N = Rod%N + + ! ------------------------------ zero some things -------------------------- + + Rod%Mext = 0.0_DbKi ! zero the external moment sum + + Lsum = 0.0_DbKi + + + ! ---------------------------- initial rod and node calculations ------------------------ + + ! calculate some orientation information for the Rod as a whole + !call GetOrientationAngles(Rod%r( :,0), Rod%r( :,N), phi, sinPhi, cosPhi, tanPhi, beta, sinBeta, cosBeta, k_hat) + call GetOrientationAngles(Rod%q, phi, sinPhi, cosPhi, tanPhi, beta, sinBeta, cosBeta, k_hat) + + ! save to internal roll and pitch variables for use in output <<< should check these, make Euler angles isntead of independent <<< + Rod%roll = -phi*sinBeta + Rod%pitch = phi*cosBeta + + ! set interior node positions and velocities (stretch the nodes between the endpoints linearly) (skipped for zero-length Rods) + DO i=1,N-1 + Rod%r( :,i) = Rod%r( :,0) + (Rod%r( :,N) - Rod%r( :,0)) * (REAL(i)/REAL(N)) + Rod%rd(:,i) = Rod%rd(:,0) + (Rod%rd(:,N) - Rod%rd(:,0)) * (REAL(i)/REAL(N)) + + Rod%V(i) = 0.25*pi * Rod%d*Rod%d * Rod%l(i) ! volume attributed to segment + END DO + + + ! apply wave kinematics (if there are any) + + DO i=0,N + CALL getWaterKin(p, Rod%r(1,i), Rod%r(2,i), Rod%r(3,i), Rod%time, m%WaveTi, Rod%U(:,i), Rod%Ud(:,i), Rod%zeta(i), Rod%PDyn(i)) + !F(i) = 1.0 ! set VOF value to one for now (everything submerged - eventually this should be element-based!!!) <<<< + ! <<<< currently F is not being used and instead a VOF variable is used within the node loop + END DO + + ! Calculated h0 (note this should be deprecated/replced) + zeta = Rod%zeta(N) ! temporary + ! get approximate location of waterline crossing along Rod axis (note: negative h0 indicates end A is above end B, and measures -distance from end A to waterline crossing) + if ((Rod%r(3,0) < zeta) .and. (Rod%r(3,N) < zeta)) then ! fully submerged case + Rod%h0 = Rod%UnstrLen + else if ((Rod%r(3,0) < zeta) .and. (Rod%r(3,N) > zeta)) then ! check if it's crossing the water plane (should also add some limits to avoid near-horizontals at some point) + Rod%h0 = (zeta - Rod%r(3,0))/Rod%q(3) ! distance along rod centerline from end A to the waterplane + else if ((Rod%r(3,N) < zeta) .and. (Rod%r(3,0) > zeta)) then ! check if it's crossing the water plane but upside down + Rod%h0 = -(zeta - Rod%r(3,0))/Rod%q(3) ! negative distance along rod centerline from end A to the waterplane + else + Rod%h0 = 0.0_DbKi ! fully unsubmerged case (ever applicable?) + end if + + + ! -------------------------- loop through all the nodes ----------------------------------- + DO I = 0, N + + + ! ------------------ calculate added mass matrix for each node ------------------------- + + ! get mass and volume considering adjacent segment lengths + IF (I==0) THEN + dL = 0.5*Rod%l(1) + m_i = 0.25*Pi * Rod%d*Rod%d * dL *Rod%rho ! (will be zero for zero-length Rods) + v_i = 0.5 *Rod%V(1) + ELSE IF (I==N) THEN + dL = 0.5*Rod%l(N) + m_i = 0.25*pi * Rod%d*Rod%d * dL *Rod%rho + v_i = 0.5*Rod%V(N) + ELSE + dL = 0.5*(Rod%l(I) + Rod%l(I+1)) + m_i = 0.25*pi * Rod%d*Rod%d * dL *Rod%rho + v_i = 0.5 *(Rod%V(I) + Rod%V(I+1)) + END IF + + ! get scalar for submerged portion + if (Rod%h0 < 0.0_DbKi) then ! upside down partially-submerged Rod case + IF (Lsum >= -Rod%h0) THEN ! if fully submerged + VOF0 = 1.0_DbKi + ELSE IF (Lsum + dL > -Rod%h0) THEN ! if partially below waterline + VOF0 = (Lsum+dL + Rod%h0)/dL + ELSE ! must be out of water + VOF0 = 0.0_DbKi + END IF + else + IF (Lsum + dL <= Rod%h0) THEN ! if fully submerged + VOF0 = 1.0_DbKi + ELSE IF (Lsum < Rod%h0) THEN ! if partially below waterline + VOF0 = (Rod%h0 - Lsum)/dL + ELSE ! must be out of water + VOF0 = 0.0_DbKi + END IF + end if + + Lsum = Lsum + dL ! add length attributed to this node to the total + + ! get submerged cross sectional area and centroid for each node + z1hi = Rod%r(3,I) + 0.5*Rod%d*abs(sinPhi) ! highest elevation of cross section at node + z1lo = Rod%r(3,I) - 0.5*Rod%d*abs(sinPhi) ! lowest elevation of cross section at node + + if (z1lo > Rod%zeta(I)) then ! fully out of water + A = 0.0 ! area + zA = 0 ! centroid depth + else if (z1hi < Rod%zeta(I)) then ! fully submerged + A = Pi*0.25*Rod%d**2 + zA = Rod%r(3,I) + else ! if z1hi*z1lo < 0.0: # if cross section crosses waterplane + if (abs(sinPhi) < 0.001) then ! if cylinder is near vertical, i.e. end is horizontal + A = 0.5_DbKi ! <<< shouldn't this just be zero? <<< + zA = 0.0_DbKi + else + G = (Rod%r(3,I)-Rod%zeta(I))/abs(sinPhi) !(-z1lo+Rod%zeta(I))/abs(sinPhi) ! distance from node to waterline cross at same axial location [m] + !A = 0.25*Rod%d**2*acos((Rod%d - 2.0*G)/Rod%d) - (0.5*Rod%d-G)*sqrt(Rod%d*G-G**2) ! area of circular cross section that is below waterline [m^2] + !zA = (z1lo-Rod%zeta(I))/2 ! very crude approximation of centroid for now... <<< need to double check zeta bit <<< + al = acos(2.0*G/Rod%d) + A = Rod%d*Rod%d/8.0 * (2.0*al - sin(2.0*al)) + zA = Rod%r(3,I) - 0.6666666666 * Rod%d* (sin(al))**3 / (2.0*al - sin(2.0*al)) + end if + end if + + VOF = VOF0*cosPhi**2 + A/(0.25*Pi*Rod%d**2)*sinPhi**2 ! this is a more refined VOF-type measure that can work for any incline + + + ! build mass and added mass matrix + DO J=1,3 + DO K=1,3 + IF (J==K) THEN + Rod%M(K,J,I) = m_i + VOF*p%rhoW*v_i*( Rod%Can*(1 - Rod%q(J)*Rod%q(K)) + Rod%Cat*Rod%q(J)*Rod%q(K) ) + ELSE + Rod%M(K,J,I) = VOF*p%rhoW*v_i*( Rod%Can*(-Rod%q(J)*Rod%q(K)) + Rod%Cat*Rod%q(J)*Rod%q(K) ) + END IF + END DO + END DO + + ! <<<< what about accounting for offset of half segment from node location for end nodes? <<<< + + +! CALL Inverse3by3(Rod%S(:,:,I), Rod%M(:,:,I)) ! invert mass matrix + + + ! ------------------ CALCULATE FORCES ON EACH NODE ---------------------------- + + if (N > 0) then ! the following force calculations are only nonzero for finite-length rods (skipping for zero-length Rods) + + ! >>> no nodal axial elasticity loads calculated since it's assumed rigid, but should I calculate tension/compression due to other loads? <<< + + ! weight (now only the dry weight) + Rod%W(:,I) = (/ 0.0_DbKi, 0.0_DbKi, -m_i * p%g /) ! assuming g is positive + + ! radial buoyancy force from sides (now calculated based on outside pressure, for submerged portion only) + Ftemp = -VOF * v_i * p%rhoW*p%g * sinPhi ! magnitude of radial buoyancy force at this node + Rod%Bo(:,I) = (/ Ftemp*cosBeta*cosPhi, Ftemp*sinBeta*cosPhi, -Ftemp*sinPhi /) + + !relative flow velocities + DO J = 1, 3 + Vi(J) = Rod%U(J,I) - Rod%rd(J,I) ! relative flow velocity over node -- this is where wave velicites would be added + END DO + + ! decomponse relative flow into components + SumSqVp = 0.0_DbKi ! start sums of squares at zero + SumSqVq = 0.0_DbKi + DO J = 1, 3 + Vq(J) = DOT_PRODUCT( Vi , Rod%q ) * Rod%q(J); ! tangential relative flow component + Vp(J) = Vi(J) - Vq(J) ! transverse relative flow component + SumSqVq = SumSqVq + Vq(J)*Vq(J) + SumSqVp = SumSqVp + Vp(J)*Vp(J) + END DO + MagVp = sqrt(SumSqVp) ! get magnitudes of flow components + MagVq = sqrt(SumSqVq) + + ! transverse and tangenential drag + Rod%Dp(:,I) = VOF * 0.5*p%rhoW*Rod%Cdn* Rod%d* dL * MagVp * Vp + Rod%Dq(:,I) = 0.0_DbKi ! 0.25*p%rhoW*Rod%Cdt* Pi*Rod%d* dL * MagVq * Vq <<< should these axial side loads be included? + + ! fluid acceleration components for current node + aq = DOT_PRODUCT(Rod%Ud(:,I), Rod%q) * Rod%q ! tangential component of fluid acceleration + ap = Rod%Ud(:,I) - aq ! normal component of fluid acceleration + ! transverse and axial Froude-Krylov force + Rod%Ap(:,I) = VOF * p%rhoW*(1.0+Rod%Can)* v_i * ap ! + Rod%Aq(:,I) = 0.0_DbKi ! p%rhoW*(1.0+Rod%Cat)* v_i * aq ! <<< just put a taper-based term here eventually? + + ! dynamic pressure + Rod%Pd(:,I) = 0.0_DbKi ! assuming zero for sides for now, until taper comes into play + + ! seabed contact (stiffness and damping, vertical-only for now) + ! interpolate the local depth from the bathymetry grid + CALL getDepthFromBathymetry(m%BathymetryGrid, m%BathGrid_Xs, m%BathGrid_Ys, Rod%r(1,I), Rod%r(2,I), depth, nvec) + + IF (Rod%r(3,I) < -depth) THEN + Rod%B(3,I) = ( (-depth - Rod%r(3,I))*p%kBot - Rod%rd(3,I)*p%cBot) * Rod%d*dL + ELSE + Rod%B(1,I) = 0.0_DbKi + Rod%B(2,I) = 0.0_DbKi + Rod%B(3,I) = 0.0_DbKi + END IF + + ELSE ! zero-length (N=0) Rod case + + ! >>>>>>>>>>>>>> still need to check handling of zero length rods <<<<<<<<<<<<<<<<<<< + + ! for zero-length rods, make sure various forces are zero + Rod%W = 0.0_DbKi + Rod%Bo = 0.0_DbKi + Rod%Dp = 0.0_DbKi + Rod%Dq = 0.0_DbKi + Rod%Ap = 0.0_DbKi + Rod%Aq = 0.0_DbKi + Rod%Pd = 0.0_DbKi + Rod%B = 0.0_DbKi + + END IF + + + ! ------ now add forces, moments, and added mass from Rod end effects (these can exist even if N==0) ------- + + IF ((I==0) .and. (z1lo < Rod%zeta(I))) THEN ! if this is end A and it is at least partially submerged + + ! >>> eventually should consider a VOF approach for the ends hTilt = 0.5*Rod%d/cosPhi <<< + + ! buoyancy force + Ftemp = -VOF * 0.25*Pi*Rod%d*Rod%d * p%rhoW*p%g* zA + Rod%Bo(:,I) = Rod%Bo(:,I) + (/ Ftemp*cosBeta*sinPhi, Ftemp*sinBeta*sinPhi, Ftemp*cosPhi /) + + ! buoyancy moment + Mtemp = -VOF * 1.0/64.0*Pi*Rod%d**4 * p%rhoW*p%g * sinPhi + Rod%Mext = Rod%Mext + (/ Mtemp*sinBeta, -Mtemp*cosBeta, 0.0_DbKi /) + + ! axial drag + Rod%Dq(:,I) = Rod%Dq(:,I) + VOF * 0.25* Pi*Rod%d*Rod%d * p%rhoW*Rod%CdEnd * MagVq * Vq + + ! >>> what about rotational drag?? <<< eqn will be Pi* Rod%d**4/16.0 omega_rel?^2... *0.5 * Cd... + + ! Froud-Krylov force + Rod%Aq(:,I) = Rod%Aq(:,I) + VOF * p%rhoW*(1.0+Rod%CaEnd)* (2.0/3.0*Pi*Rod%d**3 /8.0) * aq + + ! dynamic pressure force + Rod%Pd(:,I) = Rod%Pd(:,I) + VOF * 0.25* Pi*Rod%d*Rod%d * Rod%PDyn(I) * Rod%q + + ! added mass + DO J=1,3 + DO K=1,3 + Rod%M(K,J,I) = Rod%M(K,J,I) + VOF*p%rhoW* Rod%CaEnd* (2.0/3.0*Pi*Rod%d**3 /8.0) *Rod%q(J)*Rod%q(K) + END DO + END DO + + END IF + + IF ((I==N) .and. (z1lo < Rod%zeta(I))) THEN ! if this end B and it is at least partially submerged (note, if N=0, both this and previous if statement are true) + + ! buoyancy force + Ftemp = VOF * 0.25*Pi*Rod%d*Rod%d * p%rhoW*p%g* zA + Rod%Bo(:,I) = Rod%Bo(:,I) + (/ Ftemp*cosBeta*sinPhi, Ftemp*sinBeta*sinPhi, Ftemp*cosPhi /) + + ! buoyancy moment + Mtemp = VOF * 1.0/64.0*Pi*Rod%d**4 * p%rhoW*p%g * sinPhi + Rod%Mext = Rod%Mext + (/ Mtemp*sinBeta, -Mtemp*cosBeta, 0.0_DbKi /) + + ! axial drag + Rod%Dq(:,I) = Rod%Dq(:,I) + VOF * 0.25* Pi*Rod%d*Rod%d * p%rhoW*Rod%CdEnd * MagVq * Vq + + ! Froud-Krylov force + Rod%Aq(:,I) = Rod%Aq(:,I) + VOF * p%rhoW*(1.0+Rod%CaEnd)* (2.0/3.0*Pi*Rod%d**3 /8.0) * aq + + ! dynamic pressure force + Rod%Pd(:,I) = Rod%Pd(:,I) - VOF * 0.25* Pi*Rod%d*Rod%d * Rod%PDyn(I) * Rod%q + + ! added mass + DO J=1,3 + DO K=1,3 + Rod%M(K,J,I) = Rod%M(K,J,I) + VOF*p%rhoW* Rod%CaEnd* (2.0/3.0*Pi*Rod%d**3 /8.0) *Rod%q(J)*Rod%q(K) + END DO + END DO + + END IF + + + ! ---------------------------- total forces for this node ----------------------------- + + Rod%Fnet(:,I) = Rod%W(:,I) + Rod%Bo(:,I) + Rod%Dp(:,I) + Rod%Dq(:,I) & + + Rod%Ap(:,I) + Rod%Aq(:,I) + Rod%Pd(:,I) + Rod%B(:,I) + + + END DO ! I - done looping through nodes + + + ! ----- add waterplane moment of inertia moment if applicable ----- + IF ((Rod%r(3,0) < zeta) .and. (Rod%r(3,N) > zeta)) then ! check if it's crossing the water plane <<< may need updating + ! >>> could scale the below based on whether part of the end cap is crossing the water plane... + !Mtemp = 1.0/16.0 *Pi*Rod%d**4 * p%rhoW*p%g * sinPhi * (1.0 + 0.5* tanPhi**2) ! original (goes to infinity at 90 deg) + Mtemp = 1.0/16.0 *Pi*Rod%d**4 * p%rhoW*p%g * sinPhi * cosPhi ! simple alternative that goes to 0 at 90 deg then reverses sign beyond that + Rod%Mext = Rod%Mext + (/ Mtemp*sinBeta, -Mtemp*cosBeta, 0.0_DbKi /) + END IF + + + ! ---------------- now add in forces on end nodes from attached lines ------------------ + + ! zero the external force/moment sums (important!) + + ! loop through lines attached to end A + Rod%FextA = 0.0_DbKi + DO l=1,Rod%nAttachedA + + CALL Line_GetEndStuff(m%LineList(Rod%attachedA(l)), Fnet_i, Mnet_i, Mass_i, Rod%TopA(l)) + + ! sum quantitites + Rod%Fnet(:,0)= Rod%Fnet(:,0) + Fnet_i ! total force + Rod%FextA = Rod%FextA + Fnet_i ! a copy for outputting totalled line loads + Rod%Mext = Rod%Mext + Mnet_i ! externally applied moment + Rod%M(:,:,0) = Rod%M(:,:,0) + Mass_i ! mass at end node + + END DO + + ! loop through lines attached to end B + Rod%FextB = 0.0_DbKi + DO l=1,Rod%nAttachedB + + CALL Line_GetEndStuff(m%LineList(Rod%attachedB(l)), Fnet_i, Mnet_i, Mass_i, Rod%TopB(l)) + + ! sum quantitites + Rod%Fnet(:,N)= Rod%Fnet(:,N) + Fnet_i ! total force + Rod%FextB = Rod%FextB + Fnet_i ! a copy for outputting totalled line loads + Rod%Mext = Rod%Mext + Mnet_i ! externally applied moment + Rod%M(:,:,N) = Rod%M(:,:,N) + Mass_i ! mass at end node + + END DO + + ! ---------------- now lump everything in 6DOF about end A ----------------------------- + + ! question: do I really want to neglect the rotational inertia/drag/etc across the length of each segment? + + ! make sure 6DOF quantiaties are zeroed before adding them up + Rod%F6net = 0.0_DbKi + Rod%M6net = 0.0_DbKi + + ! now go through each node's contributions, put them about end A, and sum them + DO i = 0,Rod%N + + rRel = Rod%r(:,i) - Rod%r(:,0) ! vector from reference point to node + + ! convert segment net force into 6dof force about body ref point (if the Rod itself, end A) + CALL translateForce3to6DOF(rRel, Rod%Fnet(:,i), F6_i) + + ! convert segment mass matrix to 6by6 mass matrix about body ref point (if the Rod itself, end A) + CALL translateMass3to6DOF(rRel, Rod%M(:,:,i), M6_i) + + ! sum contributions + Rod%F6net = Rod%F6net + F6_i + Rod%M6net = Rod%M6net + M6_i + + END DO + + ! ------------- Calculate some items for the Rod as a whole here ----------------- + + ! >>> could some of these be precalculated just once? <<< + + ! add inertia terms for the Rod assuming it is uniform density (radial terms add to existing matrix which contains parallel-axis-theorem components only) + Imat_l = 0.0_DbKi + if (Rod%N > 0) then + I_l = 0.125*Rod%mass * Rod%d*Rod%d ! axial moment of inertia + I_r = Rod%mass/12 * (0.75*Rod%d*Rod%d + (Rod%UnstrLen/Rod%N)**2 ) * Rod%N ! summed radial moment of inertia for each segment individually + + Imat_l(1,1) = I_r ! inertia about CG in local orientations (as if Rod is vertical) + Imat_l(2,2) = I_r + Imat_l(3,3) = I_l + end if + + ! >>> some of the kinematics parts of this could potentially be moved to a different routine <<< + Rod%OrMat = CalcOrientation(phi, beta, 0.0_DbKi) ! get rotation matrix to put things in global rather than rod-axis orientations + + Imat = RotateM3(Imat_l, Rod%OrMat) ! rotate to give inertia matrix about CG in global frame + + ! these supplementary inertias can then be added the matrix (these are the terms ASIDE from the parallel axis terms) + Rod%M6net(4:6,4:6) = Rod%M6net(4:6,4:6) + Imat + + + ! now add centripetal and gyroscopic forces/moments, and that should be everything + h_c = 0.5*Rod%UnstrLen ! distance to center of mass + r_c = h_c*Rod%q ! vector to center of mass + + ! note that Rod%v6(4:6) is the rotational velocity vector, omega + Fcentripetal = 0.0_DbKi !<<>> do we need to ensure zero moment is passed if it's pinned? <<< + !if (abs(Rod%typeNum)==1) then + ! Fnet_out(4:6) = 0.0_DbKi + !end if + + + END SUBROUTINE Rod_GetNetForceAndMass + !-------------------------------------------------------------- + + + ! this function handles assigning a line to a connection node + SUBROUTINE Rod_AddLine(Rod, lineID, TopOfLine, endB) + + Type(MD_Rod), INTENT (INOUT) :: Rod ! the Connection object + + Integer(IntKi), INTENT( IN ) :: lineID + Integer(IntKi), INTENT( IN ) :: TopOfLine + Integer(IntKi), INTENT( IN ) :: endB ! add line to end B if 1, end A if 0 + + if (endB==1) then ! attaching to end B + + IF (wordy > 0) Print*, "L", lineID, "->R", Rod%IdNum , "b" + + IF (Rod%nAttachedB <10) THEN ! this is currently just a maximum imposed by a fixed array size. could be improved. + Rod%nAttachedB = Rod%nAttachedB + 1 ! add the line to the number connected + Rod%AttachedB(Rod%nAttachedB) = lineID + Rod%TopB(Rod%nAttachedB) = TopOfLine ! attached to line ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) + ELSE + Print*, "too many lines connected to Rod ", Rod%IdNum, " in MoorDyn!" + END IF + + else ! attaching to end A + + IF (wordy > 0) Print*, "L", lineID, "->R", Rod%IdNum , "a" + + IF (Rod%nAttachedA <10) THEN ! this is currently just a maximum imposed by a fixed array size. could be improved. + Rod%nAttachedA = Rod%nAttachedA + 1 ! add the line to the number connected + Rod%AttachedA(Rod%nAttachedA) = lineID + Rod%TopA(Rod%nAttachedA) = TopOfLine ! attached to line ... 1 = top/fairlead(end B), 0 = bottom/anchor(end A) + ELSE + Print*, "too many lines connected to Rod ", Rod%IdNum, " in MoorDyn!" + END IF + + end if + + END SUBROUTINE Rod_AddLine + + + ! this function handles removing a line from a connection node + SUBROUTINE Rod_RemoveLine(Rod, lineID, TopOfLine, endB, rEnd, rdEnd) + + Type(MD_Rod), INTENT (INOUT) :: Rod ! the Connection object + + Integer(IntKi), INTENT( IN ) :: lineID + Integer(IntKi), INTENT( OUT) :: TopOfLine + Integer(IntKi), INTENT( IN ) :: endB ! end B if 1, end A if 0 + REAL(DbKi), INTENT(INOUT) :: rEnd(3) + REAL(DbKi), INTENT(INOUT) :: rdEnd(3) + + Integer(IntKi) :: l,m,J + + if (endB==1) then ! attaching to end B + + DO l = 1,Rod%nAttachedB ! look through attached lines + + IF (Rod%AttachedB(l) == lineID) THEN ! if this is the line's entry in the attachment list + + TopOfLine = Rod%TopB(l); ! record which end of the line was attached + + DO m = l,Rod%nAttachedB-1 + + Rod%AttachedB(m) = Rod%AttachedB(m+1) ! move subsequent line links forward one spot in the list to eliminate this line link + Rod%TopB( m) = Rod%TopB(m+1) + + Rod%nAttachedB = Rod%nAttachedB - 1 ! reduce attached line counter by 1 + + ! also pass back the kinematics at the end + DO J = 1,3 + rEnd( J) = Rod%r( J,Rod%N) + rdEnd(J) = Rod%rd(J,Rod%N) + END DO + + print*, "Detached line ", lineID, " from Rod ", Rod%IdNum, " end B" + + EXIT + END DO + + IF (l == Rod%nAttachedB) THEN ! detect if line not found + print *, "Error: failed to find line to remove during RemoveLine call to Rod ", Rod%IdNum, ". Line ", lineID + END IF + END IF + END DO + + else ! attaching to end A + + DO l = 1,Rod%nAttachedA ! look through attached lines + + IF (Rod%AttachedA(l) == lineID) THEN ! if this is the line's entry in the attachment list + + TopOfLine = Rod%TopA(l); ! record which end of the line was attached + + DO m = l,Rod%nAttachedA-1 + + Rod%AttachedA(m) = Rod%AttachedA(m+1) ! move subsequent line links forward one spot in the list to eliminate this line link + Rod%TopA( m) = Rod%TopA(m+1) + + Rod%nAttachedA = Rod%nAttachedA - 1 ! reduce attached line counter by 1 + + ! also pass back the kinematics at the end + DO J = 1,3 + rEnd( J) = Rod%r( J,0) + rdEnd(J) = Rod%rd(J,0) + END DO + + print*, "Detached line ", lineID, " from Rod ", Rod%IdNum, " end A" + + EXIT + END DO + + IF (l == Rod%nAttachedA) THEN ! detect if line not found + print *, "Error: failed to find line to remove during RemoveLine call to Rod ", Rod%IdNum, ". Line ", lineID + END IF + END IF + END DO + + end if + + END SUBROUTINE Rod_RemoveLine + + + + +END MODULE MoorDyn_Rod diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index 242c7fee18..3dc43291fc 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -33,46 +33,116 @@ MODULE MoorDyn_Types !--------------------------------------------------------------------------------------------------------------------------------- USE NWTC_Library IMPLICIT NONE +! ========= MD_InputFileType ======= + TYPE, PUBLIC :: MD_InputFileType + REAL(DbKi) :: DTIC = 0.5 !< convergence check time step for IC generation [[s]] + REAL(DbKi) :: TMaxIC = 120 !< maximum time to allow for getting converged ICs [[s]] + REAL(ReKi) :: CdScaleIC = 1 !< factor to scale drag coefficients by during dynamic relaxation [[]] + REAL(ReKi) :: threshIC = 0.01 !< convergence tolerance for ICs (0.01 means 1%) [[]] + END TYPE MD_InputFileType +! ======================= ! ========= MD_InitInputType ======= TYPE, PUBLIC :: MD_InitInputType REAL(ReKi) :: g = -999.9 !< gravity constant [[m/s^2]] REAL(ReKi) :: rhoW = -999.9 !< sea density [[kg/m^3]] REAL(ReKi) :: WtrDepth = -999.9 !< depth of water [[m]] - REAL(ReKi) , DIMENSION(1:6) :: PtfmInit !< initial position of platform [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: PtfmInit !< initial position of platform(s) shape: 6, nTurbines [-] + INTEGER(IntKi) :: FarmSize = 0 !< Indicates normal FAST module mode if 0, FAST.Farm coupled mode and =nTurbines if >0 [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TurbineRefPos !< reference position of turbines in farm, shape: 3, nTurbines [-] + REAL(ReKi) :: Tmax !< simulation duration [[s]] CHARACTER(1024) :: FileName !< MoorDyn input file [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] + LOGICAL :: UsePrimaryInputFile = .TRUE. !< Read input file instead of passed data [-] + TYPE(FileInfoType) :: PassedPrimaryInputData !< Primary input file as FileInfoType (set by driver/glue code) -- String array with metadata [-] LOGICAL :: Echo !< echo parameter - do we want to echo the header line describing the input file? [-] - REAL(ReKi) :: DTIC !< convergence check time step for IC generation [[s]] - REAL(ReKi) :: TMaxIC = 120 !< maximum time to allow for getting converged ICs [[s]] - REAL(ReKi) :: CdScaleIC = 1 !< factor to scale drag coefficients by during dynamic relaxation [[]] - REAL(ReKi) :: threshIC = 0.01 !< convergence tolerance for ICs (0.01 means 1%) [[]] CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< string containing list of output channels requested in input file [-] + LOGICAL :: Linearize = .FALSE. !< Flag that tells this module if the glue code wants to linearize. [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveVel !< [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveAcc !< [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WavePDyn !< [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: WaveElev !< [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: WaveTime !< Should this be double precision? [-] END TYPE MD_InitInputType ! ======================= ! ========= MD_LineProp ======= TYPE, PUBLIC :: MD_LineProp INTEGER(IntKi) :: IdNum !< integer identifier of this set of line properties [-] - CHARACTER(10) :: name !< name/identifier of this set of line properties [-] + CHARACTER(20) :: name !< name/identifier of this set of line properties [-] REAL(DbKi) :: d !< volume-equivalent diameter [[m]] REAL(DbKi) :: w !< per-length weight in air [[kg/m]] - REAL(DbKi) :: EA !< stiffness [[N]] + REAL(DbKi) :: EA !< axial stiffness [[N]] + REAL(DbKi) :: EA_D !< axial stiffness [[N]] REAL(DbKi) :: BA !< internal damping coefficient times area [[N-s]] + REAL(DbKi) :: BA_D !< internal damping coefficient times area [[N-s]] + REAL(DbKi) :: EI !< bending stiffness [[N-m]] REAL(DbKi) :: Can !< transverse added mass coefficient [-] REAL(DbKi) :: Cat !< tangential added mass coefficient [-] REAL(DbKi) :: Cdn !< transverse drag coefficient [-] REAL(DbKi) :: Cdt !< tangential drag coefficient [-] + INTEGER(IntKi) :: ElasticMod !< Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} [-] + INTEGER(IntKi) :: nEApoints = 0 !< number of values in stress-strain lookup table (0 means using constant E) [-] + REAL(DbKi) , DIMENSION(1:30) :: stiffXs !< x array for stress-strain lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: stiffYs !< y array for stress-strain lookup table [-] + INTEGER(IntKi) :: nBApoints = 0 !< number of values in stress-strainrate lookup table (0 means using constant c) [-] + REAL(DbKi) , DIMENSION(1:30) :: dampXs !< x array for stress-strainrate lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: dampYs !< y array for stress-strainrate lookup table [-] + INTEGER(IntKi) :: nEIpoints = 0 !< number of values in bending stress-strain lookup table (0 means using constant E) [-] + REAL(DbKi) , DIMENSION(1:30) :: bstiffXs !< x array for stress-strain lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: bstiffYs !< y array for stress-strain lookup table [-] END TYPE MD_LineProp ! ======================= +! ========= MD_RodProp ======= + TYPE, PUBLIC :: MD_RodProp + INTEGER(IntKi) :: IdNum !< integer identifier of this set of rod properties [-] + CHARACTER(10) :: name !< name/identifier of this set of rod properties [-] + REAL(DbKi) :: d !< volume-equivalent diameter [[m]] + REAL(DbKi) :: w !< per-length weight in air [[kg/m]] + REAL(DbKi) :: Can !< transverse added mass coefficient [-] + REAL(DbKi) :: Cat !< tangential added mass coefficient [-] + REAL(DbKi) :: Cdn !< transverse drag coefficient [-] + REAL(DbKi) :: Cdt !< tangential drag coefficient [-] + REAL(DbKi) :: CdEnd !< drag coefficient for rod end [[-]] + REAL(DbKi) :: CaEnd !< added mass coefficient for rod end [[-]] + END TYPE MD_RodProp +! ======================= +! ========= MD_Body ======= + TYPE, PUBLIC :: MD_Body + INTEGER(IntKi) :: IdNum !< integer identifier of this Connection [-] + INTEGER(IntKi) :: typeNum !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] + INTEGER(IntKi) , DIMENSION(1:30) :: AttachedC !< list of IdNums of connections attached to this body [-] + INTEGER(IntKi) , DIMENSION(1:30) :: AttachedR !< list of IdNums of rods attached to this body [-] + INTEGER(IntKi) :: nAttachedC = 0 !< number of attached connections [-] + INTEGER(IntKi) :: nAttachedR = 0 !< number of attached rods [-] + REAL(DbKi) , DIMENSION(1:3,1:30) :: rConnectRel !< relative position of connection on body [-] + REAL(DbKi) , DIMENSION(1:6,1:30) :: r6RodRel !< relative position and orientation of rod on body [-] + REAL(DbKi) :: bodyM !< [-] + REAL(DbKi) :: bodyV !< [-] + REAL(DbKi) , DIMENSION(1:3) :: bodyI !< [-] + REAL(DbKi) , DIMENSION(1:6) :: bodyCdA !< product of drag force and frontal area of connection point [[m^2]] + REAL(DbKi) , DIMENSION(1:6) :: bodyCa !< added mass coefficient of connection point [-] + REAL(DbKi) :: time !< current time [[s]] + REAL(DbKi) , DIMENSION(1:6) :: r6 !< position [-] + REAL(DbKi) , DIMENSION(1:6) :: v6 !< velocity [-] + REAL(DbKi) , DIMENSION(1:6) :: a6 !< acceleration (only used for coupled bodies) [-] + REAL(DbKi) , DIMENSION(1:3) :: U !< water velocity at ref point [[m/s]] + REAL(DbKi) , DIMENSION(1:3) :: Ud !< water acceleration at ref point [[m/s^2]] + REAL(DbKi) :: zeta !< water surface elevation above ref point [[m]] + REAL(DbKi) , DIMENSION(1:6) :: F6net !< total force and moment on body (excluding inertial loads) [-] + REAL(DbKi) , DIMENSION(1:6,1:6) :: M6net !< total mass matrix of Body and any attached objects [-] + REAL(DbKi) , DIMENSION(1:6,1:6) :: M !< rotated body 6-dof mass and inertia matrix in global orientation [-] + REAL(DbKi) , DIMENSION(1:6,1:6) :: M0 !< body 6-dof mass and inertia matrix in its own frame [-] + REAL(DbKi) , DIMENSION(1:3,1:3) :: OrMat !< DCM for body orientation [-] + REAL(DbKi) , DIMENSION(1:3) :: rCG !< vector in body frame from ref point to CG (before rods etc..) [-] + END TYPE MD_Body +! ======================= ! ========= MD_Connect ======= TYPE, PUBLIC :: MD_Connect INTEGER(IntKi) :: IdNum !< integer identifier of this Connection [-] CHARACTER(10) :: type !< type of Connect: fix, vessel, connect [-] - INTEGER(IntKi) :: TypeNum !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: AttachedFairs !< list of IdNums of connected Line tops [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: AttachedAnchs !< list of IdNums of connected Line bottoms [-] - REAL(DbKi) :: conX !< [-] - REAL(DbKi) :: conY !< [-] - REAL(DbKi) :: conZ !< [-] + INTEGER(IntKi) :: typeNum !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] + INTEGER(IntKi) , DIMENSION(1:10) :: Attached !< list of IdNums of lines attached to this connection node [-] + INTEGER(IntKi) , DIMENSION(1:10) :: Top !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) :: nAttached = 0 !< number of attached lines [-] REAL(DbKi) :: conM !< [-] REAL(DbKi) :: conV !< [-] REAL(DbKi) :: conFX !< [-] @@ -80,33 +150,129 @@ MODULE MoorDyn_Types REAL(DbKi) :: conFZ !< [-] REAL(DbKi) :: conCa !< added mass coefficient of connection point [-] REAL(DbKi) :: conCdA !< product of drag force and frontal area of connection point [[m^2]] - REAL(DbKi) , DIMENSION(1:3) :: Ftot !< total force on node [-] - REAL(DbKi) , DIMENSION(1:3,1:3) :: Mtot !< node mass matrix, from attached lines [-] - REAL(DbKi) , DIMENSION(1:3,1:3) :: S !< inverse mass matrix [[kg]] + REAL(DbKi) :: time !< current time [[s]] REAL(DbKi) , DIMENSION(1:3) :: r !< position [-] REAL(DbKi) , DIMENSION(1:3) :: rd !< velocity [-] + REAL(DbKi) , DIMENSION(1:3) :: a !< acceleration (only used for coupled points) [-] + REAL(DbKi) , DIMENSION(1:3) :: U !< water velocity at node [[m/s]] + REAL(DbKi) , DIMENSION(1:3) :: Ud !< water acceleration at node [[m/s^2]] + REAL(DbKi) :: zeta !< water surface elevation above node [[m]] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: PDyn !< water dynamic pressure at node [[Pa]] + REAL(DbKi) , DIMENSION(1:3) :: Fnet !< total force on node (excluding inertial loads) [-] + REAL(DbKi) , DIMENSION(1:3,1:3) :: M !< node mass matrix, from attached lines [-] END TYPE MD_Connect ! ======================= +! ========= MD_Rod ======= + TYPE, PUBLIC :: MD_Rod + INTEGER(IntKi) :: IdNum !< integer identifier of this Line [-] + CHARACTER(10) :: type !< type of Rod. should match one of RodProp names [-] + INTEGER(IntKi) :: PropsIdNum !< the IdNum of the associated rod properties [-] + INTEGER(IntKi) :: typeNum !< integer identifying the type. 0=fixed, 1=vessel, 2=connect [-] + INTEGER(IntKi) , DIMENSION(1:10) :: AttachedA !< list of IdNums of lines attached to end A [-] + INTEGER(IntKi) , DIMENSION(1:10) :: AttachedB !< list of IdNums of lines attached to end B [-] + INTEGER(IntKi) , DIMENSION(1:10) :: TopA !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) , DIMENSION(1:10) :: TopB !< list of ints specifying whether each line is attached at 1 = top/fairlead(end B), 0 = bottom/anchor(end A) [-] + INTEGER(IntKi) :: nAttachedA = 0 !< number of attached lines to Rod end A [-] + INTEGER(IntKi) :: nAttachedB = 0 !< number of attached lines to Rod end B [-] + INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList !< array specifying what line quantities should be output (1 vs 0) [-] + INTEGER(IntKi) :: N !< The number of elements in the line [-] + INTEGER(IntKi) :: endTypeA !< type of connection at end A: 0=pinned to Connection, 1=cantilevered to Rod. [-] + INTEGER(IntKi) :: endTypeB !< type of connection at end B: 0=pinned to Connection, 1=cantilevered to Rod. [-] + REAL(DbKi) :: UnstrLen !< length of the rod [[m]] + REAL(DbKi) :: mass !< mass of the rod [[kg]] + REAL(DbKi) :: rho !< density [[kg/m3]] + REAL(DbKi) :: d !< volume-equivalent diameter [[m]] + REAL(DbKi) :: Can !< [[-]] + REAL(DbKi) :: Cat !< [[-]] + REAL(DbKi) :: Cdn !< [[-]] + REAL(DbKi) :: Cdt !< [[-]] + REAL(DbKi) :: CdEnd !< drag coefficient for rod end [[-]] + REAL(DbKi) :: CaEnd !< added mass coefficient for rod end [[-]] + REAL(DbKi) :: time !< current time [[s]] + REAL(DbKi) :: roll !< roll relative to vertical [deg] + REAL(DbKi) :: pitch !< pitch relative to vertical [deg] + REAL(DbKi) :: h0 !< submerged length of rod axis, distance along rod centerline from end A to the waterplane (0 <= h0 <= L) [m] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: r !< node positions [-] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: rd !< node velocities [-] + REAL(DbKi) , DIMENSION(1:3) :: q !< tangent vector for rod as a whole [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: l !< segment unstretched length [[m]] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: V !< segment volume [[m^3]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: U !< water velocity at node [[m/s]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Ud !< water acceleration at node [[m/s^2]] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: zeta !< water surface elevation above node [[m]] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: PDyn !< water dynamic pressure at node [[Pa]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: W !< weight vectors [[N]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Bo !< buoyancy force vectors [[N]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Pd !< dynamic pressure force vectors [[N]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Dp !< node drag (transverse) [[N]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Dq !< node drag (axial) [[N]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Ap !< node added mass forcing (transverse) [[N]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Aq !< node added mass forcing (axial) [[N]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: B !< node bottom contact force [[N]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Fnet !< total force on node [[N]] + REAL(DbKi) , DIMENSION(:,:,:), ALLOCATABLE :: M !< node mass matrix [[kg]] + REAL(DbKi) , DIMENSION(1:3) :: FextA !< external forces from attached lines on/about end A [-] + REAL(DbKi) , DIMENSION(1:3) :: FextB !< external forces from attached lines on/about end A [-] + REAL(DbKi) , DIMENSION(1:3) :: Mext !< external moment vector holding sum of any externally applied moments i.e. bending lines [-] + REAL(DbKi) , DIMENSION(1:6) :: r6 !< 6 DOF position vector [-] + REAL(DbKi) , DIMENSION(1:6) :: v6 !< 6 DOF velocity vector [-] + REAL(DbKi) , DIMENSION(1:6) :: a6 !< 6 DOF acceleration vector (only used for coupled Rods) [-] + REAL(DbKi) , DIMENSION(1:6) :: F6net !< total force and moment about end A (excluding inertial loads) that Rod may exert on whatever it's attached to [-] + REAL(DbKi) , DIMENSION(1:6,1:6) :: M6net !< total mass matrix about end A of Rod and any attached Points [-] + REAL(DbKi) , DIMENSION(1:3,1:3) :: OrMat !< DCM for body orientation [-] + INTEGER(IntKi) :: RodUnOut !< unit number of rod output file [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: RodWrOutput !< one row of output data for this rod [-] + END TYPE MD_Rod +! ======================= ! ========= MD_Line ======= TYPE, PUBLIC :: MD_Line INTEGER(IntKi) :: IdNum !< integer identifier of this Line [-] - CHARACTER(10) :: type !< type of line. should match one of LineProp names [-] + INTEGER(IntKi) :: PropsIdNum !< the IdNum of the associated line properties [-] + INTEGER(IntKi) :: ElasticMod !< Which elasticity model to use: {0 basic, 1 viscoelastic, 2 future SYCOM} [-] INTEGER(IntKi) , DIMENSION(1:20) :: OutFlagList !< array specifying what line quantities should be output (1 vs 0) [-] - INTEGER(IntKi) :: CtrlChan !< index of control channel that will drive line active tensioning (0 for none) [-] + INTEGER(IntKi) :: CtrlChan = 0 !< index of control channel that will drive line active tensioning (0 for none) [-] INTEGER(IntKi) :: FairConnect !< IdNum of Connection at fairlead [-] INTEGER(IntKi) :: AnchConnect !< IdNum of Connection at anchor [-] - INTEGER(IntKi) :: PropsIdNum !< the IdNum of the associated line properties [-] INTEGER(IntKi) :: N !< The number of elements in the line [-] + INTEGER(IntKi) :: endTypeA !< type of connection at end A: 0=pinned to Connection, 1=cantilevered to Rod. [-] + INTEGER(IntKi) :: endTypeB !< type of connection at end B: 0=pinned to Connection, 1=cantilevered to Rod. [-] REAL(DbKi) :: UnstrLen !< unstretched length of the line [-] - REAL(DbKi) :: BA !< internal damping coefficient times area for this line only [[N-s]] + REAL(DbKi) :: rho !< density [[kg/m3]] + REAL(DbKi) :: d !< volume-equivalent diameter [[m]] + REAL(DbKi) :: EA = 0 !< stiffness [[N]] + REAL(DbKi) :: EA_D = 0 !< dynamic stiffness when using viscoelastic model [[N]] + REAL(DbKi) :: BA = 0 !< internal damping coefficient times area for this line only [[N-s]] + REAL(DbKi) :: BA_D = 0 !< dynamic internal damping coefficient times area when using viscoelastic model [[N-s]] + REAL(DbKi) :: EI = 0 !< bending stiffness [[N-m]] + REAL(DbKi) :: Can !< [[-]] + REAL(DbKi) :: Cat !< [[-]] + REAL(DbKi) :: Cdn !< [[-]] + REAL(DbKi) :: Cdt !< [[-]] + INTEGER(IntKi) :: nEApoints = 0 !< number of values in stress-strain lookup table (0 means using constant E) [-] + REAL(DbKi) , DIMENSION(1:30) :: stiffXs !< x array for stress-strain lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: stiffYs !< y array for stress-strain lookup table [-] + INTEGER(IntKi) :: nBApoints = 0 !< number of values in stress-strainrate lookup table (0 means using constant c) [-] + REAL(DbKi) , DIMENSION(1:30) :: dampXs !< x array for stress-strainrate lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: dampYs !< y array for stress-strainrate lookup table [-] + INTEGER(IntKi) :: nEIpoints = 0 !< number of values in bending stress-strain lookup table (0 means using constant E) [-] + REAL(DbKi) , DIMENSION(1:30) :: bstiffXs !< x array for stress-strain lookup table (up to nCoef) [-] + REAL(DbKi) , DIMENSION(1:30) :: bstiffYs !< y array for stress-strain lookup table [-] + REAL(DbKi) :: time !< current time [[s]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: r !< node positions [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: rd !< node velocities [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: q !< node tangent vectors [-] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: qs !< segment tangent vectors [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: l !< segment unstretched length [[m]] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: ld !< segment unstretched length rate of change (used in active tensioning) [[m]] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: lstr !< segment stretched length [[m]] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: lstrd !< segment change in stretched length [[m/s]] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: Kurv !< curvature at each node point [[1/m]] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: dl_1 !< segment stretch attributed to static stiffness portion [[m]] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: V !< segment volume [[m^3]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: U !< water velocity at node [[m/s]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Ud !< water acceleration at node [[m/s^2]] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: zeta !< water surface elevation above node [[m]] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: PDyn !< water dynamic pressure at node [[Pa]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: T !< segment tension vectors [[N]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Td !< segment internal damping force vectors [[N]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: W !< weight/buoyancy vectors [[N]] @@ -115,17 +281,25 @@ MODULE MoorDyn_Types REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Ap !< node added mass forcing (transverse) [[N]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Aq !< node added mass forcing (axial) [[N]] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: B !< node bottom contact force [[N]] - REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: F !< total force on node [[N]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Bs !< node force due to bending moments [[N]] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: Fnet !< total force on node [[N]] REAL(DbKi) , DIMENSION(:,:,:), ALLOCATABLE :: S !< node inverse mass matrix [[kg]] REAL(DbKi) , DIMENSION(:,:,:), ALLOCATABLE :: M !< node mass matrix [[kg]] + REAL(DbKi) , DIMENSION(1:3) :: EndMomentA !< vector of end moments due to bending at line end A [[N-m]] + REAL(DbKi) , DIMENSION(1:3) :: EndMomentB !< vector of end moments due to bending at line end B [[N-m]] INTEGER(IntKi) :: LineUnOut !< unit number of line output file [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LineWrOutput !< one row of output data for this line [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: LineWrOutput !< one row of output data for this line [-] END TYPE MD_Line ! ======================= +! ========= MD_Fail ======= + TYPE, PUBLIC :: MD_Fail + INTEGER(IntKi) :: IdNum !< integer identifier of this failure [-] + END TYPE MD_Fail +! ======================= ! ========= MD_OutParmType ======= TYPE, PUBLIC :: MD_OutParmType - CHARACTER(ChanLen) :: Name !< name of output channel [-] - CHARACTER(ChanLen) :: Units !< units string [-] + CHARACTER(10) :: Name !< name of output channel [-] + CHARACTER(10) :: Units !< units string [-] INTEGER(IntKi) :: QType !< type of quantity - 0=tension, 1=x, 2=y, 3=z... [-] INTEGER(IntKi) :: OType !< type of object - 0=line, 1=connect [-] INTEGER(IntKi) :: NodeID !< node number if OType=0. 0=anchor, -1=N=Fairlead [-] @@ -138,11 +312,19 @@ MODULE MoorDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: writeOutputUnt !< second line of output file contents: units [-] TYPE(ProgDesc) :: Ver !< this module's name, version, and date [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: CableCChanRqst !< flag indicating control channel for drive line active tensioning is requested [-] + CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] + CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_x !< Names of the continuous states used in linearization [-] + CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_y !< Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_x !< Flag that tells FAST/MBC3 if the continuous states used in linearization are in the rotating frame (not used for glue) [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: DerivOrder_x !< Integer that tells FAST/MBC3 the maximum derivative order of continuous states used in linearization [-] END TYPE MD_InitOutputType ! ======================= ! ========= MD_ContinuousStateType ======= TYPE, PUBLIC :: MD_ContinuousStateType - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: states !< full list of node coordinates and velocities [[m] or [m/s]] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: states !< state vector of mooring system, e.g. node coordinates and velocities [] END TYPE MD_ContinuousStateType ! ======================= ! ========= MD_DiscreteStateType ======= @@ -163,50 +345,279 @@ MODULE MoorDyn_Types ! ========= MD_MiscVarType ======= TYPE, PUBLIC :: MD_MiscVarType TYPE(MD_LineProp) , DIMENSION(:), ALLOCATABLE :: LineTypeList !< array of properties for each line type [-] - TYPE(MD_Connect) , DIMENSION(:), ALLOCATABLE :: ConnectList !< array of connection properties [-] - TYPE(MD_Line) , DIMENSION(:), ALLOCATABLE :: LineList !< array of line properties [-] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FairIdList !< array of size NFairs listing the ID of each fairlead (index of ConnectList) [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ConnIdList !< array of size NConnss listing the ID of each connect type connection (index of ConnectList) [] - INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LineStateIndList !< starting index of each line's states in state vector [] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MDWrOutput !< Data from time step to be written to a MoorDyn output file [-] + TYPE(MD_RodProp) , DIMENSION(:), ALLOCATABLE :: RodTypeList !< array of properties for each rod type [-] + TYPE(MD_Body) :: GroundBody !< the single ground body which is the parent of all stationary connections [-] + TYPE(MD_Body) , DIMENSION(:), ALLOCATABLE :: BodyList !< array of body objects [-] + TYPE(MD_Rod) , DIMENSION(:), ALLOCATABLE :: RodList !< array of rod objects [-] + TYPE(MD_Connect) , DIMENSION(:), ALLOCATABLE :: ConnectList !< array of connection objects [-] + TYPE(MD_Line) , DIMENSION(:), ALLOCATABLE :: LineList !< array of line objects [-] + TYPE(MD_Fail) , DIMENSION(:), ALLOCATABLE :: FailList !< array of line objects [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FreeConIs !< array of free connection indices in ConnectList vector [] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CpldConIs !< array of coupled/fairlead connection indices in ConnectList vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FreeRodIs !< array of free rod indices in RodList vector [] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CpldRodIs !< array of coupled/fairlead rod indices in RodList vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: FreeBodyIs !< array of free body indices in BodyList vector [] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: CpldBodyIs !< array of coupled body indices in BodyList vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LineStateIs1 !< starting index of each line's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: LineStateIsN !< ending index of each line's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ConStateIs1 !< starting index of each line's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ConStateIsN !< ending index of each line's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: RodStateIs1 !< starting index of each rod's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: RodStateIsN !< ending index of each rod's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BodyStateIs1 !< starting index of each body's states in state vector [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BodyStateIsN !< ending index of each body's states in state vector [] + INTEGER(IntKi) :: Nx !< number of states and size of state vector [] + INTEGER(IntKi) :: WaveTi !< current interpolation index for wave time series data [] + TYPE(MD_ContinuousStateType) :: xTemp !< contains temporary state vector used in integration (put here so it's only allocated once) [-] + TYPE(MD_ContinuousStateType) :: xdTemp !< contains temporary state derivative vector used in integration (put here so it's only allocated once) [-] + REAL(DbKi) , DIMENSION(1:6) :: zeros6 !< array of zeros for convenience [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: MDWrOutput !< Data from time step to be written to a MoorDyn output file [-] + REAL(DbKi) :: LastOutTime !< Time of last writing to MD output files [-] + REAL(ReKi) , DIMENSION(1:6) :: PtfmInit !< initial position of platform for an individual (non-farm) MD instance [-] + REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: BathymetryGrid !< matrix describing the bathymetry in a grid of x's and y's [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_Xs !< array of x-coordinates in the bathymetry grid [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_Ys !< array of y-coordinates in the bathymetry grid [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BathGrid_npoints !< number of grid points to describe the bathymetry grid [-] END TYPE MD_MiscVarType ! ======================= ! ========= MD_ParameterType ======= TYPE, PUBLIC :: MD_ParameterType - INTEGER(IntKi) :: NTypes !< number of line types [] - INTEGER(IntKi) :: NConnects !< number of Connection objects [] - INTEGER(IntKi) :: NFairs !< number of Fairlead Connections [] - INTEGER(IntKi) :: NConns !< number of Connect type Connections - not to be confused with NConnects [] - INTEGER(IntKi) :: NAnchs !< number of Anchor type Connections [] - INTEGER(IntKi) :: NLines !< number of Line objects [] - REAL(ReKi) :: g = 9.81 !< gravitational constant [[kg/m^2]] - REAL(ReKi) :: rhoW !< density of seawater [[m]] - REAL(ReKi) :: WtrDpth !< water depth [[m]] - REAL(ReKi) :: kBot !< bottom stiffness [[Pa/m]] - REAL(ReKi) :: cBot !< bottom damping [[Pa-s/m]] - REAL(ReKi) :: dtM0 !< desired mooring model time step [[s]] - REAL(ReKi) :: dtCoupling !< coupling time step that MoorDyn should expect [[s]] + INTEGER(IntKi) :: nLineTypes = 0 !< number of line types [] + INTEGER(IntKi) :: nRodTypes = 0 !< number of rod types [] + INTEGER(IntKi) :: nConnects = 0 !< number of Connection objects [] + INTEGER(IntKi) :: nConnectsExtra = 0 !< number of Connection objects including space for extra ones that could arise from line failures [] + INTEGER(IntKi) :: nBodies = 0 !< number of Body objects [] + INTEGER(IntKi) :: nRods = 0 !< number of Rod objects [] + INTEGER(IntKi) :: nLines = 0 !< number of Line objects [] + INTEGER(IntKi) :: nCtrlChans = 0 !< number of distinct control channels specified for use as inputs [] + INTEGER(IntKi) :: nFails = 0 !< number of failure conditions [] + INTEGER(IntKi) :: nFreeBodies = 0 !< [] + INTEGER(IntKi) :: nFreeRods = 0 !< [] + INTEGER(IntKi) :: nFreeCons = 0 !< [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: nCpldBodies !< number of coupled bodies (for FAST.Farm, size>1 with an entry for each turbine) [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: nCpldRods !< number of coupled rods (for FAST.Farm, size>1 with an entry for each turbine) [] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: nCpldCons !< number of coupled points (for FAST.Farm, size>1 with an entry for each turbine) [] + INTEGER(IntKi) :: NConns = 0 !< number of Connect type Connections - not to be confused with NConnects [] + INTEGER(IntKi) :: NAnchs = 0 !< number of Anchor type Connections [] + REAL(DbKi) :: Tmax !< simulation duration [[s]] + REAL(DbKi) :: g = 9.81 !< gravitational constant (positive) [[m/s^2]] + REAL(DbKi) :: rhoW = 1025 !< density of seawater [[kg/m^3]] + REAL(DbKi) :: WtrDpth !< water depth [[m]] + REAL(DbKi) :: kBot !< bottom stiffness [[Pa/m]] + REAL(DbKi) :: cBot !< bottom damping [[Pa-s/m]] + REAL(DbKi) :: dtM0 !< desired mooring model time step [[s]] + REAL(DbKi) :: dtCoupling !< coupling time step that MoorDyn should expect [[s]] INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + REAL(DbKi) :: dtOut !< interval for writing output file lines [[s]] CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(MD_OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] CHARACTER(1) :: Delim !< Column delimiter for output text files [-] INTEGER(IntKi) :: MDUnOut !< Unit number of main output file [-] + CHARACTER(1024) :: PriPath !< The path to the primary MoorDyn input file, used if looking for additional input files [-] + INTEGER(IntKi) :: writeLog = -1 !< Switch for level of log file output [-] + INTEGER(IntKi) :: UnLog = -1 !< Unit number of log file [-] + INTEGER(IntKi) :: WaveKin !< Flag for whether or how to consider water kinematics [-] + INTEGER(IntKi) :: Current !< Flag for whether or how to consider water kinematics [-] + INTEGER(IntKi) :: nTurbines !< Number of turbines if MoorDyn is performing an array-level simulation with FAST.Farm, otherwise 0 [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TurbineRefPos !< reference position of turbines in farm, shape: 3, nTurbines [-] + REAL(DbKi) :: mu_kT !< transverse kinetic friction coefficient [(-)] + REAL(DbKi) :: mu_kA !< axial kinetic friction coefficient [(-)] + REAL(DbKi) :: mc !< ratio of the static friction coefficient to the kinetic friction coefficient [(-)] + REAL(DbKi) :: cv !< saturated damping coefficient [(-)] + INTEGER(IntKi) :: nxWave !< number of x wave grid points [-] + INTEGER(IntKi) :: nyWave !< number of y wave grid points [-] + INTEGER(IntKi) :: nzWave !< number of z wave grid points [-] + INTEGER(IntKi) :: ntWave !< number of wave time steps [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: pxWave !< x location of wave grid points [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: pyWave !< y location of wave grid points [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: pzWave !< z location of wave grid points [-] + REAL(SiKi) :: dtWave !< wave data time step [-] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: uxWave !< wave velocities time series at each grid point [-] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: uyWave !< wave velocities time series at each grid point [-] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: uzWave !< wave velocities time series at each grid point [-] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: axWave !< wave accelerations time series at each grid point [-] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: ayWave !< wave accelerations time series at each grid point [-] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: azWave !< wave accelerations time series at each grid point [-] + REAL(SiKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: PDyn !< wave dynamic pressure time series at each grid point [-] + REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: zeta !< wave surface elevations time series at each surface grid point [-] + INTEGER(IntKi) :: nzCurrent !< number of z current grid points [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: pzCurrent !< z location of current grid points [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: uxCurrent !< current velocities time series at each grid point [-] + REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: uyCurrent !< current velocities time series at each grid point [-] + INTEGER(IntKi) :: Nx0 !< copy of initial size of system state vector, for linearization routines [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] + INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_nx !< number of continuous states in jacobian matrix [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: dxIdx_map2_xStateIdx !< Mapping array from index of dX array to corresponding state index [-] END TYPE MD_ParameterType ! ======================= ! ========= MD_InputType ======= TYPE, PUBLIC :: MD_InputType - TYPE(MeshType) :: PtFairleadDisplacement !< mesh for position AND VELOCITY of each fairlead in X,Y,Z [[m, m/s]] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: CoupledKinematics !< array of meshes for each coupling point (6 DOF info used for rods and bodies) [[m, m/s]] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DeltaL !< change in line length command for each channel [[m]] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: DeltaLdot !< rate of change of line length command for each channel [[m]] END TYPE MD_InputType ! ======================= ! ========= MD_OutputType ======= TYPE, PUBLIC :: MD_OutputType - TYPE(MeshType) :: PtFairleadLoad !< point mesh for fairlead forces in X,Y,Z [[N]] + TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: CoupledLoads !< array of point meshes for mooring reaction forces (and moments) at coupling points [[N]] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< output vector returned to glue code [] END TYPE MD_OutputType ! ======================= CONTAINS + SUBROUTINE MD_CopyInputFileType( SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_InputFileType), INTENT(IN) :: SrcInputFileTypeData + TYPE(MD_InputFileType), INTENT(INOUT) :: DstInputFileTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyInputFileType' +! + ErrStat = ErrID_None + ErrMsg = "" + DstInputFileTypeData%DTIC = SrcInputFileTypeData%DTIC + DstInputFileTypeData%TMaxIC = SrcInputFileTypeData%TMaxIC + DstInputFileTypeData%CdScaleIC = SrcInputFileTypeData%CdScaleIC + DstInputFileTypeData%threshIC = SrcInputFileTypeData%threshIC + END SUBROUTINE MD_CopyInputFileType + + SUBROUTINE MD_DestroyInputFileType( InputFileTypeData, ErrStat, ErrMsg ) + TYPE(MD_InputFileType), INTENT(INOUT) :: InputFileTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyInputFileType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE MD_DestroyInputFileType + + SUBROUTINE MD_PackInputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(MD_InputFileType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackInputFileType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Db_BufSz = Db_BufSz + 1 ! DTIC + Db_BufSz = Db_BufSz + 1 ! TMaxIC + Re_BufSz = Re_BufSz + 1 ! CdScaleIC + Re_BufSz = Re_BufSz + 1 ! threshIC + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DbKiBuf(Db_Xferred) = InData%DTIC + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TMaxIC + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CdScaleIC + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%threshIC + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE MD_PackInputFileType + + SUBROUTINE MD_UnPackInputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MD_InputFileType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackInputFileType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%DTIC = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TMaxIC = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%CdScaleIC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%threshIC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE MD_UnPackInputFileType + SUBROUTINE MD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(MD_InitInputType), INTENT(IN) :: SrcInitInputData TYPE(MD_InitInputType), INTENT(INOUT) :: DstInitInputData @@ -227,14 +638,43 @@ SUBROUTINE MD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt DstInitInputData%g = SrcInitInputData%g DstInitInputData%rhoW = SrcInitInputData%rhoW DstInitInputData%WtrDepth = SrcInitInputData%WtrDepth +IF (ALLOCATED(SrcInitInputData%PtfmInit)) THEN + i1_l = LBOUND(SrcInitInputData%PtfmInit,1) + i1_u = UBOUND(SrcInitInputData%PtfmInit,1) + i2_l = LBOUND(SrcInitInputData%PtfmInit,2) + i2_u = UBOUND(SrcInitInputData%PtfmInit,2) + IF (.NOT. ALLOCATED(DstInitInputData%PtfmInit)) THEN + ALLOCATE(DstInitInputData%PtfmInit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%PtfmInit.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF DstInitInputData%PtfmInit = SrcInitInputData%PtfmInit +ENDIF + DstInitInputData%FarmSize = SrcInitInputData%FarmSize +IF (ALLOCATED(SrcInitInputData%TurbineRefPos)) THEN + i1_l = LBOUND(SrcInitInputData%TurbineRefPos,1) + i1_u = UBOUND(SrcInitInputData%TurbineRefPos,1) + i2_l = LBOUND(SrcInitInputData%TurbineRefPos,2) + i2_u = UBOUND(SrcInitInputData%TurbineRefPos,2) + IF (.NOT. ALLOCATED(DstInitInputData%TurbineRefPos)) THEN + ALLOCATE(DstInitInputData%TurbineRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%TurbineRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%TurbineRefPos = SrcInitInputData%TurbineRefPos +ENDIF + DstInitInputData%Tmax = SrcInitInputData%Tmax DstInitInputData%FileName = SrcInitInputData%FileName DstInitInputData%RootName = SrcInitInputData%RootName + DstInitInputData%UsePrimaryInputFile = SrcInitInputData%UsePrimaryInputFile + CALL NWTC_Library_Copyfileinfotype( SrcInitInputData%PassedPrimaryInputData, DstInitInputData%PassedPrimaryInputData, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN DstInitInputData%Echo = SrcInitInputData%Echo - DstInitInputData%DTIC = SrcInitInputData%DTIC - DstInitInputData%TMaxIC = SrcInitInputData%TMaxIC - DstInitInputData%CdScaleIC = SrcInitInputData%CdScaleIC - DstInitInputData%threshIC = SrcInitInputData%threshIC IF (ALLOCATED(SrcInitInputData%OutList)) THEN i1_l = LBOUND(SrcInitInputData%OutList,1) i1_u = UBOUND(SrcInitInputData%OutList,1) @@ -246,6 +686,79 @@ SUBROUTINE MD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrSt END IF END IF DstInitInputData%OutList = SrcInitInputData%OutList +ENDIF + DstInitInputData%Linearize = SrcInitInputData%Linearize +IF (ALLOCATED(SrcInitInputData%WaveVel)) THEN + i1_l = LBOUND(SrcInitInputData%WaveVel,1) + i1_u = UBOUND(SrcInitInputData%WaveVel,1) + i2_l = LBOUND(SrcInitInputData%WaveVel,2) + i2_u = UBOUND(SrcInitInputData%WaveVel,2) + i3_l = LBOUND(SrcInitInputData%WaveVel,3) + i3_u = UBOUND(SrcInitInputData%WaveVel,3) + IF (.NOT. ALLOCATED(DstInitInputData%WaveVel)) THEN + ALLOCATE(DstInitInputData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveVel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveVel = SrcInitInputData%WaveVel +ENDIF +IF (ALLOCATED(SrcInitInputData%WaveAcc)) THEN + i1_l = LBOUND(SrcInitInputData%WaveAcc,1) + i1_u = UBOUND(SrcInitInputData%WaveAcc,1) + i2_l = LBOUND(SrcInitInputData%WaveAcc,2) + i2_u = UBOUND(SrcInitInputData%WaveAcc,2) + i3_l = LBOUND(SrcInitInputData%WaveAcc,3) + i3_u = UBOUND(SrcInitInputData%WaveAcc,3) + IF (.NOT. ALLOCATED(DstInitInputData%WaveAcc)) THEN + ALLOCATE(DstInitInputData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveAcc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveAcc = SrcInitInputData%WaveAcc +ENDIF +IF (ALLOCATED(SrcInitInputData%WavePDyn)) THEN + i1_l = LBOUND(SrcInitInputData%WavePDyn,1) + i1_u = UBOUND(SrcInitInputData%WavePDyn,1) + i2_l = LBOUND(SrcInitInputData%WavePDyn,2) + i2_u = UBOUND(SrcInitInputData%WavePDyn,2) + IF (.NOT. ALLOCATED(DstInitInputData%WavePDyn)) THEN + ALLOCATE(DstInitInputData%WavePDyn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WavePDyn.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WavePDyn = SrcInitInputData%WavePDyn +ENDIF +IF (ALLOCATED(SrcInitInputData%WaveElev)) THEN + i1_l = LBOUND(SrcInitInputData%WaveElev,1) + i1_u = UBOUND(SrcInitInputData%WaveElev,1) + i2_l = LBOUND(SrcInitInputData%WaveElev,2) + i2_u = UBOUND(SrcInitInputData%WaveElev,2) + IF (.NOT. ALLOCATED(DstInitInputData%WaveElev)) THEN + ALLOCATE(DstInitInputData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveElev.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveElev = SrcInitInputData%WaveElev +ENDIF +IF (ALLOCATED(SrcInitInputData%WaveTime)) THEN + i1_l = LBOUND(SrcInitInputData%WaveTime,1) + i1_u = UBOUND(SrcInitInputData%WaveTime,1) + IF (.NOT. ALLOCATED(DstInitInputData%WaveTime)) THEN + ALLOCATE(DstInitInputData%WaveTime(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%WaveTime.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitInputData%WaveTime = SrcInitInputData%WaveTime ENDIF END SUBROUTINE MD_CopyInitInput @@ -258,8 +771,30 @@ SUBROUTINE MD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) ! ErrStat = ErrID_None ErrMsg = "" +IF (ALLOCATED(InitInputData%PtfmInit)) THEN + DEALLOCATE(InitInputData%PtfmInit) +ENDIF +IF (ALLOCATED(InitInputData%TurbineRefPos)) THEN + DEALLOCATE(InitInputData%TurbineRefPos) +ENDIF + CALL NWTC_Library_Destroyfileinfotype( InitInputData%PassedPrimaryInputData, ErrStat, ErrMsg ) IF (ALLOCATED(InitInputData%OutList)) THEN DEALLOCATE(InitInputData%OutList) +ENDIF +IF (ALLOCATED(InitInputData%WaveVel)) THEN + DEALLOCATE(InitInputData%WaveVel) +ENDIF +IF (ALLOCATED(InitInputData%WaveAcc)) THEN + DEALLOCATE(InitInputData%WaveAcc) +ENDIF +IF (ALLOCATED(InitInputData%WavePDyn)) THEN + DEALLOCATE(InitInputData%WavePDyn) +ENDIF +IF (ALLOCATED(InitInputData%WaveElev)) THEN + DEALLOCATE(InitInputData%WaveElev) +ENDIF +IF (ALLOCATED(InitInputData%WaveTime)) THEN + DEALLOCATE(InitInputData%WaveTime) ENDIF END SUBROUTINE MD_DestroyInitInput @@ -301,18 +836,70 @@ SUBROUTINE MD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Re_BufSz = Re_BufSz + 1 ! g Re_BufSz = Re_BufSz + 1 ! rhoW Re_BufSz = Re_BufSz + 1 ! WtrDepth + Int_BufSz = Int_BufSz + 1 ! PtfmInit allocated yes/no + IF ( ALLOCATED(InData%PtfmInit) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PtfmInit upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%PtfmInit) ! PtfmInit + END IF + Int_BufSz = Int_BufSz + 1 ! FarmSize + Int_BufSz = Int_BufSz + 1 ! TurbineRefPos allocated yes/no + IF ( ALLOCATED(InData%TurbineRefPos) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! TurbineRefPos upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TurbineRefPos) ! TurbineRefPos + END IF + Re_BufSz = Re_BufSz + 1 ! Tmax Int_BufSz = Int_BufSz + 1*LEN(InData%FileName) ! FileName Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName + Int_BufSz = Int_BufSz + 1 ! UsePrimaryInputFile + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! PassedPrimaryInputData: size of buffers for each call to pack subtype + CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, .TRUE. ) ! PassedPrimaryInputData + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! PassedPrimaryInputData + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! PassedPrimaryInputData + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! PassedPrimaryInputData + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 1 ! Echo - Re_BufSz = Re_BufSz + 1 ! DTIC - Re_BufSz = Re_BufSz + 1 ! TMaxIC - Re_BufSz = Re_BufSz + 1 ! CdScaleIC - Re_BufSz = Re_BufSz + 1 ! threshIC Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no IF ( ALLOCATED(InData%OutList) ) THEN Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList + END IF + Int_BufSz = Int_BufSz + 1 ! Linearize + Int_BufSz = Int_BufSz + 1 ! WaveVel allocated yes/no + IF ( ALLOCATED(InData%WaveVel) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! WaveVel upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveVel) ! WaveVel + END IF + Int_BufSz = Int_BufSz + 1 ! WaveAcc allocated yes/no + IF ( ALLOCATED(InData%WaveAcc) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! WaveAcc upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveAcc) ! WaveAcc + END IF + Int_BufSz = Int_BufSz + 1 ! WavePDyn allocated yes/no + IF ( ALLOCATED(InData%WavePDyn) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WavePDyn upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WavePDyn) ! WavePDyn + END IF + Int_BufSz = Int_BufSz + 1 ! WaveElev allocated yes/no + IF ( ALLOCATED(InData%WaveElev) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! WaveElev upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%WaveElev) ! WaveElev + END IF + Int_BufSz = Int_BufSz + 1 ! WaveTime allocated yes/no + IF ( ALLOCATED(InData%WaveTime) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WaveTime upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%WaveTime) ! WaveTime END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -347,51 +934,220 @@ SUBROUTINE MD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%WtrDepth Re_Xferred = Re_Xferred + 1 - DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) - ReKiBuf(Re_Xferred) = InData%PtfmInit(i1) - Re_Xferred = Re_Xferred + 1 - END DO - DO I = 1, LEN(InData%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%DTIC - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%TMaxIC - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%CdScaleIC - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%threshIC - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) THEN + IF ( .NOT. ALLOCATED(InData%PtfmInit) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmInit,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmInit,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PtfmInit,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PtfmInit,2) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i2 = LBOUND(InData%PtfmInit,2), UBOUND(InData%PtfmInit,2) + DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) + ReKiBuf(Re_Xferred) = InData%PtfmInit(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO END DO END IF - END SUBROUTINE MD_PackInitInput - - SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + IntKiBuf(Int_Xferred) = InData%FarmSize + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%TurbineRefPos) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TurbineRefPos,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineRefPos,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TurbineRefPos,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineRefPos,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%TurbineRefPos,2), UBOUND(InData%TurbineRefPos,2) + DO i1 = LBOUND(InData%TurbineRefPos,1), UBOUND(InData%TurbineRefPos,1) + ReKiBuf(Re_Xferred) = InData%TurbineRefPos(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + ReKiBuf(Re_Xferred) = InData%Tmax + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%UsePrimaryInputFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + CALL NWTC_Library_Packfileinfotype( Re_Buf, Db_Buf, Int_Buf, InData%PassedPrimaryInputData, ErrStat2, ErrMsg2, OnlySize ) ! PassedPrimaryInputData + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%OutList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OutList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO I = 1, LEN(InData%OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveVel,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) + DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) + DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) + ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveAcc) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveAcc,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) + DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) + DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WavePDyn) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WavePDyn,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WavePDyn,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WavePDyn,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WavePDyn,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WavePDyn,2), UBOUND(InData%WavePDyn,2) + DO i1 = LBOUND(InData%WavePDyn,1), UBOUND(InData%WavePDyn,1) + ReKiBuf(Re_Xferred) = InData%WavePDyn(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveElev,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) + DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) + ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%WaveTime,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + DbKiBuf(Db_Xferred) = InData%WaveTime(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE MD_PackInitInput + + SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) TYPE(MD_InitInputType), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -423,12 +1179,56 @@ SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = Re_Xferred + 1 OutData%WtrDepth = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%PtfmInit,1) - i1_u = UBOUND(OutData%PtfmInit,1) - DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) - OutData%PtfmInit(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PtfmInit not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PtfmInit)) DEALLOCATE(OutData%PtfmInit) + ALLOCATE(OutData%PtfmInit(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PtfmInit.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%PtfmInit,2), UBOUND(OutData%PtfmInit,2) + DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) + OutData%PtfmInit(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%FarmSize = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TurbineRefPos not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TurbineRefPos)) DEALLOCATE(OutData%TurbineRefPos) + ALLOCATE(OutData%TurbineRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%TurbineRefPos,2), UBOUND(OutData%TurbineRefPos,2) + DO i1 = LBOUND(OutData%TurbineRefPos,1), UBOUND(OutData%TurbineRefPos,1) + OutData%TurbineRefPos(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%Tmax = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 DO I = 1, LEN(OutData%FileName) OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) Int_Xferred = Int_Xferred + 1 @@ -437,16 +1237,50 @@ SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) Int_Xferred = Int_Xferred + 1 END DO ! I + OutData%UsePrimaryInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UsePrimaryInputFile) + Int_Xferred = Int_Xferred + 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackfileinfotype( Re_Buf, Db_Buf, Int_Buf, OutData%PassedPrimaryInputData, ErrStat2, ErrMsg2 ) ! PassedPrimaryInputData + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) Int_Xferred = Int_Xferred + 1 - OutData%DTIC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%TMaxIC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%CdScaleIC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%threshIC = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -467,45 +1301,181 @@ SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err END DO ! I END DO END IF - END SUBROUTINE MD_UnPackInitInput - - SUBROUTINE MD_CopyLineProp( SrcLinePropData, DstLinePropData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_LineProp), INTENT(IN) :: SrcLinePropData - TYPE(MD_LineProp), INTENT(INOUT) :: DstLinePropData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyLineProp' -! - ErrStat = ErrID_None - ErrMsg = "" - DstLinePropData%IdNum = SrcLinePropData%IdNum - DstLinePropData%name = SrcLinePropData%name - DstLinePropData%d = SrcLinePropData%d - DstLinePropData%w = SrcLinePropData%w - DstLinePropData%EA = SrcLinePropData%EA - DstLinePropData%BA = SrcLinePropData%BA - DstLinePropData%Can = SrcLinePropData%Can - DstLinePropData%Cat = SrcLinePropData%Cat - DstLinePropData%Cdn = SrcLinePropData%Cdn - DstLinePropData%Cdt = SrcLinePropData%Cdt - END SUBROUTINE MD_CopyLineProp - - SUBROUTINE MD_DestroyLineProp( LinePropData, ErrStat, ErrMsg ) - TYPE(MD_LineProp), INTENT(INOUT) :: LinePropData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyLineProp' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE MD_DestroyLineProp - + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveVel)) DEALLOCATE(OutData%WaveVel) + ALLOCATE(OutData%WaveVel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) + DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) + DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) + OutData%WaveVel(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveAcc)) DEALLOCATE(OutData%WaveAcc) + ALLOCATE(OutData%WaveAcc(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) + DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) + DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) + OutData%WaveAcc(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WavePDyn not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WavePDyn)) DEALLOCATE(OutData%WavePDyn) + ALLOCATE(OutData%WavePDyn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WavePDyn.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WavePDyn,2), UBOUND(OutData%WavePDyn,2) + DO i1 = LBOUND(OutData%WavePDyn,1), UBOUND(OutData%WavePDyn,1) + OutData%WavePDyn(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveElev)) DEALLOCATE(OutData%WaveElev) + ALLOCATE(OutData%WaveElev(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) + DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) + OutData%WaveElev(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%WaveTime)) DEALLOCATE(OutData%WaveTime) + ALLOCATE(OutData%WaveTime(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE MD_UnPackInitInput + + SUBROUTINE MD_CopyLineProp( SrcLinePropData, DstLinePropData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_LineProp), INTENT(IN) :: SrcLinePropData + TYPE(MD_LineProp), INTENT(INOUT) :: DstLinePropData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyLineProp' +! + ErrStat = ErrID_None + ErrMsg = "" + DstLinePropData%IdNum = SrcLinePropData%IdNum + DstLinePropData%name = SrcLinePropData%name + DstLinePropData%d = SrcLinePropData%d + DstLinePropData%w = SrcLinePropData%w + DstLinePropData%EA = SrcLinePropData%EA + DstLinePropData%EA_D = SrcLinePropData%EA_D + DstLinePropData%BA = SrcLinePropData%BA + DstLinePropData%BA_D = SrcLinePropData%BA_D + DstLinePropData%EI = SrcLinePropData%EI + DstLinePropData%Can = SrcLinePropData%Can + DstLinePropData%Cat = SrcLinePropData%Cat + DstLinePropData%Cdn = SrcLinePropData%Cdn + DstLinePropData%Cdt = SrcLinePropData%Cdt + DstLinePropData%ElasticMod = SrcLinePropData%ElasticMod + DstLinePropData%nEApoints = SrcLinePropData%nEApoints + DstLinePropData%stiffXs = SrcLinePropData%stiffXs + DstLinePropData%stiffYs = SrcLinePropData%stiffYs + DstLinePropData%nBApoints = SrcLinePropData%nBApoints + DstLinePropData%dampXs = SrcLinePropData%dampXs + DstLinePropData%dampYs = SrcLinePropData%dampYs + DstLinePropData%nEIpoints = SrcLinePropData%nEIpoints + DstLinePropData%bstiffXs = SrcLinePropData%bstiffXs + DstLinePropData%bstiffYs = SrcLinePropData%bstiffYs + END SUBROUTINE MD_CopyLineProp + + SUBROUTINE MD_DestroyLineProp( LinePropData, ErrStat, ErrMsg ) + TYPE(MD_LineProp), INTENT(INOUT) :: LinePropData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyLineProp' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE MD_DestroyLineProp + SUBROUTINE MD_PackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) @@ -546,11 +1516,24 @@ SUBROUTINE MD_PackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_BufSz = Db_BufSz + 1 ! d Db_BufSz = Db_BufSz + 1 ! w Db_BufSz = Db_BufSz + 1 ! EA + Db_BufSz = Db_BufSz + 1 ! EA_D Db_BufSz = Db_BufSz + 1 ! BA + Db_BufSz = Db_BufSz + 1 ! BA_D + Db_BufSz = Db_BufSz + 1 ! EI Db_BufSz = Db_BufSz + 1 ! Can Db_BufSz = Db_BufSz + 1 ! Cat Db_BufSz = Db_BufSz + 1 ! Cdn Db_BufSz = Db_BufSz + 1 ! Cdt + Int_BufSz = Int_BufSz + 1 ! ElasticMod + Int_BufSz = Int_BufSz + 1 ! nEApoints + Db_BufSz = Db_BufSz + SIZE(InData%stiffXs) ! stiffXs + Db_BufSz = Db_BufSz + SIZE(InData%stiffYs) ! stiffYs + Int_BufSz = Int_BufSz + 1 ! nBApoints + Db_BufSz = Db_BufSz + SIZE(InData%dampXs) ! dampXs + Db_BufSz = Db_BufSz + SIZE(InData%dampYs) ! dampYs + Int_BufSz = Int_BufSz + 1 ! nEIpoints + Db_BufSz = Db_BufSz + SIZE(InData%bstiffXs) ! bstiffXs + Db_BufSz = Db_BufSz + SIZE(InData%bstiffYs) ! bstiffYs IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -590,8 +1573,14 @@ SUBROUTINE MD_PackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = Db_Xferred + 1 DbKiBuf(Db_Xferred) = InData%EA Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%EA_D + Db_Xferred = Db_Xferred + 1 DbKiBuf(Db_Xferred) = InData%BA Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%BA_D + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%EI + Db_Xferred = Db_Xferred + 1 DbKiBuf(Db_Xferred) = InData%Can Db_Xferred = Db_Xferred + 1 DbKiBuf(Db_Xferred) = InData%Cat @@ -600,6 +1589,38 @@ SUBROUTINE MD_PackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = Db_Xferred + 1 DbKiBuf(Db_Xferred) = InData%Cdt Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ElasticMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nEApoints + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%stiffXs,1), UBOUND(InData%stiffXs,1) + DbKiBuf(Db_Xferred) = InData%stiffXs(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%stiffYs,1), UBOUND(InData%stiffYs,1) + DbKiBuf(Db_Xferred) = InData%stiffYs(i1) + Db_Xferred = Db_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%nBApoints + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%dampXs,1), UBOUND(InData%dampXs,1) + DbKiBuf(Db_Xferred) = InData%dampXs(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%dampYs,1), UBOUND(InData%dampYs,1) + DbKiBuf(Db_Xferred) = InData%dampYs(i1) + Db_Xferred = Db_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%nEIpoints + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%bstiffXs,1), UBOUND(InData%bstiffXs,1) + DbKiBuf(Db_Xferred) = InData%bstiffXs(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%bstiffYs,1), UBOUND(InData%bstiffYs,1) + DbKiBuf(Db_Xferred) = InData%bstiffYs(i1) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE MD_PackLineProp SUBROUTINE MD_UnPackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -615,6 +1636,7 @@ SUBROUTINE MD_UnPackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackLineProp' @@ -640,8 +1662,14 @@ SUBROUTINE MD_UnPackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Db_Xferred = Db_Xferred + 1 OutData%EA = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 + OutData%EA_D = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%BA = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 + OutData%BA_D = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%EI = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%Can = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 OutData%Cat = DbKiBuf(Db_Xferred) @@ -650,90 +1678,94 @@ SUBROUTINE MD_UnPackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Db_Xferred = Db_Xferred + 1 OutData%Cdt = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 + OutData%ElasticMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nEApoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%stiffXs,1) + i1_u = UBOUND(OutData%stiffXs,1) + DO i1 = LBOUND(OutData%stiffXs,1), UBOUND(OutData%stiffXs,1) + OutData%stiffXs(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%stiffYs,1) + i1_u = UBOUND(OutData%stiffYs,1) + DO i1 = LBOUND(OutData%stiffYs,1), UBOUND(OutData%stiffYs,1) + OutData%stiffYs(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%nBApoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%dampXs,1) + i1_u = UBOUND(OutData%dampXs,1) + DO i1 = LBOUND(OutData%dampXs,1), UBOUND(OutData%dampXs,1) + OutData%dampXs(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%dampYs,1) + i1_u = UBOUND(OutData%dampYs,1) + DO i1 = LBOUND(OutData%dampYs,1), UBOUND(OutData%dampYs,1) + OutData%dampYs(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%nEIpoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%bstiffXs,1) + i1_u = UBOUND(OutData%bstiffXs,1) + DO i1 = LBOUND(OutData%bstiffXs,1), UBOUND(OutData%bstiffXs,1) + OutData%bstiffXs(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%bstiffYs,1) + i1_u = UBOUND(OutData%bstiffYs,1) + DO i1 = LBOUND(OutData%bstiffYs,1), UBOUND(OutData%bstiffYs,1) + OutData%bstiffYs(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE MD_UnPackLineProp - SUBROUTINE MD_CopyConnect( SrcConnectData, DstConnectData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Connect), INTENT(IN) :: SrcConnectData - TYPE(MD_Connect), INTENT(INOUT) :: DstConnectData + SUBROUTINE MD_CopyRodProp( SrcRodPropData, DstRodPropData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_RodProp), INTENT(IN) :: SrcRodPropData + TYPE(MD_RodProp), INTENT(INOUT) :: DstRodPropData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyConnect' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyRodProp' ! ErrStat = ErrID_None ErrMsg = "" - DstConnectData%IdNum = SrcConnectData%IdNum - DstConnectData%type = SrcConnectData%type - DstConnectData%TypeNum = SrcConnectData%TypeNum -IF (ALLOCATED(SrcConnectData%AttachedFairs)) THEN - i1_l = LBOUND(SrcConnectData%AttachedFairs,1) - i1_u = UBOUND(SrcConnectData%AttachedFairs,1) - IF (.NOT. ALLOCATED(DstConnectData%AttachedFairs)) THEN - ALLOCATE(DstConnectData%AttachedFairs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConnectData%AttachedFairs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstConnectData%AttachedFairs = SrcConnectData%AttachedFairs -ENDIF -IF (ALLOCATED(SrcConnectData%AttachedAnchs)) THEN - i1_l = LBOUND(SrcConnectData%AttachedAnchs,1) - i1_u = UBOUND(SrcConnectData%AttachedAnchs,1) - IF (.NOT. ALLOCATED(DstConnectData%AttachedAnchs)) THEN - ALLOCATE(DstConnectData%AttachedAnchs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConnectData%AttachedAnchs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstConnectData%AttachedAnchs = SrcConnectData%AttachedAnchs -ENDIF - DstConnectData%conX = SrcConnectData%conX - DstConnectData%conY = SrcConnectData%conY - DstConnectData%conZ = SrcConnectData%conZ - DstConnectData%conM = SrcConnectData%conM - DstConnectData%conV = SrcConnectData%conV - DstConnectData%conFX = SrcConnectData%conFX - DstConnectData%conFY = SrcConnectData%conFY - DstConnectData%conFZ = SrcConnectData%conFZ - DstConnectData%conCa = SrcConnectData%conCa - DstConnectData%conCdA = SrcConnectData%conCdA - DstConnectData%Ftot = SrcConnectData%Ftot - DstConnectData%Mtot = SrcConnectData%Mtot - DstConnectData%S = SrcConnectData%S - DstConnectData%r = SrcConnectData%r - DstConnectData%rd = SrcConnectData%rd - END SUBROUTINE MD_CopyConnect - - SUBROUTINE MD_DestroyConnect( ConnectData, ErrStat, ErrMsg ) - TYPE(MD_Connect), INTENT(INOUT) :: ConnectData + DstRodPropData%IdNum = SrcRodPropData%IdNum + DstRodPropData%name = SrcRodPropData%name + DstRodPropData%d = SrcRodPropData%d + DstRodPropData%w = SrcRodPropData%w + DstRodPropData%Can = SrcRodPropData%Can + DstRodPropData%Cat = SrcRodPropData%Cat + DstRodPropData%Cdn = SrcRodPropData%Cdn + DstRodPropData%Cdt = SrcRodPropData%Cdt + DstRodPropData%CdEnd = SrcRodPropData%CdEnd + DstRodPropData%CaEnd = SrcRodPropData%CaEnd + END SUBROUTINE MD_CopyRodProp + + SUBROUTINE MD_DestroyRodProp( RodPropData, ErrStat, ErrMsg ) + TYPE(MD_RodProp), INTENT(INOUT) :: RodPropData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyConnect' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyRodProp' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(ConnectData%AttachedFairs)) THEN - DEALLOCATE(ConnectData%AttachedFairs) -ENDIF -IF (ALLOCATED(ConnectData%AttachedAnchs)) THEN - DEALLOCATE(ConnectData%AttachedAnchs) -ENDIF - END SUBROUTINE MD_DestroyConnect + END SUBROUTINE MD_DestroyRodProp - SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE MD_PackRodProp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_Connect), INTENT(IN) :: InData + TYPE(MD_RodProp), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -748,7 +1780,7 @@ SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackConnect' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackRodProp' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -765,33 +1797,15 @@ SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_BufSz = 0 Int_BufSz = 0 Int_BufSz = Int_BufSz + 1 ! IdNum - Int_BufSz = Int_BufSz + 1*LEN(InData%type) ! type - Int_BufSz = Int_BufSz + 1 ! TypeNum - Int_BufSz = Int_BufSz + 1 ! AttachedFairs allocated yes/no - IF ( ALLOCATED(InData%AttachedFairs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AttachedFairs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AttachedFairs) ! AttachedFairs - END IF - Int_BufSz = Int_BufSz + 1 ! AttachedAnchs allocated yes/no - IF ( ALLOCATED(InData%AttachedAnchs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AttachedAnchs upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%AttachedAnchs) ! AttachedAnchs - END IF - Db_BufSz = Db_BufSz + 1 ! conX - Db_BufSz = Db_BufSz + 1 ! conY - Db_BufSz = Db_BufSz + 1 ! conZ - Db_BufSz = Db_BufSz + 1 ! conM - Db_BufSz = Db_BufSz + 1 ! conV - Db_BufSz = Db_BufSz + 1 ! conFX - Db_BufSz = Db_BufSz + 1 ! conFY - Db_BufSz = Db_BufSz + 1 ! conFZ - Db_BufSz = Db_BufSz + 1 ! conCa - Db_BufSz = Db_BufSz + 1 ! conCdA - Db_BufSz = Db_BufSz + SIZE(InData%Ftot) ! Ftot - Db_BufSz = Db_BufSz + SIZE(InData%Mtot) ! Mtot - Db_BufSz = Db_BufSz + SIZE(InData%S) ! S - Db_BufSz = Db_BufSz + SIZE(InData%r) ! r - Db_BufSz = Db_BufSz + SIZE(InData%rd) ! rd + Int_BufSz = Int_BufSz + 1*LEN(InData%name) ! name + Db_BufSz = Db_BufSz + 1 ! d + Db_BufSz = Db_BufSz + 1 ! w + Db_BufSz = Db_BufSz + 1 ! Can + Db_BufSz = Db_BufSz + 1 ! Cat + Db_BufSz = Db_BufSz + 1 ! Cdn + Db_BufSz = Db_BufSz + 1 ! Cdt + Db_BufSz = Db_BufSz + 1 ! CdEnd + Db_BufSz = Db_BufSz + 1 ! CaEnd IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -821,93 +1835,328 @@ SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf(Int_Xferred) = InData%IdNum Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%type) - IntKiBuf(Int_Xferred) = ICHAR(InData%type(I:I), IntKi) + DO I = 1, LEN(InData%name) + IntKiBuf(Int_Xferred) = ICHAR(InData%name(I:I), IntKi) Int_Xferred = Int_Xferred + 1 END DO ! I - IntKiBuf(Int_Xferred) = InData%TypeNum - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%AttachedFairs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AttachedFairs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AttachedFairs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AttachedFairs,1), UBOUND(InData%AttachedFairs,1) - IntKiBuf(Int_Xferred) = InData%AttachedFairs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AttachedAnchs) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AttachedAnchs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AttachedAnchs,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AttachedAnchs,1), UBOUND(InData%AttachedAnchs,1) - IntKiBuf(Int_Xferred) = InData%AttachedAnchs(i1) - Int_Xferred = Int_Xferred + 1 - END DO - END IF - DbKiBuf(Db_Xferred) = InData%conX - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conY - Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conZ + DbKiBuf(Db_Xferred) = InData%d Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conM + DbKiBuf(Db_Xferred) = InData%w Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conV + DbKiBuf(Db_Xferred) = InData%Can Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conFX + DbKiBuf(Db_Xferred) = InData%Cat Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conFY + DbKiBuf(Db_Xferred) = InData%Cdn Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conFZ + DbKiBuf(Db_Xferred) = InData%Cdt Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conCa + DbKiBuf(Db_Xferred) = InData%CdEnd Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%conCdA + DbKiBuf(Db_Xferred) = InData%CaEnd Db_Xferred = Db_Xferred + 1 - DO i1 = LBOUND(InData%Ftot,1), UBOUND(InData%Ftot,1) - DbKiBuf(Db_Xferred) = InData%Ftot(i1) - Db_Xferred = Db_Xferred + 1 + END SUBROUTINE MD_PackRodProp + + SUBROUTINE MD_UnPackRodProp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MD_RodProp), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackRodProp' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%IdNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%name) + OutData%name(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%d = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%w = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Can = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Cat = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Cdn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Cdt = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%CdEnd = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%CaEnd = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END SUBROUTINE MD_UnPackRodProp + + SUBROUTINE MD_CopyBody( SrcBodyData, DstBodyData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_Body), INTENT(IN) :: SrcBodyData + TYPE(MD_Body), INTENT(INOUT) :: DstBodyData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyBody' +! + ErrStat = ErrID_None + ErrMsg = "" + DstBodyData%IdNum = SrcBodyData%IdNum + DstBodyData%typeNum = SrcBodyData%typeNum + DstBodyData%AttachedC = SrcBodyData%AttachedC + DstBodyData%AttachedR = SrcBodyData%AttachedR + DstBodyData%nAttachedC = SrcBodyData%nAttachedC + DstBodyData%nAttachedR = SrcBodyData%nAttachedR + DstBodyData%rConnectRel = SrcBodyData%rConnectRel + DstBodyData%r6RodRel = SrcBodyData%r6RodRel + DstBodyData%bodyM = SrcBodyData%bodyM + DstBodyData%bodyV = SrcBodyData%bodyV + DstBodyData%bodyI = SrcBodyData%bodyI + DstBodyData%bodyCdA = SrcBodyData%bodyCdA + DstBodyData%bodyCa = SrcBodyData%bodyCa + DstBodyData%time = SrcBodyData%time + DstBodyData%r6 = SrcBodyData%r6 + DstBodyData%v6 = SrcBodyData%v6 + DstBodyData%a6 = SrcBodyData%a6 + DstBodyData%U = SrcBodyData%U + DstBodyData%Ud = SrcBodyData%Ud + DstBodyData%zeta = SrcBodyData%zeta + DstBodyData%F6net = SrcBodyData%F6net + DstBodyData%M6net = SrcBodyData%M6net + DstBodyData%M = SrcBodyData%M + DstBodyData%M0 = SrcBodyData%M0 + DstBodyData%OrMat = SrcBodyData%OrMat + DstBodyData%rCG = SrcBodyData%rCG + END SUBROUTINE MD_CopyBody + + SUBROUTINE MD_DestroyBody( BodyData, ErrStat, ErrMsg ) + TYPE(MD_Body), INTENT(INOUT) :: BodyData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyBody' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE MD_DestroyBody + + SUBROUTINE MD_PackBody( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(MD_Body), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackBody' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! IdNum + Int_BufSz = Int_BufSz + 1 ! typeNum + Int_BufSz = Int_BufSz + SIZE(InData%AttachedC) ! AttachedC + Int_BufSz = Int_BufSz + SIZE(InData%AttachedR) ! AttachedR + Int_BufSz = Int_BufSz + 1 ! nAttachedC + Int_BufSz = Int_BufSz + 1 ! nAttachedR + Db_BufSz = Db_BufSz + SIZE(InData%rConnectRel) ! rConnectRel + Db_BufSz = Db_BufSz + SIZE(InData%r6RodRel) ! r6RodRel + Db_BufSz = Db_BufSz + 1 ! bodyM + Db_BufSz = Db_BufSz + 1 ! bodyV + Db_BufSz = Db_BufSz + SIZE(InData%bodyI) ! bodyI + Db_BufSz = Db_BufSz + SIZE(InData%bodyCdA) ! bodyCdA + Db_BufSz = Db_BufSz + SIZE(InData%bodyCa) ! bodyCa + Db_BufSz = Db_BufSz + 1 ! time + Db_BufSz = Db_BufSz + SIZE(InData%r6) ! r6 + Db_BufSz = Db_BufSz + SIZE(InData%v6) ! v6 + Db_BufSz = Db_BufSz + SIZE(InData%a6) ! a6 + Db_BufSz = Db_BufSz + SIZE(InData%U) ! U + Db_BufSz = Db_BufSz + SIZE(InData%Ud) ! Ud + Db_BufSz = Db_BufSz + 1 ! zeta + Db_BufSz = Db_BufSz + SIZE(InData%F6net) ! F6net + Db_BufSz = Db_BufSz + SIZE(InData%M6net) ! M6net + Db_BufSz = Db_BufSz + SIZE(InData%M) ! M + Db_BufSz = Db_BufSz + SIZE(InData%M0) ! M0 + Db_BufSz = Db_BufSz + SIZE(InData%OrMat) ! OrMat + Db_BufSz = Db_BufSz + SIZE(InData%rCG) ! rCG + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = InData%IdNum + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%typeNum + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%AttachedC,1), UBOUND(InData%AttachedC,1) + IntKiBuf(Int_Xferred) = InData%AttachedC(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AttachedR,1), UBOUND(InData%AttachedR,1) + IntKiBuf(Int_Xferred) = InData%AttachedR(i1) + Int_Xferred = Int_Xferred + 1 END DO - DO i2 = LBOUND(InData%Mtot,2), UBOUND(InData%Mtot,2) - DO i1 = LBOUND(InData%Mtot,1), UBOUND(InData%Mtot,1) - DbKiBuf(Db_Xferred) = InData%Mtot(i1,i2) + IntKiBuf(Int_Xferred) = InData%nAttachedC + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nAttachedR + Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%rConnectRel,2), UBOUND(InData%rConnectRel,2) + DO i1 = LBOUND(InData%rConnectRel,1), UBOUND(InData%rConnectRel,1) + DbKiBuf(Db_Xferred) = InData%rConnectRel(i1,i2) Db_Xferred = Db_Xferred + 1 END DO END DO - DO i2 = LBOUND(InData%S,2), UBOUND(InData%S,2) - DO i1 = LBOUND(InData%S,1), UBOUND(InData%S,1) - DbKiBuf(Db_Xferred) = InData%S(i1,i2) + DO i2 = LBOUND(InData%r6RodRel,2), UBOUND(InData%r6RodRel,2) + DO i1 = LBOUND(InData%r6RodRel,1), UBOUND(InData%r6RodRel,1) + DbKiBuf(Db_Xferred) = InData%r6RodRel(i1,i2) Db_Xferred = Db_Xferred + 1 END DO END DO - DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) - DbKiBuf(Db_Xferred) = InData%r(i1) + DbKiBuf(Db_Xferred) = InData%bodyM + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%bodyV + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%bodyI,1), UBOUND(InData%bodyI,1) + DbKiBuf(Db_Xferred) = InData%bodyI(i1) Db_Xferred = Db_Xferred + 1 END DO - DO i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) - DbKiBuf(Db_Xferred) = InData%rd(i1) + DO i1 = LBOUND(InData%bodyCdA,1), UBOUND(InData%bodyCdA,1) + DbKiBuf(Db_Xferred) = InData%bodyCdA(i1) Db_Xferred = Db_Xferred + 1 END DO - END SUBROUTINE MD_PackConnect + DO i1 = LBOUND(InData%bodyCa,1), UBOUND(InData%bodyCa,1) + DbKiBuf(Db_Xferred) = InData%bodyCa(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%time + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%r6,1), UBOUND(InData%r6,1) + DbKiBuf(Db_Xferred) = InData%r6(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%v6,1), UBOUND(InData%v6,1) + DbKiBuf(Db_Xferred) = InData%v6(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%a6,1), UBOUND(InData%a6,1) + DbKiBuf(Db_Xferred) = InData%a6(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) + DbKiBuf(Db_Xferred) = InData%U(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%Ud,1), UBOUND(InData%Ud,1) + DbKiBuf(Db_Xferred) = InData%Ud(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%zeta + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%F6net,1), UBOUND(InData%F6net,1) + DbKiBuf(Db_Xferred) = InData%F6net(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i2 = LBOUND(InData%M6net,2), UBOUND(InData%M6net,2) + DO i1 = LBOUND(InData%M6net,1), UBOUND(InData%M6net,1) + DbKiBuf(Db_Xferred) = InData%M6net(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) + DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) + DbKiBuf(Db_Xferred) = InData%M(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%M0,2), UBOUND(InData%M0,2) + DO i1 = LBOUND(InData%M0,1), UBOUND(InData%M0,1) + DbKiBuf(Db_Xferred) = InData%M0(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%OrMat,2), UBOUND(InData%OrMat,2) + DO i1 = LBOUND(InData%OrMat,1), UBOUND(InData%OrMat,1) + DbKiBuf(Db_Xferred) = InData%OrMat(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%rCG,1), UBOUND(InData%rCG,1) + DbKiBuf(Db_Xferred) = InData%rCG(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END SUBROUTINE MD_PackBody - SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE MD_UnPackBody( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_Connect), INTENT(INOUT) :: OutData + TYPE(MD_Body), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -920,7 +2169,7 @@ SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackConnect' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackBody' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -933,111 +2182,157 @@ SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Xferred = 1 OutData%IdNum = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%type) - OutData%type(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TypeNum = IntKiBuf(Int_Xferred) + OutData%typeNum = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AttachedFairs not allocated + i1_l = LBOUND(OutData%AttachedC,1) + i1_u = UBOUND(OutData%AttachedC,1) + DO i1 = LBOUND(OutData%AttachedC,1), UBOUND(OutData%AttachedC,1) + OutData%AttachedC(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + i1_l = LBOUND(OutData%AttachedR,1) + i1_u = UBOUND(OutData%AttachedR,1) + DO i1 = LBOUND(OutData%AttachedR,1), UBOUND(OutData%AttachedR,1) + OutData%AttachedR(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%nAttachedC = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - ELSE + OutData%nAttachedR = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AttachedFairs)) DEALLOCATE(OutData%AttachedFairs) - ALLOCATE(OutData%AttachedFairs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AttachedFairs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AttachedFairs,1), UBOUND(OutData%AttachedFairs,1) - OutData%AttachedFairs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%rConnectRel,1) + i1_u = UBOUND(OutData%rConnectRel,1) + i2_l = LBOUND(OutData%rConnectRel,2) + i2_u = UBOUND(OutData%rConnectRel,2) + DO i2 = LBOUND(OutData%rConnectRel,2), UBOUND(OutData%rConnectRel,2) + DO i1 = LBOUND(OutData%rConnectRel,1), UBOUND(OutData%rConnectRel,1) + OutData%rConnectRel(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AttachedAnchs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AttachedAnchs)) DEALLOCATE(OutData%AttachedAnchs) - ALLOCATE(OutData%AttachedAnchs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AttachedAnchs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AttachedAnchs,1), UBOUND(OutData%AttachedAnchs,1) - OutData%AttachedAnchs(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 + END DO + i1_l = LBOUND(OutData%r6RodRel,1) + i1_u = UBOUND(OutData%r6RodRel,1) + i2_l = LBOUND(OutData%r6RodRel,2) + i2_u = UBOUND(OutData%r6RodRel,2) + DO i2 = LBOUND(OutData%r6RodRel,2), UBOUND(OutData%r6RodRel,2) + DO i1 = LBOUND(OutData%r6RodRel,1), UBOUND(OutData%r6RodRel,1) + OutData%r6RodRel(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END DO - END IF - OutData%conX = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conY = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conZ = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conM = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conV = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conFX = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%conFY = DbKiBuf(Db_Xferred) + END DO + OutData%bodyM = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - OutData%conFZ = DbKiBuf(Db_Xferred) + OutData%bodyV = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - OutData%conCa = DbKiBuf(Db_Xferred) + i1_l = LBOUND(OutData%bodyI,1) + i1_u = UBOUND(OutData%bodyI,1) + DO i1 = LBOUND(OutData%bodyI,1), UBOUND(OutData%bodyI,1) + OutData%bodyI(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%bodyCdA,1) + i1_u = UBOUND(OutData%bodyCdA,1) + DO i1 = LBOUND(OutData%bodyCdA,1), UBOUND(OutData%bodyCdA,1) + OutData%bodyCdA(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%bodyCa,1) + i1_u = UBOUND(OutData%bodyCa,1) + DO i1 = LBOUND(OutData%bodyCa,1), UBOUND(OutData%bodyCa,1) + OutData%bodyCa(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%time = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - OutData%conCdA = DbKiBuf(Db_Xferred) + i1_l = LBOUND(OutData%r6,1) + i1_u = UBOUND(OutData%r6,1) + DO i1 = LBOUND(OutData%r6,1), UBOUND(OutData%r6,1) + OutData%r6(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%v6,1) + i1_u = UBOUND(OutData%v6,1) + DO i1 = LBOUND(OutData%v6,1), UBOUND(OutData%v6,1) + OutData%v6(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%a6,1) + i1_u = UBOUND(OutData%a6,1) + DO i1 = LBOUND(OutData%a6,1), UBOUND(OutData%a6,1) + OutData%a6(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%U,1) + i1_u = UBOUND(OutData%U,1) + DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) + OutData%U(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%Ud,1) + i1_u = UBOUND(OutData%Ud,1) + DO i1 = LBOUND(OutData%Ud,1), UBOUND(OutData%Ud,1) + OutData%Ud(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%zeta = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - i1_l = LBOUND(OutData%Ftot,1) - i1_u = UBOUND(OutData%Ftot,1) - DO i1 = LBOUND(OutData%Ftot,1), UBOUND(OutData%Ftot,1) - OutData%Ftot(i1) = DbKiBuf(Db_Xferred) + i1_l = LBOUND(OutData%F6net,1) + i1_u = UBOUND(OutData%F6net,1) + DO i1 = LBOUND(OutData%F6net,1), UBOUND(OutData%F6net,1) + OutData%F6net(i1) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO - i1_l = LBOUND(OutData%Mtot,1) - i1_u = UBOUND(OutData%Mtot,1) - i2_l = LBOUND(OutData%Mtot,2) - i2_u = UBOUND(OutData%Mtot,2) - DO i2 = LBOUND(OutData%Mtot,2), UBOUND(OutData%Mtot,2) - DO i1 = LBOUND(OutData%Mtot,1), UBOUND(OutData%Mtot,1) - OutData%Mtot(i1,i2) = DbKiBuf(Db_Xferred) + i1_l = LBOUND(OutData%M6net,1) + i1_u = UBOUND(OutData%M6net,1) + i2_l = LBOUND(OutData%M6net,2) + i2_u = UBOUND(OutData%M6net,2) + DO i2 = LBOUND(OutData%M6net,2), UBOUND(OutData%M6net,2) + DO i1 = LBOUND(OutData%M6net,1), UBOUND(OutData%M6net,1) + OutData%M6net(i1,i2) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END DO - i1_l = LBOUND(OutData%S,1) - i1_u = UBOUND(OutData%S,1) - i2_l = LBOUND(OutData%S,2) - i2_u = UBOUND(OutData%S,2) - DO i2 = LBOUND(OutData%S,2), UBOUND(OutData%S,2) - DO i1 = LBOUND(OutData%S,1), UBOUND(OutData%S,1) - OutData%S(i1,i2) = DbKiBuf(Db_Xferred) + i1_l = LBOUND(OutData%M,1) + i1_u = UBOUND(OutData%M,1) + i2_l = LBOUND(OutData%M,2) + i2_u = UBOUND(OutData%M,2) + DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) + DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) + OutData%M(i1,i2) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END DO - i1_l = LBOUND(OutData%r,1) - i1_u = UBOUND(OutData%r,1) - DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) - OutData%r(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 + i1_l = LBOUND(OutData%M0,1) + i1_u = UBOUND(OutData%M0,1) + i2_l = LBOUND(OutData%M0,2) + i2_u = UBOUND(OutData%M0,2) + DO i2 = LBOUND(OutData%M0,2), UBOUND(OutData%M0,2) + DO i1 = LBOUND(OutData%M0,1), UBOUND(OutData%M0,1) + OutData%M0(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END DO - i1_l = LBOUND(OutData%rd,1) - i1_u = UBOUND(OutData%rd,1) - DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) - OutData%rd(i1) = DbKiBuf(Db_Xferred) + i1_l = LBOUND(OutData%OrMat,1) + i1_u = UBOUND(OutData%OrMat,1) + i2_l = LBOUND(OutData%OrMat,2) + i2_u = UBOUND(OutData%OrMat,2) + DO i2 = LBOUND(OutData%OrMat,2), UBOUND(OutData%OrMat,2) + DO i1 = LBOUND(OutData%OrMat,1), UBOUND(OutData%OrMat,1) + OutData%OrMat(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + i1_l = LBOUND(OutData%rCG,1) + i1_u = UBOUND(OutData%rCG,1) + DO i1 = LBOUND(OutData%rCG,1), UBOUND(OutData%rCG,1) + OutData%rCG(i1) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO - END SUBROUTINE MD_UnPackConnect + END SUBROUTINE MD_UnPackBody - SUBROUTINE MD_CopyLine( SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_Line), INTENT(IN) :: SrcLineData - TYPE(MD_Line), INTENT(INOUT) :: DstLineData + SUBROUTINE MD_CopyConnect( SrcConnectData, DstConnectData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_Connect), INTENT(IN) :: SrcConnectData + TYPE(MD_Connect), INTENT(INOUT) :: DstConnectData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -1045,374 +2340,757 @@ SUBROUTINE MD_CopyLine( SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg ) INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyLine' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyConnect' ! ErrStat = ErrID_None ErrMsg = "" - DstLineData%IdNum = SrcLineData%IdNum - DstLineData%type = SrcLineData%type - DstLineData%OutFlagList = SrcLineData%OutFlagList - DstLineData%CtrlChan = SrcLineData%CtrlChan - DstLineData%FairConnect = SrcLineData%FairConnect - DstLineData%AnchConnect = SrcLineData%AnchConnect - DstLineData%PropsIdNum = SrcLineData%PropsIdNum - DstLineData%N = SrcLineData%N - DstLineData%UnstrLen = SrcLineData%UnstrLen - DstLineData%BA = SrcLineData%BA -IF (ALLOCATED(SrcLineData%r)) THEN - i1_l = LBOUND(SrcLineData%r,1) - i1_u = UBOUND(SrcLineData%r,1) - i2_l = LBOUND(SrcLineData%r,2) - i2_u = UBOUND(SrcLineData%r,2) - IF (.NOT. ALLOCATED(DstLineData%r)) THEN - ALLOCATE(DstLineData%r(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%r.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%r = SrcLineData%r -ENDIF -IF (ALLOCATED(SrcLineData%rd)) THEN - i1_l = LBOUND(SrcLineData%rd,1) - i1_u = UBOUND(SrcLineData%rd,1) - i2_l = LBOUND(SrcLineData%rd,2) - i2_u = UBOUND(SrcLineData%rd,2) - IF (.NOT. ALLOCATED(DstLineData%rd)) THEN - ALLOCATE(DstLineData%rd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%rd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%rd = SrcLineData%rd -ENDIF -IF (ALLOCATED(SrcLineData%q)) THEN - i1_l = LBOUND(SrcLineData%q,1) - i1_u = UBOUND(SrcLineData%q,1) - i2_l = LBOUND(SrcLineData%q,2) - i2_u = UBOUND(SrcLineData%q,2) - IF (.NOT. ALLOCATED(DstLineData%q)) THEN - ALLOCATE(DstLineData%q(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstConnectData%IdNum = SrcConnectData%IdNum + DstConnectData%type = SrcConnectData%type + DstConnectData%typeNum = SrcConnectData%typeNum + DstConnectData%Attached = SrcConnectData%Attached + DstConnectData%Top = SrcConnectData%Top + DstConnectData%nAttached = SrcConnectData%nAttached + DstConnectData%conM = SrcConnectData%conM + DstConnectData%conV = SrcConnectData%conV + DstConnectData%conFX = SrcConnectData%conFX + DstConnectData%conFY = SrcConnectData%conFY + DstConnectData%conFZ = SrcConnectData%conFZ + DstConnectData%conCa = SrcConnectData%conCa + DstConnectData%conCdA = SrcConnectData%conCdA + DstConnectData%time = SrcConnectData%time + DstConnectData%r = SrcConnectData%r + DstConnectData%rd = SrcConnectData%rd + DstConnectData%a = SrcConnectData%a + DstConnectData%U = SrcConnectData%U + DstConnectData%Ud = SrcConnectData%Ud + DstConnectData%zeta = SrcConnectData%zeta +IF (ALLOCATED(SrcConnectData%PDyn)) THEN + i1_l = LBOUND(SrcConnectData%PDyn,1) + i1_u = UBOUND(SrcConnectData%PDyn,1) + IF (.NOT. ALLOCATED(DstConnectData%PDyn)) THEN + ALLOCATE(DstConnectData%PDyn(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%q.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstConnectData%PDyn.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%q = SrcLineData%q + DstConnectData%PDyn = SrcConnectData%PDyn ENDIF -IF (ALLOCATED(SrcLineData%l)) THEN - i1_l = LBOUND(SrcLineData%l,1) - i1_u = UBOUND(SrcLineData%l,1) - IF (.NOT. ALLOCATED(DstLineData%l)) THEN - ALLOCATE(DstLineData%l(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%l.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstLineData%l = SrcLineData%l + DstConnectData%Fnet = SrcConnectData%Fnet + DstConnectData%M = SrcConnectData%M + END SUBROUTINE MD_CopyConnect + + SUBROUTINE MD_DestroyConnect( ConnectData, ErrStat, ErrMsg ) + TYPE(MD_Connect), INTENT(INOUT) :: ConnectData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyConnect' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(ConnectData%PDyn)) THEN + DEALLOCATE(ConnectData%PDyn) ENDIF -IF (ALLOCATED(SrcLineData%ld)) THEN - i1_l = LBOUND(SrcLineData%ld,1) - i1_u = UBOUND(SrcLineData%ld,1) - IF (.NOT. ALLOCATED(DstLineData%ld)) THEN - ALLOCATE(DstLineData%ld(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%ld.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + END SUBROUTINE MD_DestroyConnect + + SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(MD_Connect), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackConnect' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! IdNum + Int_BufSz = Int_BufSz + 1*LEN(InData%type) ! type + Int_BufSz = Int_BufSz + 1 ! typeNum + Int_BufSz = Int_BufSz + SIZE(InData%Attached) ! Attached + Int_BufSz = Int_BufSz + SIZE(InData%Top) ! Top + Int_BufSz = Int_BufSz + 1 ! nAttached + Db_BufSz = Db_BufSz + 1 ! conM + Db_BufSz = Db_BufSz + 1 ! conV + Db_BufSz = Db_BufSz + 1 ! conFX + Db_BufSz = Db_BufSz + 1 ! conFY + Db_BufSz = Db_BufSz + 1 ! conFZ + Db_BufSz = Db_BufSz + 1 ! conCa + Db_BufSz = Db_BufSz + 1 ! conCdA + Db_BufSz = Db_BufSz + 1 ! time + Db_BufSz = Db_BufSz + SIZE(InData%r) ! r + Db_BufSz = Db_BufSz + SIZE(InData%rd) ! rd + Db_BufSz = Db_BufSz + SIZE(InData%a) ! a + Db_BufSz = Db_BufSz + SIZE(InData%U) ! U + Db_BufSz = Db_BufSz + SIZE(InData%Ud) ! Ud + Db_BufSz = Db_BufSz + 1 ! zeta + Int_BufSz = Int_BufSz + 1 ! PDyn allocated yes/no + IF ( ALLOCATED(InData%PDyn) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! PDyn upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%PDyn) ! PDyn + END IF + Db_BufSz = Db_BufSz + SIZE(InData%Fnet) ! Fnet + Db_BufSz = Db_BufSz + SIZE(InData%M) ! M + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - DstLineData%ld = SrcLineData%ld -ENDIF -IF (ALLOCATED(SrcLineData%lstr)) THEN - i1_l = LBOUND(SrcLineData%lstr,1) - i1_u = UBOUND(SrcLineData%lstr,1) - IF (.NOT. ALLOCATED(DstLineData%lstr)) THEN - ALLOCATE(DstLineData%lstr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%lstr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - DstLineData%lstr = SrcLineData%lstr -ENDIF -IF (ALLOCATED(SrcLineData%lstrd)) THEN - i1_l = LBOUND(SrcLineData%lstrd,1) - i1_u = UBOUND(SrcLineData%lstrd,1) - IF (.NOT. ALLOCATED(DstLineData%lstrd)) THEN - ALLOCATE(DstLineData%lstrd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%lstrd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - DstLineData%lstrd = SrcLineData%lstrd -ENDIF -IF (ALLOCATED(SrcLineData%V)) THEN - i1_l = LBOUND(SrcLineData%V,1) - i1_u = UBOUND(SrcLineData%V,1) - IF (.NOT. ALLOCATED(DstLineData%V)) THEN - ALLOCATE(DstLineData%V(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%V.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = InData%IdNum + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%type) + IntKiBuf(Int_Xferred) = ICHAR(InData%type(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%typeNum + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%Attached,1), UBOUND(InData%Attached,1) + IntKiBuf(Int_Xferred) = InData%Attached(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%Top,1), UBOUND(InData%Top,1) + IntKiBuf(Int_Xferred) = InData%Top(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%nAttached + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%conM + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%conV + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%conFX + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%conFY + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%conFZ + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%conCa + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%conCdA + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%time + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) + DbKiBuf(Db_Xferred) = InData%r(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) + DbKiBuf(Db_Xferred) = InData%rd(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%a,1), UBOUND(InData%a,1) + DbKiBuf(Db_Xferred) = InData%a(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) + DbKiBuf(Db_Xferred) = InData%U(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%Ud,1), UBOUND(InData%Ud,1) + DbKiBuf(Db_Xferred) = InData%Ud(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%zeta + Db_Xferred = Db_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%PDyn) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%PDyn,1), UBOUND(InData%PDyn,1) + DbKiBuf(Db_Xferred) = InData%PDyn(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - DstLineData%V = SrcLineData%V -ENDIF -IF (ALLOCATED(SrcLineData%T)) THEN - i1_l = LBOUND(SrcLineData%T,1) - i1_u = UBOUND(SrcLineData%T,1) - i2_l = LBOUND(SrcLineData%T,2) - i2_u = UBOUND(SrcLineData%T,2) - IF (.NOT. ALLOCATED(DstLineData%T)) THEN - ALLOCATE(DstLineData%T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DO i1 = LBOUND(InData%Fnet,1), UBOUND(InData%Fnet,1) + DbKiBuf(Db_Xferred) = InData%Fnet(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) + DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) + DbKiBuf(Db_Xferred) = InData%M(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END SUBROUTINE MD_PackConnect + + SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MD_Connect), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackConnect' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%IdNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%type) + OutData%type(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%typeNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%Attached,1) + i1_u = UBOUND(OutData%Attached,1) + DO i1 = LBOUND(OutData%Attached,1), UBOUND(OutData%Attached,1) + OutData%Attached(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + i1_l = LBOUND(OutData%Top,1) + i1_u = UBOUND(OutData%Top,1) + DO i1 = LBOUND(OutData%Top,1), UBOUND(OutData%Top,1) + OutData%Top(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%nAttached = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%conM = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%conV = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%conFX = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%conFY = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%conFZ = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%conCa = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%conCdA = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%time = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + i1_l = LBOUND(OutData%r,1) + i1_u = UBOUND(OutData%r,1) + DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) + OutData%r(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%rd,1) + i1_u = UBOUND(OutData%rd,1) + DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) + OutData%rd(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%a,1) + i1_u = UBOUND(OutData%a,1) + DO i1 = LBOUND(OutData%a,1), UBOUND(OutData%a,1) + OutData%a(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%U,1) + i1_u = UBOUND(OutData%U,1) + DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) + OutData%U(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%Ud,1) + i1_u = UBOUND(OutData%Ud,1) + DO i1 = LBOUND(OutData%Ud,1), UBOUND(OutData%Ud,1) + OutData%Ud(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%zeta = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDyn not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PDyn)) DEALLOCATE(OutData%PDyn) + ALLOCATE(OutData%PDyn(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%T.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%PDyn,1), UBOUND(OutData%PDyn,1) + OutData%PDyn(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + i1_l = LBOUND(OutData%Fnet,1) + i1_u = UBOUND(OutData%Fnet,1) + DO i1 = LBOUND(OutData%Fnet,1), UBOUND(OutData%Fnet,1) + OutData%Fnet(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%M,1) + i1_u = UBOUND(OutData%M,1) + i2_l = LBOUND(OutData%M,2) + i2_u = UBOUND(OutData%M,2) + DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) + DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) + OutData%M(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END SUBROUTINE MD_UnPackConnect + + SUBROUTINE MD_CopyRod( SrcRodData, DstRodData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_Rod), INTENT(IN) :: SrcRodData + TYPE(MD_Rod), INTENT(INOUT) :: DstRodData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyRod' +! + ErrStat = ErrID_None + ErrMsg = "" + DstRodData%IdNum = SrcRodData%IdNum + DstRodData%type = SrcRodData%type + DstRodData%PropsIdNum = SrcRodData%PropsIdNum + DstRodData%typeNum = SrcRodData%typeNum + DstRodData%AttachedA = SrcRodData%AttachedA + DstRodData%AttachedB = SrcRodData%AttachedB + DstRodData%TopA = SrcRodData%TopA + DstRodData%TopB = SrcRodData%TopB + DstRodData%nAttachedA = SrcRodData%nAttachedA + DstRodData%nAttachedB = SrcRodData%nAttachedB + DstRodData%OutFlagList = SrcRodData%OutFlagList + DstRodData%N = SrcRodData%N + DstRodData%endTypeA = SrcRodData%endTypeA + DstRodData%endTypeB = SrcRodData%endTypeB + DstRodData%UnstrLen = SrcRodData%UnstrLen + DstRodData%mass = SrcRodData%mass + DstRodData%rho = SrcRodData%rho + DstRodData%d = SrcRodData%d + DstRodData%Can = SrcRodData%Can + DstRodData%Cat = SrcRodData%Cat + DstRodData%Cdn = SrcRodData%Cdn + DstRodData%Cdt = SrcRodData%Cdt + DstRodData%CdEnd = SrcRodData%CdEnd + DstRodData%CaEnd = SrcRodData%CaEnd + DstRodData%time = SrcRodData%time + DstRodData%roll = SrcRodData%roll + DstRodData%pitch = SrcRodData%pitch + DstRodData%h0 = SrcRodData%h0 +IF (ALLOCATED(SrcRodData%r)) THEN + i1_l = LBOUND(SrcRodData%r,1) + i1_u = UBOUND(SrcRodData%r,1) + i2_l = LBOUND(SrcRodData%r,2) + i2_u = UBOUND(SrcRodData%r,2) + IF (.NOT. ALLOCATED(DstRodData%r)) THEN + ALLOCATE(DstRodData%r(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%r.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%T = SrcLineData%T + DstRodData%r = SrcRodData%r ENDIF -IF (ALLOCATED(SrcLineData%Td)) THEN - i1_l = LBOUND(SrcLineData%Td,1) - i1_u = UBOUND(SrcLineData%Td,1) - i2_l = LBOUND(SrcLineData%Td,2) - i2_u = UBOUND(SrcLineData%Td,2) - IF (.NOT. ALLOCATED(DstLineData%Td)) THEN - ALLOCATE(DstLineData%Td(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcRodData%rd)) THEN + i1_l = LBOUND(SrcRodData%rd,1) + i1_u = UBOUND(SrcRodData%rd,1) + i2_l = LBOUND(SrcRodData%rd,2) + i2_u = UBOUND(SrcRodData%rd,2) + IF (.NOT. ALLOCATED(DstRodData%rd)) THEN + ALLOCATE(DstRodData%rd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Td.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%rd.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%Td = SrcLineData%Td + DstRodData%rd = SrcRodData%rd ENDIF -IF (ALLOCATED(SrcLineData%W)) THEN - i1_l = LBOUND(SrcLineData%W,1) - i1_u = UBOUND(SrcLineData%W,1) - i2_l = LBOUND(SrcLineData%W,2) - i2_u = UBOUND(SrcLineData%W,2) - IF (.NOT. ALLOCATED(DstLineData%W)) THEN - ALLOCATE(DstLineData%W(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + DstRodData%q = SrcRodData%q +IF (ALLOCATED(SrcRodData%l)) THEN + i1_l = LBOUND(SrcRodData%l,1) + i1_u = UBOUND(SrcRodData%l,1) + IF (.NOT. ALLOCATED(DstRodData%l)) THEN + ALLOCATE(DstRodData%l(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%W.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%l.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%W = SrcLineData%W + DstRodData%l = SrcRodData%l ENDIF -IF (ALLOCATED(SrcLineData%Dp)) THEN - i1_l = LBOUND(SrcLineData%Dp,1) - i1_u = UBOUND(SrcLineData%Dp,1) - i2_l = LBOUND(SrcLineData%Dp,2) - i2_u = UBOUND(SrcLineData%Dp,2) - IF (.NOT. ALLOCATED(DstLineData%Dp)) THEN - ALLOCATE(DstLineData%Dp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcRodData%V)) THEN + i1_l = LBOUND(SrcRodData%V,1) + i1_u = UBOUND(SrcRodData%V,1) + IF (.NOT. ALLOCATED(DstRodData%V)) THEN + ALLOCATE(DstRodData%V(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Dp.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%V.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%Dp = SrcLineData%Dp + DstRodData%V = SrcRodData%V ENDIF -IF (ALLOCATED(SrcLineData%Dq)) THEN - i1_l = LBOUND(SrcLineData%Dq,1) - i1_u = UBOUND(SrcLineData%Dq,1) - i2_l = LBOUND(SrcLineData%Dq,2) - i2_u = UBOUND(SrcLineData%Dq,2) - IF (.NOT. ALLOCATED(DstLineData%Dq)) THEN - ALLOCATE(DstLineData%Dq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcRodData%U)) THEN + i1_l = LBOUND(SrcRodData%U,1) + i1_u = UBOUND(SrcRodData%U,1) + i2_l = LBOUND(SrcRodData%U,2) + i2_u = UBOUND(SrcRodData%U,2) + IF (.NOT. ALLOCATED(DstRodData%U)) THEN + ALLOCATE(DstRodData%U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Dq.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%U.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%Dq = SrcLineData%Dq + DstRodData%U = SrcRodData%U ENDIF -IF (ALLOCATED(SrcLineData%Ap)) THEN - i1_l = LBOUND(SrcLineData%Ap,1) - i1_u = UBOUND(SrcLineData%Ap,1) - i2_l = LBOUND(SrcLineData%Ap,2) - i2_u = UBOUND(SrcLineData%Ap,2) - IF (.NOT. ALLOCATED(DstLineData%Ap)) THEN - ALLOCATE(DstLineData%Ap(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcRodData%Ud)) THEN + i1_l = LBOUND(SrcRodData%Ud,1) + i1_u = UBOUND(SrcRodData%Ud,1) + i2_l = LBOUND(SrcRodData%Ud,2) + i2_u = UBOUND(SrcRodData%Ud,2) + IF (.NOT. ALLOCATED(DstRodData%Ud)) THEN + ALLOCATE(DstRodData%Ud(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Ap.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Ud.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%Ap = SrcLineData%Ap + DstRodData%Ud = SrcRodData%Ud ENDIF -IF (ALLOCATED(SrcLineData%Aq)) THEN - i1_l = LBOUND(SrcLineData%Aq,1) - i1_u = UBOUND(SrcLineData%Aq,1) - i2_l = LBOUND(SrcLineData%Aq,2) - i2_u = UBOUND(SrcLineData%Aq,2) - IF (.NOT. ALLOCATED(DstLineData%Aq)) THEN - ALLOCATE(DstLineData%Aq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcRodData%zeta)) THEN + i1_l = LBOUND(SrcRodData%zeta,1) + i1_u = UBOUND(SrcRodData%zeta,1) + IF (.NOT. ALLOCATED(DstRodData%zeta)) THEN + ALLOCATE(DstRodData%zeta(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Aq.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%zeta.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%Aq = SrcLineData%Aq + DstRodData%zeta = SrcRodData%zeta ENDIF -IF (ALLOCATED(SrcLineData%B)) THEN - i1_l = LBOUND(SrcLineData%B,1) - i1_u = UBOUND(SrcLineData%B,1) - i2_l = LBOUND(SrcLineData%B,2) - i2_u = UBOUND(SrcLineData%B,2) - IF (.NOT. ALLOCATED(DstLineData%B)) THEN - ALLOCATE(DstLineData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcRodData%PDyn)) THEN + i1_l = LBOUND(SrcRodData%PDyn,1) + i1_u = UBOUND(SrcRodData%PDyn,1) + IF (.NOT. ALLOCATED(DstRodData%PDyn)) THEN + ALLOCATE(DstRodData%PDyn(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%B.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%PDyn.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%B = SrcLineData%B + DstRodData%PDyn = SrcRodData%PDyn ENDIF -IF (ALLOCATED(SrcLineData%F)) THEN - i1_l = LBOUND(SrcLineData%F,1) - i1_u = UBOUND(SrcLineData%F,1) - i2_l = LBOUND(SrcLineData%F,2) - i2_u = UBOUND(SrcLineData%F,2) - IF (.NOT. ALLOCATED(DstLineData%F)) THEN - ALLOCATE(DstLineData%F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcRodData%W)) THEN + i1_l = LBOUND(SrcRodData%W,1) + i1_u = UBOUND(SrcRodData%W,1) + i2_l = LBOUND(SrcRodData%W,2) + i2_u = UBOUND(SrcRodData%W,2) + IF (.NOT. ALLOCATED(DstRodData%W)) THEN + ALLOCATE(DstRodData%W(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%F.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%W.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%F = SrcLineData%F + DstRodData%W = SrcRodData%W ENDIF -IF (ALLOCATED(SrcLineData%S)) THEN - i1_l = LBOUND(SrcLineData%S,1) - i1_u = UBOUND(SrcLineData%S,1) - i2_l = LBOUND(SrcLineData%S,2) - i2_u = UBOUND(SrcLineData%S,2) - i3_l = LBOUND(SrcLineData%S,3) - i3_u = UBOUND(SrcLineData%S,3) - IF (.NOT. ALLOCATED(DstLineData%S)) THEN - ALLOCATE(DstLineData%S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) +IF (ALLOCATED(SrcRodData%Bo)) THEN + i1_l = LBOUND(SrcRodData%Bo,1) + i1_u = UBOUND(SrcRodData%Bo,1) + i2_l = LBOUND(SrcRodData%Bo,2) + i2_u = UBOUND(SrcRodData%Bo,2) + IF (.NOT. ALLOCATED(DstRodData%Bo)) THEN + ALLOCATE(DstRodData%Bo(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%S.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Bo.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%S = SrcLineData%S + DstRodData%Bo = SrcRodData%Bo ENDIF -IF (ALLOCATED(SrcLineData%M)) THEN - i1_l = LBOUND(SrcLineData%M,1) - i1_u = UBOUND(SrcLineData%M,1) - i2_l = LBOUND(SrcLineData%M,2) - i2_u = UBOUND(SrcLineData%M,2) - i3_l = LBOUND(SrcLineData%M,3) - i3_u = UBOUND(SrcLineData%M,3) - IF (.NOT. ALLOCATED(DstLineData%M)) THEN - ALLOCATE(DstLineData%M(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) +IF (ALLOCATED(SrcRodData%Pd)) THEN + i1_l = LBOUND(SrcRodData%Pd,1) + i1_u = UBOUND(SrcRodData%Pd,1) + i2_l = LBOUND(SrcRodData%Pd,2) + i2_u = UBOUND(SrcRodData%Pd,2) + IF (.NOT. ALLOCATED(DstRodData%Pd)) THEN + ALLOCATE(DstRodData%Pd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%M.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Pd.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%M = SrcLineData%M + DstRodData%Pd = SrcRodData%Pd ENDIF - DstLineData%LineUnOut = SrcLineData%LineUnOut -IF (ALLOCATED(SrcLineData%LineWrOutput)) THEN - i1_l = LBOUND(SrcLineData%LineWrOutput,1) - i1_u = UBOUND(SrcLineData%LineWrOutput,1) - IF (.NOT. ALLOCATED(DstLineData%LineWrOutput)) THEN - ALLOCATE(DstLineData%LineWrOutput(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcRodData%Dp)) THEN + i1_l = LBOUND(SrcRodData%Dp,1) + i1_u = UBOUND(SrcRodData%Dp,1) + i2_l = LBOUND(SrcRodData%Dp,2) + i2_u = UBOUND(SrcRodData%Dp,2) + IF (.NOT. ALLOCATED(DstRodData%Dp)) THEN + ALLOCATE(DstRodData%Dp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%LineWrOutput.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Dp.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLineData%LineWrOutput = SrcLineData%LineWrOutput + DstRodData%Dp = SrcRodData%Dp ENDIF - END SUBROUTINE MD_CopyLine +IF (ALLOCATED(SrcRodData%Dq)) THEN + i1_l = LBOUND(SrcRodData%Dq,1) + i1_u = UBOUND(SrcRodData%Dq,1) + i2_l = LBOUND(SrcRodData%Dq,2) + i2_u = UBOUND(SrcRodData%Dq,2) + IF (.NOT. ALLOCATED(DstRodData%Dq)) THEN + ALLOCATE(DstRodData%Dq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Dq.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRodData%Dq = SrcRodData%Dq +ENDIF +IF (ALLOCATED(SrcRodData%Ap)) THEN + i1_l = LBOUND(SrcRodData%Ap,1) + i1_u = UBOUND(SrcRodData%Ap,1) + i2_l = LBOUND(SrcRodData%Ap,2) + i2_u = UBOUND(SrcRodData%Ap,2) + IF (.NOT. ALLOCATED(DstRodData%Ap)) THEN + ALLOCATE(DstRodData%Ap(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Ap.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRodData%Ap = SrcRodData%Ap +ENDIF +IF (ALLOCATED(SrcRodData%Aq)) THEN + i1_l = LBOUND(SrcRodData%Aq,1) + i1_u = UBOUND(SrcRodData%Aq,1) + i2_l = LBOUND(SrcRodData%Aq,2) + i2_u = UBOUND(SrcRodData%Aq,2) + IF (.NOT. ALLOCATED(DstRodData%Aq)) THEN + ALLOCATE(DstRodData%Aq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Aq.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRodData%Aq = SrcRodData%Aq +ENDIF +IF (ALLOCATED(SrcRodData%B)) THEN + i1_l = LBOUND(SrcRodData%B,1) + i1_u = UBOUND(SrcRodData%B,1) + i2_l = LBOUND(SrcRodData%B,2) + i2_u = UBOUND(SrcRodData%B,2) + IF (.NOT. ALLOCATED(DstRodData%B)) THEN + ALLOCATE(DstRodData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRodData%B = SrcRodData%B +ENDIF +IF (ALLOCATED(SrcRodData%Fnet)) THEN + i1_l = LBOUND(SrcRodData%Fnet,1) + i1_u = UBOUND(SrcRodData%Fnet,1) + i2_l = LBOUND(SrcRodData%Fnet,2) + i2_u = UBOUND(SrcRodData%Fnet,2) + IF (.NOT. ALLOCATED(DstRodData%Fnet)) THEN + ALLOCATE(DstRodData%Fnet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%Fnet.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRodData%Fnet = SrcRodData%Fnet +ENDIF +IF (ALLOCATED(SrcRodData%M)) THEN + i1_l = LBOUND(SrcRodData%M,1) + i1_u = UBOUND(SrcRodData%M,1) + i2_l = LBOUND(SrcRodData%M,2) + i2_u = UBOUND(SrcRodData%M,2) + i3_l = LBOUND(SrcRodData%M,3) + i3_u = UBOUND(SrcRodData%M,3) + IF (.NOT. ALLOCATED(DstRodData%M)) THEN + ALLOCATE(DstRodData%M(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%M.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRodData%M = SrcRodData%M +ENDIF + DstRodData%FextA = SrcRodData%FextA + DstRodData%FextB = SrcRodData%FextB + DstRodData%Mext = SrcRodData%Mext + DstRodData%r6 = SrcRodData%r6 + DstRodData%v6 = SrcRodData%v6 + DstRodData%a6 = SrcRodData%a6 + DstRodData%F6net = SrcRodData%F6net + DstRodData%M6net = SrcRodData%M6net + DstRodData%OrMat = SrcRodData%OrMat + DstRodData%RodUnOut = SrcRodData%RodUnOut +IF (ALLOCATED(SrcRodData%RodWrOutput)) THEN + i1_l = LBOUND(SrcRodData%RodWrOutput,1) + i1_u = UBOUND(SrcRodData%RodWrOutput,1) + IF (.NOT. ALLOCATED(DstRodData%RodWrOutput)) THEN + ALLOCATE(DstRodData%RodWrOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRodData%RodWrOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRodData%RodWrOutput = SrcRodData%RodWrOutput +ENDIF + END SUBROUTINE MD_CopyRod - SUBROUTINE MD_DestroyLine( LineData, ErrStat, ErrMsg ) - TYPE(MD_Line), INTENT(INOUT) :: LineData + SUBROUTINE MD_DestroyRod( RodData, ErrStat, ErrMsg ) + TYPE(MD_Rod), INTENT(INOUT) :: RodData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyLine' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyRod' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(LineData%r)) THEN - DEALLOCATE(LineData%r) +IF (ALLOCATED(RodData%r)) THEN + DEALLOCATE(RodData%r) ENDIF -IF (ALLOCATED(LineData%rd)) THEN - DEALLOCATE(LineData%rd) +IF (ALLOCATED(RodData%rd)) THEN + DEALLOCATE(RodData%rd) ENDIF -IF (ALLOCATED(LineData%q)) THEN - DEALLOCATE(LineData%q) +IF (ALLOCATED(RodData%l)) THEN + DEALLOCATE(RodData%l) ENDIF -IF (ALLOCATED(LineData%l)) THEN - DEALLOCATE(LineData%l) +IF (ALLOCATED(RodData%V)) THEN + DEALLOCATE(RodData%V) ENDIF -IF (ALLOCATED(LineData%ld)) THEN - DEALLOCATE(LineData%ld) -ENDIF -IF (ALLOCATED(LineData%lstr)) THEN - DEALLOCATE(LineData%lstr) +IF (ALLOCATED(RodData%U)) THEN + DEALLOCATE(RodData%U) ENDIF -IF (ALLOCATED(LineData%lstrd)) THEN - DEALLOCATE(LineData%lstrd) +IF (ALLOCATED(RodData%Ud)) THEN + DEALLOCATE(RodData%Ud) ENDIF -IF (ALLOCATED(LineData%V)) THEN - DEALLOCATE(LineData%V) +IF (ALLOCATED(RodData%zeta)) THEN + DEALLOCATE(RodData%zeta) ENDIF -IF (ALLOCATED(LineData%T)) THEN - DEALLOCATE(LineData%T) +IF (ALLOCATED(RodData%PDyn)) THEN + DEALLOCATE(RodData%PDyn) ENDIF -IF (ALLOCATED(LineData%Td)) THEN - DEALLOCATE(LineData%Td) +IF (ALLOCATED(RodData%W)) THEN + DEALLOCATE(RodData%W) ENDIF -IF (ALLOCATED(LineData%W)) THEN - DEALLOCATE(LineData%W) +IF (ALLOCATED(RodData%Bo)) THEN + DEALLOCATE(RodData%Bo) ENDIF -IF (ALLOCATED(LineData%Dp)) THEN - DEALLOCATE(LineData%Dp) +IF (ALLOCATED(RodData%Pd)) THEN + DEALLOCATE(RodData%Pd) ENDIF -IF (ALLOCATED(LineData%Dq)) THEN - DEALLOCATE(LineData%Dq) +IF (ALLOCATED(RodData%Dp)) THEN + DEALLOCATE(RodData%Dp) ENDIF -IF (ALLOCATED(LineData%Ap)) THEN - DEALLOCATE(LineData%Ap) +IF (ALLOCATED(RodData%Dq)) THEN + DEALLOCATE(RodData%Dq) ENDIF -IF (ALLOCATED(LineData%Aq)) THEN - DEALLOCATE(LineData%Aq) +IF (ALLOCATED(RodData%Ap)) THEN + DEALLOCATE(RodData%Ap) ENDIF -IF (ALLOCATED(LineData%B)) THEN - DEALLOCATE(LineData%B) +IF (ALLOCATED(RodData%Aq)) THEN + DEALLOCATE(RodData%Aq) ENDIF -IF (ALLOCATED(LineData%F)) THEN - DEALLOCATE(LineData%F) +IF (ALLOCATED(RodData%B)) THEN + DEALLOCATE(RodData%B) ENDIF -IF (ALLOCATED(LineData%S)) THEN - DEALLOCATE(LineData%S) +IF (ALLOCATED(RodData%Fnet)) THEN + DEALLOCATE(RodData%Fnet) ENDIF -IF (ALLOCATED(LineData%M)) THEN - DEALLOCATE(LineData%M) +IF (ALLOCATED(RodData%M)) THEN + DEALLOCATE(RodData%M) ENDIF -IF (ALLOCATED(LineData%LineWrOutput)) THEN - DEALLOCATE(LineData%LineWrOutput) +IF (ALLOCATED(RodData%RodWrOutput)) THEN + DEALLOCATE(RodData%RodWrOutput) ENDIF - END SUBROUTINE MD_DestroyLine + END SUBROUTINE MD_DestroyRod - SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE MD_PackRod( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_Line), INTENT(IN) :: InData + TYPE(MD_Rod), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -1427,7 +3105,7 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackLine' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackRod' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -1445,14 +3123,32 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_BufSz = 0 Int_BufSz = Int_BufSz + 1 ! IdNum Int_BufSz = Int_BufSz + 1*LEN(InData%type) ! type - Int_BufSz = Int_BufSz + SIZE(InData%OutFlagList) ! OutFlagList - Int_BufSz = Int_BufSz + 1 ! CtrlChan - Int_BufSz = Int_BufSz + 1 ! FairConnect - Int_BufSz = Int_BufSz + 1 ! AnchConnect Int_BufSz = Int_BufSz + 1 ! PropsIdNum + Int_BufSz = Int_BufSz + 1 ! typeNum + Int_BufSz = Int_BufSz + SIZE(InData%AttachedA) ! AttachedA + Int_BufSz = Int_BufSz + SIZE(InData%AttachedB) ! AttachedB + Int_BufSz = Int_BufSz + SIZE(InData%TopA) ! TopA + Int_BufSz = Int_BufSz + SIZE(InData%TopB) ! TopB + Int_BufSz = Int_BufSz + 1 ! nAttachedA + Int_BufSz = Int_BufSz + 1 ! nAttachedB + Int_BufSz = Int_BufSz + SIZE(InData%OutFlagList) ! OutFlagList Int_BufSz = Int_BufSz + 1 ! N + Int_BufSz = Int_BufSz + 1 ! endTypeA + Int_BufSz = Int_BufSz + 1 ! endTypeB Db_BufSz = Db_BufSz + 1 ! UnstrLen - Db_BufSz = Db_BufSz + 1 ! BA + Db_BufSz = Db_BufSz + 1 ! mass + Db_BufSz = Db_BufSz + 1 ! rho + Db_BufSz = Db_BufSz + 1 ! d + Db_BufSz = Db_BufSz + 1 ! Can + Db_BufSz = Db_BufSz + 1 ! Cat + Db_BufSz = Db_BufSz + 1 ! Cdn + Db_BufSz = Db_BufSz + 1 ! Cdt + Db_BufSz = Db_BufSz + 1 ! CdEnd + Db_BufSz = Db_BufSz + 1 ! CaEnd + Db_BufSz = Db_BufSz + 1 ! time + Db_BufSz = Db_BufSz + 1 ! roll + Db_BufSz = Db_BufSz + 1 ! pitch + Db_BufSz = Db_BufSz + 1 ! h0 Int_BufSz = Int_BufSz + 1 ! r allocated yes/no IF ( ALLOCATED(InData%r) ) THEN Int_BufSz = Int_BufSz + 2*2 ! r upper/lower bounds for each dimension @@ -1463,51 +3159,52 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_BufSz = Int_BufSz + 2*2 ! rd upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%rd) ! rd END IF - Int_BufSz = Int_BufSz + 1 ! q allocated yes/no - IF ( ALLOCATED(InData%q) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! q upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%q) ! q - END IF Int_BufSz = Int_BufSz + 1 ! l allocated yes/no IF ( ALLOCATED(InData%l) ) THEN Int_BufSz = Int_BufSz + 2*1 ! l upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%l) ! l END IF - Int_BufSz = Int_BufSz + 1 ! ld allocated yes/no - IF ( ALLOCATED(InData%ld) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ld upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%ld) ! ld - END IF - Int_BufSz = Int_BufSz + 1 ! lstr allocated yes/no - IF ( ALLOCATED(InData%lstr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! lstr upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%lstr) ! lstr - END IF - Int_BufSz = Int_BufSz + 1 ! lstrd allocated yes/no - IF ( ALLOCATED(InData%lstrd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! lstrd upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%lstrd) ! lstrd - END IF Int_BufSz = Int_BufSz + 1 ! V allocated yes/no IF ( ALLOCATED(InData%V) ) THEN Int_BufSz = Int_BufSz + 2*1 ! V upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%V) ! V END IF - Int_BufSz = Int_BufSz + 1 ! T allocated yes/no - IF ( ALLOCATED(InData%T) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! T upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%T) ! T + Int_BufSz = Int_BufSz + 1 ! U allocated yes/no + IF ( ALLOCATED(InData%U) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! U upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%U) ! U END IF - Int_BufSz = Int_BufSz + 1 ! Td allocated yes/no - IF ( ALLOCATED(InData%Td) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Td upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%Td) ! Td + Int_BufSz = Int_BufSz + 1 ! Ud allocated yes/no + IF ( ALLOCATED(InData%Ud) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Ud upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Ud) ! Ud + END IF + Int_BufSz = Int_BufSz + 1 ! zeta allocated yes/no + IF ( ALLOCATED(InData%zeta) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! zeta upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%zeta) ! zeta + END IF + Int_BufSz = Int_BufSz + 1 ! PDyn allocated yes/no + IF ( ALLOCATED(InData%PDyn) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! PDyn upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%PDyn) ! PDyn END IF Int_BufSz = Int_BufSz + 1 ! W allocated yes/no IF ( ALLOCATED(InData%W) ) THEN Int_BufSz = Int_BufSz + 2*2 ! W upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%W) ! W END IF + Int_BufSz = Int_BufSz + 1 ! Bo allocated yes/no + IF ( ALLOCATED(InData%Bo) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Bo upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Bo) ! Bo + END IF + Int_BufSz = Int_BufSz + 1 ! Pd allocated yes/no + IF ( ALLOCATED(InData%Pd) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Pd upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Pd) ! Pd + END IF Int_BufSz = Int_BufSz + 1 ! Dp allocated yes/no IF ( ALLOCATED(InData%Dp) ) THEN Int_BufSz = Int_BufSz + 2*2 ! Dp upper/lower bounds for each dimension @@ -1533,26 +3230,30 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Int_BufSz = Int_BufSz + 2*2 ! B upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%B) ! B END IF - Int_BufSz = Int_BufSz + 1 ! F allocated yes/no - IF ( ALLOCATED(InData%F) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! F upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%F) ! F - END IF - Int_BufSz = Int_BufSz + 1 ! S allocated yes/no - IF ( ALLOCATED(InData%S) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! S upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%S) ! S + Int_BufSz = Int_BufSz + 1 ! Fnet allocated yes/no + IF ( ALLOCATED(InData%Fnet) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Fnet upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Fnet) ! Fnet END IF Int_BufSz = Int_BufSz + 1 ! M allocated yes/no IF ( ALLOCATED(InData%M) ) THEN Int_BufSz = Int_BufSz + 2*3 ! M upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%M) ! M END IF - Int_BufSz = Int_BufSz + 1 ! LineUnOut - Int_BufSz = Int_BufSz + 1 ! LineWrOutput allocated yes/no - IF ( ALLOCATED(InData%LineWrOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineWrOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%LineWrOutput) ! LineWrOutput + Db_BufSz = Db_BufSz + SIZE(InData%FextA) ! FextA + Db_BufSz = Db_BufSz + SIZE(InData%FextB) ! FextB + Db_BufSz = Db_BufSz + SIZE(InData%Mext) ! Mext + Db_BufSz = Db_BufSz + SIZE(InData%r6) ! r6 + Db_BufSz = Db_BufSz + SIZE(InData%v6) ! v6 + Db_BufSz = Db_BufSz + SIZE(InData%a6) ! a6 + Db_BufSz = Db_BufSz + SIZE(InData%F6net) ! F6net + Db_BufSz = Db_BufSz + SIZE(InData%M6net) ! M6net + Db_BufSz = Db_BufSz + SIZE(InData%OrMat) ! OrMat + Int_BufSz = Int_BufSz + 1 ! RodUnOut + Int_BufSz = Int_BufSz + 1 ! RodWrOutput allocated yes/no + IF ( ALLOCATED(InData%RodWrOutput) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RodWrOutput upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%RodWrOutput) ! RodWrOutput END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -1587,23 +3288,67 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf(Int_Xferred) = ICHAR(InData%type(I:I), IntKi) Int_Xferred = Int_Xferred + 1 END DO ! I - DO i1 = LBOUND(InData%OutFlagList,1), UBOUND(InData%OutFlagList,1) - IntKiBuf(Int_Xferred) = InData%OutFlagList(i1) + IntKiBuf(Int_Xferred) = InData%PropsIdNum + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%typeNum + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%AttachedA,1), UBOUND(InData%AttachedA,1) + IntKiBuf(Int_Xferred) = InData%AttachedA(i1) Int_Xferred = Int_Xferred + 1 END DO - IntKiBuf(Int_Xferred) = InData%CtrlChan + DO i1 = LBOUND(InData%AttachedB,1), UBOUND(InData%AttachedB,1) + IntKiBuf(Int_Xferred) = InData%AttachedB(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%TopA,1), UBOUND(InData%TopA,1) + IntKiBuf(Int_Xferred) = InData%TopA(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%TopB,1), UBOUND(InData%TopB,1) + IntKiBuf(Int_Xferred) = InData%TopB(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%nAttachedA Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%FairConnect + IntKiBuf(Int_Xferred) = InData%nAttachedB Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%AnchConnect + DO i1 = LBOUND(InData%OutFlagList,1), UBOUND(InData%OutFlagList,1) + IntKiBuf(Int_Xferred) = InData%OutFlagList(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%N Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%PropsIdNum + IntKiBuf(Int_Xferred) = InData%endTypeA Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%N + IntKiBuf(Int_Xferred) = InData%endTypeB Int_Xferred = Int_Xferred + 1 DbKiBuf(Db_Xferred) = InData%UnstrLen Db_Xferred = Db_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%BA + DbKiBuf(Db_Xferred) = InData%mass + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%rho + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%d + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Can + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Cat + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Cdn + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Cdt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CdEnd + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CaEnd + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%time + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%roll + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%pitch + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%h0 Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%r) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1645,157 +3390,166 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%q) ) THEN + DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) + DbKiBuf(Db_Xferred) = InData%q(i1) + Db_Xferred = Db_Xferred + 1 + END DO + IF ( .NOT. ALLOCATED(InData%l) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%q,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%l,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%l,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%q,2), UBOUND(InData%q,2) - DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) - DbKiBuf(Db_Xferred) = InData%q(i1,i2) - Db_Xferred = Db_Xferred + 1 - END DO + DO i1 = LBOUND(InData%l,1), UBOUND(InData%l,1) + DbKiBuf(Db_Xferred) = InData%l(i1) + Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%l) ) THEN + IF ( .NOT. ALLOCATED(InData%V) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%l,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%l,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%V,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%l,1), UBOUND(InData%l,1) - DbKiBuf(Db_Xferred) = InData%l(i1) + DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) + DbKiBuf(Db_Xferred) = InData%V(i1) Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%ld) ) THEN + IF ( .NOT. ALLOCATED(InData%U) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ld,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ld,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%U,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%U,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U,2) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%ld,1), UBOUND(InData%ld,1) - DbKiBuf(Db_Xferred) = InData%ld(i1) - Db_Xferred = Db_Xferred + 1 + DO i2 = LBOUND(InData%U,2), UBOUND(InData%U,2) + DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) + DbKiBuf(Db_Xferred) = InData%U(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%lstr) ) THEN + IF ( .NOT. ALLOCATED(InData%Ud) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%lstr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstr,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Ud,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ud,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Ud,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ud,2) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%lstr,1), UBOUND(InData%lstr,1) - DbKiBuf(Db_Xferred) = InData%lstr(i1) - Db_Xferred = Db_Xferred + 1 + DO i2 = LBOUND(InData%Ud,2), UBOUND(InData%Ud,2) + DO i1 = LBOUND(InData%Ud,1), UBOUND(InData%Ud,1) + DbKiBuf(Db_Xferred) = InData%Ud(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%lstrd) ) THEN + IF ( .NOT. ALLOCATED(InData%zeta) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%lstrd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstrd,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%zeta,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%lstrd,1), UBOUND(InData%lstrd,1) - DbKiBuf(Db_Xferred) = InData%lstrd(i1) + DO i1 = LBOUND(InData%zeta,1), UBOUND(InData%zeta,1) + DbKiBuf(Db_Xferred) = InData%zeta(i1) Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%V) ) THEN + IF ( .NOT. ALLOCATED(InData%PDyn) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) - DbKiBuf(Db_Xferred) = InData%V(i1) + DO i1 = LBOUND(InData%PDyn,1), UBOUND(InData%PDyn,1) + DbKiBuf(Db_Xferred) = InData%PDyn(i1) Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%T) ) THEN + IF ( .NOT. ALLOCATED(InData%W) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%W,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%T,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%W,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,2) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%T,2), UBOUND(InData%T,2) - DO i1 = LBOUND(InData%T,1), UBOUND(InData%T,1) - DbKiBuf(Db_Xferred) = InData%T(i1,i2) + DO i2 = LBOUND(InData%W,2), UBOUND(InData%W,2) + DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) + DbKiBuf(Db_Xferred) = InData%W(i1,i2) Db_Xferred = Db_Xferred + 1 END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%Td) ) THEN + IF ( .NOT. ALLOCATED(InData%Bo) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Td,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Td,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Bo,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bo,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Td,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Td,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Bo,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bo,2) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%Td,2), UBOUND(InData%Td,2) - DO i1 = LBOUND(InData%Td,1), UBOUND(InData%Td,1) - DbKiBuf(Db_Xferred) = InData%Td(i1,i2) + DO i2 = LBOUND(InData%Bo,2), UBOUND(InData%Bo,2) + DO i1 = LBOUND(InData%Bo,1), UBOUND(InData%Bo,1) + DbKiBuf(Db_Xferred) = InData%Bo(i1,i2) Db_Xferred = Db_Xferred + 1 END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%W) ) THEN + IF ( .NOT. ALLOCATED(InData%Pd) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Pd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%W,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Pd,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,2) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%W,2), UBOUND(InData%W,2) - DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) - DbKiBuf(Db_Xferred) = InData%W(i1,i2) + DO i2 = LBOUND(InData%Pd,2), UBOUND(InData%Pd,2) + DO i1 = LBOUND(InData%Pd,1), UBOUND(InData%Pd,1) + DbKiBuf(Db_Xferred) = InData%Pd(i1,i2) Db_Xferred = Db_Xferred + 1 END DO END DO @@ -1900,51 +3654,26 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%F) ) THEN + IF ( .NOT. ALLOCATED(InData%Fnet) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Fnet,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fnet,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%F,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Fnet,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fnet,2) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%F,2), UBOUND(InData%F,2) - DO i1 = LBOUND(InData%F,1), UBOUND(InData%F,1) - DbKiBuf(Db_Xferred) = InData%F(i1,i2) + DO i2 = LBOUND(InData%Fnet,2), UBOUND(InData%Fnet,2) + DO i1 = LBOUND(InData%Fnet,1), UBOUND(InData%Fnet,1) + DbKiBuf(Db_Xferred) = InData%Fnet(i1,i2) Db_Xferred = Db_Xferred + 1 END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%S) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%S,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%S,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%S,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%S,3), UBOUND(InData%S,3) - DO i2 = LBOUND(InData%S,2), UBOUND(InData%S,2) - DO i1 = LBOUND(InData%S,1), UBOUND(InData%S,1) - DbKiBuf(Db_Xferred) = InData%S(i1,i2,i3) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF IF ( .NOT. ALLOCATED(InData%M) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1970,30 +3699,70 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz END DO END DO END IF - IntKiBuf(Int_Xferred) = InData%LineUnOut - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LineWrOutput) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineWrOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineWrOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%LineWrOutput,1), UBOUND(InData%LineWrOutput,1) - ReKiBuf(Re_Xferred) = InData%LineWrOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackLine - - SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + DO i1 = LBOUND(InData%FextA,1), UBOUND(InData%FextA,1) + DbKiBuf(Db_Xferred) = InData%FextA(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FextB,1), UBOUND(InData%FextB,1) + DbKiBuf(Db_Xferred) = InData%FextB(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%Mext,1), UBOUND(InData%Mext,1) + DbKiBuf(Db_Xferred) = InData%Mext(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%r6,1), UBOUND(InData%r6,1) + DbKiBuf(Db_Xferred) = InData%r6(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%v6,1), UBOUND(InData%v6,1) + DbKiBuf(Db_Xferred) = InData%v6(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%a6,1), UBOUND(InData%a6,1) + DbKiBuf(Db_Xferred) = InData%a6(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F6net,1), UBOUND(InData%F6net,1) + DbKiBuf(Db_Xferred) = InData%F6net(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i2 = LBOUND(InData%M6net,2), UBOUND(InData%M6net,2) + DO i1 = LBOUND(InData%M6net,1), UBOUND(InData%M6net,1) + DbKiBuf(Db_Xferred) = InData%M6net(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%OrMat,2), UBOUND(InData%OrMat,2) + DO i1 = LBOUND(InData%OrMat,1), UBOUND(InData%OrMat,1) + DbKiBuf(Db_Xferred) = InData%OrMat(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + IntKiBuf(Int_Xferred) = InData%RodUnOut + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%RodWrOutput) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RodWrOutput,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodWrOutput,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%RodWrOutput,1), UBOUND(InData%RodWrOutput,1) + DbKiBuf(Db_Xferred) = InData%RodWrOutput(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE MD_PackRod + + SUBROUTINE MD_UnPackRod( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_Line), INTENT(INOUT) :: OutData + TYPE(MD_Rod), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -2007,7 +3776,7 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackLine' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackRod' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -2024,25 +3793,77 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) OutData%type(I:I) = CHAR(IntKiBuf(Int_Xferred)) Int_Xferred = Int_Xferred + 1 END DO ! I + OutData%PropsIdNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%typeNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%AttachedA,1) + i1_u = UBOUND(OutData%AttachedA,1) + DO i1 = LBOUND(OutData%AttachedA,1), UBOUND(OutData%AttachedA,1) + OutData%AttachedA(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + i1_l = LBOUND(OutData%AttachedB,1) + i1_u = UBOUND(OutData%AttachedB,1) + DO i1 = LBOUND(OutData%AttachedB,1), UBOUND(OutData%AttachedB,1) + OutData%AttachedB(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + i1_l = LBOUND(OutData%TopA,1) + i1_u = UBOUND(OutData%TopA,1) + DO i1 = LBOUND(OutData%TopA,1), UBOUND(OutData%TopA,1) + OutData%TopA(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + i1_l = LBOUND(OutData%TopB,1) + i1_u = UBOUND(OutData%TopB,1) + DO i1 = LBOUND(OutData%TopB,1), UBOUND(OutData%TopB,1) + OutData%TopB(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%nAttachedA = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nAttachedB = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%OutFlagList,1) i1_u = UBOUND(OutData%OutFlagList,1) DO i1 = LBOUND(OutData%OutFlagList,1), UBOUND(OutData%OutFlagList,1) OutData%OutFlagList(i1) = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 END DO - OutData%CtrlChan = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%FairConnect = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%AnchConnect = IntKiBuf(Int_Xferred) + OutData%N = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - OutData%PropsIdNum = IntKiBuf(Int_Xferred) + OutData%endTypeA = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - OutData%N = IntKiBuf(Int_Xferred) + OutData%endTypeB = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%UnstrLen = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - OutData%BA = DbKiBuf(Db_Xferred) + OutData%mass = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%rho = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%d = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Can = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Cat = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Cdn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Cdt = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%CdEnd = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%CaEnd = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%time = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%roll = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%pitch = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%h0 = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r not allocated Int_Xferred = Int_Xferred + 1 @@ -2090,120 +3911,131 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q not allocated + i1_l = LBOUND(OutData%q,1) + i1_u = UBOUND(OutData%q,1) + DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) + OutData%q(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! l not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%q)) DEALLOCATE(OutData%q) - ALLOCATE(OutData%q(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%l)) DEALLOCATE(OutData%l) + ALLOCATE(OutData%l(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%q,2), UBOUND(OutData%q,2) - DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) - OutData%q(i1,i2) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO + DO i1 = LBOUND(OutData%l,1), UBOUND(OutData%l,1) + OutData%l(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! l not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%l)) DEALLOCATE(OutData%l) - ALLOCATE(OutData%l(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%V)) DEALLOCATE(OutData%V) + ALLOCATE(OutData%V(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%l,1), UBOUND(OutData%l,1) - OutData%l(i1) = DbKiBuf(Db_Xferred) + DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) + OutData%V(i1) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ld not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ld)) DEALLOCATE(OutData%ld) - ALLOCATE(OutData%ld(i1_l:i1_u),STAT=ErrStat2) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%U)) DEALLOCATE(OutData%U) + ALLOCATE(OutData%U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ld.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%ld,1), UBOUND(OutData%ld,1) - OutData%ld(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 + DO i2 = LBOUND(OutData%U,2), UBOUND(OutData%U,2) + DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) + OutData%U(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lstr not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ud not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%lstr)) DEALLOCATE(OutData%lstr) - ALLOCATE(OutData%lstr(i1_l:i1_u),STAT=ErrStat2) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Ud)) DEALLOCATE(OutData%Ud) + ALLOCATE(OutData%Ud(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstr.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ud.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%lstr,1), UBOUND(OutData%lstr,1) - OutData%lstr(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 + DO i2 = LBOUND(OutData%Ud,2), UBOUND(OutData%Ud,2) + DO i1 = LBOUND(OutData%Ud,1), UBOUND(OutData%Ud,1) + OutData%Ud(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lstrd not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zeta not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%lstrd)) DEALLOCATE(OutData%lstrd) - ALLOCATE(OutData%lstrd(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%zeta)) DEALLOCATE(OutData%zeta) + ALLOCATE(OutData%zeta(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstrd.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%lstrd,1), UBOUND(OutData%lstrd,1) - OutData%lstrd(i1) = DbKiBuf(Db_Xferred) + DO i1 = LBOUND(OutData%zeta,1), UBOUND(OutData%zeta,1) + OutData%zeta(i1) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDyn not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%V)) DEALLOCATE(OutData%V) - ALLOCATE(OutData%V(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%PDyn)) DEALLOCATE(OutData%PDyn) + ALLOCATE(OutData%PDyn(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) - OutData%V(i1) = DbKiBuf(Db_Xferred) + DO i1 = LBOUND(OutData%PDyn,1), UBOUND(OutData%PDyn,1) + OutData%PDyn(i1) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -2213,20 +4045,20 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%T)) DEALLOCATE(OutData%T) - ALLOCATE(OutData%T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%W)) DEALLOCATE(OutData%W) + ALLOCATE(OutData%W(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%T,2), UBOUND(OutData%T,2) - DO i1 = LBOUND(OutData%T,1), UBOUND(OutData%T,1) - OutData%T(i1,i2) = DbKiBuf(Db_Xferred) + DO i2 = LBOUND(OutData%W,2), UBOUND(OutData%W,2) + DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) + OutData%W(i1,i2) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Td not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Bo not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -2236,20 +4068,20 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Td)) DEALLOCATE(OutData%Td) - ALLOCATE(OutData%Td(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Bo)) DEALLOCATE(OutData%Bo) + ALLOCATE(OutData%Bo(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Td.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bo.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%Td,2), UBOUND(OutData%Td,2) - DO i1 = LBOUND(OutData%Td,1), UBOUND(OutData%Td,1) - OutData%Td(i1,i2) = DbKiBuf(Db_Xferred) + DO i2 = LBOUND(OutData%Bo,2), UBOUND(OutData%Bo,2) + DO i1 = LBOUND(OutData%Bo,1), UBOUND(OutData%Bo,1) + OutData%Bo(i1,i2) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pd not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -2259,15 +4091,15 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%W)) DEALLOCATE(OutData%W) - ALLOCATE(OutData%W(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Pd)) DEALLOCATE(OutData%Pd) + ALLOCATE(OutData%Pd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%W,2), UBOUND(OutData%W,2) - DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) - OutData%W(i1,i2) = DbKiBuf(Db_Xferred) + DO i2 = LBOUND(OutData%Pd,2), UBOUND(OutData%Pd,2) + DO i1 = LBOUND(OutData%Pd,1), UBOUND(OutData%Pd,1) + OutData%Pd(i1,i2) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END DO @@ -2387,7 +4219,7 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fnet not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -2397,47 +4229,19 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%F)) DEALLOCATE(OutData%F) - ALLOCATE(OutData%F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Fnet)) DEALLOCATE(OutData%Fnet) + ALLOCATE(OutData%Fnet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fnet.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%F,2), UBOUND(OutData%F,2) - DO i1 = LBOUND(OutData%F,1), UBOUND(OutData%F,1) - OutData%F(i1,i2) = DbKiBuf(Db_Xferred) + DO i2 = LBOUND(OutData%Fnet,2), UBOUND(OutData%Fnet,2) + DO i1 = LBOUND(OutData%Fnet,1), UBOUND(OutData%Fnet,1) + OutData%Fnet(i1,i2) = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! S not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%S)) DEALLOCATE(OutData%S) - ALLOCATE(OutData%S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%S.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%S,3), UBOUND(OutData%S,3) - DO i2 = LBOUND(OutData%S,2), UBOUND(OutData%S,2) - DO i1 = LBOUND(OutData%S,1), UBOUND(OutData%S,1) - OutData%S(i1,i2,i3) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - END DO - END DO - END DO - END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2466,617 +4270,620 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) END DO END DO END IF - OutData%LineUnOut = IntKiBuf(Int_Xferred) + i1_l = LBOUND(OutData%FextA,1) + i1_u = UBOUND(OutData%FextA,1) + DO i1 = LBOUND(OutData%FextA,1), UBOUND(OutData%FextA,1) + OutData%FextA(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%FextB,1) + i1_u = UBOUND(OutData%FextB,1) + DO i1 = LBOUND(OutData%FextB,1), UBOUND(OutData%FextB,1) + OutData%FextB(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%Mext,1) + i1_u = UBOUND(OutData%Mext,1) + DO i1 = LBOUND(OutData%Mext,1), UBOUND(OutData%Mext,1) + OutData%Mext(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%r6,1) + i1_u = UBOUND(OutData%r6,1) + DO i1 = LBOUND(OutData%r6,1), UBOUND(OutData%r6,1) + OutData%r6(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%v6,1) + i1_u = UBOUND(OutData%v6,1) + DO i1 = LBOUND(OutData%v6,1), UBOUND(OutData%v6,1) + OutData%v6(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%a6,1) + i1_u = UBOUND(OutData%a6,1) + DO i1 = LBOUND(OutData%a6,1), UBOUND(OutData%a6,1) + OutData%a6(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%F6net,1) + i1_u = UBOUND(OutData%F6net,1) + DO i1 = LBOUND(OutData%F6net,1), UBOUND(OutData%F6net,1) + OutData%F6net(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%M6net,1) + i1_u = UBOUND(OutData%M6net,1) + i2_l = LBOUND(OutData%M6net,2) + i2_u = UBOUND(OutData%M6net,2) + DO i2 = LBOUND(OutData%M6net,2), UBOUND(OutData%M6net,2) + DO i1 = LBOUND(OutData%M6net,1), UBOUND(OutData%M6net,1) + OutData%M6net(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + i1_l = LBOUND(OutData%OrMat,1) + i1_u = UBOUND(OutData%OrMat,1) + i2_l = LBOUND(OutData%OrMat,2) + i2_u = UBOUND(OutData%OrMat,2) + DO i2 = LBOUND(OutData%OrMat,2), UBOUND(OutData%OrMat,2) + DO i1 = LBOUND(OutData%OrMat,1), UBOUND(OutData%OrMat,1) + OutData%OrMat(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + OutData%RodUnOut = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineWrOutput not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodWrOutput not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LineWrOutput)) DEALLOCATE(OutData%LineWrOutput) - ALLOCATE(OutData%LineWrOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%RodWrOutput)) DEALLOCATE(OutData%RodWrOutput) + ALLOCATE(OutData%RodWrOutput(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineWrOutput.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodWrOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%LineWrOutput,1), UBOUND(OutData%LineWrOutput,1) - OutData%LineWrOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%RodWrOutput,1), UBOUND(OutData%RodWrOutput,1) + OutData%RodWrOutput(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END DO END IF - END SUBROUTINE MD_UnPackLine + END SUBROUTINE MD_UnPackRod - SUBROUTINE MD_CopyOutParmType( SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_OutParmType), INTENT(IN) :: SrcOutParmTypeData - TYPE(MD_OutParmType), INTENT(INOUT) :: DstOutParmTypeData + SUBROUTINE MD_CopyLine( SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_Line), INTENT(IN) :: SrcLineData + TYPE(MD_Line), INTENT(INOUT) :: DstLineData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyOutParmType' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyLine' ! ErrStat = ErrID_None ErrMsg = "" - DstOutParmTypeData%Name = SrcOutParmTypeData%Name - DstOutParmTypeData%Units = SrcOutParmTypeData%Units - DstOutParmTypeData%QType = SrcOutParmTypeData%QType - DstOutParmTypeData%OType = SrcOutParmTypeData%OType - DstOutParmTypeData%NodeID = SrcOutParmTypeData%NodeID - DstOutParmTypeData%ObjID = SrcOutParmTypeData%ObjID - END SUBROUTINE MD_CopyOutParmType - - SUBROUTINE MD_DestroyOutParmType( OutParmTypeData, ErrStat, ErrMsg ) - TYPE(MD_OutParmType), INTENT(INOUT) :: OutParmTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyOutParmType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE MD_DestroyOutParmType - - SUBROUTINE MD_PackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_OutParmType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackOutParmType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1*LEN(InData%Name) ! Name - Int_BufSz = Int_BufSz + 1*LEN(InData%Units) ! Units - Int_BufSz = Int_BufSz + 1 ! QType - Int_BufSz = Int_BufSz + 1 ! OType - Int_BufSz = Int_BufSz + 1 ! NodeID - Int_BufSz = Int_BufSz + 1 ! ObjID - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DstLineData%IdNum = SrcLineData%IdNum + DstLineData%PropsIdNum = SrcLineData%PropsIdNum + DstLineData%ElasticMod = SrcLineData%ElasticMod + DstLineData%OutFlagList = SrcLineData%OutFlagList + DstLineData%CtrlChan = SrcLineData%CtrlChan + DstLineData%FairConnect = SrcLineData%FairConnect + DstLineData%AnchConnect = SrcLineData%AnchConnect + DstLineData%N = SrcLineData%N + DstLineData%endTypeA = SrcLineData%endTypeA + DstLineData%endTypeB = SrcLineData%endTypeB + DstLineData%UnstrLen = SrcLineData%UnstrLen + DstLineData%rho = SrcLineData%rho + DstLineData%d = SrcLineData%d + DstLineData%EA = SrcLineData%EA + DstLineData%EA_D = SrcLineData%EA_D + DstLineData%BA = SrcLineData%BA + DstLineData%BA_D = SrcLineData%BA_D + DstLineData%EI = SrcLineData%EI + DstLineData%Can = SrcLineData%Can + DstLineData%Cat = SrcLineData%Cat + DstLineData%Cdn = SrcLineData%Cdn + DstLineData%Cdt = SrcLineData%Cdt + DstLineData%nEApoints = SrcLineData%nEApoints + DstLineData%stiffXs = SrcLineData%stiffXs + DstLineData%stiffYs = SrcLineData%stiffYs + DstLineData%nBApoints = SrcLineData%nBApoints + DstLineData%dampXs = SrcLineData%dampXs + DstLineData%dampYs = SrcLineData%dampYs + DstLineData%nEIpoints = SrcLineData%nEIpoints + DstLineData%bstiffXs = SrcLineData%bstiffXs + DstLineData%bstiffYs = SrcLineData%bstiffYs + DstLineData%time = SrcLineData%time +IF (ALLOCATED(SrcLineData%r)) THEN + i1_l = LBOUND(SrcLineData%r,1) + i1_u = UBOUND(SrcLineData%r,1) + i2_l = LBOUND(SrcLineData%r,2) + i2_u = UBOUND(SrcLineData%r,2) + IF (.NOT. ALLOCATED(DstLineData%r)) THEN + ALLOCATE(DstLineData%r(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%r.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DstLineData%r = SrcLineData%r +ENDIF +IF (ALLOCATED(SrcLineData%rd)) THEN + i1_l = LBOUND(SrcLineData%rd,1) + i1_u = UBOUND(SrcLineData%rd,1) + i2_l = LBOUND(SrcLineData%rd,2) + i2_u = UBOUND(SrcLineData%rd,2) + IF (.NOT. ALLOCATED(DstLineData%rd)) THEN + ALLOCATE(DstLineData%rd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%rd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DstLineData%rd = SrcLineData%rd +ENDIF +IF (ALLOCATED(SrcLineData%q)) THEN + i1_l = LBOUND(SrcLineData%q,1) + i1_u = UBOUND(SrcLineData%q,1) + i2_l = LBOUND(SrcLineData%q,2) + i2_u = UBOUND(SrcLineData%q,2) + IF (.NOT. ALLOCATED(DstLineData%q)) THEN + ALLOCATE(DstLineData%q(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%q.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO I = 1, LEN(InData%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Units) - IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%QType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%OType - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NodeID - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%ObjID - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_PackOutParmType - - SUBROUTINE MD_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_OutParmType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackOutParmType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - DO I = 1, LEN(OutData%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Units) - OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%QType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%OType = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%NodeID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%ObjID = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_UnPackOutParmType - - SUBROUTINE MD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(MD_InitOutputType), INTENT(INOUT) :: DstInitOutputData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%writeOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%writeOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%writeOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%writeOutputHdr)) THEN - ALLOCATE(DstInitOutputData%writeOutputHdr(i1_l:i1_u),STAT=ErrStat2) + DstLineData%q = SrcLineData%q +ENDIF +IF (ALLOCATED(SrcLineData%qs)) THEN + i1_l = LBOUND(SrcLineData%qs,1) + i1_u = UBOUND(SrcLineData%qs,1) + i2_l = LBOUND(SrcLineData%qs,2) + i2_u = UBOUND(SrcLineData%qs,2) + IF (.NOT. ALLOCATED(DstLineData%qs)) THEN + ALLOCATE(DstLineData%qs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%writeOutputHdr.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%qs.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstInitOutputData%writeOutputHdr = SrcInitOutputData%writeOutputHdr + DstLineData%qs = SrcLineData%qs ENDIF -IF (ALLOCATED(SrcInitOutputData%writeOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%writeOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%writeOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%writeOutputUnt)) THEN - ALLOCATE(DstInitOutputData%writeOutputUnt(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLineData%l)) THEN + i1_l = LBOUND(SrcLineData%l,1) + i1_u = UBOUND(SrcLineData%l,1) + IF (.NOT. ALLOCATED(DstLineData%l)) THEN + ALLOCATE(DstLineData%l(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%writeOutputUnt.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%l.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstInitOutputData%writeOutputUnt = SrcInitOutputData%writeOutputUnt + DstLineData%l = SrcLineData%l ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInitOutputData%CableCChanRqst)) THEN - i1_l = LBOUND(SrcInitOutputData%CableCChanRqst,1) - i1_u = UBOUND(SrcInitOutputData%CableCChanRqst,1) - IF (.NOT. ALLOCATED(DstInitOutputData%CableCChanRqst)) THEN - ALLOCATE(DstInitOutputData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLineData%ld)) THEN + i1_l = LBOUND(SrcLineData%ld,1) + i1_u = UBOUND(SrcLineData%ld,1) + IF (.NOT. ALLOCATED(DstLineData%ld)) THEN + ALLOCATE(DstLineData%ld(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%ld.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst + DstLineData%ld = SrcLineData%ld ENDIF - END SUBROUTINE MD_CopyInitOutput - - SUBROUTINE MD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(MD_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyInitOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitOutputData%writeOutputHdr)) THEN - DEALLOCATE(InitOutputData%writeOutputHdr) +IF (ALLOCATED(SrcLineData%lstr)) THEN + i1_l = LBOUND(SrcLineData%lstr,1) + i1_u = UBOUND(SrcLineData%lstr,1) + IF (.NOT. ALLOCATED(DstLineData%lstr)) THEN + ALLOCATE(DstLineData%lstr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%lstr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLineData%lstr = SrcLineData%lstr ENDIF -IF (ALLOCATED(InitOutputData%writeOutputUnt)) THEN - DEALLOCATE(InitOutputData%writeOutputUnt) +IF (ALLOCATED(SrcLineData%lstrd)) THEN + i1_l = LBOUND(SrcLineData%lstrd,1) + i1_u = UBOUND(SrcLineData%lstrd,1) + IF (.NOT. ALLOCATED(DstLineData%lstrd)) THEN + ALLOCATE(DstLineData%lstrd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%lstrd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLineData%lstrd = SrcLineData%lstrd ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) -IF (ALLOCATED(InitOutputData%CableCChanRqst)) THEN - DEALLOCATE(InitOutputData%CableCChanRqst) +IF (ALLOCATED(SrcLineData%Kurv)) THEN + i1_l = LBOUND(SrcLineData%Kurv,1) + i1_u = UBOUND(SrcLineData%Kurv,1) + IF (.NOT. ALLOCATED(DstLineData%Kurv)) THEN + ALLOCATE(DstLineData%Kurv(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Kurv.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLineData%Kurv = SrcLineData%Kurv ENDIF - END SUBROUTINE MD_DestroyInitOutput - - SUBROUTINE MD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_InitOutputType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackInitOutput' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! writeOutputHdr allocated yes/no - IF ( ALLOCATED(InData%writeOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! writeOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%writeOutputHdr)*LEN(InData%writeOutputHdr) ! writeOutputHdr +IF (ALLOCATED(SrcLineData%dl_1)) THEN + i1_l = LBOUND(SrcLineData%dl_1,1) + i1_u = UBOUND(SrcLineData%dl_1,1) + IF (.NOT. ALLOCATED(DstLineData%dl_1)) THEN + ALLOCATE(DstLineData%dl_1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%dl_1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! writeOutputUnt allocated yes/no - IF ( ALLOCATED(InData%writeOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! writeOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%writeOutputUnt)*LEN(InData%writeOutputUnt) ! writeOutputUnt + DstLineData%dl_1 = SrcLineData%dl_1 +ENDIF +IF (ALLOCATED(SrcLineData%V)) THEN + i1_l = LBOUND(SrcLineData%V,1) + i1_u = UBOUND(SrcLineData%V,1) + IF (.NOT. ALLOCATED(DstLineData%V)) THEN + ALLOCATE(DstLineData%V(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%V.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! CableCChanRqst allocated yes/no - IF ( ALLOCATED(InData%CableCChanRqst) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! CableCChanRqst upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%CableCChanRqst) ! CableCChanRqst + DstLineData%V = SrcLineData%V +ENDIF +IF (ALLOCATED(SrcLineData%U)) THEN + i1_l = LBOUND(SrcLineData%U,1) + i1_u = UBOUND(SrcLineData%U,1) + i2_l = LBOUND(SrcLineData%U,2) + i2_u = UBOUND(SrcLineData%U,2) + IF (.NOT. ALLOCATED(DstLineData%U)) THEN + ALLOCATE(DstLineData%U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%U.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DstLineData%U = SrcLineData%U +ENDIF +IF (ALLOCATED(SrcLineData%Ud)) THEN + i1_l = LBOUND(SrcLineData%Ud,1) + i1_u = UBOUND(SrcLineData%Ud,1) + i2_l = LBOUND(SrcLineData%Ud,2) + i2_u = UBOUND(SrcLineData%Ud,2) + IF (.NOT. ALLOCATED(DstLineData%Ud)) THEN + ALLOCATE(DstLineData%Ud(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Ud.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DstLineData%Ud = SrcLineData%Ud +ENDIF +IF (ALLOCATED(SrcLineData%zeta)) THEN + i1_l = LBOUND(SrcLineData%zeta,1) + i1_u = UBOUND(SrcLineData%zeta,1) + IF (.NOT. ALLOCATED(DstLineData%zeta)) THEN + ALLOCATE(DstLineData%zeta(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%zeta.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DstLineData%zeta = SrcLineData%zeta +ENDIF +IF (ALLOCATED(SrcLineData%PDyn)) THEN + i1_l = LBOUND(SrcLineData%PDyn,1) + i1_u = UBOUND(SrcLineData%PDyn,1) + IF (.NOT. ALLOCATED(DstLineData%PDyn)) THEN + ALLOCATE(DstLineData%PDyn(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%PDyn.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%writeOutputHdr) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%writeOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%writeOutputHdr,1), UBOUND(InData%writeOutputHdr,1) - DO I = 1, LEN(InData%writeOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%writeOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO + DstLineData%PDyn = SrcLineData%PDyn +ENDIF +IF (ALLOCATED(SrcLineData%T)) THEN + i1_l = LBOUND(SrcLineData%T,1) + i1_u = UBOUND(SrcLineData%T,1) + i2_l = LBOUND(SrcLineData%T,2) + i2_u = UBOUND(SrcLineData%T,2) + IF (.NOT. ALLOCATED(DstLineData%T)) THEN + ALLOCATE(DstLineData%T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%T.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%writeOutputUnt) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%writeOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%writeOutputUnt,1), UBOUND(InData%writeOutputUnt,1) - DO I = 1, LEN(InData%writeOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%writeOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO + DstLineData%T = SrcLineData%T +ENDIF +IF (ALLOCATED(SrcLineData%Td)) THEN + i1_l = LBOUND(SrcLineData%Td,1) + i1_u = UBOUND(SrcLineData%Td,1) + i2_l = LBOUND(SrcLineData%Td,2) + i2_u = UBOUND(SrcLineData%Td,2) + IF (.NOT. ALLOCATED(DstLineData%Td)) THEN + ALLOCATE(DstLineData%Td(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Td.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%CableCChanRqst) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CableCChanRqst,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableCChanRqst,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%CableCChanRqst,1), UBOUND(InData%CableCChanRqst,1) - IntKiBuf(Int_Xferred) = TRANSFER(InData%CableCChanRqst(i1), IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END DO + DstLineData%Td = SrcLineData%Td +ENDIF +IF (ALLOCATED(SrcLineData%W)) THEN + i1_l = LBOUND(SrcLineData%W,1) + i1_u = UBOUND(SrcLineData%W,1) + i2_l = LBOUND(SrcLineData%W,2) + i2_u = UBOUND(SrcLineData%W,2) + IF (.NOT. ALLOCATED(DstLineData%W)) THEN + ALLOCATE(DstLineData%W(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%W.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - END SUBROUTINE MD_PackInitOutput - - SUBROUTINE MD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_InitOutputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackInitOutput' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! writeOutputHdr not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%writeOutputHdr)) DEALLOCATE(OutData%writeOutputHdr) - ALLOCATE(OutData%writeOutputHdr(i1_l:i1_u),STAT=ErrStat2) + DstLineData%W = SrcLineData%W +ENDIF +IF (ALLOCATED(SrcLineData%Dp)) THEN + i1_l = LBOUND(SrcLineData%Dp,1) + i1_u = UBOUND(SrcLineData%Dp,1) + i2_l = LBOUND(SrcLineData%Dp,2) + i2_u = UBOUND(SrcLineData%Dp,2) + IF (.NOT. ALLOCATED(DstLineData%Dp)) THEN + ALLOCATE(DstLineData%Dp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Dp.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%writeOutputHdr,1), UBOUND(OutData%writeOutputHdr,1) - DO I = 1, LEN(OutData%writeOutputHdr) - OutData%writeOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! writeOutputUnt not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%writeOutputUnt)) DEALLOCATE(OutData%writeOutputUnt) - ALLOCATE(OutData%writeOutputUnt(i1_l:i1_u),STAT=ErrStat2) + DstLineData%Dp = SrcLineData%Dp +ENDIF +IF (ALLOCATED(SrcLineData%Dq)) THEN + i1_l = LBOUND(SrcLineData%Dq,1) + i1_u = UBOUND(SrcLineData%Dq,1) + i2_l = LBOUND(SrcLineData%Dq,2) + i2_u = UBOUND(SrcLineData%Dq,2) + IF (.NOT. ALLOCATED(DstLineData%Dq)) THEN + ALLOCATE(DstLineData%Dq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Dq.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%writeOutputUnt,1), UBOUND(OutData%writeOutputUnt,1) - DO I = 1, LEN(OutData%writeOutputUnt) - OutData%writeOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableCChanRqst not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CableCChanRqst)) DEALLOCATE(OutData%CableCChanRqst) - ALLOCATE(OutData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) + DstLineData%Dq = SrcLineData%Dq +ENDIF +IF (ALLOCATED(SrcLineData%Ap)) THEN + i1_l = LBOUND(SrcLineData%Ap,1) + i1_u = UBOUND(SrcLineData%Ap,1) + i2_l = LBOUND(SrcLineData%Ap,2) + i2_u = UBOUND(SrcLineData%Ap,2) + IF (.NOT. ALLOCATED(DstLineData%Ap)) THEN + ALLOCATE(DstLineData%Ap(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Ap.', ErrStat, ErrMsg,RoutineName) + RETURN END IF - DO i1 = LBOUND(OutData%CableCChanRqst,1), UBOUND(OutData%CableCChanRqst,1) - OutData%CableCChanRqst(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%CableCChanRqst(i1)) - Int_Xferred = Int_Xferred + 1 - END DO END IF - END SUBROUTINE MD_UnPackInitOutput - - SUBROUTINE MD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(MD_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcContStateData%states)) THEN - i1_l = LBOUND(SrcContStateData%states,1) - i1_u = UBOUND(SrcContStateData%states,1) - IF (.NOT. ALLOCATED(DstContStateData%states)) THEN - ALLOCATE(DstContStateData%states(i1_l:i1_u),STAT=ErrStat2) + DstLineData%Ap = SrcLineData%Ap +ENDIF +IF (ALLOCATED(SrcLineData%Aq)) THEN + i1_l = LBOUND(SrcLineData%Aq,1) + i1_u = UBOUND(SrcLineData%Aq,1) + i2_l = LBOUND(SrcLineData%Aq,2) + i2_u = UBOUND(SrcLineData%Aq,2) + IF (.NOT. ALLOCATED(DstLineData%Aq)) THEN + ALLOCATE(DstLineData%Aq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%states.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Aq.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstContStateData%states = SrcContStateData%states + DstLineData%Aq = SrcLineData%Aq ENDIF - END SUBROUTINE MD_CopyContState +IF (ALLOCATED(SrcLineData%B)) THEN + i1_l = LBOUND(SrcLineData%B,1) + i1_u = UBOUND(SrcLineData%B,1) + i2_l = LBOUND(SrcLineData%B,2) + i2_u = UBOUND(SrcLineData%B,2) + IF (.NOT. ALLOCATED(DstLineData%B)) THEN + ALLOCATE(DstLineData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLineData%B = SrcLineData%B +ENDIF +IF (ALLOCATED(SrcLineData%Bs)) THEN + i1_l = LBOUND(SrcLineData%Bs,1) + i1_u = UBOUND(SrcLineData%Bs,1) + i2_l = LBOUND(SrcLineData%Bs,2) + i2_u = UBOUND(SrcLineData%Bs,2) + IF (.NOT. ALLOCATED(DstLineData%Bs)) THEN + ALLOCATE(DstLineData%Bs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Bs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLineData%Bs = SrcLineData%Bs +ENDIF +IF (ALLOCATED(SrcLineData%Fnet)) THEN + i1_l = LBOUND(SrcLineData%Fnet,1) + i1_u = UBOUND(SrcLineData%Fnet,1) + i2_l = LBOUND(SrcLineData%Fnet,2) + i2_u = UBOUND(SrcLineData%Fnet,2) + IF (.NOT. ALLOCATED(DstLineData%Fnet)) THEN + ALLOCATE(DstLineData%Fnet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%Fnet.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLineData%Fnet = SrcLineData%Fnet +ENDIF +IF (ALLOCATED(SrcLineData%S)) THEN + i1_l = LBOUND(SrcLineData%S,1) + i1_u = UBOUND(SrcLineData%S,1) + i2_l = LBOUND(SrcLineData%S,2) + i2_u = UBOUND(SrcLineData%S,2) + i3_l = LBOUND(SrcLineData%S,3) + i3_u = UBOUND(SrcLineData%S,3) + IF (.NOT. ALLOCATED(DstLineData%S)) THEN + ALLOCATE(DstLineData%S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%S.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLineData%S = SrcLineData%S +ENDIF +IF (ALLOCATED(SrcLineData%M)) THEN + i1_l = LBOUND(SrcLineData%M,1) + i1_u = UBOUND(SrcLineData%M,1) + i2_l = LBOUND(SrcLineData%M,2) + i2_u = UBOUND(SrcLineData%M,2) + i3_l = LBOUND(SrcLineData%M,3) + i3_u = UBOUND(SrcLineData%M,3) + IF (.NOT. ALLOCATED(DstLineData%M)) THEN + ALLOCATE(DstLineData%M(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%M.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLineData%M = SrcLineData%M +ENDIF + DstLineData%EndMomentA = SrcLineData%EndMomentA + DstLineData%EndMomentB = SrcLineData%EndMomentB + DstLineData%LineUnOut = SrcLineData%LineUnOut +IF (ALLOCATED(SrcLineData%LineWrOutput)) THEN + i1_l = LBOUND(SrcLineData%LineWrOutput,1) + i1_u = UBOUND(SrcLineData%LineWrOutput,1) + IF (.NOT. ALLOCATED(DstLineData%LineWrOutput)) THEN + ALLOCATE(DstLineData%LineWrOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLineData%LineWrOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLineData%LineWrOutput = SrcLineData%LineWrOutput +ENDIF + END SUBROUTINE MD_CopyLine - SUBROUTINE MD_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(MD_ContinuousStateType), INTENT(INOUT) :: ContStateData + SUBROUTINE MD_DestroyLine( LineData, ErrStat, ErrMsg ) + TYPE(MD_Line), INTENT(INOUT) :: LineData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyContState' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyLine' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(ContStateData%states)) THEN - DEALLOCATE(ContStateData%states) +IF (ALLOCATED(LineData%r)) THEN + DEALLOCATE(LineData%r) ENDIF - END SUBROUTINE MD_DestroyContState +IF (ALLOCATED(LineData%rd)) THEN + DEALLOCATE(LineData%rd) +ENDIF +IF (ALLOCATED(LineData%q)) THEN + DEALLOCATE(LineData%q) +ENDIF +IF (ALLOCATED(LineData%qs)) THEN + DEALLOCATE(LineData%qs) +ENDIF +IF (ALLOCATED(LineData%l)) THEN + DEALLOCATE(LineData%l) +ENDIF +IF (ALLOCATED(LineData%ld)) THEN + DEALLOCATE(LineData%ld) +ENDIF +IF (ALLOCATED(LineData%lstr)) THEN + DEALLOCATE(LineData%lstr) +ENDIF +IF (ALLOCATED(LineData%lstrd)) THEN + DEALLOCATE(LineData%lstrd) +ENDIF +IF (ALLOCATED(LineData%Kurv)) THEN + DEALLOCATE(LineData%Kurv) +ENDIF +IF (ALLOCATED(LineData%dl_1)) THEN + DEALLOCATE(LineData%dl_1) +ENDIF +IF (ALLOCATED(LineData%V)) THEN + DEALLOCATE(LineData%V) +ENDIF +IF (ALLOCATED(LineData%U)) THEN + DEALLOCATE(LineData%U) +ENDIF +IF (ALLOCATED(LineData%Ud)) THEN + DEALLOCATE(LineData%Ud) +ENDIF +IF (ALLOCATED(LineData%zeta)) THEN + DEALLOCATE(LineData%zeta) +ENDIF +IF (ALLOCATED(LineData%PDyn)) THEN + DEALLOCATE(LineData%PDyn) +ENDIF +IF (ALLOCATED(LineData%T)) THEN + DEALLOCATE(LineData%T) +ENDIF +IF (ALLOCATED(LineData%Td)) THEN + DEALLOCATE(LineData%Td) +ENDIF +IF (ALLOCATED(LineData%W)) THEN + DEALLOCATE(LineData%W) +ENDIF +IF (ALLOCATED(LineData%Dp)) THEN + DEALLOCATE(LineData%Dp) +ENDIF +IF (ALLOCATED(LineData%Dq)) THEN + DEALLOCATE(LineData%Dq) +ENDIF +IF (ALLOCATED(LineData%Ap)) THEN + DEALLOCATE(LineData%Ap) +ENDIF +IF (ALLOCATED(LineData%Aq)) THEN + DEALLOCATE(LineData%Aq) +ENDIF +IF (ALLOCATED(LineData%B)) THEN + DEALLOCATE(LineData%B) +ENDIF +IF (ALLOCATED(LineData%Bs)) THEN + DEALLOCATE(LineData%Bs) +ENDIF +IF (ALLOCATED(LineData%Fnet)) THEN + DEALLOCATE(LineData%Fnet) +ENDIF +IF (ALLOCATED(LineData%S)) THEN + DEALLOCATE(LineData%S) +ENDIF +IF (ALLOCATED(LineData%M)) THEN + DEALLOCATE(LineData%M) +ENDIF +IF (ALLOCATED(LineData%LineWrOutput)) THEN + DEALLOCATE(LineData%LineWrOutput) +ENDIF + END SUBROUTINE MD_DestroyLine - SUBROUTINE MD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_ContinuousStateType), INTENT(IN) :: InData + TYPE(MD_Line), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -3091,7 +4898,7 @@ SUBROUTINE MD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackContState' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackLine' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -3107,10 +4914,180 @@ SUBROUTINE MD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! states allocated yes/no - IF ( ALLOCATED(InData%states) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! states upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%states) ! states + Int_BufSz = Int_BufSz + 1 ! IdNum + Int_BufSz = Int_BufSz + 1 ! PropsIdNum + Int_BufSz = Int_BufSz + 1 ! ElasticMod + Int_BufSz = Int_BufSz + SIZE(InData%OutFlagList) ! OutFlagList + Int_BufSz = Int_BufSz + 1 ! CtrlChan + Int_BufSz = Int_BufSz + 1 ! FairConnect + Int_BufSz = Int_BufSz + 1 ! AnchConnect + Int_BufSz = Int_BufSz + 1 ! N + Int_BufSz = Int_BufSz + 1 ! endTypeA + Int_BufSz = Int_BufSz + 1 ! endTypeB + Db_BufSz = Db_BufSz + 1 ! UnstrLen + Db_BufSz = Db_BufSz + 1 ! rho + Db_BufSz = Db_BufSz + 1 ! d + Db_BufSz = Db_BufSz + 1 ! EA + Db_BufSz = Db_BufSz + 1 ! EA_D + Db_BufSz = Db_BufSz + 1 ! BA + Db_BufSz = Db_BufSz + 1 ! BA_D + Db_BufSz = Db_BufSz + 1 ! EI + Db_BufSz = Db_BufSz + 1 ! Can + Db_BufSz = Db_BufSz + 1 ! Cat + Db_BufSz = Db_BufSz + 1 ! Cdn + Db_BufSz = Db_BufSz + 1 ! Cdt + Int_BufSz = Int_BufSz + 1 ! nEApoints + Db_BufSz = Db_BufSz + SIZE(InData%stiffXs) ! stiffXs + Db_BufSz = Db_BufSz + SIZE(InData%stiffYs) ! stiffYs + Int_BufSz = Int_BufSz + 1 ! nBApoints + Db_BufSz = Db_BufSz + SIZE(InData%dampXs) ! dampXs + Db_BufSz = Db_BufSz + SIZE(InData%dampYs) ! dampYs + Int_BufSz = Int_BufSz + 1 ! nEIpoints + Db_BufSz = Db_BufSz + SIZE(InData%bstiffXs) ! bstiffXs + Db_BufSz = Db_BufSz + SIZE(InData%bstiffYs) ! bstiffYs + Db_BufSz = Db_BufSz + 1 ! time + Int_BufSz = Int_BufSz + 1 ! r allocated yes/no + IF ( ALLOCATED(InData%r) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! r upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%r) ! r + END IF + Int_BufSz = Int_BufSz + 1 ! rd allocated yes/no + IF ( ALLOCATED(InData%rd) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! rd upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%rd) ! rd + END IF + Int_BufSz = Int_BufSz + 1 ! q allocated yes/no + IF ( ALLOCATED(InData%q) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! q upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%q) ! q + END IF + Int_BufSz = Int_BufSz + 1 ! qs allocated yes/no + IF ( ALLOCATED(InData%qs) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! qs upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%qs) ! qs + END IF + Int_BufSz = Int_BufSz + 1 ! l allocated yes/no + IF ( ALLOCATED(InData%l) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! l upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%l) ! l + END IF + Int_BufSz = Int_BufSz + 1 ! ld allocated yes/no + IF ( ALLOCATED(InData%ld) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ld upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%ld) ! ld + END IF + Int_BufSz = Int_BufSz + 1 ! lstr allocated yes/no + IF ( ALLOCATED(InData%lstr) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! lstr upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%lstr) ! lstr + END IF + Int_BufSz = Int_BufSz + 1 ! lstrd allocated yes/no + IF ( ALLOCATED(InData%lstrd) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! lstrd upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%lstrd) ! lstrd + END IF + Int_BufSz = Int_BufSz + 1 ! Kurv allocated yes/no + IF ( ALLOCATED(InData%Kurv) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Kurv upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Kurv) ! Kurv + END IF + Int_BufSz = Int_BufSz + 1 ! dl_1 allocated yes/no + IF ( ALLOCATED(InData%dl_1) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! dl_1 upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%dl_1) ! dl_1 + END IF + Int_BufSz = Int_BufSz + 1 ! V allocated yes/no + IF ( ALLOCATED(InData%V) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! V upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%V) ! V + END IF + Int_BufSz = Int_BufSz + 1 ! U allocated yes/no + IF ( ALLOCATED(InData%U) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! U upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%U) ! U + END IF + Int_BufSz = Int_BufSz + 1 ! Ud allocated yes/no + IF ( ALLOCATED(InData%Ud) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Ud upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Ud) ! Ud + END IF + Int_BufSz = Int_BufSz + 1 ! zeta allocated yes/no + IF ( ALLOCATED(InData%zeta) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! zeta upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%zeta) ! zeta + END IF + Int_BufSz = Int_BufSz + 1 ! PDyn allocated yes/no + IF ( ALLOCATED(InData%PDyn) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! PDyn upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%PDyn) ! PDyn + END IF + Int_BufSz = Int_BufSz + 1 ! T allocated yes/no + IF ( ALLOCATED(InData%T) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! T upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%T) ! T + END IF + Int_BufSz = Int_BufSz + 1 ! Td allocated yes/no + IF ( ALLOCATED(InData%Td) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Td upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Td) ! Td + END IF + Int_BufSz = Int_BufSz + 1 ! W allocated yes/no + IF ( ALLOCATED(InData%W) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! W upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%W) ! W + END IF + Int_BufSz = Int_BufSz + 1 ! Dp allocated yes/no + IF ( ALLOCATED(InData%Dp) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Dp upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Dp) ! Dp + END IF + Int_BufSz = Int_BufSz + 1 ! Dq allocated yes/no + IF ( ALLOCATED(InData%Dq) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Dq upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Dq) ! Dq + END IF + Int_BufSz = Int_BufSz + 1 ! Ap allocated yes/no + IF ( ALLOCATED(InData%Ap) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Ap upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Ap) ! Ap + END IF + Int_BufSz = Int_BufSz + 1 ! Aq allocated yes/no + IF ( ALLOCATED(InData%Aq) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Aq upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Aq) ! Aq + END IF + Int_BufSz = Int_BufSz + 1 ! B allocated yes/no + IF ( ALLOCATED(InData%B) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! B upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%B) ! B + END IF + Int_BufSz = Int_BufSz + 1 ! Bs allocated yes/no + IF ( ALLOCATED(InData%Bs) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Bs upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Bs) ! Bs + END IF + Int_BufSz = Int_BufSz + 1 ! Fnet allocated yes/no + IF ( ALLOCATED(InData%Fnet) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Fnet upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Fnet) ! Fnet + END IF + Int_BufSz = Int_BufSz + 1 ! S allocated yes/no + IF ( ALLOCATED(InData%S) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! S upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%S) ! S + END IF + Int_BufSz = Int_BufSz + 1 ! M allocated yes/no + IF ( ALLOCATED(InData%M) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! M upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%M) ! M + END IF + Db_BufSz = Db_BufSz + SIZE(InData%EndMomentA) ! EndMomentA + Db_BufSz = Db_BufSz + SIZE(InData%EndMomentB) ! EndMomentB + Int_BufSz = Int_BufSz + 1 ! LineUnOut + Int_BufSz = Int_BufSz + 1 ! LineWrOutput allocated yes/no + IF ( ALLOCATED(InData%LineWrOutput) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LineWrOutput upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%LineWrOutput) ! LineWrOutput END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -3139,604 +5116,5974 @@ SUBROUTINE MD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - IF ( .NOT. ALLOCATED(InData%states) ) THEN + IntKiBuf(Int_Xferred) = InData%IdNum + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PropsIdNum + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ElasticMod + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%OutFlagList,1), UBOUND(InData%OutFlagList,1) + IntKiBuf(Int_Xferred) = InData%OutFlagList(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%CtrlChan + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%FairConnect + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AnchConnect + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%N + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%endTypeA + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%endTypeB + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%UnstrLen + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%rho + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%d + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%EA + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%EA_D + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%BA + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%BA_D + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%EI + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Can + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Cat + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Cdn + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Cdt + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nEApoints + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%stiffXs,1), UBOUND(InData%stiffXs,1) + DbKiBuf(Db_Xferred) = InData%stiffXs(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%stiffYs,1), UBOUND(InData%stiffYs,1) + DbKiBuf(Db_Xferred) = InData%stiffYs(i1) + Db_Xferred = Db_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%nBApoints + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%dampXs,1), UBOUND(InData%dampXs,1) + DbKiBuf(Db_Xferred) = InData%dampXs(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%dampYs,1), UBOUND(InData%dampYs,1) + DbKiBuf(Db_Xferred) = InData%dampYs(i1) + Db_Xferred = Db_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%nEIpoints + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%bstiffXs,1), UBOUND(InData%bstiffXs,1) + DbKiBuf(Db_Xferred) = InData%bstiffXs(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%bstiffYs,1), UBOUND(InData%bstiffYs,1) + DbKiBuf(Db_Xferred) = InData%bstiffYs(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%time + Db_Xferred = Db_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%r) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%states,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%states,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%r,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,2) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%states,1), UBOUND(InData%states,1) - DbKiBuf(Db_Xferred) = InData%states(i1) - Db_Xferred = Db_Xferred + 1 + DO i2 = LBOUND(InData%r,2), UBOUND(InData%r,2) + DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) + DbKiBuf(Db_Xferred) = InData%r(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO END DO END IF - END SUBROUTINE MD_PackContState - - SUBROUTINE MD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_ContinuousStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackContState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! states not allocated + IF ( .NOT. ALLOCATED(InData%rd) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%rd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rd,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%states)) DEALLOCATE(OutData%states) - ALLOCATE(OutData%states(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%states.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%states,1), UBOUND(OutData%states,1) - OutData%states(i1) = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%rd,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rd,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%rd,2), UBOUND(InData%rd,2) + DO i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) + DbKiBuf(Db_Xferred) = InData%rd(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO END DO END IF - END SUBROUTINE MD_UnPackContState + IF ( .NOT. ALLOCATED(InData%q) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%q,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%q,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,2) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE MD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(MD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstDiscStateData%dummy = SrcDiscStateData%dummy - END SUBROUTINE MD_CopyDiscState + DO i2 = LBOUND(InData%q,2), UBOUND(InData%q,2) + DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) + DbKiBuf(Db_Xferred) = InData%q(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%qs) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%qs,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qs,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%qs,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qs,2) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE MD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(MD_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyDiscState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE MD_DestroyDiscState + DO i2 = LBOUND(InData%qs,2), UBOUND(InData%qs,2) + DO i1 = LBOUND(InData%qs,1), UBOUND(InData%qs,1) + DbKiBuf(Db_Xferred) = InData%qs(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%l) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%l,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%l,1) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE MD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_DiscreteStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackDiscState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + DO i1 = LBOUND(InData%l,1), UBOUND(InData%l,1) + DbKiBuf(Db_Xferred) = InData%l(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ld) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ld,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ld,1) + Int_Xferred = Int_Xferred + 2 - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DO i1 = LBOUND(InData%ld,1), UBOUND(InData%ld,1) + DbKiBuf(Db_Xferred) = InData%ld(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF ( .NOT. ALLOCATED(InData%lstr) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%lstr,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstr,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%lstr,1), UBOUND(InData%lstr,1) + DbKiBuf(Db_Xferred) = InData%lstr(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF ( .NOT. ALLOCATED(InData%lstrd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%lstrd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstrd,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%lstrd,1), UBOUND(InData%lstrd,1) + DbKiBuf(Db_Xferred) = InData%lstrd(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + IF ( .NOT. ALLOCATED(InData%Kurv) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Kurv,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kurv,1) + Int_Xferred = Int_Xferred + 2 - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 + DO i1 = LBOUND(InData%Kurv,1), UBOUND(InData%Kurv,1) + DbKiBuf(Db_Xferred) = InData%Kurv(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%dl_1) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dl_1,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl_1,1) + Int_Xferred = Int_Xferred + 2 - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_PackDiscState + DO i1 = LBOUND(InData%dl_1,1), UBOUND(InData%dl_1,1) + DbKiBuf(Db_Xferred) = InData%dl_1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%V) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%V,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE MD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_DiscreteStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackDiscState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_UnPackDiscState + DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) + DbKiBuf(Db_Xferred) = InData%V(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%U) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%U,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%U,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U,2) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE MD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(MD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%dummy = SrcConstrStateData%dummy - END SUBROUTINE MD_CopyConstrState + DO i2 = LBOUND(InData%U,2), UBOUND(InData%U,2) + DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) + DbKiBuf(Db_Xferred) = InData%U(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Ud) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Ud,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ud,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Ud,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ud,2) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE MD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(MD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyConstrState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE MD_DestroyConstrState + DO i2 = LBOUND(InData%Ud,2), UBOUND(InData%Ud,2) + DO i1 = LBOUND(InData%Ud,1), UBOUND(InData%Ud,1) + DbKiBuf(Db_Xferred) = InData%Ud(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%zeta) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%zeta,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,1) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE MD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_ConstraintStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackConstrState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + DO i1 = LBOUND(InData%zeta,1), UBOUND(InData%zeta,1) + DbKiBuf(Db_Xferred) = InData%zeta(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PDyn) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,1) + Int_Xferred = Int_Xferred + 2 - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DO i1 = LBOUND(InData%PDyn,1), UBOUND(InData%PDyn,1) + DbKiBuf(Db_Xferred) = InData%PDyn(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + IF ( .NOT. ALLOCATED(InData%T) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%T,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%T,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%T,2), UBOUND(InData%T,2) + DO i1 = LBOUND(InData%T,1), UBOUND(InData%T,1) + DbKiBuf(Db_Xferred) = InData%T(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Td) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Td,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Td,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Td,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Td,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Td,2), UBOUND(InData%Td,2) + DO i1 = LBOUND(InData%Td,1), UBOUND(InData%Td,1) + DbKiBuf(Db_Xferred) = InData%Td(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%W) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%W,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%W,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%W,2), UBOUND(InData%W,2) + DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) + DbKiBuf(Db_Xferred) = InData%W(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Dp) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Dp,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Dp,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Dp,2), UBOUND(InData%Dp,2) + DO i1 = LBOUND(InData%Dp,1), UBOUND(InData%Dp,1) + DbKiBuf(Db_Xferred) = InData%Dp(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Dq) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Dq,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dq,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Dq,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dq,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Dq,2), UBOUND(InData%Dq,2) + DO i1 = LBOUND(InData%Dq,1), UBOUND(InData%Dq,1) + DbKiBuf(Db_Xferred) = InData%Dq(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Ap) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Ap,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ap,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Ap,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ap,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Ap,2), UBOUND(InData%Ap,2) + DO i1 = LBOUND(InData%Ap,1), UBOUND(InData%Ap,1) + DbKiBuf(Db_Xferred) = InData%Ap(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Aq) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Aq,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aq,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Aq,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aq,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Aq,2), UBOUND(InData%Aq,2) + DO i1 = LBOUND(InData%Aq,1), UBOUND(InData%Aq,1) + DbKiBuf(Db_Xferred) = InData%Aq(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%B) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%B,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%B,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) + DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) + DbKiBuf(Db_Xferred) = InData%B(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Bs) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Bs,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bs,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Bs,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bs,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Bs,2), UBOUND(InData%Bs,2) + DO i1 = LBOUND(InData%Bs,1), UBOUND(InData%Bs,1) + DbKiBuf(Db_Xferred) = InData%Bs(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Fnet) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Fnet,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fnet,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Fnet,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fnet,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Fnet,2), UBOUND(InData%Fnet,2) + DO i1 = LBOUND(InData%Fnet,1), UBOUND(InData%Fnet,1) + DbKiBuf(Db_Xferred) = InData%Fnet(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%S) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%S,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%S,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%S,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%S,3), UBOUND(InData%S,3) + DO i2 = LBOUND(InData%S,2), UBOUND(InData%S,2) + DO i1 = LBOUND(InData%S,1), UBOUND(InData%S,1) + DbKiBuf(Db_Xferred) = InData%S(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%M) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%M,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%M,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%M,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%M,3), UBOUND(InData%M,3) + DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) + DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) + DbKiBuf(Db_Xferred) = InData%M(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + DO i1 = LBOUND(InData%EndMomentA,1), UBOUND(InData%EndMomentA,1) + DbKiBuf(Db_Xferred) = InData%EndMomentA(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%EndMomentB,1), UBOUND(InData%EndMomentB,1) + DbKiBuf(Db_Xferred) = InData%EndMomentB(i1) + Db_Xferred = Db_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%LineUnOut + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%LineWrOutput) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LineWrOutput,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineWrOutput,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LineWrOutput,1), UBOUND(InData%LineWrOutput,1) + DbKiBuf(Db_Xferred) = InData%LineWrOutput(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE MD_PackLine + + SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MD_Line), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackLine' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%IdNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PropsIdNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ElasticMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%OutFlagList,1) + i1_u = UBOUND(OutData%OutFlagList,1) + DO i1 = LBOUND(OutData%OutFlagList,1), UBOUND(OutData%OutFlagList,1) + OutData%OutFlagList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%CtrlChan = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FairConnect = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AnchConnect = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%N = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%endTypeA = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%endTypeB = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnstrLen = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%rho = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%d = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%EA = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%EA_D = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%BA = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%BA_D = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%EI = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Can = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Cat = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Cdn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Cdt = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%nEApoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%stiffXs,1) + i1_u = UBOUND(OutData%stiffXs,1) + DO i1 = LBOUND(OutData%stiffXs,1), UBOUND(OutData%stiffXs,1) + OutData%stiffXs(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%stiffYs,1) + i1_u = UBOUND(OutData%stiffYs,1) + DO i1 = LBOUND(OutData%stiffYs,1), UBOUND(OutData%stiffYs,1) + OutData%stiffYs(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%nBApoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%dampXs,1) + i1_u = UBOUND(OutData%dampXs,1) + DO i1 = LBOUND(OutData%dampXs,1), UBOUND(OutData%dampXs,1) + OutData%dampXs(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%dampYs,1) + i1_u = UBOUND(OutData%dampYs,1) + DO i1 = LBOUND(OutData%dampYs,1), UBOUND(OutData%dampYs,1) + OutData%dampYs(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%nEIpoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%bstiffXs,1) + i1_u = UBOUND(OutData%bstiffXs,1) + DO i1 = LBOUND(OutData%bstiffXs,1), UBOUND(OutData%bstiffXs,1) + OutData%bstiffXs(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%bstiffYs,1) + i1_u = UBOUND(OutData%bstiffYs,1) + DO i1 = LBOUND(OutData%bstiffYs,1), UBOUND(OutData%bstiffYs,1) + OutData%bstiffYs(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%time = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%r)) DEALLOCATE(OutData%r) + ALLOCATE(OutData%r(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%r,2), UBOUND(OutData%r,2) + DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) + OutData%r(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%rd)) DEALLOCATE(OutData%rd) + ALLOCATE(OutData%rd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%rd,2), UBOUND(OutData%rd,2) + DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) + OutData%rd(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%q)) DEALLOCATE(OutData%q) + ALLOCATE(OutData%q(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%q,2), UBOUND(OutData%q,2) + DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) + OutData%q(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qs not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%qs)) DEALLOCATE(OutData%qs) + ALLOCATE(OutData%qs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%qs,2), UBOUND(OutData%qs,2) + DO i1 = LBOUND(OutData%qs,1), UBOUND(OutData%qs,1) + OutData%qs(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! l not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%l)) DEALLOCATE(OutData%l) + ALLOCATE(OutData%l(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%l,1), UBOUND(OutData%l,1) + OutData%l(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ld not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ld)) DEALLOCATE(OutData%ld) + ALLOCATE(OutData%ld(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ld.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ld,1), UBOUND(OutData%ld,1) + OutData%ld(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lstr not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%lstr)) DEALLOCATE(OutData%lstr) + ALLOCATE(OutData%lstr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%lstr,1), UBOUND(OutData%lstr,1) + OutData%lstr(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lstrd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%lstrd)) DEALLOCATE(OutData%lstrd) + ALLOCATE(OutData%lstrd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstrd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%lstrd,1), UBOUND(OutData%lstrd,1) + OutData%lstrd(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kurv not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Kurv)) DEALLOCATE(OutData%Kurv) + ALLOCATE(OutData%Kurv(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kurv.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Kurv,1), UBOUND(OutData%Kurv,1) + OutData%Kurv(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dl_1 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%dl_1)) DEALLOCATE(OutData%dl_1) + ALLOCATE(OutData%dl_1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dl_1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%dl_1,1), UBOUND(OutData%dl_1,1) + OutData%dl_1(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%V)) DEALLOCATE(OutData%V) + ALLOCATE(OutData%V(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) + OutData%V(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%U)) DEALLOCATE(OutData%U) + ALLOCATE(OutData%U(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%U,2), UBOUND(OutData%U,2) + DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) + OutData%U(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ud not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Ud)) DEALLOCATE(OutData%Ud) + ALLOCATE(OutData%Ud(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ud.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Ud,2), UBOUND(OutData%Ud,2) + DO i1 = LBOUND(OutData%Ud,1), UBOUND(OutData%Ud,1) + OutData%Ud(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zeta not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%zeta)) DEALLOCATE(OutData%zeta) + ALLOCATE(OutData%zeta(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%zeta,1), UBOUND(OutData%zeta,1) + OutData%zeta(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDyn not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PDyn)) DEALLOCATE(OutData%PDyn) + ALLOCATE(OutData%PDyn(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%PDyn,1), UBOUND(OutData%PDyn,1) + OutData%PDyn(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%T)) DEALLOCATE(OutData%T) + ALLOCATE(OutData%T(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%T,2), UBOUND(OutData%T,2) + DO i1 = LBOUND(OutData%T,1), UBOUND(OutData%T,1) + OutData%T(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Td not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Td)) DEALLOCATE(OutData%Td) + ALLOCATE(OutData%Td(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Td.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Td,2), UBOUND(OutData%Td,2) + DO i1 = LBOUND(OutData%Td,1), UBOUND(OutData%Td,1) + OutData%Td(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%W)) DEALLOCATE(OutData%W) + ALLOCATE(OutData%W(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%W,2), UBOUND(OutData%W,2) + DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) + OutData%W(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dp not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Dp)) DEALLOCATE(OutData%Dp) + ALLOCATE(OutData%Dp(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Dp,2), UBOUND(OutData%Dp,2) + DO i1 = LBOUND(OutData%Dp,1), UBOUND(OutData%Dp,1) + OutData%Dp(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dq not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Dq)) DEALLOCATE(OutData%Dq) + ALLOCATE(OutData%Dq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dq.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Dq,2), UBOUND(OutData%Dq,2) + DO i1 = LBOUND(OutData%Dq,1), UBOUND(OutData%Dq,1) + OutData%Dq(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ap not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Ap)) DEALLOCATE(OutData%Ap) + ALLOCATE(OutData%Ap(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ap.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Ap,2), UBOUND(OutData%Ap,2) + DO i1 = LBOUND(OutData%Ap,1), UBOUND(OutData%Ap,1) + OutData%Ap(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Aq not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Aq)) DEALLOCATE(OutData%Aq) + ALLOCATE(OutData%Aq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aq.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Aq,2), UBOUND(OutData%Aq,2) + DO i1 = LBOUND(OutData%Aq,1), UBOUND(OutData%Aq,1) + OutData%Aq(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%B)) DEALLOCATE(OutData%B) + ALLOCATE(OutData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) + DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) + OutData%B(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Bs not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Bs)) DEALLOCATE(OutData%Bs) + ALLOCATE(OutData%Bs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Bs,2), UBOUND(OutData%Bs,2) + DO i1 = LBOUND(OutData%Bs,1), UBOUND(OutData%Bs,1) + OutData%Bs(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fnet not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Fnet)) DEALLOCATE(OutData%Fnet) + ALLOCATE(OutData%Fnet(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fnet.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Fnet,2), UBOUND(OutData%Fnet,2) + DO i1 = LBOUND(OutData%Fnet,1), UBOUND(OutData%Fnet,1) + OutData%Fnet(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! S not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%S)) DEALLOCATE(OutData%S) + ALLOCATE(OutData%S(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%S.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%S,3), UBOUND(OutData%S,3) + DO i2 = LBOUND(OutData%S,2), UBOUND(OutData%S,2) + DO i1 = LBOUND(OutData%S,1), UBOUND(OutData%S,1) + OutData%S(i1,i2,i3) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%M)) DEALLOCATE(OutData%M) + ALLOCATE(OutData%M(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%M,3), UBOUND(OutData%M,3) + DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) + DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) + OutData%M(i1,i2,i3) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + i1_l = LBOUND(OutData%EndMomentA,1) + i1_u = UBOUND(OutData%EndMomentA,1) + DO i1 = LBOUND(OutData%EndMomentA,1), UBOUND(OutData%EndMomentA,1) + OutData%EndMomentA(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + i1_l = LBOUND(OutData%EndMomentB,1) + i1_u = UBOUND(OutData%EndMomentB,1) + DO i1 = LBOUND(OutData%EndMomentB,1), UBOUND(OutData%EndMomentB,1) + OutData%EndMomentB(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%LineUnOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineWrOutput not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LineWrOutput)) DEALLOCATE(OutData%LineWrOutput) + ALLOCATE(OutData%LineWrOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineWrOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LineWrOutput,1), UBOUND(OutData%LineWrOutput,1) + OutData%LineWrOutput(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE MD_UnPackLine + + SUBROUTINE MD_CopyFail( SrcFailData, DstFailData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_Fail), INTENT(IN) :: SrcFailData + TYPE(MD_Fail), INTENT(INOUT) :: DstFailData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyFail' +! + ErrStat = ErrID_None + ErrMsg = "" + DstFailData%IdNum = SrcFailData%IdNum + END SUBROUTINE MD_CopyFail + + SUBROUTINE MD_DestroyFail( FailData, ErrStat, ErrMsg ) + TYPE(MD_Fail), INTENT(INOUT) :: FailData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyFail' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE MD_DestroyFail + + SUBROUTINE MD_PackFail( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(MD_Fail), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackFail' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! IdNum + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = InData%IdNum + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE MD_PackFail + + SUBROUTINE MD_UnPackFail( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MD_Fail), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackFail' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%IdNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE MD_UnPackFail + + SUBROUTINE MD_CopyOutParmType( SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_OutParmType), INTENT(IN) :: SrcOutParmTypeData + TYPE(MD_OutParmType), INTENT(INOUT) :: DstOutParmTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyOutParmType' +! + ErrStat = ErrID_None + ErrMsg = "" + DstOutParmTypeData%Name = SrcOutParmTypeData%Name + DstOutParmTypeData%Units = SrcOutParmTypeData%Units + DstOutParmTypeData%QType = SrcOutParmTypeData%QType + DstOutParmTypeData%OType = SrcOutParmTypeData%OType + DstOutParmTypeData%NodeID = SrcOutParmTypeData%NodeID + DstOutParmTypeData%ObjID = SrcOutParmTypeData%ObjID + END SUBROUTINE MD_CopyOutParmType + + SUBROUTINE MD_DestroyOutParmType( OutParmTypeData, ErrStat, ErrMsg ) + TYPE(MD_OutParmType), INTENT(INOUT) :: OutParmTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyOutParmType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE MD_DestroyOutParmType + + SUBROUTINE MD_PackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(MD_OutParmType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackOutParmType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1*LEN(InData%Name) ! Name + Int_BufSz = Int_BufSz + 1*LEN(InData%Units) ! Units + Int_BufSz = Int_BufSz + 1 ! QType + Int_BufSz = Int_BufSz + 1 ! OType + Int_BufSz = Int_BufSz + 1 ! NodeID + Int_BufSz = Int_BufSz + 1 ! ObjID + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO I = 1, LEN(InData%Name) + IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Units) + IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%QType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NodeID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ObjID + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE MD_PackOutParmType + + SUBROUTINE MD_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MD_OutParmType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackOutParmType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + DO I = 1, LEN(OutData%Name) + OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Units) + OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%QType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NodeID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ObjID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE MD_UnPackOutParmType + + SUBROUTINE MD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_InitOutputType), INTENT(IN) :: SrcInitOutputData + TYPE(MD_InitOutputType), INTENT(INOUT) :: DstInitOutputData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyInitOutput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcInitOutputData%writeOutputHdr)) THEN + i1_l = LBOUND(SrcInitOutputData%writeOutputHdr,1) + i1_u = UBOUND(SrcInitOutputData%writeOutputHdr,1) + IF (.NOT. ALLOCATED(DstInitOutputData%writeOutputHdr)) THEN + ALLOCATE(DstInitOutputData%writeOutputHdr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%writeOutputHdr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%writeOutputHdr = SrcInitOutputData%writeOutputHdr +ENDIF +IF (ALLOCATED(SrcInitOutputData%writeOutputUnt)) THEN + i1_l = LBOUND(SrcInitOutputData%writeOutputUnt,1) + i1_u = UBOUND(SrcInitOutputData%writeOutputUnt,1) + IF (.NOT. ALLOCATED(DstInitOutputData%writeOutputUnt)) THEN + ALLOCATE(DstInitOutputData%writeOutputUnt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%writeOutputUnt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%writeOutputUnt = SrcInitOutputData%writeOutputUnt +ENDIF + CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcInitOutputData%CableCChanRqst)) THEN + i1_l = LBOUND(SrcInitOutputData%CableCChanRqst,1) + i1_u = UBOUND(SrcInitOutputData%CableCChanRqst,1) + IF (.NOT. ALLOCATED(DstInitOutputData%CableCChanRqst)) THEN + ALLOCATE(DstInitOutputData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%CableCChanRqst = SrcInitOutputData%CableCChanRqst +ENDIF +IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN + i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) + i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) + IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_y)) THEN + ALLOCATE(DstInitOutputData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y +ENDIF +IF (ALLOCATED(SrcInitOutputData%LinNames_x)) THEN + i1_l = LBOUND(SrcInitOutputData%LinNames_x,1) + i1_u = UBOUND(SrcInitOutputData%LinNames_x,1) + IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_x)) THEN + ALLOCATE(DstInitOutputData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%LinNames_x = SrcInitOutputData%LinNames_x +ENDIF +IF (ALLOCATED(SrcInitOutputData%LinNames_u)) THEN + i1_l = LBOUND(SrcInitOutputData%LinNames_u,1) + i1_u = UBOUND(SrcInitOutputData%LinNames_u,1) + IF (.NOT. ALLOCATED(DstInitOutputData%LinNames_u)) THEN + ALLOCATE(DstInitOutputData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u +ENDIF +IF (ALLOCATED(SrcInitOutputData%RotFrame_y)) THEN + i1_l = LBOUND(SrcInitOutputData%RotFrame_y,1) + i1_u = UBOUND(SrcInitOutputData%RotFrame_y,1) + IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_y)) THEN + ALLOCATE(DstInitOutputData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y +ENDIF +IF (ALLOCATED(SrcInitOutputData%RotFrame_x)) THEN + i1_l = LBOUND(SrcInitOutputData%RotFrame_x,1) + i1_u = UBOUND(SrcInitOutputData%RotFrame_x,1) + IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_x)) THEN + ALLOCATE(DstInitOutputData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%RotFrame_x = SrcInitOutputData%RotFrame_x +ENDIF +IF (ALLOCATED(SrcInitOutputData%RotFrame_u)) THEN + i1_l = LBOUND(SrcInitOutputData%RotFrame_u,1) + i1_u = UBOUND(SrcInitOutputData%RotFrame_u,1) + IF (.NOT. ALLOCATED(DstInitOutputData%RotFrame_u)) THEN + ALLOCATE(DstInitOutputData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u +ENDIF +IF (ALLOCATED(SrcInitOutputData%IsLoad_u)) THEN + i1_l = LBOUND(SrcInitOutputData%IsLoad_u,1) + i1_u = UBOUND(SrcInitOutputData%IsLoad_u,1) + IF (.NOT. ALLOCATED(DstInitOutputData%IsLoad_u)) THEN + ALLOCATE(DstInitOutputData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u +ENDIF +IF (ALLOCATED(SrcInitOutputData%DerivOrder_x)) THEN + i1_l = LBOUND(SrcInitOutputData%DerivOrder_x,1) + i1_u = UBOUND(SrcInitOutputData%DerivOrder_x,1) + IF (.NOT. ALLOCATED(DstInitOutputData%DerivOrder_x)) THEN + ALLOCATE(DstInitOutputData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInitOutputData%DerivOrder_x = SrcInitOutputData%DerivOrder_x +ENDIF + END SUBROUTINE MD_CopyInitOutput + + SUBROUTINE MD_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) + TYPE(MD_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyInitOutput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(InitOutputData%writeOutputHdr)) THEN + DEALLOCATE(InitOutputData%writeOutputHdr) +ENDIF +IF (ALLOCATED(InitOutputData%writeOutputUnt)) THEN + DEALLOCATE(InitOutputData%writeOutputUnt) +ENDIF + CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) +IF (ALLOCATED(InitOutputData%CableCChanRqst)) THEN + DEALLOCATE(InitOutputData%CableCChanRqst) +ENDIF +IF (ALLOCATED(InitOutputData%LinNames_y)) THEN + DEALLOCATE(InitOutputData%LinNames_y) +ENDIF +IF (ALLOCATED(InitOutputData%LinNames_x)) THEN + DEALLOCATE(InitOutputData%LinNames_x) +ENDIF +IF (ALLOCATED(InitOutputData%LinNames_u)) THEN + DEALLOCATE(InitOutputData%LinNames_u) +ENDIF +IF (ALLOCATED(InitOutputData%RotFrame_y)) THEN + DEALLOCATE(InitOutputData%RotFrame_y) +ENDIF +IF (ALLOCATED(InitOutputData%RotFrame_x)) THEN + DEALLOCATE(InitOutputData%RotFrame_x) +ENDIF +IF (ALLOCATED(InitOutputData%RotFrame_u)) THEN + DEALLOCATE(InitOutputData%RotFrame_u) +ENDIF +IF (ALLOCATED(InitOutputData%IsLoad_u)) THEN + DEALLOCATE(InitOutputData%IsLoad_u) +ENDIF +IF (ALLOCATED(InitOutputData%DerivOrder_x)) THEN + DEALLOCATE(InitOutputData%DerivOrder_x) +ENDIF + END SUBROUTINE MD_DestroyInitOutput + + SUBROUTINE MD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(MD_InitOutputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackInitOutput' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! writeOutputHdr allocated yes/no + IF ( ALLOCATED(InData%writeOutputHdr) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! writeOutputHdr upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%writeOutputHdr)*LEN(InData%writeOutputHdr) ! writeOutputHdr + END IF + Int_BufSz = Int_BufSz + 1 ! writeOutputUnt allocated yes/no + IF ( ALLOCATED(InData%writeOutputUnt) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! writeOutputUnt upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%writeOutputUnt)*LEN(InData%writeOutputUnt) ! writeOutputUnt + END IF + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype + CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Ver + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Ver + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Ver + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! CableCChanRqst allocated yes/no + IF ( ALLOCATED(InData%CableCChanRqst) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! CableCChanRqst upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%CableCChanRqst) ! CableCChanRqst + END IF + Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no + IF ( ALLOCATED(InData%LinNames_y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%LinNames_y)*LEN(InData%LinNames_y) ! LinNames_y + END IF + Int_BufSz = Int_BufSz + 1 ! LinNames_x allocated yes/no + IF ( ALLOCATED(InData%LinNames_x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LinNames_x upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%LinNames_x)*LEN(InData%LinNames_x) ! LinNames_x + END IF + Int_BufSz = Int_BufSz + 1 ! LinNames_u allocated yes/no + IF ( ALLOCATED(InData%LinNames_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LinNames_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%LinNames_u)*LEN(InData%LinNames_u) ! LinNames_u + END IF + Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no + IF ( ALLOCATED(InData%RotFrame_y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y + END IF + Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no + IF ( ALLOCATED(InData%RotFrame_x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x + END IF + Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no + IF ( ALLOCATED(InData%RotFrame_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u + END IF + Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no + IF ( ALLOCATED(InData%IsLoad_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u + END IF + Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no + IF ( ALLOCATED(InData%DerivOrder_x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%writeOutputHdr) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%writeOutputHdr,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputHdr,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%writeOutputHdr,1), UBOUND(InData%writeOutputHdr,1) + DO I = 1, LEN(InData%writeOutputHdr) + IntKiBuf(Int_Xferred) = ICHAR(InData%writeOutputHdr(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%writeOutputUnt) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%writeOutputUnt,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputUnt,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%writeOutputUnt,1), UBOUND(InData%writeOutputUnt,1) + DO I = 1, LEN(InData%writeOutputUnt) + IntKiBuf(Int_Xferred) = ICHAR(InData%writeOutputUnt(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%CableCChanRqst) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CableCChanRqst,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CableCChanRqst,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%CableCChanRqst,1), UBOUND(InData%CableCChanRqst,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%CableCChanRqst(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) + DO I = 1, LEN(InData%LinNames_y) + IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_y(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) + DO I = 1, LEN(InData%LinNames_x) + IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_x(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LinNames_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) + DO I = 1, LEN(InData%LinNames_u) + IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_u(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IsLoad_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DerivOrder_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) + IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + END SUBROUTINE MD_PackInitOutput + + SUBROUTINE MD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MD_InitOutputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackInitOutput' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! writeOutputHdr not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%writeOutputHdr)) DEALLOCATE(OutData%writeOutputHdr) + ALLOCATE(OutData%writeOutputHdr(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputHdr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%writeOutputHdr,1), UBOUND(OutData%writeOutputHdr,1) + DO I = 1, LEN(OutData%writeOutputHdr) + OutData%writeOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! writeOutputUnt not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%writeOutputUnt)) DEALLOCATE(OutData%writeOutputUnt) + ALLOCATE(OutData%writeOutputUnt(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputUnt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%writeOutputUnt,1), UBOUND(OutData%writeOutputUnt,1) + DO I = 1, LEN(OutData%writeOutputUnt) + OutData%writeOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CableCChanRqst not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CableCChanRqst)) DEALLOCATE(OutData%CableCChanRqst) + ALLOCATE(OutData%CableCChanRqst(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CableCChanRqst.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%CableCChanRqst,1), UBOUND(OutData%CableCChanRqst,1) + OutData%CableCChanRqst(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%CableCChanRqst(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LinNames_y)) DEALLOCATE(OutData%LinNames_y) + ALLOCATE(OutData%LinNames_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + DO I = 1, LEN(OutData%LinNames_y) + OutData%LinNames_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LinNames_x)) DEALLOCATE(OutData%LinNames_x) + ALLOCATE(OutData%LinNames_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) + DO I = 1, LEN(OutData%LinNames_x) + OutData%LinNames_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LinNames_u)) DEALLOCATE(OutData%LinNames_u) + ALLOCATE(OutData%LinNames_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + DO I = 1, LEN(OutData%LinNames_u) + OutData%LinNames_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) + ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) + OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) + ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) + OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) + ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) + OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) + ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) + ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) + OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + END SUBROUTINE MD_UnPackInitOutput + + SUBROUTINE MD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_ContinuousStateType), INTENT(IN) :: SrcContStateData + TYPE(MD_ContinuousStateType), INTENT(INOUT) :: DstContStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyContState' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcContStateData%states)) THEN + i1_l = LBOUND(SrcContStateData%states,1) + i1_u = UBOUND(SrcContStateData%states,1) + IF (.NOT. ALLOCATED(DstContStateData%states)) THEN + ALLOCATE(DstContStateData%states(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%states.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstContStateData%states = SrcContStateData%states +ENDIF + END SUBROUTINE MD_CopyContState + + SUBROUTINE MD_DestroyContState( ContStateData, ErrStat, ErrMsg ) + TYPE(MD_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyContState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(ContStateData%states)) THEN + DEALLOCATE(ContStateData%states) +ENDIF + END SUBROUTINE MD_DestroyContState + + SUBROUTINE MD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(MD_ContinuousStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackContState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! states allocated yes/no + IF ( ALLOCATED(InData%states) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! states upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%states) ! states + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%states) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%states,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%states,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%states,1), UBOUND(InData%states,1) + DbKiBuf(Db_Xferred) = InData%states(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE MD_PackContState + + SUBROUTINE MD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MD_ContinuousStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackContState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! states not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%states)) DEALLOCATE(OutData%states) + ALLOCATE(OutData%states(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%states.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%states,1), UBOUND(OutData%states,1) + OutData%states(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE MD_UnPackContState + + SUBROUTINE MD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_DiscreteStateType), INTENT(IN) :: SrcDiscStateData + TYPE(MD_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyDiscState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstDiscStateData%dummy = SrcDiscStateData%dummy + END SUBROUTINE MD_CopyDiscState + + SUBROUTINE MD_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) + TYPE(MD_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyDiscState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE MD_DestroyDiscState + + SUBROUTINE MD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(MD_DiscreteStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackDiscState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! dummy + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE MD_PackDiscState + + SUBROUTINE MD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MD_DiscreteStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackDiscState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE MD_UnPackDiscState + + SUBROUTINE MD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_ConstraintStateType), INTENT(IN) :: SrcConstrStateData + TYPE(MD_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyConstrState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstConstrStateData%dummy = SrcConstrStateData%dummy + END SUBROUTINE MD_CopyConstrState + + SUBROUTINE MD_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) + TYPE(MD_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyConstrState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE MD_DestroyConstrState + + SUBROUTINE MD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(MD_ConstraintStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackConstrState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! dummy + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE MD_PackConstrState + + SUBROUTINE MD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MD_ConstraintStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackConstrState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE MD_UnPackConstrState + + SUBROUTINE MD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_OtherStateType), INTENT(IN) :: SrcOtherStateData + TYPE(MD_OtherStateType), INTENT(INOUT) :: DstOtherStateData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyOtherState' +! + ErrStat = ErrID_None + ErrMsg = "" + DstOtherStateData%dummy = SrcOtherStateData%dummy + END SUBROUTINE MD_CopyOtherState + + SUBROUTINE MD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) + TYPE(MD_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyOtherState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE MD_DestroyOtherState + + SUBROUTINE MD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(MD_OtherStateType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackOtherState' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! dummy + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE MD_PackOtherState + + SUBROUTINE MD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MD_OtherStateType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackOtherState' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE MD_UnPackOtherState + + SUBROUTINE MD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_MiscVarType), INTENT(IN) :: SrcMiscData + TYPE(MD_MiscVarType), INTENT(INOUT) :: DstMiscData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyMisc' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcMiscData%LineTypeList)) THEN + i1_l = LBOUND(SrcMiscData%LineTypeList,1) + i1_u = UBOUND(SrcMiscData%LineTypeList,1) + IF (.NOT. ALLOCATED(DstMiscData%LineTypeList)) THEN + ALLOCATE(DstMiscData%LineTypeList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineTypeList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMiscData%LineTypeList,1), UBOUND(SrcMiscData%LineTypeList,1) + CALL MD_Copylineprop( SrcMiscData%LineTypeList(i1), DstMiscData%LineTypeList(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcMiscData%RodTypeList)) THEN + i1_l = LBOUND(SrcMiscData%RodTypeList,1) + i1_u = UBOUND(SrcMiscData%RodTypeList,1) + IF (.NOT. ALLOCATED(DstMiscData%RodTypeList)) THEN + ALLOCATE(DstMiscData%RodTypeList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodTypeList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMiscData%RodTypeList,1), UBOUND(SrcMiscData%RodTypeList,1) + CALL MD_Copyrodprop( SrcMiscData%RodTypeList(i1), DstMiscData%RodTypeList(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL MD_Copybody( SrcMiscData%GroundBody, DstMiscData%GroundBody, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcMiscData%BodyList)) THEN + i1_l = LBOUND(SrcMiscData%BodyList,1) + i1_u = UBOUND(SrcMiscData%BodyList,1) + IF (.NOT. ALLOCATED(DstMiscData%BodyList)) THEN + ALLOCATE(DstMiscData%BodyList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMiscData%BodyList,1), UBOUND(SrcMiscData%BodyList,1) + CALL MD_Copybody( SrcMiscData%BodyList(i1), DstMiscData%BodyList(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcMiscData%RodList)) THEN + i1_l = LBOUND(SrcMiscData%RodList,1) + i1_u = UBOUND(SrcMiscData%RodList,1) + IF (.NOT. ALLOCATED(DstMiscData%RodList)) THEN + ALLOCATE(DstMiscData%RodList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMiscData%RodList,1), UBOUND(SrcMiscData%RodList,1) + CALL MD_Copyrod( SrcMiscData%RodList(i1), DstMiscData%RodList(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcMiscData%ConnectList)) THEN + i1_l = LBOUND(SrcMiscData%ConnectList,1) + i1_u = UBOUND(SrcMiscData%ConnectList,1) + IF (.NOT. ALLOCATED(DstMiscData%ConnectList)) THEN + ALLOCATE(DstMiscData%ConnectList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConnectList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMiscData%ConnectList,1), UBOUND(SrcMiscData%ConnectList,1) + CALL MD_Copyconnect( SrcMiscData%ConnectList(i1), DstMiscData%ConnectList(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcMiscData%LineList)) THEN + i1_l = LBOUND(SrcMiscData%LineList,1) + i1_u = UBOUND(SrcMiscData%LineList,1) + IF (.NOT. ALLOCATED(DstMiscData%LineList)) THEN + ALLOCATE(DstMiscData%LineList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMiscData%LineList,1), UBOUND(SrcMiscData%LineList,1) + CALL MD_Copyline( SrcMiscData%LineList(i1), DstMiscData%LineList(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcMiscData%FailList)) THEN + i1_l = LBOUND(SrcMiscData%FailList,1) + i1_u = UBOUND(SrcMiscData%FailList,1) + IF (.NOT. ALLOCATED(DstMiscData%FailList)) THEN + ALLOCATE(DstMiscData%FailList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FailList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMiscData%FailList,1), UBOUND(SrcMiscData%FailList,1) + CALL MD_Copyfail( SrcMiscData%FailList(i1), DstMiscData%FailList(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcMiscData%FreeConIs)) THEN + i1_l = LBOUND(SrcMiscData%FreeConIs,1) + i1_u = UBOUND(SrcMiscData%FreeConIs,1) + IF (.NOT. ALLOCATED(DstMiscData%FreeConIs)) THEN + ALLOCATE(DstMiscData%FreeConIs(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeConIs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%FreeConIs = SrcMiscData%FreeConIs +ENDIF +IF (ALLOCATED(SrcMiscData%CpldConIs)) THEN + i1_l = LBOUND(SrcMiscData%CpldConIs,1) + i1_u = UBOUND(SrcMiscData%CpldConIs,1) + i2_l = LBOUND(SrcMiscData%CpldConIs,2) + i2_u = UBOUND(SrcMiscData%CpldConIs,2) + IF (.NOT. ALLOCATED(DstMiscData%CpldConIs)) THEN + ALLOCATE(DstMiscData%CpldConIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldConIs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%CpldConIs = SrcMiscData%CpldConIs +ENDIF +IF (ALLOCATED(SrcMiscData%FreeRodIs)) THEN + i1_l = LBOUND(SrcMiscData%FreeRodIs,1) + i1_u = UBOUND(SrcMiscData%FreeRodIs,1) + IF (.NOT. ALLOCATED(DstMiscData%FreeRodIs)) THEN + ALLOCATE(DstMiscData%FreeRodIs(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeRodIs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%FreeRodIs = SrcMiscData%FreeRodIs +ENDIF +IF (ALLOCATED(SrcMiscData%CpldRodIs)) THEN + i1_l = LBOUND(SrcMiscData%CpldRodIs,1) + i1_u = UBOUND(SrcMiscData%CpldRodIs,1) + i2_l = LBOUND(SrcMiscData%CpldRodIs,2) + i2_u = UBOUND(SrcMiscData%CpldRodIs,2) + IF (.NOT. ALLOCATED(DstMiscData%CpldRodIs)) THEN + ALLOCATE(DstMiscData%CpldRodIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldRodIs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%CpldRodIs = SrcMiscData%CpldRodIs +ENDIF +IF (ALLOCATED(SrcMiscData%FreeBodyIs)) THEN + i1_l = LBOUND(SrcMiscData%FreeBodyIs,1) + i1_u = UBOUND(SrcMiscData%FreeBodyIs,1) + IF (.NOT. ALLOCATED(DstMiscData%FreeBodyIs)) THEN + ALLOCATE(DstMiscData%FreeBodyIs(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FreeBodyIs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%FreeBodyIs = SrcMiscData%FreeBodyIs +ENDIF +IF (ALLOCATED(SrcMiscData%CpldBodyIs)) THEN + i1_l = LBOUND(SrcMiscData%CpldBodyIs,1) + i1_u = UBOUND(SrcMiscData%CpldBodyIs,1) + i2_l = LBOUND(SrcMiscData%CpldBodyIs,2) + i2_u = UBOUND(SrcMiscData%CpldBodyIs,2) + IF (.NOT. ALLOCATED(DstMiscData%CpldBodyIs)) THEN + ALLOCATE(DstMiscData%CpldBodyIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CpldBodyIs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%CpldBodyIs = SrcMiscData%CpldBodyIs +ENDIF +IF (ALLOCATED(SrcMiscData%LineStateIs1)) THEN + i1_l = LBOUND(SrcMiscData%LineStateIs1,1) + i1_u = UBOUND(SrcMiscData%LineStateIs1,1) + IF (.NOT. ALLOCATED(DstMiscData%LineStateIs1)) THEN + ALLOCATE(DstMiscData%LineStateIs1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIs1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%LineStateIs1 = SrcMiscData%LineStateIs1 +ENDIF +IF (ALLOCATED(SrcMiscData%LineStateIsN)) THEN + i1_l = LBOUND(SrcMiscData%LineStateIsN,1) + i1_u = UBOUND(SrcMiscData%LineStateIsN,1) + IF (.NOT. ALLOCATED(DstMiscData%LineStateIsN)) THEN + ALLOCATE(DstMiscData%LineStateIsN(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIsN.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%LineStateIsN = SrcMiscData%LineStateIsN +ENDIF +IF (ALLOCATED(SrcMiscData%ConStateIs1)) THEN + i1_l = LBOUND(SrcMiscData%ConStateIs1,1) + i1_u = UBOUND(SrcMiscData%ConStateIs1,1) + IF (.NOT. ALLOCATED(DstMiscData%ConStateIs1)) THEN + ALLOCATE(DstMiscData%ConStateIs1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConStateIs1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%ConStateIs1 = SrcMiscData%ConStateIs1 +ENDIF +IF (ALLOCATED(SrcMiscData%ConStateIsN)) THEN + i1_l = LBOUND(SrcMiscData%ConStateIsN,1) + i1_u = UBOUND(SrcMiscData%ConStateIsN,1) + IF (.NOT. ALLOCATED(DstMiscData%ConStateIsN)) THEN + ALLOCATE(DstMiscData%ConStateIsN(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConStateIsN.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%ConStateIsN = SrcMiscData%ConStateIsN +ENDIF +IF (ALLOCATED(SrcMiscData%RodStateIs1)) THEN + i1_l = LBOUND(SrcMiscData%RodStateIs1,1) + i1_u = UBOUND(SrcMiscData%RodStateIs1,1) + IF (.NOT. ALLOCATED(DstMiscData%RodStateIs1)) THEN + ALLOCATE(DstMiscData%RodStateIs1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIs1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%RodStateIs1 = SrcMiscData%RodStateIs1 +ENDIF +IF (ALLOCATED(SrcMiscData%RodStateIsN)) THEN + i1_l = LBOUND(SrcMiscData%RodStateIsN,1) + i1_u = UBOUND(SrcMiscData%RodStateIsN,1) + IF (.NOT. ALLOCATED(DstMiscData%RodStateIsN)) THEN + ALLOCATE(DstMiscData%RodStateIsN(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%RodStateIsN.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%RodStateIsN = SrcMiscData%RodStateIsN +ENDIF +IF (ALLOCATED(SrcMiscData%BodyStateIs1)) THEN + i1_l = LBOUND(SrcMiscData%BodyStateIs1,1) + i1_u = UBOUND(SrcMiscData%BodyStateIs1,1) + IF (.NOT. ALLOCATED(DstMiscData%BodyStateIs1)) THEN + ALLOCATE(DstMiscData%BodyStateIs1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIs1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BodyStateIs1 = SrcMiscData%BodyStateIs1 +ENDIF +IF (ALLOCATED(SrcMiscData%BodyStateIsN)) THEN + i1_l = LBOUND(SrcMiscData%BodyStateIsN,1) + i1_u = UBOUND(SrcMiscData%BodyStateIsN,1) + IF (.NOT. ALLOCATED(DstMiscData%BodyStateIsN)) THEN + ALLOCATE(DstMiscData%BodyStateIsN(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BodyStateIsN.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BodyStateIsN = SrcMiscData%BodyStateIsN +ENDIF + DstMiscData%Nx = SrcMiscData%Nx + DstMiscData%WaveTi = SrcMiscData%WaveTi + CALL MD_CopyContState( SrcMiscData%xTemp, DstMiscData%xTemp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MD_CopyContState( SrcMiscData%xdTemp, DstMiscData%xdTemp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstMiscData%zeros6 = SrcMiscData%zeros6 +IF (ALLOCATED(SrcMiscData%MDWrOutput)) THEN + i1_l = LBOUND(SrcMiscData%MDWrOutput,1) + i1_u = UBOUND(SrcMiscData%MDWrOutput,1) + IF (.NOT. ALLOCATED(DstMiscData%MDWrOutput)) THEN + ALLOCATE(DstMiscData%MDWrOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MDWrOutput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%MDWrOutput = SrcMiscData%MDWrOutput +ENDIF + DstMiscData%LastOutTime = SrcMiscData%LastOutTime + DstMiscData%PtfmInit = SrcMiscData%PtfmInit +IF (ALLOCATED(SrcMiscData%BathymetryGrid)) THEN + i1_l = LBOUND(SrcMiscData%BathymetryGrid,1) + i1_u = UBOUND(SrcMiscData%BathymetryGrid,1) + i2_l = LBOUND(SrcMiscData%BathymetryGrid,2) + i2_u = UBOUND(SrcMiscData%BathymetryGrid,2) + IF (.NOT. ALLOCATED(DstMiscData%BathymetryGrid)) THEN + ALLOCATE(DstMiscData%BathymetryGrid(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathymetryGrid.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BathymetryGrid = SrcMiscData%BathymetryGrid +ENDIF +IF (ALLOCATED(SrcMiscData%BathGrid_Xs)) THEN + i1_l = LBOUND(SrcMiscData%BathGrid_Xs,1) + i1_u = UBOUND(SrcMiscData%BathGrid_Xs,1) + IF (.NOT. ALLOCATED(DstMiscData%BathGrid_Xs)) THEN + ALLOCATE(DstMiscData%BathGrid_Xs(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Xs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BathGrid_Xs = SrcMiscData%BathGrid_Xs +ENDIF +IF (ALLOCATED(SrcMiscData%BathGrid_Ys)) THEN + i1_l = LBOUND(SrcMiscData%BathGrid_Ys,1) + i1_u = UBOUND(SrcMiscData%BathGrid_Ys,1) + IF (.NOT. ALLOCATED(DstMiscData%BathGrid_Ys)) THEN + ALLOCATE(DstMiscData%BathGrid_Ys(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_Ys.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BathGrid_Ys = SrcMiscData%BathGrid_Ys +ENDIF +IF (ALLOCATED(SrcMiscData%BathGrid_npoints)) THEN + i1_l = LBOUND(SrcMiscData%BathGrid_npoints,1) + i1_u = UBOUND(SrcMiscData%BathGrid_npoints,1) + IF (.NOT. ALLOCATED(DstMiscData%BathGrid_npoints)) THEN + ALLOCATE(DstMiscData%BathGrid_npoints(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%BathGrid_npoints.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%BathGrid_npoints = SrcMiscData%BathGrid_npoints +ENDIF + END SUBROUTINE MD_CopyMisc + + SUBROUTINE MD_DestroyMisc( MiscData, ErrStat, ErrMsg ) + TYPE(MD_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyMisc' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(MiscData%LineTypeList)) THEN +DO i1 = LBOUND(MiscData%LineTypeList,1), UBOUND(MiscData%LineTypeList,1) + CALL MD_Destroylineprop( MiscData%LineTypeList(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(MiscData%LineTypeList) +ENDIF +IF (ALLOCATED(MiscData%RodTypeList)) THEN +DO i1 = LBOUND(MiscData%RodTypeList,1), UBOUND(MiscData%RodTypeList,1) + CALL MD_Destroyrodprop( MiscData%RodTypeList(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(MiscData%RodTypeList) +ENDIF + CALL MD_Destroybody( MiscData%GroundBody, ErrStat, ErrMsg ) +IF (ALLOCATED(MiscData%BodyList)) THEN +DO i1 = LBOUND(MiscData%BodyList,1), UBOUND(MiscData%BodyList,1) + CALL MD_Destroybody( MiscData%BodyList(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(MiscData%BodyList) +ENDIF +IF (ALLOCATED(MiscData%RodList)) THEN +DO i1 = LBOUND(MiscData%RodList,1), UBOUND(MiscData%RodList,1) + CALL MD_Destroyrod( MiscData%RodList(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(MiscData%RodList) +ENDIF +IF (ALLOCATED(MiscData%ConnectList)) THEN +DO i1 = LBOUND(MiscData%ConnectList,1), UBOUND(MiscData%ConnectList,1) + CALL MD_Destroyconnect( MiscData%ConnectList(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(MiscData%ConnectList) +ENDIF +IF (ALLOCATED(MiscData%LineList)) THEN +DO i1 = LBOUND(MiscData%LineList,1), UBOUND(MiscData%LineList,1) + CALL MD_Destroyline( MiscData%LineList(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(MiscData%LineList) +ENDIF +IF (ALLOCATED(MiscData%FailList)) THEN +DO i1 = LBOUND(MiscData%FailList,1), UBOUND(MiscData%FailList,1) + CALL MD_Destroyfail( MiscData%FailList(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(MiscData%FailList) +ENDIF +IF (ALLOCATED(MiscData%FreeConIs)) THEN + DEALLOCATE(MiscData%FreeConIs) +ENDIF +IF (ALLOCATED(MiscData%CpldConIs)) THEN + DEALLOCATE(MiscData%CpldConIs) +ENDIF +IF (ALLOCATED(MiscData%FreeRodIs)) THEN + DEALLOCATE(MiscData%FreeRodIs) +ENDIF +IF (ALLOCATED(MiscData%CpldRodIs)) THEN + DEALLOCATE(MiscData%CpldRodIs) +ENDIF +IF (ALLOCATED(MiscData%FreeBodyIs)) THEN + DEALLOCATE(MiscData%FreeBodyIs) +ENDIF +IF (ALLOCATED(MiscData%CpldBodyIs)) THEN + DEALLOCATE(MiscData%CpldBodyIs) +ENDIF +IF (ALLOCATED(MiscData%LineStateIs1)) THEN + DEALLOCATE(MiscData%LineStateIs1) +ENDIF +IF (ALLOCATED(MiscData%LineStateIsN)) THEN + DEALLOCATE(MiscData%LineStateIsN) +ENDIF +IF (ALLOCATED(MiscData%ConStateIs1)) THEN + DEALLOCATE(MiscData%ConStateIs1) +ENDIF +IF (ALLOCATED(MiscData%ConStateIsN)) THEN + DEALLOCATE(MiscData%ConStateIsN) +ENDIF +IF (ALLOCATED(MiscData%RodStateIs1)) THEN + DEALLOCATE(MiscData%RodStateIs1) +ENDIF +IF (ALLOCATED(MiscData%RodStateIsN)) THEN + DEALLOCATE(MiscData%RodStateIsN) +ENDIF +IF (ALLOCATED(MiscData%BodyStateIs1)) THEN + DEALLOCATE(MiscData%BodyStateIs1) +ENDIF +IF (ALLOCATED(MiscData%BodyStateIsN)) THEN + DEALLOCATE(MiscData%BodyStateIsN) +ENDIF + CALL MD_DestroyContState( MiscData%xTemp, ErrStat, ErrMsg ) + CALL MD_DestroyContState( MiscData%xdTemp, ErrStat, ErrMsg ) +IF (ALLOCATED(MiscData%MDWrOutput)) THEN + DEALLOCATE(MiscData%MDWrOutput) +ENDIF +IF (ALLOCATED(MiscData%BathymetryGrid)) THEN + DEALLOCATE(MiscData%BathymetryGrid) +ENDIF +IF (ALLOCATED(MiscData%BathGrid_Xs)) THEN + DEALLOCATE(MiscData%BathGrid_Xs) +ENDIF +IF (ALLOCATED(MiscData%BathGrid_Ys)) THEN + DEALLOCATE(MiscData%BathGrid_Ys) +ENDIF +IF (ALLOCATED(MiscData%BathGrid_npoints)) THEN + DEALLOCATE(MiscData%BathGrid_npoints) +ENDIF + END SUBROUTINE MD_DestroyMisc + + SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(MD_MiscVarType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackMisc' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! LineTypeList allocated yes/no + IF ( ALLOCATED(InData%LineTypeList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LineTypeList upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%LineTypeList,1), UBOUND(InData%LineTypeList,1) + Int_BufSz = Int_BufSz + 3 ! LineTypeList: size of buffers for each call to pack subtype + CALL MD_Packlineprop( Re_Buf, Db_Buf, Int_Buf, InData%LineTypeList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LineTypeList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! LineTypeList + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! LineTypeList + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! LineTypeList + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! RodTypeList allocated yes/no + IF ( ALLOCATED(InData%RodTypeList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RodTypeList upper/lower bounds for each dimension + DO i1 = LBOUND(InData%RodTypeList,1), UBOUND(InData%RodTypeList,1) + Int_BufSz = Int_BufSz + 3 ! RodTypeList: size of buffers for each call to pack subtype + CALL MD_Packrodprop( Re_Buf, Db_Buf, Int_Buf, InData%RodTypeList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! RodTypeList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! RodTypeList + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! RodTypeList + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! RodTypeList + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! GroundBody: size of buffers for each call to pack subtype + CALL MD_Packbody( Re_Buf, Db_Buf, Int_Buf, InData%GroundBody, ErrStat2, ErrMsg2, .TRUE. ) ! GroundBody + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! GroundBody + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! GroundBody + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! GroundBody + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! BodyList allocated yes/no + IF ( ALLOCATED(InData%BodyList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BodyList upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BodyList,1), UBOUND(InData%BodyList,1) + Int_BufSz = Int_BufSz + 3 ! BodyList: size of buffers for each call to pack subtype + CALL MD_Packbody( Re_Buf, Db_Buf, Int_Buf, InData%BodyList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BodyList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BodyList + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BodyList + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BodyList + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! RodList allocated yes/no + IF ( ALLOCATED(InData%RodList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RodList upper/lower bounds for each dimension + DO i1 = LBOUND(InData%RodList,1), UBOUND(InData%RodList,1) + Int_BufSz = Int_BufSz + 3 ! RodList: size of buffers for each call to pack subtype + CALL MD_Packrod( Re_Buf, Db_Buf, Int_Buf, InData%RodList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! RodList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! RodList + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! RodList + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! RodList + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! ConnectList allocated yes/no + IF ( ALLOCATED(InData%ConnectList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ConnectList upper/lower bounds for each dimension + DO i1 = LBOUND(InData%ConnectList,1), UBOUND(InData%ConnectList,1) + Int_BufSz = Int_BufSz + 3 ! ConnectList: size of buffers for each call to pack subtype + CALL MD_Packconnect( Re_Buf, Db_Buf, Int_Buf, InData%ConnectList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ConnectList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ConnectList + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ConnectList + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ConnectList + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! LineList allocated yes/no + IF ( ALLOCATED(InData%LineList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LineList upper/lower bounds for each dimension + DO i1 = LBOUND(InData%LineList,1), UBOUND(InData%LineList,1) + Int_BufSz = Int_BufSz + 3 ! LineList: size of buffers for each call to pack subtype + CALL MD_Packline( Re_Buf, Db_Buf, Int_Buf, InData%LineList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LineList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! LineList + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! LineList + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! LineList + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! FailList allocated yes/no + IF ( ALLOCATED(InData%FailList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! FailList upper/lower bounds for each dimension + DO i1 = LBOUND(InData%FailList,1), UBOUND(InData%FailList,1) + Int_BufSz = Int_BufSz + 3 ! FailList: size of buffers for each call to pack subtype + CALL MD_Packfail( Re_Buf, Db_Buf, Int_Buf, InData%FailList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! FailList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! FailList + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! FailList + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! FailList + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! FreeConIs allocated yes/no + IF ( ALLOCATED(InData%FreeConIs) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! FreeConIs upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%FreeConIs) ! FreeConIs + END IF + Int_BufSz = Int_BufSz + 1 ! CpldConIs allocated yes/no + IF ( ALLOCATED(InData%CpldConIs) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! CpldConIs upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%CpldConIs) ! CpldConIs + END IF + Int_BufSz = Int_BufSz + 1 ! FreeRodIs allocated yes/no + IF ( ALLOCATED(InData%FreeRodIs) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! FreeRodIs upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%FreeRodIs) ! FreeRodIs + END IF + Int_BufSz = Int_BufSz + 1 ! CpldRodIs allocated yes/no + IF ( ALLOCATED(InData%CpldRodIs) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! CpldRodIs upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%CpldRodIs) ! CpldRodIs + END IF + Int_BufSz = Int_BufSz + 1 ! FreeBodyIs allocated yes/no + IF ( ALLOCATED(InData%FreeBodyIs) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! FreeBodyIs upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%FreeBodyIs) ! FreeBodyIs + END IF + Int_BufSz = Int_BufSz + 1 ! CpldBodyIs allocated yes/no + IF ( ALLOCATED(InData%CpldBodyIs) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! CpldBodyIs upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%CpldBodyIs) ! CpldBodyIs + END IF + Int_BufSz = Int_BufSz + 1 ! LineStateIs1 allocated yes/no + IF ( ALLOCATED(InData%LineStateIs1) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LineStateIs1 upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%LineStateIs1) ! LineStateIs1 + END IF + Int_BufSz = Int_BufSz + 1 ! LineStateIsN allocated yes/no + IF ( ALLOCATED(InData%LineStateIsN) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LineStateIsN upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%LineStateIsN) ! LineStateIsN + END IF + Int_BufSz = Int_BufSz + 1 ! ConStateIs1 allocated yes/no + IF ( ALLOCATED(InData%ConStateIs1) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ConStateIs1 upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ConStateIs1) ! ConStateIs1 + END IF + Int_BufSz = Int_BufSz + 1 ! ConStateIsN allocated yes/no + IF ( ALLOCATED(InData%ConStateIsN) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ConStateIsN upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ConStateIsN) ! ConStateIsN + END IF + Int_BufSz = Int_BufSz + 1 ! RodStateIs1 allocated yes/no + IF ( ALLOCATED(InData%RodStateIs1) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RodStateIs1 upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RodStateIs1) ! RodStateIs1 + END IF + Int_BufSz = Int_BufSz + 1 ! RodStateIsN allocated yes/no + IF ( ALLOCATED(InData%RodStateIsN) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RodStateIsN upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RodStateIsN) ! RodStateIsN + END IF + Int_BufSz = Int_BufSz + 1 ! BodyStateIs1 allocated yes/no + IF ( ALLOCATED(InData%BodyStateIs1) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BodyStateIs1 upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BodyStateIs1) ! BodyStateIs1 + END IF + Int_BufSz = Int_BufSz + 1 ! BodyStateIsN allocated yes/no + IF ( ALLOCATED(InData%BodyStateIsN) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BodyStateIsN upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BodyStateIsN) ! BodyStateIsN + END IF + Int_BufSz = Int_BufSz + 1 ! Nx + Int_BufSz = Int_BufSz + 1 ! WaveTi + Int_BufSz = Int_BufSz + 3 ! xTemp: size of buffers for each call to pack subtype + CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xTemp, ErrStat2, ErrMsg2, .TRUE. ) ! xTemp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xTemp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xTemp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xTemp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! xdTemp: size of buffers for each call to pack subtype + CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdTemp, ErrStat2, ErrMsg2, .TRUE. ) ! xdTemp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xdTemp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xdTemp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xdTemp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Db_BufSz = Db_BufSz + SIZE(InData%zeros6) ! zeros6 + Int_BufSz = Int_BufSz + 1 ! MDWrOutput allocated yes/no + IF ( ALLOCATED(InData%MDWrOutput) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! MDWrOutput upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%MDWrOutput) ! MDWrOutput + END IF + Db_BufSz = Db_BufSz + 1 ! LastOutTime + Re_BufSz = Re_BufSz + SIZE(InData%PtfmInit) ! PtfmInit + Int_BufSz = Int_BufSz + 1 ! BathymetryGrid allocated yes/no + IF ( ALLOCATED(InData%BathymetryGrid) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BathymetryGrid upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%BathymetryGrid) ! BathymetryGrid + END IF + Int_BufSz = Int_BufSz + 1 ! BathGrid_Xs allocated yes/no + IF ( ALLOCATED(InData%BathGrid_Xs) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BathGrid_Xs upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%BathGrid_Xs) ! BathGrid_Xs + END IF + Int_BufSz = Int_BufSz + 1 ! BathGrid_Ys allocated yes/no + IF ( ALLOCATED(InData%BathGrid_Ys) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BathGrid_Ys upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%BathGrid_Ys) ! BathGrid_Ys + END IF + Int_BufSz = Int_BufSz + 1 ! BathGrid_npoints allocated yes/no + IF ( ALLOCATED(InData%BathGrid_npoints) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BathGrid_npoints upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BathGrid_npoints) ! BathGrid_npoints + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%LineTypeList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LineTypeList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineTypeList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LineTypeList,1), UBOUND(InData%LineTypeList,1) + CALL MD_Packlineprop( Re_Buf, Db_Buf, Int_Buf, InData%LineTypeList(i1), ErrStat2, ErrMsg2, OnlySize ) ! LineTypeList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RodTypeList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RodTypeList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodTypeList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%RodTypeList,1), UBOUND(InData%RodTypeList,1) + CALL MD_Packrodprop( Re_Buf, Db_Buf, Int_Buf, InData%RodTypeList(i1), ErrStat2, ErrMsg2, OnlySize ) ! RodTypeList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL MD_Packbody( Re_Buf, Db_Buf, Int_Buf, InData%GroundBody, ErrStat2, ErrMsg2, OnlySize ) ! GroundBody + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%BodyList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BodyList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BodyList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BodyList,1), UBOUND(InData%BodyList,1) + CALL MD_Packbody( Re_Buf, Db_Buf, Int_Buf, InData%BodyList(i1), ErrStat2, ErrMsg2, OnlySize ) ! BodyList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RodList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RodList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%RodList,1), UBOUND(InData%RodList,1) + CALL MD_Packrod( Re_Buf, Db_Buf, Int_Buf, InData%RodList(i1), ErrStat2, ErrMsg2, OnlySize ) ! RodList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ConnectList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ConnectList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ConnectList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ConnectList,1), UBOUND(InData%ConnectList,1) + CALL MD_Packconnect( Re_Buf, Db_Buf, Int_Buf, InData%ConnectList(i1), ErrStat2, ErrMsg2, OnlySize ) ! ConnectList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%LineList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LineList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LineList,1), UBOUND(InData%LineList,1) + CALL MD_Packline( Re_Buf, Db_Buf, Int_Buf, InData%LineList(i1), ErrStat2, ErrMsg2, OnlySize ) ! LineList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%FailList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%FailList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FailList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%FailList,1), UBOUND(InData%FailList,1) + CALL MD_Packfail( Re_Buf, Db_Buf, Int_Buf, InData%FailList(i1), ErrStat2, ErrMsg2, OnlySize ) ! FailList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%FreeConIs) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%FreeConIs,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreeConIs,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%FreeConIs,1), UBOUND(InData%FreeConIs,1) + IntKiBuf(Int_Xferred) = InData%FreeConIs(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%CpldConIs) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldConIs,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldConIs,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldConIs,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldConIs,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%CpldConIs,2), UBOUND(InData%CpldConIs,2) + DO i1 = LBOUND(InData%CpldConIs,1), UBOUND(InData%CpldConIs,1) + IntKiBuf(Int_Xferred) = InData%CpldConIs(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%FreeRodIs) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%FreeRodIs,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreeRodIs,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%FreeRodIs,1), UBOUND(InData%FreeRodIs,1) + IntKiBuf(Int_Xferred) = InData%FreeRodIs(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%CpldRodIs) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldRodIs,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldRodIs,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldRodIs,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldRodIs,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%CpldRodIs,2), UBOUND(InData%CpldRodIs,2) + DO i1 = LBOUND(InData%CpldRodIs,1), UBOUND(InData%CpldRodIs,1) + IntKiBuf(Int_Xferred) = InData%CpldRodIs(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%FreeBodyIs) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%FreeBodyIs,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreeBodyIs,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%FreeBodyIs,1), UBOUND(InData%FreeBodyIs,1) + IntKiBuf(Int_Xferred) = InData%FreeBodyIs(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%CpldBodyIs) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldBodyIs,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldBodyIs,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CpldBodyIs,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CpldBodyIs,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%CpldBodyIs,2), UBOUND(InData%CpldBodyIs,2) + DO i1 = LBOUND(InData%CpldBodyIs,1), UBOUND(InData%CpldBodyIs,1) + IntKiBuf(Int_Xferred) = InData%CpldBodyIs(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%LineStateIs1) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LineStateIs1,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineStateIs1,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LineStateIs1,1), UBOUND(InData%LineStateIs1,1) + IntKiBuf(Int_Xferred) = InData%LineStateIs1(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%LineStateIsN) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LineStateIsN,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineStateIsN,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LineStateIsN,1), UBOUND(InData%LineStateIsN,1) + IntKiBuf(Int_Xferred) = InData%LineStateIsN(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ConStateIs1) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ConStateIs1,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ConStateIs1,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ConStateIs1,1), UBOUND(InData%ConStateIs1,1) + IntKiBuf(Int_Xferred) = InData%ConStateIs1(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ConStateIsN) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ConStateIsN,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ConStateIsN,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ConStateIsN,1), UBOUND(InData%ConStateIsN,1) + IntKiBuf(Int_Xferred) = InData%ConStateIsN(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RodStateIs1) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RodStateIs1,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodStateIs1,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%RodStateIs1,1), UBOUND(InData%RodStateIs1,1) + IntKiBuf(Int_Xferred) = InData%RodStateIs1(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RodStateIsN) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RodStateIsN,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RodStateIsN,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%RodStateIsN,1), UBOUND(InData%RodStateIsN,1) + IntKiBuf(Int_Xferred) = InData%RodStateIsN(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BodyStateIs1) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BodyStateIs1,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BodyStateIs1,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BodyStateIs1,1), UBOUND(InData%BodyStateIs1,1) + IntKiBuf(Int_Xferred) = InData%BodyStateIs1(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BodyStateIsN) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BodyStateIsN,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BodyStateIsN,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BodyStateIsN,1), UBOUND(InData%BodyStateIsN,1) + IntKiBuf(Int_Xferred) = InData%BodyStateIsN(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%Nx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveTi + Int_Xferred = Int_Xferred + 1 + CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xTemp, ErrStat2, ErrMsg2, OnlySize ) ! xTemp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdTemp, ErrStat2, ErrMsg2, OnlySize ) ! xdTemp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + DO i1 = LBOUND(InData%zeros6,1), UBOUND(InData%zeros6,1) + DbKiBuf(Db_Xferred) = InData%zeros6(i1) + Db_Xferred = Db_Xferred + 1 + END DO + IF ( .NOT. ALLOCATED(InData%MDWrOutput) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%MDWrOutput,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MDWrOutput,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%MDWrOutput,1), UBOUND(InData%MDWrOutput,1) + DbKiBuf(Db_Xferred) = InData%MDWrOutput(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + DbKiBuf(Db_Xferred) = InData%LastOutTime + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) + ReKiBuf(Re_Xferred) = InData%PtfmInit(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IF ( .NOT. ALLOCATED(InData%BathymetryGrid) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BathymetryGrid,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathymetryGrid,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BathymetryGrid,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathymetryGrid,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BathymetryGrid,2), UBOUND(InData%BathymetryGrid,2) + DO i1 = LBOUND(InData%BathymetryGrid,1), UBOUND(InData%BathymetryGrid,1) + DbKiBuf(Db_Xferred) = InData%BathymetryGrid(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BathGrid_Xs) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BathGrid_Xs,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathGrid_Xs,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BathGrid_Xs,1), UBOUND(InData%BathGrid_Xs,1) + DbKiBuf(Db_Xferred) = InData%BathGrid_Xs(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BathGrid_Ys) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BathGrid_Ys,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathGrid_Ys,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BathGrid_Ys,1), UBOUND(InData%BathGrid_Ys,1) + DbKiBuf(Db_Xferred) = InData%BathGrid_Ys(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BathGrid_npoints) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BathGrid_npoints,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BathGrid_npoints,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BathGrid_npoints,1), UBOUND(InData%BathGrid_npoints,1) + IntKiBuf(Int_Xferred) = InData%BathGrid_npoints(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + END SUBROUTINE MD_PackMisc + + SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MD_MiscVarType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackMisc' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineTypeList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LineTypeList)) DEALLOCATE(OutData%LineTypeList) + ALLOCATE(OutData%LineTypeList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineTypeList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LineTypeList,1), UBOUND(OutData%LineTypeList,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_Unpacklineprop( Re_Buf, Db_Buf, Int_Buf, OutData%LineTypeList(i1), ErrStat2, ErrMsg2 ) ! LineTypeList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodTypeList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RodTypeList)) DEALLOCATE(OutData%RodTypeList) + ALLOCATE(OutData%RodTypeList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodTypeList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RodTypeList,1), UBOUND(OutData%RodTypeList,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_Unpackrodprop( Re_Buf, Db_Buf, Int_Buf, OutData%RodTypeList(i1), ErrStat2, ErrMsg2 ) ! RodTypeList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_Unpackbody( Re_Buf, Db_Buf, Int_Buf, OutData%GroundBody, ErrStat2, ErrMsg2 ) ! GroundBody + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BodyList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BodyList)) DEALLOCATE(OutData%BodyList) + ALLOCATE(OutData%BodyList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BodyList,1), UBOUND(OutData%BodyList,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_Unpackbody( Re_Buf, Db_Buf, Int_Buf, OutData%BodyList(i1), ErrStat2, ErrMsg2 ) ! BodyList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RodList)) DEALLOCATE(OutData%RodList) + ALLOCATE(OutData%RodList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RodList,1), UBOUND(OutData%RodList,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_Unpackrod( Re_Buf, Db_Buf, Int_Buf, OutData%RodList(i1), ErrStat2, ErrMsg2 ) ! RodList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ConnectList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ConnectList)) DEALLOCATE(OutData%ConnectList) + ALLOCATE(OutData%ConnectList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConnectList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ConnectList,1), UBOUND(OutData%ConnectList,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_Unpackconnect( Re_Buf, Db_Buf, Int_Buf, OutData%ConnectList(i1), ErrStat2, ErrMsg2 ) ! ConnectList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LineList)) DEALLOCATE(OutData%LineList) + ALLOCATE(OutData%LineList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LineList,1), UBOUND(OutData%LineList,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_Unpackline( Re_Buf, Db_Buf, Int_Buf, OutData%LineList(i1), ErrStat2, ErrMsg2 ) ! LineList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FailList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%FailList)) DEALLOCATE(OutData%FailList) + ALLOCATE(OutData%FailList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FailList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%FailList,1), UBOUND(OutData%FailList,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_Unpackfail( Re_Buf, Db_Buf, Int_Buf, OutData%FailList(i1), ErrStat2, ErrMsg2 ) ! FailList + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreeConIs not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%FreeConIs)) DEALLOCATE(OutData%FreeConIs) + ALLOCATE(OutData%FreeConIs(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeConIs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%FreeConIs,1), UBOUND(OutData%FreeConIs,1) + OutData%FreeConIs(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CpldConIs not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CpldConIs)) DEALLOCATE(OutData%CpldConIs) + ALLOCATE(OutData%CpldConIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldConIs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%CpldConIs,2), UBOUND(OutData%CpldConIs,2) + DO i1 = LBOUND(OutData%CpldConIs,1), UBOUND(OutData%CpldConIs,1) + OutData%CpldConIs(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreeRodIs not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%FreeRodIs)) DEALLOCATE(OutData%FreeRodIs) + ALLOCATE(OutData%FreeRodIs(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeRodIs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%FreeRodIs,1), UBOUND(OutData%FreeRodIs,1) + OutData%FreeRodIs(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CpldRodIs not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CpldRodIs)) DEALLOCATE(OutData%CpldRodIs) + ALLOCATE(OutData%CpldRodIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldRodIs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%CpldRodIs,2), UBOUND(OutData%CpldRodIs,2) + DO i1 = LBOUND(OutData%CpldRodIs,1), UBOUND(OutData%CpldRodIs,1) + OutData%CpldRodIs(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreeBodyIs not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%FreeBodyIs)) DEALLOCATE(OutData%FreeBodyIs) + ALLOCATE(OutData%FreeBodyIs(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreeBodyIs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%FreeBodyIs,1), UBOUND(OutData%FreeBodyIs,1) + OutData%FreeBodyIs(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CpldBodyIs not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CpldBodyIs)) DEALLOCATE(OutData%CpldBodyIs) + ALLOCATE(OutData%CpldBodyIs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CpldBodyIs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%CpldBodyIs,2), UBOUND(OutData%CpldBodyIs,2) + DO i1 = LBOUND(OutData%CpldBodyIs,1), UBOUND(OutData%CpldBodyIs,1) + OutData%CpldBodyIs(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineStateIs1 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LineStateIs1)) DEALLOCATE(OutData%LineStateIs1) + ALLOCATE(OutData%LineStateIs1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIs1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LineStateIs1,1), UBOUND(OutData%LineStateIs1,1) + OutData%LineStateIs1(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineStateIsN not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LineStateIsN)) DEALLOCATE(OutData%LineStateIsN) + ALLOCATE(OutData%LineStateIsN(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIsN.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%LineStateIsN,1), UBOUND(OutData%LineStateIsN,1) + OutData%LineStateIsN(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ConStateIs1 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ConStateIs1)) DEALLOCATE(OutData%ConStateIs1) + ALLOCATE(OutData%ConStateIs1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConStateIs1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ConStateIs1,1), UBOUND(OutData%ConStateIs1,1) + OutData%ConStateIs1(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ConStateIsN not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ConStateIsN)) DEALLOCATE(OutData%ConStateIsN) + ALLOCATE(OutData%ConStateIsN(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConStateIsN.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ConStateIsN,1), UBOUND(OutData%ConStateIsN,1) + OutData%ConStateIsN(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodStateIs1 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RodStateIs1)) DEALLOCATE(OutData%RodStateIs1) + ALLOCATE(OutData%RodStateIs1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodStateIs1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RodStateIs1,1), UBOUND(OutData%RodStateIs1,1) + OutData%RodStateIs1(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RodStateIsN not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RodStateIsN)) DEALLOCATE(OutData%RodStateIsN) + ALLOCATE(OutData%RodStateIsN(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RodStateIsN.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RodStateIsN,1), UBOUND(OutData%RodStateIsN,1) + OutData%RodStateIsN(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BodyStateIs1 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BodyStateIs1)) DEALLOCATE(OutData%BodyStateIs1) + ALLOCATE(OutData%BodyStateIs1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyStateIs1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BodyStateIs1,1), UBOUND(OutData%BodyStateIs1,1) + OutData%BodyStateIs1(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BodyStateIsN not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BodyStateIsN)) DEALLOCATE(OutData%BodyStateIsN) + ALLOCATE(OutData%BodyStateIsN(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BodyStateIsN.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BodyStateIsN,1), UBOUND(OutData%BodyStateIsN,1) + OutData%BodyStateIsN(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%Nx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveTi = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xTemp, ErrStat2, ErrMsg2 ) ! xTemp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdTemp, ErrStat2, ErrMsg2 ) ! xdTemp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + i1_l = LBOUND(OutData%zeros6,1) + i1_u = UBOUND(OutData%zeros6,1) + DO i1 = LBOUND(OutData%zeros6,1), UBOUND(OutData%zeros6,1) + OutData%zeros6(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MDWrOutput not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%MDWrOutput)) DEALLOCATE(OutData%MDWrOutput) + ALLOCATE(OutData%MDWrOutput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MDWrOutput.', ErrStat, ErrMsg,RoutineName) RETURN - END IF + END IF + DO i1 = LBOUND(OutData%MDWrOutput,1), UBOUND(OutData%MDWrOutput,1) + OutData%MDWrOutput(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + OutData%LastOutTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + i1_l = LBOUND(OutData%PtfmInit,1) + i1_u = UBOUND(OutData%PtfmInit,1) + DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) + OutData%PtfmInit(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathymetryGrid not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BathymetryGrid)) DEALLOCATE(OutData%BathymetryGrid) + ALLOCATE(OutData%BathymetryGrid(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathymetryGrid.', ErrStat, ErrMsg,RoutineName) RETURN - END IF + END IF + DO i2 = LBOUND(OutData%BathymetryGrid,2), UBOUND(OutData%BathymetryGrid,2) + DO i1 = LBOUND(OutData%BathymetryGrid,1), UBOUND(OutData%BathymetryGrid,1) + OutData%BathymetryGrid(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_PackConstrState - - SUBROUTINE MD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_ConstraintStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackConstrState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_UnPackConstrState - - SUBROUTINE MD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(MD_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%dummy = SrcOtherStateData%dummy - END SUBROUTINE MD_CopyOtherState - - SUBROUTINE MD_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(MD_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyOtherState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE MD_DestroyOtherState - - SUBROUTINE MD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_OtherStateType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackOtherState' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! dummy - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathGrid_Xs not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BathGrid_Xs)) DEALLOCATE(OutData%BathGrid_Xs) + ALLOCATE(OutData%BathGrid_Xs(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_Xs.', ErrStat, ErrMsg,RoutineName) RETURN - END IF + END IF + DO i1 = LBOUND(OutData%BathGrid_Xs,1), UBOUND(OutData%BathGrid_Xs,1) + OutData%BathGrid_Xs(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathGrid_Ys not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BathGrid_Ys)) DEALLOCATE(OutData%BathGrid_Ys) + ALLOCATE(OutData%BathGrid_Ys(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_Ys.', ErrStat, ErrMsg,RoutineName) RETURN - END IF + END IF + DO i1 = LBOUND(OutData%BathGrid_Ys,1), UBOUND(OutData%BathGrid_Ys,1) + OutData%BathGrid_Ys(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BathGrid_npoints not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BathGrid_npoints)) DEALLOCATE(OutData%BathGrid_npoints) + ALLOCATE(OutData%BathGrid_npoints(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BathGrid_npoints.', ErrStat, ErrMsg,RoutineName) RETURN - END IF + END IF + DO i1 = LBOUND(OutData%BathGrid_npoints,1), UBOUND(OutData%BathGrid_npoints,1) + OutData%BathGrid_npoints(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - ReKiBuf(Re_Xferred) = InData%dummy - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_PackOtherState - - SUBROUTINE MD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_OtherStateType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackOtherState' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE MD_UnPackOtherState - - SUBROUTINE MD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(MD_MiscVarType), INTENT(INOUT) :: DstMiscData + END SUBROUTINE MD_UnPackMisc + + SUBROUTINE MD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MD_ParameterType), INTENT(IN) :: SrcParamData + TYPE(MD_ParameterType), INTENT(INOUT) :: DstParamData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyMisc' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyParam' ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(SrcMiscData%LineTypeList)) THEN - i1_l = LBOUND(SrcMiscData%LineTypeList,1) - i1_u = UBOUND(SrcMiscData%LineTypeList,1) - IF (.NOT. ALLOCATED(DstMiscData%LineTypeList)) THEN - ALLOCATE(DstMiscData%LineTypeList(i1_l:i1_u),STAT=ErrStat2) + DstParamData%nLineTypes = SrcParamData%nLineTypes + DstParamData%nRodTypes = SrcParamData%nRodTypes + DstParamData%nConnects = SrcParamData%nConnects + DstParamData%nConnectsExtra = SrcParamData%nConnectsExtra + DstParamData%nBodies = SrcParamData%nBodies + DstParamData%nRods = SrcParamData%nRods + DstParamData%nLines = SrcParamData%nLines + DstParamData%nCtrlChans = SrcParamData%nCtrlChans + DstParamData%nFails = SrcParamData%nFails + DstParamData%nFreeBodies = SrcParamData%nFreeBodies + DstParamData%nFreeRods = SrcParamData%nFreeRods + DstParamData%nFreeCons = SrcParamData%nFreeCons +IF (ALLOCATED(SrcParamData%nCpldBodies)) THEN + i1_l = LBOUND(SrcParamData%nCpldBodies,1) + i1_u = UBOUND(SrcParamData%nCpldBodies,1) + IF (.NOT. ALLOCATED(DstParamData%nCpldBodies)) THEN + ALLOCATE(DstParamData%nCpldBodies(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineTypeList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldBodies.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcMiscData%LineTypeList,1), UBOUND(SrcMiscData%LineTypeList,1) - CALL MD_Copylineprop( SrcMiscData%LineTypeList(i1), DstMiscData%LineTypeList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO + DstParamData%nCpldBodies = SrcParamData%nCpldBodies ENDIF -IF (ALLOCATED(SrcMiscData%ConnectList)) THEN - i1_l = LBOUND(SrcMiscData%ConnectList,1) - i1_u = UBOUND(SrcMiscData%ConnectList,1) - IF (.NOT. ALLOCATED(DstMiscData%ConnectList)) THEN - ALLOCATE(DstMiscData%ConnectList(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcParamData%nCpldRods)) THEN + i1_l = LBOUND(SrcParamData%nCpldRods,1) + i1_u = UBOUND(SrcParamData%nCpldRods,1) + IF (.NOT. ALLOCATED(DstParamData%nCpldRods)) THEN + ALLOCATE(DstParamData%nCpldRods(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConnectList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldRods.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcMiscData%ConnectList,1), UBOUND(SrcMiscData%ConnectList,1) - CALL MD_Copyconnect( SrcMiscData%ConnectList(i1), DstMiscData%ConnectList(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO + DstParamData%nCpldRods = SrcParamData%nCpldRods ENDIF -IF (ALLOCATED(SrcMiscData%LineList)) THEN - i1_l = LBOUND(SrcMiscData%LineList,1) - i1_u = UBOUND(SrcMiscData%LineList,1) - IF (.NOT. ALLOCATED(DstMiscData%LineList)) THEN - ALLOCATE(DstMiscData%LineList(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcParamData%nCpldCons)) THEN + i1_l = LBOUND(SrcParamData%nCpldCons,1) + i1_u = UBOUND(SrcParamData%nCpldCons,1) + IF (.NOT. ALLOCATED(DstParamData%nCpldCons)) THEN + ALLOCATE(DstParamData%nCpldCons(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%nCpldCons.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcMiscData%LineList,1), UBOUND(SrcMiscData%LineList,1) - CALL MD_Copyline( SrcMiscData%LineList(i1), DstMiscData%LineList(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DstParamData%nCpldCons = SrcParamData%nCpldCons +ENDIF + DstParamData%NConns = SrcParamData%NConns + DstParamData%NAnchs = SrcParamData%NAnchs + DstParamData%Tmax = SrcParamData%Tmax + DstParamData%g = SrcParamData%g + DstParamData%rhoW = SrcParamData%rhoW + DstParamData%WtrDpth = SrcParamData%WtrDpth + DstParamData%kBot = SrcParamData%kBot + DstParamData%cBot = SrcParamData%cBot + DstParamData%dtM0 = SrcParamData%dtM0 + DstParamData%dtCoupling = SrcParamData%dtCoupling + DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%dtOut = SrcParamData%dtOut + DstParamData%RootName = SrcParamData%RootName +IF (ALLOCATED(SrcParamData%OutParam)) THEN + i1_l = LBOUND(SrcParamData%OutParam,1) + i1_u = UBOUND(SrcParamData%OutParam,1) + IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN + ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) + CALL MD_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcMiscData%FairIdList)) THEN - i1_l = LBOUND(SrcMiscData%FairIdList,1) - i1_u = UBOUND(SrcMiscData%FairIdList,1) - IF (.NOT. ALLOCATED(DstMiscData%FairIdList)) THEN - ALLOCATE(DstMiscData%FairIdList(i1_l:i1_u),STAT=ErrStat2) + DstParamData%Delim = SrcParamData%Delim + DstParamData%MDUnOut = SrcParamData%MDUnOut + DstParamData%PriPath = SrcParamData%PriPath + DstParamData%writeLog = SrcParamData%writeLog + DstParamData%UnLog = SrcParamData%UnLog + DstParamData%WaveKin = SrcParamData%WaveKin + DstParamData%Current = SrcParamData%Current + DstParamData%nTurbines = SrcParamData%nTurbines +IF (ALLOCATED(SrcParamData%TurbineRefPos)) THEN + i1_l = LBOUND(SrcParamData%TurbineRefPos,1) + i1_u = UBOUND(SrcParamData%TurbineRefPos,1) + i2_l = LBOUND(SrcParamData%TurbineRefPos,2) + i2_u = UBOUND(SrcParamData%TurbineRefPos,2) + IF (.NOT. ALLOCATED(DstParamData%TurbineRefPos)) THEN + ALLOCATE(DstParamData%TurbineRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TurbineRefPos.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%TurbineRefPos = SrcParamData%TurbineRefPos +ENDIF + DstParamData%mu_kT = SrcParamData%mu_kT + DstParamData%mu_kA = SrcParamData%mu_kA + DstParamData%mc = SrcParamData%mc + DstParamData%cv = SrcParamData%cv + DstParamData%nxWave = SrcParamData%nxWave + DstParamData%nyWave = SrcParamData%nyWave + DstParamData%nzWave = SrcParamData%nzWave + DstParamData%ntWave = SrcParamData%ntWave +IF (ALLOCATED(SrcParamData%pxWave)) THEN + i1_l = LBOUND(SrcParamData%pxWave,1) + i1_u = UBOUND(SrcParamData%pxWave,1) + IF (.NOT. ALLOCATED(DstParamData%pxWave)) THEN + ALLOCATE(DstParamData%pxWave(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%FairIdList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pxWave.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMiscData%FairIdList = SrcMiscData%FairIdList + DstParamData%pxWave = SrcParamData%pxWave ENDIF -IF (ALLOCATED(SrcMiscData%ConnIdList)) THEN - i1_l = LBOUND(SrcMiscData%ConnIdList,1) - i1_u = UBOUND(SrcMiscData%ConnIdList,1) - IF (.NOT. ALLOCATED(DstMiscData%ConnIdList)) THEN - ALLOCATE(DstMiscData%ConnIdList(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcParamData%pyWave)) THEN + i1_l = LBOUND(SrcParamData%pyWave,1) + i1_u = UBOUND(SrcParamData%pyWave,1) + IF (.NOT. ALLOCATED(DstParamData%pyWave)) THEN + ALLOCATE(DstParamData%pyWave(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ConnIdList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pyWave.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMiscData%ConnIdList = SrcMiscData%ConnIdList + DstParamData%pyWave = SrcParamData%pyWave ENDIF -IF (ALLOCATED(SrcMiscData%LineStateIndList)) THEN - i1_l = LBOUND(SrcMiscData%LineStateIndList,1) - i1_u = UBOUND(SrcMiscData%LineStateIndList,1) - IF (.NOT. ALLOCATED(DstMiscData%LineStateIndList)) THEN - ALLOCATE(DstMiscData%LineStateIndList(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcParamData%pzWave)) THEN + i1_l = LBOUND(SrcParamData%pzWave,1) + i1_u = UBOUND(SrcParamData%pzWave,1) + IF (.NOT. ALLOCATED(DstParamData%pzWave)) THEN + ALLOCATE(DstParamData%pzWave(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%LineStateIndList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzWave.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMiscData%LineStateIndList = SrcMiscData%LineStateIndList + DstParamData%pzWave = SrcParamData%pzWave ENDIF -IF (ALLOCATED(SrcMiscData%MDWrOutput)) THEN - i1_l = LBOUND(SrcMiscData%MDWrOutput,1) - i1_u = UBOUND(SrcMiscData%MDWrOutput,1) - IF (.NOT. ALLOCATED(DstMiscData%MDWrOutput)) THEN - ALLOCATE(DstMiscData%MDWrOutput(i1_l:i1_u),STAT=ErrStat2) + DstParamData%dtWave = SrcParamData%dtWave +IF (ALLOCATED(SrcParamData%uxWave)) THEN + i1_l = LBOUND(SrcParamData%uxWave,1) + i1_u = UBOUND(SrcParamData%uxWave,1) + i2_l = LBOUND(SrcParamData%uxWave,2) + i2_u = UBOUND(SrcParamData%uxWave,2) + i3_l = LBOUND(SrcParamData%uxWave,3) + i3_u = UBOUND(SrcParamData%uxWave,3) + i4_l = LBOUND(SrcParamData%uxWave,4) + i4_u = UBOUND(SrcParamData%uxWave,4) + IF (.NOT. ALLOCATED(DstParamData%uxWave)) THEN + ALLOCATE(DstParamData%uxWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%MDWrOutput.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxWave.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMiscData%MDWrOutput = SrcMiscData%MDWrOutput + DstParamData%uxWave = SrcParamData%uxWave ENDIF - END SUBROUTINE MD_CopyMisc +IF (ALLOCATED(SrcParamData%uyWave)) THEN + i1_l = LBOUND(SrcParamData%uyWave,1) + i1_u = UBOUND(SrcParamData%uyWave,1) + i2_l = LBOUND(SrcParamData%uyWave,2) + i2_u = UBOUND(SrcParamData%uyWave,2) + i3_l = LBOUND(SrcParamData%uyWave,3) + i3_u = UBOUND(SrcParamData%uyWave,3) + i4_l = LBOUND(SrcParamData%uyWave,4) + i4_u = UBOUND(SrcParamData%uyWave,4) + IF (.NOT. ALLOCATED(DstParamData%uyWave)) THEN + ALLOCATE(DstParamData%uyWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyWave.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%uyWave = SrcParamData%uyWave +ENDIF +IF (ALLOCATED(SrcParamData%uzWave)) THEN + i1_l = LBOUND(SrcParamData%uzWave,1) + i1_u = UBOUND(SrcParamData%uzWave,1) + i2_l = LBOUND(SrcParamData%uzWave,2) + i2_u = UBOUND(SrcParamData%uzWave,2) + i3_l = LBOUND(SrcParamData%uzWave,3) + i3_u = UBOUND(SrcParamData%uzWave,3) + i4_l = LBOUND(SrcParamData%uzWave,4) + i4_u = UBOUND(SrcParamData%uzWave,4) + IF (.NOT. ALLOCATED(DstParamData%uzWave)) THEN + ALLOCATE(DstParamData%uzWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uzWave.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%uzWave = SrcParamData%uzWave +ENDIF +IF (ALLOCATED(SrcParamData%axWave)) THEN + i1_l = LBOUND(SrcParamData%axWave,1) + i1_u = UBOUND(SrcParamData%axWave,1) + i2_l = LBOUND(SrcParamData%axWave,2) + i2_u = UBOUND(SrcParamData%axWave,2) + i3_l = LBOUND(SrcParamData%axWave,3) + i3_u = UBOUND(SrcParamData%axWave,3) + i4_l = LBOUND(SrcParamData%axWave,4) + i4_u = UBOUND(SrcParamData%axWave,4) + IF (.NOT. ALLOCATED(DstParamData%axWave)) THEN + ALLOCATE(DstParamData%axWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%axWave.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%axWave = SrcParamData%axWave +ENDIF +IF (ALLOCATED(SrcParamData%ayWave)) THEN + i1_l = LBOUND(SrcParamData%ayWave,1) + i1_u = UBOUND(SrcParamData%ayWave,1) + i2_l = LBOUND(SrcParamData%ayWave,2) + i2_u = UBOUND(SrcParamData%ayWave,2) + i3_l = LBOUND(SrcParamData%ayWave,3) + i3_u = UBOUND(SrcParamData%ayWave,3) + i4_l = LBOUND(SrcParamData%ayWave,4) + i4_u = UBOUND(SrcParamData%ayWave,4) + IF (.NOT. ALLOCATED(DstParamData%ayWave)) THEN + ALLOCATE(DstParamData%ayWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ayWave.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%ayWave = SrcParamData%ayWave +ENDIF +IF (ALLOCATED(SrcParamData%azWave)) THEN + i1_l = LBOUND(SrcParamData%azWave,1) + i1_u = UBOUND(SrcParamData%azWave,1) + i2_l = LBOUND(SrcParamData%azWave,2) + i2_u = UBOUND(SrcParamData%azWave,2) + i3_l = LBOUND(SrcParamData%azWave,3) + i3_u = UBOUND(SrcParamData%azWave,3) + i4_l = LBOUND(SrcParamData%azWave,4) + i4_u = UBOUND(SrcParamData%azWave,4) + IF (.NOT. ALLOCATED(DstParamData%azWave)) THEN + ALLOCATE(DstParamData%azWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%azWave.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%azWave = SrcParamData%azWave +ENDIF +IF (ALLOCATED(SrcParamData%PDyn)) THEN + i1_l = LBOUND(SrcParamData%PDyn,1) + i1_u = UBOUND(SrcParamData%PDyn,1) + i2_l = LBOUND(SrcParamData%PDyn,2) + i2_u = UBOUND(SrcParamData%PDyn,2) + i3_l = LBOUND(SrcParamData%PDyn,3) + i3_u = UBOUND(SrcParamData%PDyn,3) + i4_l = LBOUND(SrcParamData%PDyn,4) + i4_u = UBOUND(SrcParamData%PDyn,4) + IF (.NOT. ALLOCATED(DstParamData%PDyn)) THEN + ALLOCATE(DstParamData%PDyn(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%PDyn.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%PDyn = SrcParamData%PDyn +ENDIF +IF (ALLOCATED(SrcParamData%zeta)) THEN + i1_l = LBOUND(SrcParamData%zeta,1) + i1_u = UBOUND(SrcParamData%zeta,1) + i2_l = LBOUND(SrcParamData%zeta,2) + i2_u = UBOUND(SrcParamData%zeta,2) + i3_l = LBOUND(SrcParamData%zeta,3) + i3_u = UBOUND(SrcParamData%zeta,3) + IF (.NOT. ALLOCATED(DstParamData%zeta)) THEN + ALLOCATE(DstParamData%zeta(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%zeta.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%zeta = SrcParamData%zeta +ENDIF + DstParamData%nzCurrent = SrcParamData%nzCurrent +IF (ALLOCATED(SrcParamData%pzCurrent)) THEN + i1_l = LBOUND(SrcParamData%pzCurrent,1) + i1_u = UBOUND(SrcParamData%pzCurrent,1) + IF (.NOT. ALLOCATED(DstParamData%pzCurrent)) THEN + ALLOCATE(DstParamData%pzCurrent(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%pzCurrent.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%pzCurrent = SrcParamData%pzCurrent +ENDIF +IF (ALLOCATED(SrcParamData%uxCurrent)) THEN + i1_l = LBOUND(SrcParamData%uxCurrent,1) + i1_u = UBOUND(SrcParamData%uxCurrent,1) + IF (.NOT. ALLOCATED(DstParamData%uxCurrent)) THEN + ALLOCATE(DstParamData%uxCurrent(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uxCurrent.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%uxCurrent = SrcParamData%uxCurrent +ENDIF +IF (ALLOCATED(SrcParamData%uyCurrent)) THEN + i1_l = LBOUND(SrcParamData%uyCurrent,1) + i1_u = UBOUND(SrcParamData%uyCurrent,1) + IF (.NOT. ALLOCATED(DstParamData%uyCurrent)) THEN + ALLOCATE(DstParamData%uyCurrent(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%uyCurrent.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%uyCurrent = SrcParamData%uyCurrent +ENDIF + DstParamData%Nx0 = SrcParamData%Nx0 +IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN + i1_l = LBOUND(SrcParamData%Jac_u_indx,1) + i1_u = UBOUND(SrcParamData%Jac_u_indx,1) + i2_l = LBOUND(SrcParamData%Jac_u_indx,2) + i2_u = UBOUND(SrcParamData%Jac_u_indx,2) + IF (.NOT. ALLOCATED(DstParamData%Jac_u_indx)) THEN + ALLOCATE(DstParamData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%Jac_u_indx = SrcParamData%Jac_u_indx +ENDIF +IF (ALLOCATED(SrcParamData%du)) THEN + i1_l = LBOUND(SrcParamData%du,1) + i1_u = UBOUND(SrcParamData%du,1) + IF (.NOT. ALLOCATED(DstParamData%du)) THEN + ALLOCATE(DstParamData%du(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%du.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%du = SrcParamData%du +ENDIF +IF (ALLOCATED(SrcParamData%dx)) THEN + i1_l = LBOUND(SrcParamData%dx,1) + i1_u = UBOUND(SrcParamData%dx,1) + IF (.NOT. ALLOCATED(DstParamData%dx)) THEN + ALLOCATE(DstParamData%dx(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%dx = SrcParamData%dx +ENDIF + DstParamData%Jac_ny = SrcParamData%Jac_ny + DstParamData%Jac_nx = SrcParamData%Jac_nx +IF (ALLOCATED(SrcParamData%dxIdx_map2_xStateIdx)) THEN + i1_l = LBOUND(SrcParamData%dxIdx_map2_xStateIdx,1) + i1_u = UBOUND(SrcParamData%dxIdx_map2_xStateIdx,1) + IF (.NOT. ALLOCATED(DstParamData%dxIdx_map2_xStateIdx)) THEN + ALLOCATE(DstParamData%dxIdx_map2_xStateIdx(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%dxIdx_map2_xStateIdx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%dxIdx_map2_xStateIdx = SrcParamData%dxIdx_map2_xStateIdx +ENDIF + END SUBROUTINE MD_CopyParam - SUBROUTINE MD_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(MD_MiscVarType), INTENT(INOUT) :: MiscData + SUBROUTINE MD_DestroyParam( ParamData, ErrStat, ErrMsg ) + TYPE(MD_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyMisc' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyParam' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(MiscData%LineTypeList)) THEN -DO i1 = LBOUND(MiscData%LineTypeList,1), UBOUND(MiscData%LineTypeList,1) - CALL MD_Destroylineprop( MiscData%LineTypeList(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(MiscData%LineTypeList) +IF (ALLOCATED(ParamData%nCpldBodies)) THEN + DEALLOCATE(ParamData%nCpldBodies) ENDIF -IF (ALLOCATED(MiscData%ConnectList)) THEN -DO i1 = LBOUND(MiscData%ConnectList,1), UBOUND(MiscData%ConnectList,1) - CALL MD_Destroyconnect( MiscData%ConnectList(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(MiscData%ConnectList) +IF (ALLOCATED(ParamData%nCpldRods)) THEN + DEALLOCATE(ParamData%nCpldRods) ENDIF -IF (ALLOCATED(MiscData%LineList)) THEN -DO i1 = LBOUND(MiscData%LineList,1), UBOUND(MiscData%LineList,1) - CALL MD_Destroyline( MiscData%LineList(i1), ErrStat, ErrMsg ) +IF (ALLOCATED(ParamData%nCpldCons)) THEN + DEALLOCATE(ParamData%nCpldCons) +ENDIF +IF (ALLOCATED(ParamData%OutParam)) THEN +DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) + CALL MD_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) ENDDO - DEALLOCATE(MiscData%LineList) + DEALLOCATE(ParamData%OutParam) ENDIF -IF (ALLOCATED(MiscData%FairIdList)) THEN - DEALLOCATE(MiscData%FairIdList) +IF (ALLOCATED(ParamData%TurbineRefPos)) THEN + DEALLOCATE(ParamData%TurbineRefPos) ENDIF -IF (ALLOCATED(MiscData%ConnIdList)) THEN - DEALLOCATE(MiscData%ConnIdList) +IF (ALLOCATED(ParamData%pxWave)) THEN + DEALLOCATE(ParamData%pxWave) ENDIF -IF (ALLOCATED(MiscData%LineStateIndList)) THEN - DEALLOCATE(MiscData%LineStateIndList) +IF (ALLOCATED(ParamData%pyWave)) THEN + DEALLOCATE(ParamData%pyWave) ENDIF -IF (ALLOCATED(MiscData%MDWrOutput)) THEN - DEALLOCATE(MiscData%MDWrOutput) +IF (ALLOCATED(ParamData%pzWave)) THEN + DEALLOCATE(ParamData%pzWave) ENDIF - END SUBROUTINE MD_DestroyMisc +IF (ALLOCATED(ParamData%uxWave)) THEN + DEALLOCATE(ParamData%uxWave) +ENDIF +IF (ALLOCATED(ParamData%uyWave)) THEN + DEALLOCATE(ParamData%uyWave) +ENDIF +IF (ALLOCATED(ParamData%uzWave)) THEN + DEALLOCATE(ParamData%uzWave) +ENDIF +IF (ALLOCATED(ParamData%axWave)) THEN + DEALLOCATE(ParamData%axWave) +ENDIF +IF (ALLOCATED(ParamData%ayWave)) THEN + DEALLOCATE(ParamData%ayWave) +ENDIF +IF (ALLOCATED(ParamData%azWave)) THEN + DEALLOCATE(ParamData%azWave) +ENDIF +IF (ALLOCATED(ParamData%PDyn)) THEN + DEALLOCATE(ParamData%PDyn) +ENDIF +IF (ALLOCATED(ParamData%zeta)) THEN + DEALLOCATE(ParamData%zeta) +ENDIF +IF (ALLOCATED(ParamData%pzCurrent)) THEN + DEALLOCATE(ParamData%pzCurrent) +ENDIF +IF (ALLOCATED(ParamData%uxCurrent)) THEN + DEALLOCATE(ParamData%uxCurrent) +ENDIF +IF (ALLOCATED(ParamData%uyCurrent)) THEN + DEALLOCATE(ParamData%uyCurrent) +ENDIF +IF (ALLOCATED(ParamData%Jac_u_indx)) THEN + DEALLOCATE(ParamData%Jac_u_indx) +ENDIF +IF (ALLOCATED(ParamData%du)) THEN + DEALLOCATE(ParamData%du) +ENDIF +IF (ALLOCATED(ParamData%dx)) THEN + DEALLOCATE(ParamData%dx) +ENDIF +IF (ALLOCATED(ParamData%dxIdx_map2_xStateIdx)) THEN + DEALLOCATE(ParamData%dxIdx_map2_xStateIdx) +ENDIF + END SUBROUTINE MD_DestroyParam - SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE MD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_MiscVarType), INTENT(IN) :: InData + TYPE(MD_ParameterType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -3751,7 +11098,7 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackMisc' + CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackParam' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -3763,99 +11110,189 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz ENDIF ! ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! LineTypeList allocated yes/no - IF ( ALLOCATED(InData%LineTypeList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineTypeList upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%LineTypeList,1), UBOUND(InData%LineTypeList,1) - Int_BufSz = Int_BufSz + 3 ! LineTypeList: size of buffers for each call to pack subtype - CALL MD_Packlineprop( Re_Buf, Db_Buf, Int_Buf, InData%LineTypeList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LineTypeList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! LineTypeList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! LineTypeList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! LineTypeList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! ConnectList allocated yes/no - IF ( ALLOCATED(InData%ConnectList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ConnectList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ConnectList,1), UBOUND(InData%ConnectList,1) - Int_BufSz = Int_BufSz + 3 ! ConnectList: size of buffers for each call to pack subtype - CALL MD_Packconnect( Re_Buf, Db_Buf, Int_Buf, InData%ConnectList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ConnectList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ConnectList - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ConnectList - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ConnectList - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! LineList allocated yes/no - IF ( ALLOCATED(InData%LineList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineList upper/lower bounds for each dimension - DO i1 = LBOUND(InData%LineList,1), UBOUND(InData%LineList,1) - Int_BufSz = Int_BufSz + 3 ! LineList: size of buffers for each call to pack subtype - CALL MD_Packline( Re_Buf, Db_Buf, Int_Buf, InData%LineList(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LineList + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! nLineTypes + Int_BufSz = Int_BufSz + 1 ! nRodTypes + Int_BufSz = Int_BufSz + 1 ! nConnects + Int_BufSz = Int_BufSz + 1 ! nConnectsExtra + Int_BufSz = Int_BufSz + 1 ! nBodies + Int_BufSz = Int_BufSz + 1 ! nRods + Int_BufSz = Int_BufSz + 1 ! nLines + Int_BufSz = Int_BufSz + 1 ! nCtrlChans + Int_BufSz = Int_BufSz + 1 ! nFails + Int_BufSz = Int_BufSz + 1 ! nFreeBodies + Int_BufSz = Int_BufSz + 1 ! nFreeRods + Int_BufSz = Int_BufSz + 1 ! nFreeCons + Int_BufSz = Int_BufSz + 1 ! nCpldBodies allocated yes/no + IF ( ALLOCATED(InData%nCpldBodies) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! nCpldBodies upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%nCpldBodies) ! nCpldBodies + END IF + Int_BufSz = Int_BufSz + 1 ! nCpldRods allocated yes/no + IF ( ALLOCATED(InData%nCpldRods) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! nCpldRods upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%nCpldRods) ! nCpldRods + END IF + Int_BufSz = Int_BufSz + 1 ! nCpldCons allocated yes/no + IF ( ALLOCATED(InData%nCpldCons) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! nCpldCons upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%nCpldCons) ! nCpldCons + END IF + Int_BufSz = Int_BufSz + 1 ! NConns + Int_BufSz = Int_BufSz + 1 ! NAnchs + Db_BufSz = Db_BufSz + 1 ! Tmax + Db_BufSz = Db_BufSz + 1 ! g + Db_BufSz = Db_BufSz + 1 ! rhoW + Db_BufSz = Db_BufSz + 1 ! WtrDpth + Db_BufSz = Db_BufSz + 1 ! kBot + Db_BufSz = Db_BufSz + 1 ! cBot + Db_BufSz = Db_BufSz + 1 ! dtM0 + Db_BufSz = Db_BufSz + 1 ! dtCoupling + Int_BufSz = Int_BufSz + 1 ! NumOuts + Db_BufSz = Db_BufSz + 1 ! dtOut + Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName + Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no + IF ( ALLOCATED(InData%OutParam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) + Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype + CALL MD_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! LineList + IF(ALLOCATED(Re_Buf)) THEN ! OutParam Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! LineList + IF(ALLOCATED(Db_Buf)) THEN ! OutParam Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! LineList + IF(ALLOCATED(Int_Buf)) THEN ! OutParam Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF END DO END IF - Int_BufSz = Int_BufSz + 1 ! FairIdList allocated yes/no - IF ( ALLOCATED(InData%FairIdList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FairIdList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%FairIdList) ! FairIdList - END IF - Int_BufSz = Int_BufSz + 1 ! ConnIdList allocated yes/no - IF ( ALLOCATED(InData%ConnIdList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ConnIdList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ConnIdList) ! ConnIdList - END IF - Int_BufSz = Int_BufSz + 1 ! LineStateIndList allocated yes/no - IF ( ALLOCATED(InData%LineStateIndList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LineStateIndList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%LineStateIndList) ! LineStateIndList - END IF - Int_BufSz = Int_BufSz + 1 ! MDWrOutput allocated yes/no - IF ( ALLOCATED(InData%MDWrOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! MDWrOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MDWrOutput) ! MDWrOutput + Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim + Int_BufSz = Int_BufSz + 1 ! MDUnOut + Int_BufSz = Int_BufSz + 1*LEN(InData%PriPath) ! PriPath + Int_BufSz = Int_BufSz + 1 ! writeLog + Int_BufSz = Int_BufSz + 1 ! UnLog + Int_BufSz = Int_BufSz + 1 ! WaveKin + Int_BufSz = Int_BufSz + 1 ! Current + Int_BufSz = Int_BufSz + 1 ! nTurbines + Int_BufSz = Int_BufSz + 1 ! TurbineRefPos allocated yes/no + IF ( ALLOCATED(InData%TurbineRefPos) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! TurbineRefPos upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%TurbineRefPos) ! TurbineRefPos + END IF + Db_BufSz = Db_BufSz + 1 ! mu_kT + Db_BufSz = Db_BufSz + 1 ! mu_kA + Db_BufSz = Db_BufSz + 1 ! mc + Db_BufSz = Db_BufSz + 1 ! cv + Int_BufSz = Int_BufSz + 1 ! nxWave + Int_BufSz = Int_BufSz + 1 ! nyWave + Int_BufSz = Int_BufSz + 1 ! nzWave + Int_BufSz = Int_BufSz + 1 ! ntWave + Int_BufSz = Int_BufSz + 1 ! pxWave allocated yes/no + IF ( ALLOCATED(InData%pxWave) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! pxWave upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%pxWave) ! pxWave + END IF + Int_BufSz = Int_BufSz + 1 ! pyWave allocated yes/no + IF ( ALLOCATED(InData%pyWave) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! pyWave upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%pyWave) ! pyWave + END IF + Int_BufSz = Int_BufSz + 1 ! pzWave allocated yes/no + IF ( ALLOCATED(InData%pzWave) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! pzWave upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%pzWave) ! pzWave + END IF + Re_BufSz = Re_BufSz + 1 ! dtWave + Int_BufSz = Int_BufSz + 1 ! uxWave allocated yes/no + IF ( ALLOCATED(InData%uxWave) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! uxWave upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%uxWave) ! uxWave + END IF + Int_BufSz = Int_BufSz + 1 ! uyWave allocated yes/no + IF ( ALLOCATED(InData%uyWave) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! uyWave upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%uyWave) ! uyWave + END IF + Int_BufSz = Int_BufSz + 1 ! uzWave allocated yes/no + IF ( ALLOCATED(InData%uzWave) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! uzWave upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%uzWave) ! uzWave + END IF + Int_BufSz = Int_BufSz + 1 ! axWave allocated yes/no + IF ( ALLOCATED(InData%axWave) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! axWave upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%axWave) ! axWave + END IF + Int_BufSz = Int_BufSz + 1 ! ayWave allocated yes/no + IF ( ALLOCATED(InData%ayWave) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! ayWave upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%ayWave) ! ayWave + END IF + Int_BufSz = Int_BufSz + 1 ! azWave allocated yes/no + IF ( ALLOCATED(InData%azWave) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! azWave upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%azWave) ! azWave + END IF + Int_BufSz = Int_BufSz + 1 ! PDyn allocated yes/no + IF ( ALLOCATED(InData%PDyn) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! PDyn upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PDyn) ! PDyn + END IF + Int_BufSz = Int_BufSz + 1 ! zeta allocated yes/no + IF ( ALLOCATED(InData%zeta) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! zeta upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%zeta) ! zeta + END IF + Int_BufSz = Int_BufSz + 1 ! nzCurrent + Int_BufSz = Int_BufSz + 1 ! pzCurrent allocated yes/no + IF ( ALLOCATED(InData%pzCurrent) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! pzCurrent upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%pzCurrent) ! pzCurrent + END IF + Int_BufSz = Int_BufSz + 1 ! uxCurrent allocated yes/no + IF ( ALLOCATED(InData%uxCurrent) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! uxCurrent upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%uxCurrent) ! uxCurrent + END IF + Int_BufSz = Int_BufSz + 1 ! uyCurrent allocated yes/no + IF ( ALLOCATED(InData%uyCurrent) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! uyCurrent upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%uyCurrent) ! uyCurrent + END IF + Int_BufSz = Int_BufSz + 1 ! Nx0 + Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no + IF ( ALLOCATED(InData%Jac_u_indx) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx + END IF + Int_BufSz = Int_BufSz + 1 ! du allocated yes/no + IF ( ALLOCATED(InData%du) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! du upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%du) ! du + END IF + Int_BufSz = Int_BufSz + 1 ! dx allocated yes/no + IF ( ALLOCATED(InData%dx) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! dx upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%dx) ! dx + END IF + Int_BufSz = Int_BufSz + 1 ! Jac_ny + Int_BufSz = Int_BufSz + 1 ! Jac_nx + Int_BufSz = Int_BufSz + 1 ! dxIdx_map2_xStateIdx allocated yes/no + IF ( ALLOCATED(InData%dxIdx_map2_xStateIdx) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! dxIdx_map2_xStateIdx upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%dxIdx_map2_xStateIdx) ! dxIdx_map2_xStateIdx END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -3884,232 +11321,752 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Db_Xferred = 1 Int_Xferred = 1 - IF ( .NOT. ALLOCATED(InData%LineTypeList) ) THEN + IntKiBuf(Int_Xferred) = InData%nLineTypes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nRodTypes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nConnects + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nConnectsExtra + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nBodies + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nRods + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nLines + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nCtrlChans + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nFails + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nFreeBodies + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nFreeRods + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nFreeCons + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%nCpldBodies) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%nCpldBodies,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nCpldBodies,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%nCpldBodies,1), UBOUND(InData%nCpldBodies,1) + IntKiBuf(Int_Xferred) = InData%nCpldBodies(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%nCpldRods) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%nCpldRods,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nCpldRods,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%nCpldRods,1), UBOUND(InData%nCpldRods,1) + IntKiBuf(Int_Xferred) = InData%nCpldRods(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%nCpldCons) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%nCpldCons,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nCpldCons,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%nCpldCons,1), UBOUND(InData%nCpldCons,1) + IntKiBuf(Int_Xferred) = InData%nCpldCons(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NConns + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NAnchs + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Tmax + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%g + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%rhoW + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%WtrDpth + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%kBot + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%cBot + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dtM0 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dtCoupling + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dtOut + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) + CALL MD_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%MDUnOut + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%PriPath) + IntKiBuf(Int_Xferred) = ICHAR(InData%PriPath(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%writeLog + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnLog + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveKin + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Current + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nTurbines + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%TurbineRefPos) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TurbineRefPos,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineRefPos,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TurbineRefPos,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineRefPos,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%TurbineRefPos,2), UBOUND(InData%TurbineRefPos,2) + DO i1 = LBOUND(InData%TurbineRefPos,1), UBOUND(InData%TurbineRefPos,1) + ReKiBuf(Re_Xferred) = InData%TurbineRefPos(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DbKiBuf(Db_Xferred) = InData%mu_kT + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%mu_kA + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%mc + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%cv + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nxWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nyWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nzWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ntWave + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%pxWave) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%pxWave,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pxWave,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%pxWave,1), UBOUND(InData%pxWave,1) + ReKiBuf(Re_Xferred) = InData%pxWave(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%pyWave) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%pyWave,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pyWave,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%pyWave,1), UBOUND(InData%pyWave,1) + ReKiBuf(Re_Xferred) = InData%pyWave(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%pzWave) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%pzWave,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzWave,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%pzWave,1), UBOUND(InData%pzWave,1) + ReKiBuf(Re_Xferred) = InData%pzWave(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%dtWave + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%uxWave) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%uxWave,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxWave,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%uxWave,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxWave,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%uxWave,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxWave,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%uxWave,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxWave,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%uxWave,4), UBOUND(InData%uxWave,4) + DO i3 = LBOUND(InData%uxWave,3), UBOUND(InData%uxWave,3) + DO i2 = LBOUND(InData%uxWave,2), UBOUND(InData%uxWave,2) + DO i1 = LBOUND(InData%uxWave,1), UBOUND(InData%uxWave,1) + ReKiBuf(Re_Xferred) = InData%uxWave(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%uyWave) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%uyWave,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyWave,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%uyWave,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyWave,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%uyWave,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyWave,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%uyWave,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyWave,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%uyWave,4), UBOUND(InData%uyWave,4) + DO i3 = LBOUND(InData%uyWave,3), UBOUND(InData%uyWave,3) + DO i2 = LBOUND(InData%uyWave,2), UBOUND(InData%uyWave,2) + DO i1 = LBOUND(InData%uyWave,1), UBOUND(InData%uyWave,1) + ReKiBuf(Re_Xferred) = InData%uyWave(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%uzWave) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%uzWave,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uzWave,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%uzWave,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uzWave,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%uzWave,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uzWave,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%uzWave,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uzWave,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%uzWave,4), UBOUND(InData%uzWave,4) + DO i3 = LBOUND(InData%uzWave,3), UBOUND(InData%uzWave,3) + DO i2 = LBOUND(InData%uzWave,2), UBOUND(InData%uzWave,2) + DO i1 = LBOUND(InData%uzWave,1), UBOUND(InData%uzWave,1) + ReKiBuf(Re_Xferred) = InData%uzWave(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%axWave) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%axWave,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axWave,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%axWave,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axWave,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%axWave,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axWave,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%axWave,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axWave,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%axWave,4), UBOUND(InData%axWave,4) + DO i3 = LBOUND(InData%axWave,3), UBOUND(InData%axWave,3) + DO i2 = LBOUND(InData%axWave,2), UBOUND(InData%axWave,2) + DO i1 = LBOUND(InData%axWave,1), UBOUND(InData%axWave,1) + ReKiBuf(Re_Xferred) = InData%axWave(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ayWave) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ayWave,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ayWave,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ayWave,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ayWave,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ayWave,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ayWave,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ayWave,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ayWave,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%ayWave,4), UBOUND(InData%ayWave,4) + DO i3 = LBOUND(InData%ayWave,3), UBOUND(InData%ayWave,3) + DO i2 = LBOUND(InData%ayWave,2), UBOUND(InData%ayWave,2) + DO i1 = LBOUND(InData%ayWave,1), UBOUND(InData%ayWave,1) + ReKiBuf(Re_Xferred) = InData%ayWave(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%azWave) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineTypeList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineTypeList,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%azWave,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%azWave,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%azWave,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%azWave,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%azWave,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%azWave,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%azWave,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%azWave,4) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LineTypeList,1), UBOUND(InData%LineTypeList,1) - CALL MD_Packlineprop( Re_Buf, Db_Buf, Int_Buf, InData%LineTypeList(i1), ErrStat2, ErrMsg2, OnlySize ) ! LineTypeList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i4 = LBOUND(InData%azWave,4), UBOUND(InData%azWave,4) + DO i3 = LBOUND(InData%azWave,3), UBOUND(InData%azWave,3) + DO i2 = LBOUND(InData%azWave,2), UBOUND(InData%azWave,2) + DO i1 = LBOUND(InData%azWave,1), UBOUND(InData%azWave,1) + ReKiBuf(Re_Xferred) = InData%azWave(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%PDyn) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PDyn,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDyn,4) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO + DO i4 = LBOUND(InData%PDyn,4), UBOUND(InData%PDyn,4) + DO i3 = LBOUND(InData%PDyn,3), UBOUND(InData%PDyn,3) + DO i2 = LBOUND(InData%PDyn,2), UBOUND(InData%PDyn,2) + DO i1 = LBOUND(InData%PDyn,1), UBOUND(InData%PDyn,1) + ReKiBuf(Re_Xferred) = InData%PDyn(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%ConnectList) ) THEN + IF ( .NOT. ALLOCATED(InData%zeta) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ConnectList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ConnectList,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%zeta,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%zeta,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%zeta,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zeta,3) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%ConnectList,1), UBOUND(InData%ConnectList,1) - CALL MD_Packconnect( Re_Buf, Db_Buf, Int_Buf, InData%ConnectList(i1), ErrStat2, ErrMsg2, OnlySize ) ! ConnectList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i3 = LBOUND(InData%zeta,3), UBOUND(InData%zeta,3) + DO i2 = LBOUND(InData%zeta,2), UBOUND(InData%zeta,2) + DO i1 = LBOUND(InData%zeta,1), UBOUND(InData%zeta,1) + ReKiBuf(Re_Xferred) = InData%zeta(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%nzCurrent + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%pzCurrent) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%pzCurrent,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzCurrent,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO + DO i1 = LBOUND(InData%pzCurrent,1), UBOUND(InData%pzCurrent,1) + ReKiBuf(Re_Xferred) = InData%pzCurrent(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IF ( .NOT. ALLOCATED(InData%LineList) ) THEN + IF ( .NOT. ALLOCATED(InData%uxCurrent) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineList,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%uxCurrent,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uxCurrent,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LineList,1), UBOUND(InData%LineList,1) - CALL MD_Packline( Re_Buf, Db_Buf, Int_Buf, InData%LineList(i1), ErrStat2, ErrMsg2, OnlySize ) ! LineList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%uxCurrent,1), UBOUND(InData%uxCurrent,1) + ReKiBuf(Re_Xferred) = InData%uxCurrent(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%uyCurrent) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%uyCurrent,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uyCurrent,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO + DO i1 = LBOUND(InData%uyCurrent,1), UBOUND(InData%uyCurrent,1) + ReKiBuf(Re_Xferred) = InData%uyCurrent(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IF ( .NOT. ALLOCATED(InData%FairIdList) ) THEN + IntKiBuf(Int_Xferred) = InData%Nx0 + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%FairIdList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FairIdList,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%FairIdList,1), UBOUND(InData%FairIdList,1) - IntKiBuf(Int_Xferred) = InData%FairIdList(i1) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%ConnIdList) ) THEN + IF ( .NOT. ALLOCATED(InData%du) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ConnIdList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ConnIdList,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%du,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%ConnIdList,1), UBOUND(InData%ConnIdList,1) - IntKiBuf(Int_Xferred) = InData%ConnIdList(i1) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) + DbKiBuf(Db_Xferred) = InData%du(i1) + Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%LineStateIndList) ) THEN + IF ( .NOT. ALLOCATED(InData%dx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LineStateIndList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineStateIndList,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%dx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LineStateIndList,1), UBOUND(InData%LineStateIndList,1) - IntKiBuf(Int_Xferred) = InData%LineStateIndList(i1) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) + DbKiBuf(Db_Xferred) = InData%dx(i1) + Db_Xferred = Db_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%MDWrOutput) ) THEN + IntKiBuf(Int_Xferred) = InData%Jac_ny + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Jac_nx + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%dxIdx_map2_xStateIdx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MDWrOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MDWrOutput,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%MDWrOutput,1), UBOUND(InData%MDWrOutput,1) - ReKiBuf(Re_Xferred) = InData%MDWrOutput(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - END SUBROUTINE MD_PackMisc - - SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineTypeList not allocated + IntKiBuf( Int_Xferred ) = LBOUND(InData%dxIdx_map2_xStateIdx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxIdx_map2_xStateIdx,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%dxIdx_map2_xStateIdx,1), UBOUND(InData%dxIdx_map2_xStateIdx,1) + IntKiBuf(Int_Xferred) = InData%dxIdx_map2_xStateIdx(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + END SUBROUTINE MD_PackParam + + SUBROUTINE MD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MD_ParameterType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackParam' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%nLineTypes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nRodTypes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nConnects = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nConnectsExtra = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nBodies = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nRods = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nLines = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nCtrlChans = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nFails = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nFreeBodies = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nFreeRods = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nFreeCons = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nCpldBodies not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%nCpldBodies)) DEALLOCATE(OutData%nCpldBodies) + ALLOCATE(OutData%nCpldBodies(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldBodies.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%nCpldBodies,1), UBOUND(OutData%nCpldBodies,1) + OutData%nCpldBodies(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nCpldRods not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%nCpldRods)) DEALLOCATE(OutData%nCpldRods) + ALLOCATE(OutData%nCpldRods(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldRods.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%nCpldRods,1), UBOUND(OutData%nCpldRods,1) + OutData%nCpldRods(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nCpldCons not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%nCpldCons)) DEALLOCATE(OutData%nCpldCons) + ALLOCATE(OutData%nCpldCons(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nCpldCons.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%nCpldCons,1), UBOUND(OutData%nCpldCons,1) + OutData%nCpldCons(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%NConns = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NAnchs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Tmax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%g = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%rhoW = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WtrDpth = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%kBot = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%cBot = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%dtM0 = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%dtCoupling = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%dtOut = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LineTypeList)) DEALLOCATE(OutData%LineTypeList) - ALLOCATE(OutData%LineTypeList(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) + ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineTypeList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%LineTypeList,1), UBOUND(OutData%LineTypeList,1) + DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -4143,7 +12100,7 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_Unpacklineprop( Re_Buf, Db_Buf, Int_Buf, OutData%LineTypeList(i1), ErrStat2, ErrMsg2 ) ! LineTypeList + CALL MD_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4152,564 +12109,519 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ConnectList not allocated + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%MDUnOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%PriPath) + OutData%PriPath(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%writeLog = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnLog = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveKin = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Current = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nTurbines = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TurbineRefPos not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ConnectList)) DEALLOCATE(OutData%ConnectList) - ALLOCATE(OutData%ConnectList(i1_l:i1_u),STAT=ErrStat2) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TurbineRefPos)) DEALLOCATE(OutData%TurbineRefPos) + ALLOCATE(OutData%TurbineRefPos(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConnectList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineRefPos.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%ConnectList,1), UBOUND(OutData%ConnectList,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_Unpackconnect( Re_Buf, Db_Buf, Int_Buf, OutData%ConnectList(i1), ErrStat2, ErrMsg2 ) ! ConnectList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO + DO i2 = LBOUND(OutData%TurbineRefPos,2), UBOUND(OutData%TurbineRefPos,2) + DO i1 = LBOUND(OutData%TurbineRefPos,1), UBOUND(OutData%TurbineRefPos,1) + OutData%TurbineRefPos(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineList not allocated + OutData%mu_kT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%mu_kA = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%mc = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%cv = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%nxWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nyWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nzWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ntWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pxWave not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LineList)) DEALLOCATE(OutData%LineList) - ALLOCATE(OutData%LineList(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%pxWave)) DEALLOCATE(OutData%pxWave) + ALLOCATE(OutData%pxWave(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pxWave.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%LineList,1), UBOUND(OutData%LineList,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_Unpackline( Re_Buf, Db_Buf, Int_Buf, OutData%LineList(i1), ErrStat2, ErrMsg2 ) ! LineList - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO + DO i1 = LBOUND(OutData%pxWave,1), UBOUND(OutData%pxWave,1) + OutData%pxWave(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pyWave not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%pyWave)) DEALLOCATE(OutData%pyWave) + ALLOCATE(OutData%pyWave(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pyWave.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%pyWave,1), UBOUND(OutData%pyWave,1) + OutData%pyWave(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzWave not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%pzWave)) DEALLOCATE(OutData%pzWave) + ALLOCATE(OutData%pzWave(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzWave.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%pzWave,1), UBOUND(OutData%pzWave,1) + OutData%pzWave(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%dtWave = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uxWave not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%uxWave)) DEALLOCATE(OutData%uxWave) + ALLOCATE(OutData%uxWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uxWave.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%uxWave,4), UBOUND(OutData%uxWave,4) + DO i3 = LBOUND(OutData%uxWave,3), UBOUND(OutData%uxWave,3) + DO i2 = LBOUND(OutData%uxWave,2), UBOUND(OutData%uxWave,2) + DO i1 = LBOUND(OutData%uxWave,1), UBOUND(OutData%uxWave,1) + OutData%uxWave(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uyWave not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%uyWave)) DEALLOCATE(OutData%uyWave) + ALLOCATE(OutData%uyWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uyWave.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%uyWave,4), UBOUND(OutData%uyWave,4) + DO i3 = LBOUND(OutData%uyWave,3), UBOUND(OutData%uyWave,3) + DO i2 = LBOUND(OutData%uyWave,2), UBOUND(OutData%uyWave,2) + DO i1 = LBOUND(OutData%uyWave,1), UBOUND(OutData%uyWave,1) + OutData%uyWave(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uzWave not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%uzWave)) DEALLOCATE(OutData%uzWave) + ALLOCATE(OutData%uzWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uzWave.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%uzWave,4), UBOUND(OutData%uzWave,4) + DO i3 = LBOUND(OutData%uzWave,3), UBOUND(OutData%uzWave,3) + DO i2 = LBOUND(OutData%uzWave,2), UBOUND(OutData%uzWave,2) + DO i1 = LBOUND(OutData%uzWave,1), UBOUND(OutData%uzWave,1) + OutData%uzWave(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FairIdList not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! axWave not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%FairIdList)) DEALLOCATE(OutData%FairIdList) - ALLOCATE(OutData%FairIdList(i1_l:i1_u),STAT=ErrStat2) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%axWave)) DEALLOCATE(OutData%axWave) + ALLOCATE(OutData%axWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FairIdList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%axWave.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%FairIdList,1), UBOUND(OutData%FairIdList,1) - OutData%FairIdList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 + DO i4 = LBOUND(OutData%axWave,4), UBOUND(OutData%axWave,4) + DO i3 = LBOUND(OutData%axWave,3), UBOUND(OutData%axWave,3) + DO i2 = LBOUND(OutData%axWave,2), UBOUND(OutData%axWave,2) + DO i1 = LBOUND(OutData%axWave,1), UBOUND(OutData%axWave,1) + OutData%axWave(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ConnIdList not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ayWave not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ConnIdList)) DEALLOCATE(OutData%ConnIdList) - ALLOCATE(OutData%ConnIdList(i1_l:i1_u),STAT=ErrStat2) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ayWave)) DEALLOCATE(OutData%ayWave) + ALLOCATE(OutData%ayWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConnIdList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ayWave.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%ConnIdList,1), UBOUND(OutData%ConnIdList,1) - OutData%ConnIdList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 + DO i4 = LBOUND(OutData%ayWave,4), UBOUND(OutData%ayWave,4) + DO i3 = LBOUND(OutData%ayWave,3), UBOUND(OutData%ayWave,3) + DO i2 = LBOUND(OutData%ayWave,2), UBOUND(OutData%ayWave,2) + DO i1 = LBOUND(OutData%ayWave,1), UBOUND(OutData%ayWave,1) + OutData%ayWave(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineStateIndList not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! azWave not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LineStateIndList)) DEALLOCATE(OutData%LineStateIndList) - ALLOCATE(OutData%LineStateIndList(i1_l:i1_u),STAT=ErrStat2) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%azWave)) DEALLOCATE(OutData%azWave) + ALLOCATE(OutData%azWave(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIndList.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%azWave.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%LineStateIndList,1), UBOUND(OutData%LineStateIndList,1) - OutData%LineStateIndList(i1) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 + DO i4 = LBOUND(OutData%azWave,4), UBOUND(OutData%azWave,4) + DO i3 = LBOUND(OutData%azWave,3), UBOUND(OutData%azWave,3) + DO i2 = LBOUND(OutData%azWave,2), UBOUND(OutData%azWave,2) + DO i1 = LBOUND(OutData%azWave,1), UBOUND(OutData%azWave,1) + OutData%azWave(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MDWrOutput not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDyn not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%MDWrOutput)) DEALLOCATE(OutData%MDWrOutput) - ALLOCATE(OutData%MDWrOutput(i1_l:i1_u),STAT=ErrStat2) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i4_l = IntKiBuf( Int_Xferred ) + i4_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%PDyn)) DEALLOCATE(OutData%PDyn) + ALLOCATE(OutData%PDyn(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MDWrOutput.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDyn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%MDWrOutput,1), UBOUND(OutData%MDWrOutput,1) - OutData%MDWrOutput(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 + DO i4 = LBOUND(OutData%PDyn,4), UBOUND(OutData%PDyn,4) + DO i3 = LBOUND(OutData%PDyn,3), UBOUND(OutData%PDyn,3) + DO i2 = LBOUND(OutData%PDyn,2), UBOUND(OutData%PDyn,2) + DO i1 = LBOUND(OutData%PDyn,1), UBOUND(OutData%PDyn,1) + OutData%PDyn(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END DO END IF - END SUBROUTINE MD_UnPackMisc - - SUBROUTINE MD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MD_ParameterType), INTENT(IN) :: SrcParamData - TYPE(MD_ParameterType), INTENT(INOUT) :: DstParamData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%NTypes = SrcParamData%NTypes - DstParamData%NConnects = SrcParamData%NConnects - DstParamData%NFairs = SrcParamData%NFairs - DstParamData%NConns = SrcParamData%NConns - DstParamData%NAnchs = SrcParamData%NAnchs - DstParamData%NLines = SrcParamData%NLines - DstParamData%g = SrcParamData%g - DstParamData%rhoW = SrcParamData%rhoW - DstParamData%WtrDpth = SrcParamData%WtrDpth - DstParamData%kBot = SrcParamData%kBot - DstParamData%cBot = SrcParamData%cBot - DstParamData%dtM0 = SrcParamData%dtM0 - DstParamData%dtCoupling = SrcParamData%dtCoupling - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%RootName = SrcParamData%RootName -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zeta not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%zeta)) DEALLOCATE(OutData%zeta) + ALLOCATE(OutData%zeta(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL MD_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstParamData%Delim = SrcParamData%Delim - DstParamData%MDUnOut = SrcParamData%MDUnOut - END SUBROUTINE MD_CopyParam - - SUBROUTINE MD_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(MD_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'MD_DestroyParam' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL MD_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF - END SUBROUTINE MD_DestroyParam - - SUBROUTINE MD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MD_ParameterType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_PackParam' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NTypes - Int_BufSz = Int_BufSz + 1 ! NConnects - Int_BufSz = Int_BufSz + 1 ! NFairs - Int_BufSz = Int_BufSz + 1 ! NConns - Int_BufSz = Int_BufSz + 1 ! NAnchs - Int_BufSz = Int_BufSz + 1 ! NLines - Re_BufSz = Re_BufSz + 1 ! g - Re_BufSz = Re_BufSz + 1 ! rhoW - Re_BufSz = Re_BufSz + 1 ! WtrDpth - Re_BufSz = Re_BufSz + 1 ! kBot - Re_BufSz = Re_BufSz + 1 ! cBot - Re_BufSz = Re_BufSz + 1 ! dtM0 - Re_BufSz = Re_BufSz + 1 ! dtCoupling - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL MD_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim - Int_BufSz = Int_BufSz + 1 ! MDUnOut - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zeta.', ErrStat, ErrMsg,RoutineName) RETURN - END IF + END IF + DO i3 = LBOUND(OutData%zeta,3), UBOUND(OutData%zeta,3) + DO i2 = LBOUND(OutData%zeta,2), UBOUND(OutData%zeta,2) + DO i1 = LBOUND(OutData%zeta,1), UBOUND(OutData%zeta,1) + OutData%zeta(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf(Int_Xferred) = InData%NTypes + OutData%nzCurrent = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NConnects + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzCurrent not allocated Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NFairs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NConns - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NAnchs - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NLines - Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%g - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%rhoW - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%kBot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%cBot - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dtM0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%dtCoupling - Re_Xferred = Re_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumOuts + ELSE Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN - IntKiBuf( Int_Xferred ) = 0 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%pzCurrent)) DEALLOCATE(OutData%pzCurrent) + ALLOCATE(OutData%pzCurrent(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%pzCurrent.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%pzCurrent,1), UBOUND(OutData%pzCurrent,1) + OutData%pzCurrent(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uxCurrent not allocated Int_Xferred = Int_Xferred + 1 ELSE - IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL MD_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO + IF (ALLOCATED(OutData%uxCurrent)) DEALLOCATE(OutData%uxCurrent) + ALLOCATE(OutData%uxCurrent(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uxCurrent.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%uxCurrent,1), UBOUND(OutData%uxCurrent,1) + OutData%uxCurrent(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf(Int_Xferred) = InData%MDUnOut - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE MD_PackParam - - SUBROUTINE MD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MD_ParameterType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackParam' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%NTypes = IntKiBuf(Int_Xferred) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uyCurrent not allocated Int_Xferred = Int_Xferred + 1 - OutData%NConnects = IntKiBuf(Int_Xferred) + ELSE Int_Xferred = Int_Xferred + 1 - OutData%NFairs = IntKiBuf(Int_Xferred) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%uyCurrent)) DEALLOCATE(OutData%uyCurrent) + ALLOCATE(OutData%uyCurrent(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uyCurrent.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%uyCurrent,1), UBOUND(OutData%uyCurrent,1) + OutData%uyCurrent(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Nx0 = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - OutData%NConns = IntKiBuf(Int_Xferred) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated Int_Xferred = Int_Xferred + 1 - OutData%NAnchs = IntKiBuf(Int_Xferred) + ELSE Int_Xferred = Int_Xferred + 1 - OutData%NLines = IntKiBuf(Int_Xferred) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) + ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated Int_Xferred = Int_Xferred + 1 - OutData%g = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%rhoW = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%kBot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%cBot = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dtM0 = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%dtCoupling = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - OutData%NumOuts = IntKiBuf(Int_Xferred) + ELSE Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%du)) DEALLOCATE(OutData%du) + ALLOCATE(OutData%du(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) + OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%dx)) DEALLOCATE(OutData%dx) + ALLOCATE(OutData%dx(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL MD_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO + DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) + OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%MDUnOut = IntKiBuf(Int_Xferred) + OutData%Jac_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Jac_nx = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dxIdx_map2_xStateIdx not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%dxIdx_map2_xStateIdx)) DEALLOCATE(OutData%dxIdx_map2_xStateIdx) + ALLOCATE(OutData%dxIdx_map2_xStateIdx(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dxIdx_map2_xStateIdx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%dxIdx_map2_xStateIdx,1), UBOUND(OutData%dxIdx_map2_xStateIdx,1) + OutData%dxIdx_map2_xStateIdx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF END SUBROUTINE MD_UnPackParam SUBROUTINE MD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -4727,9 +12639,22 @@ SUBROUTINE MD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) ! ErrStat = ErrID_None ErrMsg = "" - CALL MeshCopy( SrcInputData%PtFairleadDisplacement, DstInputData%PtFairleadDisplacement, CtrlCode, ErrStat2, ErrMsg2 ) +IF (ALLOCATED(SrcInputData%CoupledKinematics)) THEN + i1_l = LBOUND(SrcInputData%CoupledKinematics,1) + i1_u = UBOUND(SrcInputData%CoupledKinematics,1) + IF (.NOT. ALLOCATED(DstInputData%CoupledKinematics)) THEN + ALLOCATE(DstInputData%CoupledKinematics(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CoupledKinematics.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcInputData%CoupledKinematics,1), UBOUND(SrcInputData%CoupledKinematics,1) + CALL MeshCopy( SrcInputData%CoupledKinematics(i1), DstInputData%CoupledKinematics(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF IF (ALLOCATED(SrcInputData%DeltaL)) THEN i1_l = LBOUND(SrcInputData%DeltaL,1) i1_u = UBOUND(SrcInputData%DeltaL,1) @@ -4765,7 +12690,12 @@ SUBROUTINE MD_DestroyInput( InputData, ErrStat, ErrMsg ) ! ErrStat = ErrID_None ErrMsg = "" - CALL MeshDestroy( InputData%PtFairleadDisplacement, ErrStat, ErrMsg ) +IF (ALLOCATED(InputData%CoupledKinematics)) THEN +DO i1 = LBOUND(InputData%CoupledKinematics,1), UBOUND(InputData%CoupledKinematics,1) + CALL MeshDestroy( InputData%CoupledKinematics(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(InputData%CoupledKinematics) +ENDIF IF (ALLOCATED(InputData%DeltaL)) THEN DEALLOCATE(InputData%DeltaL) ENDIF @@ -4809,24 +12739,30 @@ SUBROUTINE MD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! CoupledKinematics allocated yes/no + IF ( ALLOCATED(InData%CoupledKinematics) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! CoupledKinematics upper/lower bounds for each dimension ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtFairleadDisplacement: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtFairleadDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtFairleadDisplacement + DO i1 = LBOUND(InData%CoupledKinematics,1), UBOUND(InData%CoupledKinematics,1) + Int_BufSz = Int_BufSz + 3 ! CoupledKinematics: size of buffers for each call to pack subtype + CALL MeshPack( InData%CoupledKinematics(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! CoupledKinematics CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! PtFairleadDisplacement + IF(ALLOCATED(Re_Buf)) THEN ! CoupledKinematics Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtFairleadDisplacement + IF(ALLOCATED(Db_Buf)) THEN ! CoupledKinematics Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtFairleadDisplacement + IF(ALLOCATED(Int_Buf)) THEN ! CoupledKinematics Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! DeltaL allocated yes/no IF ( ALLOCATED(InData%DeltaL) ) THEN Int_BufSz = Int_BufSz + 2*1 ! DeltaL upper/lower bounds for each dimension @@ -4864,7 +12800,18 @@ SUBROUTINE MD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - CALL MeshPack( InData%PtFairleadDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtFairleadDisplacement + IF ( .NOT. ALLOCATED(InData%CoupledKinematics) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CoupledKinematics,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CoupledKinematics,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%CoupledKinematics,1), UBOUND(InData%CoupledKinematics,1) + CALL MeshPack( InData%CoupledKinematics(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! CoupledKinematics CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4892,6 +12839,8 @@ SUBROUTINE MD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + END DO + END IF IF ( .NOT. ALLOCATED(InData%DeltaL) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4951,6 +12900,20 @@ SUBROUTINE MD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CoupledKinematics not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CoupledKinematics)) DEALLOCATE(OutData%CoupledKinematics) + ALLOCATE(OutData%CoupledKinematics(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledKinematics.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%CoupledKinematics,1), UBOUND(OutData%CoupledKinematics,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -4984,13 +12947,15 @@ SUBROUTINE MD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%PtFairleadDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtFairleadDisplacement + CALL MeshUnpack( OutData%CoupledKinematics(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! CoupledKinematics CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DeltaL not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5044,9 +13009,22 @@ SUBROUTINE MD_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMs ! ErrStat = ErrID_None ErrMsg = "" - CALL MeshCopy( SrcOutputData%PtFairleadLoad, DstOutputData%PtFairleadLoad, CtrlCode, ErrStat2, ErrMsg2 ) +IF (ALLOCATED(SrcOutputData%CoupledLoads)) THEN + i1_l = LBOUND(SrcOutputData%CoupledLoads,1) + i1_u = UBOUND(SrcOutputData%CoupledLoads,1) + IF (.NOT. ALLOCATED(DstOutputData%CoupledLoads)) THEN + ALLOCATE(DstOutputData%CoupledLoads(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%CoupledLoads.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcOutputData%CoupledLoads,1), UBOUND(SrcOutputData%CoupledLoads,1) + CALL MeshCopy( SrcOutputData%CoupledLoads(i1), DstOutputData%CoupledLoads(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN i1_l = LBOUND(SrcOutputData%WriteOutput,1) i1_u = UBOUND(SrcOutputData%WriteOutput,1) @@ -5070,7 +13048,12 @@ SUBROUTINE MD_DestroyOutput( OutputData, ErrStat, ErrMsg ) ! ErrStat = ErrID_None ErrMsg = "" - CALL MeshDestroy( OutputData%PtFairleadLoad, ErrStat, ErrMsg ) +IF (ALLOCATED(OutputData%CoupledLoads)) THEN +DO i1 = LBOUND(OutputData%CoupledLoads,1), UBOUND(OutputData%CoupledLoads,1) + CALL MeshDestroy( OutputData%CoupledLoads(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(OutputData%CoupledLoads) +ENDIF IF (ALLOCATED(OutputData%WriteOutput)) THEN DEALLOCATE(OutputData%WriteOutput) ENDIF @@ -5111,24 +13094,30 @@ SUBROUTINE MD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! CoupledLoads allocated yes/no + IF ( ALLOCATED(InData%CoupledLoads) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! CoupledLoads upper/lower bounds for each dimension ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! PtFairleadLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%PtFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! PtFairleadLoad + DO i1 = LBOUND(InData%CoupledLoads,1), UBOUND(InData%CoupledLoads,1) + Int_BufSz = Int_BufSz + 3 ! CoupledLoads: size of buffers for each call to pack subtype + CALL MeshPack( InData%CoupledLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! CoupledLoads CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! PtFairleadLoad + IF(ALLOCATED(Re_Buf)) THEN ! CoupledLoads Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! PtFairleadLoad + IF(ALLOCATED(Db_Buf)) THEN ! CoupledLoads Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! PtFairleadLoad + IF(ALLOCATED(Int_Buf)) THEN ! CoupledLoads Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no IF ( ALLOCATED(InData%WriteOutput) ) THEN Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension @@ -5161,7 +13150,18 @@ SUBROUTINE MD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - CALL MeshPack( InData%PtFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtFairleadLoad + IF ( .NOT. ALLOCATED(InData%CoupledLoads) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CoupledLoads,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CoupledLoads,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%CoupledLoads,1), UBOUND(InData%CoupledLoads,1) + CALL MeshPack( InData%CoupledLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! CoupledLoads CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5189,6 +13189,8 @@ SUBROUTINE MD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + END DO + END IF IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5233,6 +13235,20 @@ SUBROUTINE MD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CoupledLoads not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CoupledLoads)) DEALLOCATE(OutData%CoupledLoads) + ALLOCATE(OutData%CoupledLoads(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CoupledLoads.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%CoupledLoads,1), UBOUND(OutData%CoupledLoads,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5266,13 +13282,15 @@ SUBROUTINE MD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%PtFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! PtFairleadLoad + CALL MeshUnpack( OutData%CoupledLoads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! CoupledLoads CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5388,8 +13406,12 @@ SUBROUTINE MD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) END IF ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) +IF (ALLOCATED(u_out%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN + DO i1 = LBOUND(u_out%CoupledKinematics,1),UBOUND(u_out%CoupledKinematics,1) + CALL MeshExtrapInterp1(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated IF (ALLOCATED(u_out%DeltaL) .AND. ALLOCATED(u1%DeltaL)) THEN DO i1 = LBOUND(u_out%DeltaL,1),UBOUND(u_out%DeltaL,1) b = -(u1%DeltaL(i1) - u2%DeltaL(i1)) @@ -5459,8 +13481,12 @@ SUBROUTINE MD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM END IF ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, u3%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) +IF (ALLOCATED(u_out%CoupledKinematics) .AND. ALLOCATED(u1%CoupledKinematics)) THEN + DO i1 = LBOUND(u_out%CoupledKinematics,1),UBOUND(u_out%CoupledKinematics,1) + CALL MeshExtrapInterp2(u1%CoupledKinematics(i1), u2%CoupledKinematics(i1), u3%CoupledKinematics(i1), tin, u_out%CoupledKinematics(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated IF (ALLOCATED(u_out%DeltaL) .AND. ALLOCATED(u1%DeltaL)) THEN DO i1 = LBOUND(u_out%DeltaL,1),UBOUND(u_out%DeltaL,1) b = (t(3)**2*(u1%DeltaL(i1) - u2%DeltaL(i1)) + t(2)**2*(-u1%DeltaL(i1) + u3%DeltaL(i1)))* scaleFactor @@ -5572,8 +13598,12 @@ SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg END IF ScaleFactor = t_out / t(2) - CALL MeshExtrapInterp1(y1%PtFairleadLoad, y2%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) +IF (ALLOCATED(y_out%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN + DO i1 = LBOUND(y_out%CoupledLoads,1),UBOUND(y_out%CoupledLoads,1) + CALL MeshExtrapInterp1(y1%CoupledLoads(i1), y2%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) @@ -5637,8 +13667,12 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err END IF ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) - CALL MeshExtrapInterp2(y1%PtFairleadLoad, y2%PtFairleadLoad, y3%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) +IF (ALLOCATED(y_out%CoupledLoads) .AND. ALLOCATED(y1%CoupledLoads)) THEN + DO i1 = LBOUND(y_out%CoupledLoads,1),UBOUND(y_out%CoupledLoads,1) + CALL MeshExtrapInterp2(y1%CoupledLoads(i1), y2%CoupledLoads(i1), y3%CoupledLoads(i1), tin, y_out%CoupledLoads(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + ENDDO +END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor diff --git a/modules/moordyn/src/MoorDyn_bathymetry.txt b/modules/moordyn/src/MoorDyn_bathymetry.txt new file mode 100644 index 0000000000..bfe4ffbbbd --- /dev/null +++ b/modules/moordyn/src/MoorDyn_bathymetry.txt @@ -0,0 +1,8 @@ +--- MoorDyn Bathymetry Input File --- +nGridX 4 +nGridY 4 + -800 -10 10 800 +-800 400 400 500 500 + -10 400 400 500 500 + 10 600 600 600 600 + 800 600 600 600 600 \ No newline at end of file diff --git a/modules/openfast-library/src/FAST_Lin.f90 b/modules/openfast-library/src/FAST_Lin.f90 index 63b06f2344..b0301a27f1 100644 --- a/modules/openfast-library/src/FAST_Lin.f90 +++ b/modules/openfast-library/src/FAST_Lin.f90 @@ -118,6 +118,9 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, NumBlNodes, ErrStat, if ( p_FAST%CompMooring == Module_MAP ) then p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_MAP + else if ( p_FAST%CompMooring == Module_MD ) then + p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 + p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_MD end if @@ -1107,6 +1110,63 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, end if ! if ( p_FAST%LinOutMod ) end if ! if ( p_FAST%CompMooring == Module_MAP ) + + !..................... + ! MoorDyn + !..................... + if ( p_FAST%CompMooring == Module_MD ) then + + call MD_JacobianPInput( t_global, MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), & + MD%OtherSt(STATE_CURR), MD%y, MD%m, ErrStat2, ErrMsg2, & + dXdu=y_FAST%Lin%Modules(Module_MD)%Instance(1)%B, & + dYdu=y_FAST%Lin%Modules(Module_MD)%Instance(1)%D ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + call MD_JacobianPContState( t_global, MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), MD%OtherSt(STATE_CURR), & + MD%y, MD%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_MD)%Instance(1)%C, & + dXdx=y_FAST%Lin%Modules(Module_MD)%Instance(1)%A ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! get the operating point + call MD_GetOP( t_global, MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), & + MD%OtherSt(STATE_CURR), MD%y, MD%m, ErrStat2, ErrMsg2, & + u_op=y_FAST%Lin%Modules(Module_MD)%Instance(1)%op_u, & + y_op=y_FAST%Lin%Modules(Module_MD)%Instance(1)%op_y, & + x_op=y_FAST%Lin%Modules(Module_MD)%Instance(1)%op_x, & + dx_op=y_FAST%Lin%Modules(Module_MD)%Instance(1)%op_dx ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + ! write the module matrices: + if (p_FAST%LinOutMod) then + + OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_MD)) + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_MD)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + if (p_FAST%LinOutJac) then + ! Jacobians + ! dXdx, dXdu, dYdx, dYdu: + call WrPartialMatrix( y_FAST%Lin%Modules(Module_MD)%Instance(1)%A, Un, p_FAST%OutFmt, 'dXdx' ) + call WrPartialMatrix( y_FAST%Lin%Modules(Module_MD)%Instance(1)%B, Un, p_FAST%OutFmt, 'dXdu', UseCol=y_FAST%Lin%Modules(Module_MD)%Instance(1)%use_u ) + call WrPartialMatrix( y_FAST%Lin%Modules(Module_MD)%Instance(1)%C, Un, p_FAST%OutFmt, 'dYdx', UseRow=y_FAST%Lin%Modules(Module_MD)%Instance(1)%use_y ) + call WrPartialMatrix( y_FAST%Lin%Modules(Module_MD)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', UseRow=y_FAST%Lin%Modules(Module_MD)%Instance(1)%use_y, & + UseCol=y_FAST%Lin%Modules(Module_MD)%Instance(1)%use_u ) + end if + + ! finish writing the file + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_MD)%Instance(1) ) + + end if ! if ( p_FAST%LinOutMod ) + end if ! if ( p_FAST%CompMooring == Module_MD ) + !..................... ! Linearization of glue code Input/Output solve: !..................... @@ -1667,7 +1727,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, !............ ! we need to do this for CompElast=ED and CompElast=BD - call Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, HD, SD, MAPp, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, HD, SD, MAPp, MD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !............ @@ -1703,12 +1763,20 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, ! \f$ \frac{\partial U_\Lambda^{SD}}{\partial u^{MAP}} \end{bmatrix} = \f$ (dUdu block row 7=SD) !............ IF (p_FAST%CompSub == MODULE_SD) THEN - call Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, SD%Input(1), SD%y, ED%y, HD, MAPp, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, SD%Input(1), SD%y, ED%y, HD, MAPp, MD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ELSE IF (p_FAST%CompSub == Module_ExtPtfm) THEN CALL WrScr('>>> FAST_LIN: Linear_ExtPtfm_InputSolve_du, TODO') ENDIF + !............ + ! \f$ \frac{\partial U_\Lambda^{MD}}{\partial u^{MD}} \end{bmatrix} = \f$ (dUdu block row 9=MD) <<<< + !............ + if (p_FAST%CompMooring == MODULE_MD) then + call Linear_MD_InputSolve_du( p_FAST, y_FAST, MD%Input(1), ED%y, SD%y, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if + ! LIN-TODO: Update the doc lines below to include SrvD, HD, SD, and MAP !..................................... ! dUdy @@ -1758,7 +1826,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial y^{MAP}} \end{bmatrix} = \f$ (dUdy block row 3=ED) !............ - call Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, HD, SD, MAPp, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, HD, SD, MAPp, MD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !............ @@ -1801,7 +1869,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, !LIN-TODO: Add doc strings and look at above doc string IF (p_FAST%CompSub == Module_SD) THEN - call Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, SD%Input(1), SD%y, ED%y, HD, MAPp, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, SD%Input(1), SD%y, ED%y, HD, MAPp, MD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ELSE IF (p_FAST%CompSub == Module_ExtPtfm) THEN write(*,*)'>>> FAST_LIN: Linear_ExtPtfm_InputSolve_dy, TODO' @@ -1815,6 +1883,14 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, call Linear_MAP_InputSolve_dy( p_FAST, y_FAST, MAPp%Input(1), ED%y, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if + !............ + ! \f$ \frac{\partial U_\Lambda^{MD}}{\partial y^{ED}} \end{bmatrix} = \f$ + ! \f$ \frac{\partial U_\Lambda^{MD}}{\partial y^{SD}} \end{bmatrix} = \f$ (dUdy block row 9=MD) <<<< + !............ + if (p_FAST%CompMooring == MODULE_MD) then + call Linear_MD_InputSolve_dy( p_FAST, y_FAST, MD%Input(1), ED%y, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + end if END SUBROUTINE Glue_Jacobians @@ -1882,7 +1958,7 @@ END SUBROUTINE Linear_IfW_InputSolve_du_AD !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{ED}/du^{BD} and dU^{ED}/du^{AD} blocks (ED row) of dUdu. (i.e., how do changes in the AD and BD inputs affect the ED inputs?) -SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD, BD, HD, SD, MAPp, MeshMapData, dUdu, ErrStat, ErrMsg ) +SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD, BD, HD, SD, MAPp, MD, MeshMapData, dUdu, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) @@ -1895,6 +1971,7 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HD data at t TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SD data at t TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data at t + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MD data at t TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status @@ -1910,6 +1987,7 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD INTEGER(IntKi) :: HD_Start ! starting index of dUdu (column) where HD motion inputs are located INTEGER(IntKi) :: SD_Start ! starting index of dUdu (column) where SD TP motion inputs are located INTEGER(IntKi) :: MAP_Start ! starting index of dUdu (column) where MAP fairlead motion inputs are located + INTEGER(IntKi) :: MD_Start ! starting index of dUdu (column) where MD fairlead motion inputs are located INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None @@ -2164,6 +2242,29 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD call SetBlockMatrix( dUdu, MeshMapData%Mooring_P_2_ED_P%dM%m_us, ED_Start_mt, MAP_Start ) end if + !.......... + ! dU^{ED}/du^{MD} + !.......... + else if ( p_FAST%CompMooring == Module_MD ) then + + ED_Start_mt = Indx_u_ED_Platform_Start(u_ED, y_FAST) & + + u_ED%PlatformPtMesh%NNodes * 3 ! 3 forces at each node (we're going to start at the moments) + + ! Transfer MD loads to ED PlatformPtmesh input: + ! we're mapping loads, so we also need the sibling meshes' displacements: + + MD_Start = y_FAST%Lin%Modules(Module_MD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + + ! NOTE: Assumes at least one coupled MD object + + CALL Linearize_Point_to_Point( MD%y%CoupledLoads(1), u_ED%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, MD%Input(1)%CoupledKinematics(1), y_ED%PlatformPtMesh) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! HD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%Mooring_P_2_ED_P%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%Mooring_P_2_ED_P%dM%m_us, ED_Start_mt, MD_Start ) + end if + end if end if @@ -2172,7 +2273,7 @@ END SUBROUTINE Linear_ED_InputSolve_du !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{SD}/du^{SrvD}, dU^{SD}/du^{HD}, dU^{SD}/du^{SD}, and dU^{SD}/du^{MAP} blocks (SD row) of dUdu. (i.e., how do changes in SrvD, HD, SD, and MAP inputs affect the SD inputs?) -SUBROUTINE Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, MAPp, MeshMapData, dUdu, ErrStat, ErrMsg ) +SUBROUTINE Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, MAPp, MD, MeshMapData, dUdu, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) @@ -2182,6 +2283,7 @@ SUBROUTINE Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HD data at t TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data at t + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MD data at t TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(SD)/du^(AD) block INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status @@ -2190,7 +2292,7 @@ SUBROUTINE Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, ! local variables INTEGER(IntKi) :: j, SrvD_Start INTEGER(IntKi) :: HD_Start - INTEGER(IntKi) :: MAP_Start + INTEGER(IntKi) :: MAP_Start, MD_Start INTEGER(IntKi) :: SD_Start, SD_Start_td, SD_Start_tr INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None @@ -2309,31 +2411,52 @@ SUBROUTINE Linear_SD_InputSolve_du( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, ! dU^{SD}/du^{MAP} !.......... - if ( p_FAST%CompMooring == Module_MAP ) then + if ( p_FAST%CompMooring == Module_MAP ) then - ! Transfer MAP loads to ED PlatformPtmesh input: - ! we're mapping loads, so we also need the sibling meshes' displacements: + ! Transfer MAP loads to ED PlatformPtmesh input: + ! we're mapping loads, so we also need the sibling meshes' displacements: + + MAP_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - MAP_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - - ! NOTE: Assumes at least one MAP Fairlead point - - CALL Linearize_Point_to_Point( MAPp%y%ptFairleadLoad, u_SD%LMesh, MeshMapData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2, MAPp%Input(1)%PtFairDisplacement, y_SD%Y3Mesh) !MAPp%Input(1)%ptFairleadLoad and y_SD%Y3Mesh contain the displaced positions for load calculations - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! SD is source in the mapping, so we want M_{uSm} - if (allocated(MeshMapData%Mooring_P_2_SD_P%dM%m_us )) then - call SetBlockMatrix( dUdu, MeshMapData%Mooring_P_2_SD_P%dM%m_us, SD_Start, MAP_Start ) - end if + ! NOTE: Assumes at least one MAP Fairlead point + + CALL Linearize_Point_to_Point( MAPp%y%ptFairleadLoad, u_SD%LMesh, MeshMapData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2, MAPp%Input(1)%PtFairDisplacement, y_SD%Y3Mesh) !MAPp%Input(1)%ptFairleadLoad and y_SD%Y3Mesh contain the displaced positions for load calculations + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! SD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%Mooring_P_2_SD_P%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%Mooring_P_2_SD_P%dM%m_us, SD_Start, MAP_Start ) + end if + + !.......... + ! dU^{SD}/du^{MD} + !.......... + else if ( p_FAST%CompMooring == Module_MD ) then + + ! Transfer MD loads to ED PlatformPtmesh input: + ! we're mapping loads, so we also need the sibling meshes' displacements: + + MD_Start = y_FAST%Lin%Modules(Module_MD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + ! NOTE: Assumes at least one coupled MD object + + CALL Linearize_Point_to_Point( MD%y%CoupledLoads(1), u_SD%LMesh, MeshMapData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2, MD%Input(1)%CoupledKinematics(1), y_SD%Y3Mesh) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! SD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%Mooring_P_2_SD_P%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%Mooring_P_2_SD_P%dM%m_us, SD_Start, MD_Start ) end if + + end if + END IF END SUBROUTINE Linear_SD_InputSolve_du !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{SD}/dy^{SrvD}, dU^{SD}/dy^{HD} and dU^{SD}/dy^{SD} blocks (SD row) of dUdu. (i.e., how do changes in SrvD, HD, and SD inputs affect the SD inputs?) -SUBROUTINE Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, MAPp, MeshMapData, dUdy, ErrStat, ErrMsg ) +SUBROUTINE Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, MAPp, MD, MeshMapData, dUdy, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< Glue-code output parameters (for linearization) @@ -2343,14 +2466,15 @@ SUBROUTINE Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HD data at t TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data at t + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MD data at t TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^(SD)/dy^(SD) block INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message ! local variables - INTEGER(IntKi) :: j, SrvD_Out_Start, SD_Start, SD_Out_Start, HD_Start, HD_Out_Start, ED_Out_Start, MAP_Out_Start - INTEGER(IntKi) :: MAP_Start + INTEGER(IntKi) :: j, SrvD_Out_Start, SD_Start, SD_Out_Start, HD_Start, HD_Out_Start, ED_Out_Start, MAP_Out_Start, MD_Out_Start + INTEGER(IntKi) :: MAP_Start, MD_Start ! INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation ! CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None @@ -2440,6 +2564,23 @@ SUBROUTINE Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) ! start of u_SD%LMesh%TranslationDisp field call Assemble_dUdy_Loads(MAPp%y%ptFairLeadLoad, u_SD%LMesh, MeshMapData%Mooring_P_2_SD_P, SD_Start, MAP_Out_Start, dUdy) + ! SD translation displacement-to-SD moment transfer (dU^{SD}/dy^{SD}): + SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) + u_SD%LMesh%NNodes*3 ! start of u_ED%LMesh%Moment field (skip the SD forces) + SD_Out_Start = Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y3Mesh%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%Mooring_P_2_SD_P%dM%m_uD, SD_Start, SD_Out_Start ) + end if + + !.......... + ! dU^{SD}/dy^{MD} + !.......... + else if ( p_FAST%CompMooring == Module_MD ) then + if ( MD%y%CoupledLoads(1)%Committed ) then ! meshes for floating + !!! ! This linearization was done in forming dUdu (see Linear_SD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + MD_Out_Start = y_FAST%Lin%Modules(Module_MD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) ! start of u_SD%LMesh%TranslationDisp field + call Assemble_dUdy_Loads(MD%y%CoupledLoads(1), u_SD%LMesh, MeshMapData%Mooring_P_2_SD_P, SD_Start, MD_Out_Start, dUdy) + ! SD translation displacement-to-SD moment transfer (dU^{SD}/dy^{SD}): SD_Start = Indx_u_SD_LMesh_Start(u_SD, y_FAST) + u_SD%LMesh%NNodes*3 ! start of u_ED%LMesh%Moment field (skip the SD forces) SD_Out_Start = Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y3Mesh%TranslationDisp field @@ -3001,7 +3142,7 @@ END SUBROUTINE Linear_SrvD_InputSolve_dy !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{ED}/dy^{SrvD}, dU^{ED}/dy^{ED}, dU^{ED}/dy^{BD}, dU^{ED}/dy^{AD}, dU^{ED}/dy^{HD}, and dU^{ED}/dy^{MAP} !! blocks of dUdy. (i.e., how do changes in the SrvD, ED, BD, AD, HD, and MAP outputs effect the ED inputs?) -SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD, BD, HD, SD, MAPp, MeshMapData, dUdy, ErrStat, ErrMsg ) +SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD, BD, HD, SD, MAPp, MD, MeshMapData, dUdy, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) @@ -3014,6 +3155,7 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HD data at t TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SD data at t TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data at t + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MD data at t TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^(ED)/du^(AD) block @@ -3032,6 +3174,7 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD INTEGER(IntKi) :: HD_Out_Start ! starting index of dUdy (column) where HD output fields are located INTEGER(IntKi) :: SD_Out_Start ! starting index of dUdy (column) where SD output fields are located INTEGER(IntKi) :: MAP_Out_Start ! starting index of dUdy (column) where MAP output fields are located + INTEGER(IntKi) :: MD_Out_Start ! starting index of dUdy (column) where MoorDyn output fields are located CHARACTER(*), PARAMETER :: RoutineName = 'Linear_ED_InputSolve_dy' @@ -3246,7 +3389,21 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field call SumBlockMatrix( dUdy, MeshMapData%Mooring_P_2_ED_P%dM%m_uD, ED_Start, ED_Out_Start ) end if - + ! MoorDyn + ! parts of dU^{ED}/dy^{MD} and dU^{ED}/dy^{ED}: + else if ( p_FAST%CompMooring == Module_MD ) then + if ( MD%y%CoupledLoads(1)%Committed ) then ! meshes for floating + !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + MD_Out_Start = y_FAST%Lin%Modules(Module_MD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%TranslationDisp field + call Assemble_dUdy_Loads(MD%y%CoupledLoads(1), u_ED%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ED_Start, MD_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) + ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%Mooring_P_2_ED_P%dM%m_uD, ED_Start, ED_Out_Start ) + end if end if else if ( p_FAST%CompSub == Module_SD ) then ! SubDyn @@ -3905,6 +4062,141 @@ SUBROUTINE Linear_MAP_InputSolve_dy( p_FAST, y_FAST, u_MAP, y_ED, y_SD, MeshMapD END IF END SUBROUTINE Linear_MAP_InputSolve_dy +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{MD}/du^{MD} block of dUdu. (i.e., how do changes in the MD outputs affect +!! the MD inputs?) +SUBROUTINE Linear_MD_InputSolve_du( p_FAST, y_FAST, u_MD, y_ED, y_SD, MeshMapData, dUdu, ErrStat, ErrMsg ) + + ! Passed variables + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(MD_InputType), INTENT(INOUT) :: u_MD !< The inputs to MoorDyn + TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the ElastoDyn structural dynamics module + TYPE(SD_OutputType), INTENT(IN) :: y_SD !< The outputs from the SubDyn structural dynamics module + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^{MD}/dy^{ED} block + + INTEGER(IntKi) :: ErrStat !< Error status of the operation + CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables: + + INTEGER(IntKi) :: MD_Start_td ! starting index of dUdu (column) where particular MD fields are located + INTEGER(IntKi) :: MD_Start_tr ! starting index of dUdu (row) where particular MD fields are located + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_MD_InputSolve_du' + + + ErrStat = ErrID_None + ErrMsg = "" + IF (u_MD%CoupledKinematics(1)%Committed) THEN + !................................... + ! FairLead Mesh + !................................... + + if ( p_FAST%CompSub == Module_SD ) THEN + ! dU^{MD}/du^{MD} + call Linearize_Point_to_Point( y_SD%Y3Mesh, u_MD%CoupledKinematics(1), MeshMapData%SDy3_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + + ! MD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} + MD_Start_td = y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + MD_Start_tr = MD_Start_td + u_MD%CoupledKinematics(1)%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field + + ! translational velocity: + if (allocated(MeshMapData%SDy3_P_2_Mooring_P%dM%tv_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%SDy3_P_2_Mooring_P%dM%tv_ud, MD_Start_tr, MD_Start_td ) + end if + + ! translational acceleration: + MD_Start_tr = MD_Start_tr + u_MD%CoupledKinematics(1)%NNodes * 6 ! skip 2 fields ( TranslationVel and RotationVel) + if (allocated(MeshMapData%SDy3_P_2_Mooring_P%dM%ta_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%SDy3_P_2_Mooring_P%dM%ta_ud, MD_Start_tr, MD_Start_td ) + end if + + else if ( p_FAST%CompSub == Module_None ) THEN + ! dU^{MD}/du^{MD} + call Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_MD%CoupledKinematics(1), MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + + ! MD is destination in the mapping, so we want M_{tv_uD} and M_{ta_uD} + MD_Start_td = y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + MD_Start_tr = MD_Start_td + u_MD%CoupledKinematics(1)%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field + + ! translational velocity: + if (allocated(MeshMapData%ED_P_2_Mooring_P%dM%tv_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_Mooring_P%dM%tv_ud, MD_Start_tr, MD_Start_td ) + end if + + ! translational acceleration: + MD_Start_tr = MD_Start_tr + u_MD%CoupledKinematics(1)%NNodes * 6 ! skip 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field + if (allocated(MeshMapData%ED_P_2_Mooring_P%dM%ta_uD )) then + call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_Mooring_P%dM%ta_ud, MD_Start_tr, MD_Start_td ) + end if + + end if + + + END IF +END SUBROUTINE Linear_MD_InputSolve_du + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{MD}/dy^{ED} block of dUdy. (i.e., how do changes in the ED outputs affect +!! the MD inputs?) +SUBROUTINE Linear_MD_InputSolve_dy( p_FAST, y_FAST, u_MD, y_ED, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) + + ! Passed variables + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(MD_InputType), INTENT(INOUT) :: u_MD !< The inputs to MoorDyn + TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the ElastoDyn structural dynamics module + TYPE(SD_OutputType), INTENT(IN) :: y_SD !< The outputs from the SubDyn structural dynamics module + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{MD}/dy^{ED} block + + INTEGER(IntKi) :: ErrStat !< Error status of the operation + CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables: + + INTEGER(IntKi) :: MD_Start ! starting index of dUdy (column) where particular MD fields are located + INTEGER(IntKi) :: ED_Out_Start! starting index of dUdy (row) where particular ED fields are located + INTEGER(IntKi) :: SD_Out_Start! starting index of dUdy (row) where particular SD fields are located + CHARACTER(*), PARAMETER :: RoutineName = 'Linear_MD_InputSolve_dy' + + + ErrStat = ErrID_None + ErrMsg = "" + IF (u_MD%CoupledKinematics(1)%Committed) THEN + !................................... + ! FairLead Mesh + !................................... + + MD_Start = y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + + if ( p_FAST%CompSub == Module_SD ) THEN + ! dU^{MD}/dy^{SD} + + !!! ! This linearization was done in forming dUdu (see Linear_MD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!call Linearize_Point_to_Point( y_SD%Y3Mesh, u_MD%CoupledKinematics(1), MeshMapData%SD_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + + SD_Out_Start = Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y3Mesh%TranslationDisp field + call Assemble_dUdy_Motions( y_SD%Y3Mesh, u_MD%CoupledKinematics(1), MeshMapData%SDy3_P_2_Mooring_P, MD_Start, SD_Out_Start, dUdy, OnlyTranslationDisp=.false.) + + else if ( p_FAST%CompSub == Module_None ) THEN + ! dU^{MD}/dy^{ED} + !!! ! This linearization was done in forming dUdu (see Linear_MD_InputSolve_du()), so we don't need to re-calculate these matrices + !!! ! while forming dUdy, too. + !!!call Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_MD%CoupledKinematics, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + + ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_MD%CoupledKinematics(1), MeshMapData%ED_P_2_Mooring_P, MD_Start, ED_Out_Start, dUdy, OnlyTranslationDisp=.false.) + + end if + + END IF +END SUBROUTINE Linear_MD_InputSolve_dy + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine allocates the state matrices for the glue code and concatenates the module-level state matrices into @@ -4876,7 +5168,7 @@ FUNCTION Indx_y_SD_Y1Mesh_Start(y_SD, y_FAST) RESULT(SD_Out_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< SD outputs at t - INTEGER :: SD_Out_Start !< starting index of this mesh in ElastoDyn outputs + INTEGER :: SD_Out_Start !< starting index of this mesh in SubDyn outputs SD_Out_Start = y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) END FUNCTION Indx_y_SD_Y1Mesh_Start @@ -4886,7 +5178,7 @@ FUNCTION Indx_y_SD_Y2Mesh_Start(y_SD, y_FAST) RESULT(SD_Out_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< SD outputs at t - INTEGER :: SD_Out_Start !< starting index of this mesh in ElastoDyn outputs + INTEGER :: SD_Out_Start !< starting index of this mesh in SubDyn outputs SD_Out_Start = Indx_y_SD_Y1Mesh_Start(y_SD, y_FAST) + y_SD%Y1Mesh%NNodes * 6 ! 3 forces + 3 moments at each node! skip all of the Y1Mesh data and get to the beginning of END FUNCTION Indx_y_SD_Y2Mesh_Start @@ -4895,9 +5187,9 @@ FUNCTION Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) RESULT(SD_Out_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< SD outputs at t - INTEGER :: SD_Out_Start !< starting index of this mesh in ElastoDyn outputs + INTEGER :: SD_Out_Start !< starting index of this mesh in SubDyn outputs - SD_Out_Start = Indx_y_SD_Y2Mesh_Start(y_SD, y_FAST) + y_SD%Y2Mesh%NNodes * 6 ! 3 forces + 3 moments at each node! skip all of the Y1Mesh data and get to the beginning of + SD_Out_Start = Indx_y_SD_Y2Mesh_Start(y_SD, y_FAST) + y_SD%Y2Mesh%NNodes * 6 ! 3 forces + 3 moments at each node! skip all of the Y2Mesh data and get to the beginning of Y3Mesh END FUNCTION Indx_y_SD_Y3Mesh_Start !---------------------------------------------------------------------------------------------------------------------------------- @@ -5283,6 +5575,7 @@ SUBROUTINE SaveOP(i, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtf CALL MAP_CopyInput (MAPp%Input(1), y_FAST%op%u_MAP(i), CtrlCode, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_MD) THEN CALL MD_CopyContState (MD%x( STATE_CURR), y_FAST%op%x_MD(i), CtrlCode, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5295,6 +5588,7 @@ SUBROUTINE SaveOP(i, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtf CALL MD_CopyInput (MD%Input(1), y_FAST%op%u_MD(i), CtrlCode, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN CALL FEAM_CopyContState (FEAM%x( STATE_CURR), y_FAST%op%x_FEAM(i), CtrlCode, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -6155,8 +6449,25 @@ SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, H call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end if - !! MoorDyn - !ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + ! MoorDyn + ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + + allocate( MD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating MD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call MD_CopyOutput(MD%y, MD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call MD_CopyOutput(MD%y, MD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + + + !! FEAM !ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN !! OrcaFlex @@ -6332,8 +6643,17 @@ SUBROUTINE FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, CALL MAP_CopyOutput (MAPp%y, MAPp%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !! MoorDyn - !ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + ! MoorDyn + ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL MD_CopyOutput (MD%Output(j), MD%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL MD_CopyOutput (MD%y, MD%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + !! FEAM !ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN !! OrcaFlex @@ -6494,8 +6814,16 @@ SUBROUTINE FAST_DiffInterpOutputs( psi_target, p_FAST, y_FAST, m_FAST, ED, BD, S call MAP_GetOP( t_global, MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), MAPp%OtherSt, & MAPp%y_interp, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_MAP)%Instance(1)%op_y) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - !! MoorDyn - !ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + ! MoorDyn + ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + + CALL MD_Output_ExtrapInterp (MD%Output, m_FAST%Lin%Psi, MD%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call MD_GetOP( t_global, MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), MD%OtherSt(STATE_CURR), & + MD%y_interp, MD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_MD)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + !! FEAM !ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN !! OrcaFlex diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index c806cef96f..e18fc48de7 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -118,6 +118,9 @@ typedef ^ FAST_ParameterType IntKi CompIce - - - "Compute ice loading (switch) { 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)" - +typedef ^ FAST_ParameterType IntKi WaveFieldMod - - - "Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin" - +typedef ^ FAST_ParameterType logical FarmIntegration - .false. - "whether this is called from FAST.Farm (or another program that doesn't want FAST to call all of the init stuff first)" - +typedef ^ FAST_ParameterType SiKi TurbinePos {3} - - "Initial position of turbine base (origin used for graphics)" m # Environmental conditions: typedef ^ FAST_ParameterType ReKi Gravity - - - "Gravitational acceleration" m/s^2 typedef ^ FAST_ParameterType ReKi AirDens - - - "Air density" kg/m^3 @@ -166,7 +169,6 @@ typedef ^ FAST_ParameterType CHARACTER(1024) VTK_OutFileRoot - "''" - "The rootn typedef ^ FAST_ParameterType INTEGER VTK_tWidth - - - "Width of number of files for leading zeros in file name format" - typedef ^ FAST_ParameterType DbKi VTK_fps - - - "number of frames per second to output VTK data" - typedef ^ FAST_ParameterType FAST_VTK_SurfaceType VTK_surface - - - "Data for VTK surface visualization" -typedef ^ FAST_ParameterType SiKi TurbinePos {3} - - "Initial position of turbine base (origin used for graphics)" m typedef ^ FAST_ParameterType CHARACTER(4) Tdesc - - - "description of turbine ID (for FAST.Farm) screen printing" # Parameters for linearization @@ -558,6 +560,8 @@ typedef ^ ^ MD_ParameterType p - - - "Parameters" typedef ^ ^ MD_InputType u - - - "System inputs" typedef ^ ^ MD_OutputType y - - - "System outputs" typedef ^ ^ MD_MiscVarType m - - - "Misc/optimization variables" +typedef ^ ^ MD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ MD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ MD_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -640,6 +644,8 @@ typedef ^ FAST_ModuleMapType Integer Jac_u_indx {:}{:} - - "matrix to help fill/ typedef ^ FAST_ModuleMapType MeshType u_ED_NacelleLoads - - - "copy of ED input mesh" typedef ^ FAST_ModuleMapType MeshType u_ED_PlatformPtMesh - - - "copy of ED input mesh" typedef ^ FAST_ModuleMapType MeshType u_ED_PlatformPtMesh_2 - - - "copy of ED input mesh (used only for temporary storage)" +typedef ^ FAST_ModuleMapType MeshType u_ED_PlatformPtMesh_3 - - - "copy of ED input mesh (used only for temporary storage)" +typedef ^ FAST_ModuleMapType MeshType u_ED_PlatformPtMesh_MDf - - - "copy of ED input mesh used to store loads from farm-level MD" typedef ^ FAST_ModuleMapType MeshType u_ED_TowerPtloads - - - "copy of ED input mesh" typedef ^ FAST_ModuleMapType MeshType u_ED_BladePtLoads {:} - - "copy of ED input mesh" typedef ^ FAST_ModuleMapType MeshType u_SD_TPMesh - - - "copy of SD input mesh" @@ -656,6 +662,7 @@ typedef ^ FAST_ModuleMapType MeshType y_BD_BldMotion_4Loads {:} - - "BD blade mo typedef ^ FAST_ModuleMapType MeshType u_BD_Distrload {:} - - "copy of BD DistrLoad input meshes" typedef ^ FAST_ModuleMapType MeshType u_Orca_PtfmMesh - - - "copy of Orca PtfmMesh input mesh" typedef ^ FAST_ModuleMapType MeshType u_ExtPtfm_PtfmMesh - - - "copy of ExtPtfm_MCKF PtfmMesh input mesh" +#typedef ^ FAST_ModuleMapType MeshType u_FarmMD_CoupledLoads - - - "FAST-internal copy of MoorDyn's CoupledLoads output mesh for use with shared moorings in FAST.Farm" # ..... FAST_ExternalInput data ....................................................................................................... typedef FAST FAST_ExternInputType ReKi GenTrq - - - "generator torque input from Simulink/Labview" typedef ^ FAST_ExternInputType ReKi ElecPwr - - - "electric power input from Simulink/Labview" @@ -723,7 +730,8 @@ typedef ^ FAST_ExternInitType DbKi Tmax - -1 - "External code specified Tmax" s typedef ^ FAST_ExternInitType IntKi SensorType - SensorType_None - "lidar sensor type, which should not be pulsed at the moment; this input should be replaced with a section in the InflowWind input file" - typedef ^ FAST_ExternInitType LOGICAL LidRadialVel - - - "TRUE => return radial component, FALSE => return 'x' direction estimate" - typedef ^ FAST_ExternInitType IntKi TurbineID - 0 - "ID number for turbine (used to create output file naming convention)" - -typedef ^ FAST_ExternInitType ReKi TurbinePos {3} - - "Initial position of turbine base (origin used in future for graphics)" m +typedef ^ FAST_ExternInitType ReKi TurbinePos {3} - - "Initial position of turbine base (origin used for graphics or in FAST.Farm)" m +typedef ^ FAST_ExternInitType IntKi WaveFieldMod - - - "Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin" - typedef ^ FAST_ExternInitType IntKi NumSC2CtrlGlob - - - "number of global controller inputs [from supercontroller]" - typedef ^ FAST_ExternInitType IntKi NumSC2Ctrl - - - "number of turbine specific controller inputs [from supercontroller]" - typedef ^ FAST_ExternInitType IntKi NumCtrl2SC - - - "number of controller outputs [to supercontroller]" - @@ -737,7 +745,6 @@ typedef ^ FAST_ExternInitType CHARACTER(1024) RootName - - - "Root name of FAST typedef ^ FAST_ExternInitType IntKi NumActForcePtsBlade - - - "number of actuator line force points in blade" - typedef ^ FAST_ExternInitType IntKi NumActForcePtsTower - - - "number of actuator line force points in tower" - - # ..... FAST Turbine Data (one realization) ....................................................................................................... typedef ^ FAST_TurbineType IntKi TurbID - 1 - "Turbine ID Number" - typedef ^ FAST_TurbineType FAST_ParameterType p_FAST - - - "Parameters for the glue code" - diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index 036117f180..2e53cebc88 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -1394,8 +1394,8 @@ SUBROUTINE Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, y_ED, u_HD, u_SD, u_ExtPtfm, ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN ! motions: - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_MD%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//'u_MD%PtFairleadDisplacement' ) + CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_MD%CoupledKinematics(1), MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//'u_MD%CoupledKinematics' ) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN ! motions: @@ -2031,6 +2031,7 @@ SUBROUTINE U_ED_HD_Residual( y_ED2, y_HD2, u_IN, U_Resid) !.................. ! Set mooring line inputs (which don't have acceleration fields) !.................. + !TODO: MoorDyn input mesh now has acceleration fields, and they are used in some uncommon cases. Is this an issue? <<< IF ( p_FAST%CompMooring == Module_MAP ) THEN @@ -2044,10 +2045,10 @@ SUBROUTINE U_ED_HD_Residual( y_ED2, y_HD2, u_IN, U_Resid) ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN ! note: MD_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, u_MD%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) + CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, u_MD%CoupledKinematics(1), MeshMapData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Transfer_Point_to_Point( y_MD%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MD%PtFairleadDisplacement, PlatformMotions ) !u_MD and y_ED contain the displacements needed for moment calculations + CALL Transfer_Point_to_Point( y_MD%CoupledLoads(1), MeshMapData%u_ED_PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MD%CoupledKinematics(1), PlatformMotions ) !u_MD and y_ED contain the displacements needed for moment calculations CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN @@ -2065,7 +2066,14 @@ SUBROUTINE U_ED_HD_Residual( y_ED2, y_HD2, u_IN, U_Resid) MeshMapData%u_ED_PlatformPtMesh%Moment = 0.0_ReKi END IF - + + + ! add farm-level mooring loads if applicable >>> note: not yet set up for SubDyn <<< + IF (p_FAST%FarmIntegration) THEN + MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_MDf%Force + MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_MDf%Moment + END IF + ! Map motions for ServodDyn Structural control (TMD) if used and forces from the TMD to the platform IF ( p_FAST%CompServo == Module_SrvD .and. p_FAST%CompSub /= Module_SD ) THEN @@ -2975,10 +2983,10 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! note: MD_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) if ( p_FAST%CompSub == Module_SD ) then - CALL Transfer_Point_to_Point( y_SD2%y3Mesh, u_MD%PtFairleadDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) + CALL Transfer_Point_to_Point( y_SD2%y3Mesh, u_MD%CoupledKinematics(1), MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) else - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, u_MD%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) + CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, u_MD%CoupledKinematics(1), MeshMapData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) end if @@ -3262,13 +3270,13 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN if ( p_FAST%CompSub == Module_SD ) then - CALL Transfer_Point_to_Point( y_MD%PtFairleadLoad, MeshMapData%u_SD_LMesh_2, MeshMapData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2, u_MD%PtFairleadDisplacement, y_SD2%Y3Mesh ) !u_MD and y_SD contain the displacements needed for moment calculations + CALL Transfer_Point_to_Point( y_MD%CoupledLoads(1), MeshMapData%u_SD_LMesh_2, MeshMapData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2, u_MD%CoupledKinematics(1), y_SD2%Y3Mesh ) !u_MD and y_SD contain the displacements needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) MeshMapData%u_SD_LMesh%Force = MeshMapData%u_SD_LMesh%Force + MeshMapData%u_SD_LMesh_2%Force MeshMapData%u_SD_LMesh%Moment = MeshMapData%u_SD_LMesh%Moment + MeshMapData%u_SD_LMesh_2%Moment else - CALL Transfer_Point_to_Point( y_MD%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MD%PtFairleadDisplacement, PlatformMotions ) !u_MD and y_ED contain the displacements needed for moment calculations + CALL Transfer_Point_to_Point( y_MD%CoupledLoads(1), MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MD%CoupledKinematics(1), PlatformMotions ) !u_MD and y_ED contain the displacements needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force @@ -3297,7 +3305,14 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_2%Moment END IF - + + + ! add farm-level mooring loads if applicable + IF (p_FAST%FarmIntegration) THEN + MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_MDf%Force + MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_MDf%Moment + END IF + ! Map the forces from the platform mounted TMD (from ServoDyn) to the platform reference point IF ( p_FAST%CompServo == Module_SrvD .and. p_FAST%CompSub /= Module_SD .and. allocated(y_SrvD%SStCLoadMesh)) THEN @@ -4230,8 +4245,8 @@ SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp MAPp%Input(1)%PtFairDisplacement%RemapFlag = .FALSE. MAPp%y%PtFairleadLoad%RemapFlag = .FALSE. ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN - MD%Input(1)%PtFairleadDisplacement%RemapFlag = .FALSE. - MD%y%PtFairleadLoad%RemapFlag = .FALSE. + MD%Input(1)%CoupledKinematics(1)%RemapFlag = .FALSE. + MD%y%CoupledLoads(1)%RemapFlag = .FALSE. ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN FEAM%Input(1)%PtFairleadDisplacement%RemapFlag = .FALSE. FEAM%y%PtFairleadLoad%RemapFlag = .FALSE. @@ -4766,18 +4781,18 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ! SubDyn <-> MoorDyn !------------------------- ! MoorDyn point mesh to/from SubDyn point mesh - CALL MeshMapCreate( MD%y%PtFairleadLoad, SD%Input(1)%LMesh, MeshMapData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( MD%y%CoupledLoads(1), SD%Input(1)%LMesh, MeshMapData%Mooring_P_2_SD_P, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_SD_P' ) - CALL MeshMapCreate( SD%y%y3Mesh, MD%Input(1)%PtFairleadDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( SD%y%y3Mesh, MD%Input(1)%CoupledKinematics(1), MeshMapData%SDy3_P_2_Mooring_P, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SDy3_P_2_Mooring_P' ) ELSE !------------------------- ! ElastoDyn <-> MoorDyn !------------------------- ! MoorDyn point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( MD%y%PtFairleadLoad, PlatformLoads, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( MD%y%CoupledLoads(1), PlatformLoads, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_Ptfm' ) - CALL MeshMapCreate( PlatformMotion, MD%Input(1)%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( PlatformMotion, MD%Input(1)%CoupledKinematics(1), MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_Mooring_P' ) END IF ! p_FAST%CompSub == Module_SD @@ -4901,6 +4916,19 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M CALL MeshCopy ( ED%Input(1)%PlatformPtMesh, MeshMapData%u_ED_PlatformPtMesh_2, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_PlatformPtMesh_2' ) + CALL MeshCopy ( ED%Input(1)%PlatformPtMesh, MeshMapData%u_ED_PlatformPtMesh_3, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_PlatformPtMesh_3' ) + + ! for now, setting up this additional load mesh for farm-level MD loads if in FAST.Farm (@mhall TODO: add more checks/handling) <<< + if (p_FAST%FarmIntegration) then + CALL MeshCopy ( ED%Input(1)%PlatformPtMesh, MeshMapData%u_ED_PlatformPtMesh_MDf, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_PlatformPtMesh_MDf' ) + + ! need to initialize to zero? + MeshMapData%u_ED_PlatformPtMesh_MDf%Force = 0.0_ReKi + MeshMapData%u_ED_PlatformPtMesh_MDf%Moment = 0.0_ReKi + end if + IF ( p_FAST%CompElast == Module_BD ) THEN @@ -5097,7 +5125,7 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca CALL Transfer_Point_to_Point( SD%y%y3Mesh, MAPp%Input(1)%PtFairDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN - CALL Transfer_Point_to_Point( SD%y%y3Mesh, MD%Input(1)%PtFairleadDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) + CALL Transfer_Point_to_Point( SD%y%y3Mesh, MD%Input(1)%CoupledKinematics(1), MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN CALL Transfer_Point_to_Point( SD%y%y3Mesh, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) @@ -5314,10 +5342,10 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, ! note: MD_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) if ( p_FAST%CompSub == Module_SD ) then - CALL Transfer_Point_to_Point( SD%y%y3Mesh, MD%Input(1)%PtFairleadDisplacement, MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) + CALL Transfer_Point_to_Point( SD%y%y3Mesh, MD%Input(1)%CoupledKinematics(1), MeshMapData%SDy3_P_2_Mooring_P, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) else - CALL Transfer_Point_to_Point( ED%y%PlatformPtMesh, MD%Input(1)%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) + CALL Transfer_Point_to_Point( ED%y%PlatformPtMesh, MD%Input(1)%CoupledKinematics(1), MeshMapData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) endif diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 7e76905eca..0d4318ca7e 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -23,6 +23,7 @@ MODULE FAST_Subs USE FAST_Solver USE FAST_Linear + USE Waves, ONLY : WaveGrid_n USE SC_DataEx USE VersionInfo @@ -32,7 +33,7 @@ MODULE FAST_Subs !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! INITIALIZATION ROUTINES !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> a wrapper routine to call FAST_Initialize a the full-turbine simulation level (makes easier to write top-level driver) +!> a wrapper routine to call FAST_Initialize at the full-turbine simulation level (makes easier to write top-level driver) SUBROUTINE FAST_InitializeAll_T( t_initial, TurbID, Turbine, ErrStat, ErrMsg, InFile, ExternInitData ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time @@ -190,10 +191,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, END IF ! ... Open and read input files ... - ! also, set turbine reference position for graphics output + ! also, set applicable farm paramters and turbine reference position also for graphics output p_FAST%UseSC = .FALSE. if (PRESENT(ExternInitData)) then + p_FAST%FarmIntegration = ExternInitData%FarmIntegration p_FAST%TurbinePos = ExternInitData%TurbinePos + p_FAST%WaveFieldMod = ExternInitData%WaveFieldMod if( (ExternInitData%NumSC2CtrlGlob .gt. 0) .or. (ExternInitData%NumSC2Ctrl .gt. 0) .or. (ExternInitData%NumCtrl2SC .gt. 0)) then p_FAST%UseSC = .TRUE. end if @@ -206,6 +209,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, else p_FAST%TurbinePos = 0.0_ReKi + p_FAST%WaveFieldMod = 0 CALL FAST_Init( p_FAST, m_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2 ) ! We have the name of the input file from somewhere else (e.g. Simulink) end if @@ -741,7 +745,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_HD%hasIce = p_FAST%CompIce /= Module_None Init%InData_HD%Linearize = p_FAST%Linearize - ! if wave field needs an offset, modify these values (added at request of SOWFA developers): + ! these values support wave field handling + Init%InData_HD%WaveFieldMod = p_FAST%WaveFieldMod Init%InData_HD%PtfmLocationX = p_FAST%TurbinePos(1) Init%InData_HD%PtfmLocationY = p_FAST%TurbinePos(2) @@ -946,14 +951,28 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! initialize MoorDyn ! ........................ ELSEIF (p_FAST%CompMooring == Module_MD) THEN + + ! some new allocations needed with version that's compatible with farm-level use + ALLOCATE( Init%InData_MD%PtfmInit(6,1), Init%InData_MD%TurbineRefPos(3,1), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating MoorDyn PtfmInit and TurbineRefPos initialization inputs.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF Init%InData_MD%FileName = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. Init%InData_MD%RootName = p_FAST%OutFileRoot - Init%InData_MD%PtfmInit = Init%OutData_ED%PlatformPos !ED%x(STATE_CURR)%QT(1:6) ! initial position of the platform !bjj: this should come from Init%OutData_ED, not x_ED - Init%InData_MD%g = p_FAST%Gravity ! This need to be according to g from driver - Init%InData_MD%rhoW = Init%OutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn + Init%InData_MD%PtfmInit(:,1) = Init%OutData_ED%PlatformPos ! initial position of the platform (when a FAST module, MoorDyn just takes one row in this matrix) + Init%InData_MD%FarmSize = 0 ! 0 here indicates normal FAST module use of MoorDyn, for a single turbine + Init%InData_MD%TurbineRefPos(:,1) = 0.0_DbKi ! for normal FAST use, the global reference frame is at 0,0,0 + Init%InData_MD%g = p_FAST%Gravity ! This need to be according to g used in ElastoDyn + Init%InData_MD%rhoW = Init%OutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn Init%InData_MD%WtrDepth = Init%OutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn + Init%InData_MD%Tmax = p_FAST%TMax ! expected simulation duration (used by MoorDyn for wave kinematics preprocesing) + + Init%InData_MD%Linearize = p_FAST%Linearize + CALL MD_Init( Init%InData_MD, MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), & MD%OtherSt(STATE_CURR), MD%y, MD%m, p_FAST%dt_module( MODULE_MD ), Init%OutData_MD, ErrStat2, ErrMsg2 ) @@ -962,7 +981,22 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, p_FAST%ModuleInitialized(Module_MD) = .TRUE. CALL SetModuleSubstepTime(Module_MD, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + + allocate( y_FAST%Lin%Modules(MODULE_MD)%Instance(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(MD).", ErrStat, ErrMsg, RoutineName ) + else + if (allocated(Init%OutData_MD%LinNames_y)) call move_alloc(Init%OutData_MD%LinNames_y,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%Names_y) + if (allocated(Init%OutData_MD%LinNames_x)) call move_alloc(Init%OutData_MD%LinNames_x,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%Names_x) + if (allocated(Init%OutData_MD%LinNames_u)) call move_alloc(Init%OutData_MD%LinNames_u,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%Names_u) + if (allocated(Init%OutData_MD%RotFrame_y)) call move_alloc(Init%OutData_MD%RotFrame_y,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%RotFrame_y) + if (allocated(Init%OutData_MD%RotFrame_x)) call move_alloc(Init%OutData_MD%RotFrame_x,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%RotFrame_x) + if (allocated(Init%OutData_MD%RotFrame_u)) call move_alloc(Init%OutData_MD%RotFrame_u,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%RotFrame_u) + if (allocated(Init%OutData_MD%IsLoad_u )) call move_alloc(Init%OutData_MD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%IsLoad_u ) + if (allocated(Init%OutData_MD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%NumOutputs = size(Init%OutData_MD%WriteOutputHdr) + if (allocated(Init%OutData_MD%DerivOrder_x)) call move_alloc(Init%OutData_MD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_MD)%Instance(1)%DerivOrder_x) + end if + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN @@ -1913,7 +1947,7 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) if (p%CompAero == MODULE_AD14) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the AeroDyn v14 module.',ErrStat, ErrMsg, RoutineName) !if (p%CompSub == MODULE_SD) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the SubDyn module.',ErrStat, ErrMsg, RoutineName) if (p%CompSub /= MODULE_None .and. p%CompSub /= MODULE_SD ) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the ExtPtfm_MCKF substructure module.',ErrStat, ErrMsg, RoutineName) - if (p%CompMooring /= MODULE_None .and. p%CompMooring /= MODULE_MAP) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the FEAMooring or MoorDyn mooring modules.',ErrStat, ErrMsg, RoutineName) + if (p%CompMooring /= MODULE_None .and. p%CompMooring == MODULE_FEAM) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the FEAMooring mooring module.',ErrStat, ErrMsg, RoutineName) if (p%CompIce /= MODULE_None) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for any of the ice loading modules.',ErrStat, ErrMsg, RoutineName) end if @@ -5612,8 +5646,8 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, H ! MoorDyn ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN if (allocated(MD%Input)) then - call MeshWrVTK(p_FAST%TurbinePos, MD%y%PtFairleadLoad, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, MD%Input(1)%PtFairleadDisplacement ) - !call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, MD%y%CoupledLoads(1), trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, MD%Input(1)%CoupledKinematics(1) ) + !call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%CoupledKinematics, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end if ! FEAMooring @@ -5747,7 +5781,7 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, ! IF ( p_FAST%CompMooring == Module_MAP ) THEN ! call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) +! call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%CoupledKinematics, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN ! call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'FEAM_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! END IF @@ -5868,7 +5902,7 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW ! IF ( p_FAST%CompMooring == Module_MAP ) THEN ! call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) ! ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%CoupledKinematics, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) ! ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN ! call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'FEAM_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) ! END IF diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index d16e227aa9..324ea28ca3 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -136,6 +136,9 @@ MODULE FAST_Types INTEGER(IntKi) :: MHK !< MHK turbine type (switch) {0=Not an MHK turbine; 1=Fixed MHK turbine; 2=Floating MHK turbine} [-] LOGICAL :: UseDWM !< Use the DWM module in AeroDyn [-] LOGICAL :: Linearize !< Linearization analysis (flag) [-] + INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] + LOGICAL :: FarmIntegration = .false. !< whether this is called from FAST.Farm (or another program that doesn't want FAST to call all of the init stuff first) [-] + REAL(SiKi) , DIMENSION(1:3) :: TurbinePos !< Initial position of turbine base (origin used for graphics) [m] REAL(ReKi) :: Gravity !< Gravitational acceleration [m/s^2] REAL(ReKi) :: AirDens !< Air density [kg/m^3] REAL(ReKi) :: WtrDens !< Water density [kg/m^3] @@ -180,7 +183,6 @@ MODULE FAST_Types INTEGER(IntKi) :: VTK_tWidth !< Width of number of files for leading zeros in file name format [-] REAL(DbKi) :: VTK_fps !< number of frames per second to output VTK data [-] TYPE(FAST_VTK_SurfaceType) :: VTK_surface !< Data for VTK surface visualization [-] - REAL(SiKi) , DIMENSION(1:3) :: TurbinePos !< Initial position of turbine base (origin used for graphics) [m] CHARACTER(4) :: Tdesc !< description of turbine ID (for FAST.Farm) screen printing [-] LOGICAL :: CalcSteady !< Calculate a steady-state periodic operating point before linearization [unused if Linearize=False] [-] INTEGER(IntKi) :: TrimCase !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [unused if Linearize=False; used only if CalcSteady=True] [-] @@ -583,6 +585,8 @@ MODULE FAST_Types TYPE(MD_InputType) :: u !< System inputs [-] TYPE(MD_OutputType) :: y !< System outputs [-] TYPE(MD_MiscVarType) :: m !< Misc/optimization variables [-] + TYPE(MD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(MD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE MoorDyn_Data @@ -653,6 +657,8 @@ MODULE FAST_Types TYPE(MeshType) :: u_ED_NacelleLoads !< copy of ED input mesh [-] TYPE(MeshType) :: u_ED_PlatformPtMesh !< copy of ED input mesh [-] TYPE(MeshType) :: u_ED_PlatformPtMesh_2 !< copy of ED input mesh (used only for temporary storage) [-] + TYPE(MeshType) :: u_ED_PlatformPtMesh_3 !< copy of ED input mesh (used only for temporary storage) [-] + TYPE(MeshType) :: u_ED_PlatformPtMesh_MDf !< copy of ED input mesh used to store loads from farm-level MD [-] TYPE(MeshType) :: u_ED_TowerPtloads !< copy of ED input mesh [-] TYPE(MeshType) , DIMENSION(:), ALLOCATABLE :: u_ED_BladePtLoads !< copy of ED input mesh [-] TYPE(MeshType) :: u_SD_TPMesh !< copy of SD input mesh [-] @@ -740,7 +746,8 @@ MODULE FAST_Types INTEGER(IntKi) :: SensorType = SensorType_None !< lidar sensor type, which should not be pulsed at the moment; this input should be replaced with a section in the InflowWind input file [-] LOGICAL :: LidRadialVel !< TRUE => return radial component, FALSE => return 'x' direction estimate [-] INTEGER(IntKi) :: TurbineID = 0 !< ID number for turbine (used to create output file naming convention) [-] - REAL(ReKi) , DIMENSION(1:3) :: TurbinePos !< Initial position of turbine base (origin used in future for graphics) [m] + REAL(ReKi) , DIMENSION(1:3) :: TurbinePos !< Initial position of turbine base (origin used for graphics or in FAST.Farm) [m] + INTEGER(IntKi) :: WaveFieldMod !< Wave field handling (-) (switch) 0: use individual HydroDyn inputs without adjustment, 1: adjust wave phases based on turbine offsets from farm origin [-] INTEGER(IntKi) :: NumSC2CtrlGlob !< number of global controller inputs [from supercontroller] [-] INTEGER(IntKi) :: NumSC2Ctrl !< number of turbine specific controller inputs [from supercontroller] [-] INTEGER(IntKi) :: NumCtrl2SC !< number of controller outputs [to supercontroller] [-] @@ -2116,6 +2123,9 @@ SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%MHK = SrcParamData%MHK DstParamData%UseDWM = SrcParamData%UseDWM DstParamData%Linearize = SrcParamData%Linearize + DstParamData%WaveFieldMod = SrcParamData%WaveFieldMod + DstParamData%FarmIntegration = SrcParamData%FarmIntegration + DstParamData%TurbinePos = SrcParamData%TurbinePos DstParamData%Gravity = SrcParamData%Gravity DstParamData%AirDens = SrcParamData%AirDens DstParamData%WtrDens = SrcParamData%WtrDens @@ -2162,7 +2172,6 @@ SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg CALL FAST_Copyvtk_surfacetype( SrcParamData%VTK_surface, DstParamData%VTK_surface, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - DstParamData%TurbinePos = SrcParamData%TurbinePos DstParamData%Tdesc = SrcParamData%Tdesc DstParamData%CalcSteady = SrcParamData%CalcSteady DstParamData%TrimCase = SrcParamData%TrimCase @@ -2259,6 +2268,9 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 1 ! MHK Int_BufSz = Int_BufSz + 1 ! UseDWM Int_BufSz = Int_BufSz + 1 ! Linearize + Int_BufSz = Int_BufSz + 1 ! WaveFieldMod + Int_BufSz = Int_BufSz + 1 ! FarmIntegration + Re_BufSz = Re_BufSz + SIZE(InData%TurbinePos) ! TurbinePos Re_BufSz = Re_BufSz + 1 ! Gravity Re_BufSz = Re_BufSz + 1 ! AirDens Re_BufSz = Re_BufSz + 1 ! WtrDens @@ -2320,7 +2332,6 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Re_BufSz = Re_BufSz + SIZE(InData%TurbinePos) ! TurbinePos Int_BufSz = Int_BufSz + 1*LEN(InData%Tdesc) ! Tdesc Int_BufSz = Int_BufSz + 1 ! CalcSteady Int_BufSz = Int_BufSz + 1 ! TrimCase @@ -2442,6 +2453,14 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveFieldMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FarmIntegration, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TurbinePos,1), UBOUND(InData%TurbinePos,1) + ReKiBuf(Re_Xferred) = InData%TurbinePos(i1) + Re_Xferred = Re_Xferred + 1 + END DO ReKiBuf(Re_Xferred) = InData%Gravity Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%AirDens @@ -2588,10 +2607,6 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DO i1 = LBOUND(InData%TurbinePos,1), UBOUND(InData%TurbinePos,1) - ReKiBuf(Re_Xferred) = InData%TurbinePos(i1) - Re_Xferred = Re_Xferred + 1 - END DO DO I = 1, LEN(InData%Tdesc) IntKiBuf(Int_Xferred) = ICHAR(InData%Tdesc(I:I), IntKi) Int_Xferred = Int_Xferred + 1 @@ -2755,6 +2770,16 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Int_Xferred = Int_Xferred + 1 OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) Int_Xferred = Int_Xferred + 1 + OutData%WaveFieldMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FarmIntegration = TRANSFER(IntKiBuf(Int_Xferred), OutData%FarmIntegration) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%TurbinePos,1) + i1_u = UBOUND(OutData%TurbinePos,1) + DO i1 = LBOUND(OutData%TurbinePos,1), UBOUND(OutData%TurbinePos,1) + OutData%TurbinePos(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO OutData%Gravity = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 OutData%AirDens = ReKiBuf(Re_Xferred) @@ -2915,12 +2940,6 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - i1_l = LBOUND(OutData%TurbinePos,1) - i1_u = UBOUND(OutData%TurbinePos,1) - DO i1 = LBOUND(OutData%TurbinePos,1), UBOUND(OutData%TurbinePos,1) - OutData%TurbinePos(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO DO I = 1, LEN(OutData%Tdesc) OutData%Tdesc(I:I) = CHAR(IntKiBuf(Int_Xferred)) Int_Xferred = Int_Xferred + 1 @@ -33758,6 +33777,25 @@ SUBROUTINE FAST_CopyMoorDyn_Data( SrcMoorDyn_DataData, DstMoorDyn_DataData, Ctrl CALL MD_CopyMisc( SrcMoorDyn_DataData%m, DstMoorDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcMoorDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcMoorDyn_DataData%Output,1) + i1_u = UBOUND(SrcMoorDyn_DataData%Output,1) + IF (.NOT. ALLOCATED(DstMoorDyn_DataData%Output)) THEN + ALLOCATE(DstMoorDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMoorDyn_DataData%Output,1), UBOUND(SrcMoorDyn_DataData%Output,1) + CALL MD_CopyOutput( SrcMoorDyn_DataData%Output(i1), DstMoorDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL MD_CopyOutput( SrcMoorDyn_DataData%y_interp, DstMoorDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN IF (ALLOCATED(SrcMoorDyn_DataData%Input)) THEN i1_l = LBOUND(SrcMoorDyn_DataData%Input,1) i1_u = UBOUND(SrcMoorDyn_DataData%Input,1) @@ -33813,6 +33851,13 @@ SUBROUTINE FAST_DestroyMoorDyn_Data( MoorDyn_DataData, ErrStat, ErrMsg ) CALL MD_DestroyInput( MoorDyn_DataData%u, ErrStat, ErrMsg ) CALL MD_DestroyOutput( MoorDyn_DataData%y, ErrStat, ErrMsg ) CALL MD_DestroyMisc( MoorDyn_DataData%m, ErrStat, ErrMsg ) +IF (ALLOCATED(MoorDyn_DataData%Output)) THEN +DO i1 = LBOUND(MoorDyn_DataData%Output,1), UBOUND(MoorDyn_DataData%Output,1) + CALL MD_DestroyOutput( MoorDyn_DataData%Output(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(MoorDyn_DataData%Output) +ENDIF + CALL MD_DestroyOutput( MoorDyn_DataData%y_interp, ErrStat, ErrMsg ) IF (ALLOCATED(MoorDyn_DataData%Input)) THEN DO i1 = LBOUND(MoorDyn_DataData%Input,1), UBOUND(MoorDyn_DataData%Input,1) CALL MD_DestroyInput( MoorDyn_DataData%Input(i1), ErrStat, ErrMsg ) @@ -34004,6 +34049,46 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no IF ( ALLOCATED(InData%Input) ) THEN Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension @@ -34267,6 +34352,75 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Output) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf @@ -34709,6 +34863,102 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) @@ -36351,6 +36601,12 @@ SUBROUTINE FAST_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, C CALL MeshCopy( SrcModuleMapTypeData%u_ED_PlatformPtMesh_2, DstModuleMapTypeData%u_ED_PlatformPtMesh_2, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_ED_PlatformPtMesh_3, DstModuleMapTypeData%u_ED_PlatformPtMesh_3, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_ED_PlatformPtMesh_MDf, DstModuleMapTypeData%u_ED_PlatformPtMesh_MDf, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN CALL MeshCopy( SrcModuleMapTypeData%u_ED_TowerPtloads, DstModuleMapTypeData%u_ED_TowerPtloads, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat>=AbortErrLev) RETURN @@ -36625,6 +36881,8 @@ SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) CALL MeshDestroy( ModuleMapTypeData%u_ED_NacelleLoads, ErrStat, ErrMsg ) CALL MeshDestroy( ModuleMapTypeData%u_ED_PlatformPtMesh, ErrStat, ErrMsg ) CALL MeshDestroy( ModuleMapTypeData%u_ED_PlatformPtMesh_2, ErrStat, ErrMsg ) + CALL MeshDestroy( ModuleMapTypeData%u_ED_PlatformPtMesh_3, ErrStat, ErrMsg ) + CALL MeshDestroy( ModuleMapTypeData%u_ED_PlatformPtMesh_MDf, ErrStat, ErrMsg ) CALL MeshDestroy( ModuleMapTypeData%u_ED_TowerPtloads, ErrStat, ErrMsg ) IF (ALLOCATED(ModuleMapTypeData%u_ED_BladePtLoads)) THEN DO i1 = LBOUND(ModuleMapTypeData%u_ED_BladePtLoads,1), UBOUND(ModuleMapTypeData%u_ED_BladePtLoads,1) @@ -37645,6 +37903,40 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! u_ED_PlatformPtMesh_3: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_ED_PlatformPtMesh_3, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_PlatformPtMesh_3 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_ED_PlatformPtMesh_3 + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_ED_PlatformPtMesh_3 + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_ED_PlatformPtMesh_3 + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_ED_PlatformPtMesh_MDf: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_ED_PlatformPtMesh_MDf, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_PlatformPtMesh_MDf + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_ED_PlatformPtMesh_MDf + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_ED_PlatformPtMesh_MDf + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_ED_PlatformPtMesh_MDf + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 3 ! u_ED_TowerPtloads: size of buffers for each call to pack subtype CALL MeshPack( InData%u_ED_TowerPtloads, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_TowerPtloads CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -39574,6 +39866,62 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_ED_PlatformPtMesh_3, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_PlatformPtMesh_3 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_ED_PlatformPtMesh_MDf, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_PlatformPtMesh_MDf + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf)) THEN IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf @@ -42369,6 +42717,86 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%u_ED_PlatformPtMesh_3, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_PlatformPtMesh_3 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MeshUnpack( OutData%u_ED_PlatformPtMesh_MDf, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_PlatformPtMesh_MDf + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) @@ -46618,6 +47046,7 @@ SUBROUTINE FAST_CopyExternInitType( SrcExternInitTypeData, DstExternInitTypeData DstExternInitTypeData%LidRadialVel = SrcExternInitTypeData%LidRadialVel DstExternInitTypeData%TurbineID = SrcExternInitTypeData%TurbineID DstExternInitTypeData%TurbinePos = SrcExternInitTypeData%TurbinePos + DstExternInitTypeData%WaveFieldMod = SrcExternInitTypeData%WaveFieldMod DstExternInitTypeData%NumSC2CtrlGlob = SrcExternInitTypeData%NumSC2CtrlGlob DstExternInitTypeData%NumSC2Ctrl = SrcExternInitTypeData%NumSC2Ctrl DstExternInitTypeData%NumCtrl2SC = SrcExternInitTypeData%NumCtrl2SC @@ -46711,6 +47140,7 @@ SUBROUTINE FAST_PackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 1 ! LidRadialVel Int_BufSz = Int_BufSz + 1 ! TurbineID Re_BufSz = Re_BufSz + SIZE(InData%TurbinePos) ! TurbinePos + Int_BufSz = Int_BufSz + 1 ! WaveFieldMod Int_BufSz = Int_BufSz + 1 ! NumSC2CtrlGlob Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC @@ -46770,6 +47200,8 @@ SUBROUTINE FAST_PackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ReKiBuf(Re_Xferred) = InData%TurbinePos(i1) Re_Xferred = Re_Xferred + 1 END DO + IntKiBuf(Int_Xferred) = InData%WaveFieldMod + Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%NumSC2CtrlGlob Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl @@ -46871,6 +47303,8 @@ SUBROUTINE FAST_UnPackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt OutData%TurbinePos(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO + OutData%WaveFieldMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%NumSC2CtrlGlob = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) diff --git a/modules/subdyn/src/FEM.f90 b/modules/subdyn/src/FEM.f90 index ba74d2bf50..b8a9eed453 100644 --- a/modules/subdyn/src/FEM.f90 +++ b/modules/subdyn/src/FEM.f90 @@ -84,7 +84,7 @@ SUBROUTINE EigenSolve(K, M, N, bCheckSingularity, EigVect, Omega, ErrStat, ErrMs Omega2(:) =0.0_LaKi DO I=1,N !Initialize the key and calculate Omega KEY(I)=I - Omega2(I) = AlphaR(I)/Beta(I) + !Omega2(I) = AlphaR(I)/Beta(I) if ( EqualRealNos(real(Beta(I),ReKi),0.0_ReKi) ) then ! --- Beta =0 if (bCheckSingularity) call WrScr('[WARN] Large eigenvalue found, system may be ill-conditioned') diff --git a/reg_tests/r-test b/reg_tests/r-test index 62ce348c8c..477c181d9f 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 62ce348c8cc798e1b7e7c6d826fc2a054512b6d6 +Subproject commit 477c181d9fe909f317f17c718789a1031290ae5c diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index 8b50656451..62d1593276 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -154,31 +154,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -188,31 +188,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -226,31 +226,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -264,31 +264,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -302,31 +302,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -340,31 +340,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -378,31 +378,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -437,31 +437,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -478,31 +478,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -521,31 +521,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -556,31 +556,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -600,31 +600,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -642,32 +642,32 @@ - - - - - + + + - - - - - + - + + + + + + + @@ -686,31 +686,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -724,31 +724,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -762,31 +762,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -800,31 +800,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -838,31 +838,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -876,31 +876,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -914,60 +914,60 @@ - - - - - + + + - - - + - + + + - + + + - - - - - + + + - - - + - + + + - + + + @@ -990,60 +990,60 @@ - - - - - + + + - - - + - + + + - + + + - - - - - + + + - - - + - + + + - + + + @@ -1094,31 +1094,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -1126,31 +1126,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -1179,31 +1179,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -1217,31 +1217,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -1255,31 +1255,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -1293,31 +1293,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -1331,31 +1331,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -1369,31 +1369,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -1407,31 +1407,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -1445,31 +1445,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -1483,31 +1483,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -1534,31 +1534,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -1575,31 +1575,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -1613,31 +1613,31 @@ - + - + - + - - - - - + - + + + - + + + @@ -1654,31 +1654,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -1692,35 +1692,40 @@ - + + + + + + - - - - - + + + - - - + - + + + - + + + @@ -1738,478 +1743,468 @@ - - - - - + + + + + - + - + - - - + - - - - - + + + - - - + - + + + - + + + - - - - - + + + - - - + - + + + - + + + - - - - - + + + - - - + - + + + - + + + - - - - - + + + - - - + - + + + - + + + - - - - - - + + + + - + - + - - - + - - - - - + + + - - - + - + + + - + + + - - - - - + + + - - - + - + + + - + + + - - - - - + + + - - - + - + + + - + + + - - - - - + + + - - - + - + + + - + + + - - - - - - + + + + - + - + - - - + - - - - - + + + - - - + - + + + - + + + - - - - - + + + - - - + - + + + - + + + - - - - - + + + - - - + - + + + - + + + - - - - - + + + - - - + - + + + - + + + - - - - - + + + - - - + - + + + - + + + @@ -2241,48 +2236,48 @@ - + - + - - - + + + - - - - - + + + - - - + - + + + - + + + @@ -2299,31 +2294,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -2337,31 +2332,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -2385,31 +2380,31 @@ - - - - - + + + - - - + - + + + - + + + @@ -2433,31 +2428,31 @@ - - - - - + + + - - - + - + + + - + + + diff --git a/vs-build/MAPlib/MAP_dll.vcxproj b/vs-build/MAPlib/MAP_dll.vcxproj index 7956ac13cd..22373bf523 100644 --- a/vs-build/MAPlib/MAP_dll.vcxproj +++ b/vs-build/MAPlib/MAP_dll.vcxproj @@ -214,4 +214,4 @@ - \ No newline at end of file + diff --git a/vs-build/MoorDyn/MoorDynDriver.sln b/vs-build/MoorDyn/MoorDynDriver.sln new file mode 100644 index 0000000000..93af1f3831 --- /dev/null +++ b/vs-build/MoorDyn/MoorDynDriver.sln @@ -0,0 +1,31 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +# Visual Studio Version 16 +VisualStudioVersion = 16.0.31613.86 +MinimumVisualStudioVersion = 10.0.40219.1 +Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "MoorDynDriver", "MoorDynDriver.vfproj", "{815C302F-A93D-4C22-9329-717B085113C0}" +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug|x64 = Debug|x64 + Debug|x86 = Debug|x86 + Release|x64 = Release|x64 + Release|x86 = Release|x86 + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {815C302F-A93D-4C22-9329-717B085113C0}.Debug|x64.ActiveCfg = Debug|x64 + {815C302F-A93D-4C22-9329-717B085113C0}.Debug|x64.Build.0 = Debug|x64 + {815C302F-A93D-4C22-9329-717B085113C0}.Debug|x86.ActiveCfg = Debug|Win32 + {815C302F-A93D-4C22-9329-717B085113C0}.Debug|x86.Build.0 = Debug|Win32 + {815C302F-A93D-4C22-9329-717B085113C0}.Release|x64.ActiveCfg = Release|x64 + {815C302F-A93D-4C22-9329-717B085113C0}.Release|x64.Build.0 = Release|x64 + {815C302F-A93D-4C22-9329-717B085113C0}.Release|x86.ActiveCfg = Release|Win32 + {815C302F-A93D-4C22-9329-717B085113C0}.Release|x86.Build.0 = Release|Win32 + EndGlobalSection + GlobalSection(SolutionProperties) = preSolution + HideSolutionNode = FALSE + EndGlobalSection + GlobalSection(ExtensibilityGlobals) = postSolution + SolutionGuid = {8141B2B8-9857-455F-978C-8B086DDB3E6A} + EndGlobalSection +EndGlobal diff --git a/vs-build/MoorDyn/MoorDynDriver.vfproj b/vs-build/MoorDyn/MoorDynDriver.vfproj new file mode 100644 index 0000000000..2396eb9279 --- /dev/null +++ b/vs-build/MoorDyn/MoorDynDriver.vfproj @@ -0,0 +1,167 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +