From 4768172f7aacf08373d3316e94aedbac58d66a61 Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 20 Jan 2026 11:10:34 -0700 Subject: [PATCH 1/4] StC: bugfix in DLL applied forces Update comments and add warning for now StC channel requested --- modules/servodyn/src/BladedInterface_EX.f90 | 6 +++--- modules/servodyn/src/StrucCtrl.f90 | 22 ++++++++------------- 2 files changed, 11 insertions(+), 17 deletions(-) diff --git a/modules/servodyn/src/BladedInterface_EX.f90 b/modules/servodyn/src/BladedInterface_EX.f90 index b2f08be893..0049dcced5 100644 --- a/modules/servodyn/src/BladedInterface_EX.f90 +++ b/modules/servodyn/src/BladedInterface_EX.f90 @@ -277,15 +277,15 @@ end subroutine InitCableCtrl subroutine InitStCCtrl() integer(IntKi) :: I,J ! Generic counters - ! Error check the Cable Ctrl + ! Error check the StC Ctrl if (.not. allocated(StC_CtrlChanInitInfo%Requestor)) then ErrStat2=ErrID_Fatal - ErrMsg2='StC control string array indicating which module requested cable controls is missing (StC_CtrlChanInitInfo%Requestor)' + ErrMsg2='StC control string array indicating which module requested StC controls is missing (StC_CtrlChanInitInfo%Requestor)' if (Failed()) return endif if (size(StC_CtrlChanInitInfo%Requestor) /= p%NumStC_Control) then ErrStat2=ErrID_Fatal - ErrMsg2='Size of StC control string array (StC_CtrlChanInitInfo%Requestor) does not match the number of requested cable control channels.' + ErrMsg2='Size of StC control string array (StC_CtrlChanInitInfo%Requestor) does not match the number of requested StC control channels.' if (Failed()) return endif if ( (size(StC_CtrlChanInitInfo%InitMeasDisp,2) /= p%NumStC_Control) .or. & diff --git a/modules/servodyn/src/StrucCtrl.f90 b/modules/servodyn/src/StrucCtrl.f90 index 0c0cea0da6..adf74e536f 100644 --- a/modules/servodyn/src/StrucCtrl.f90 +++ b/modules/servodyn/src/StrucCtrl.f90 @@ -975,20 +975,11 @@ SUBROUTINE StC_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ELSEIF ( p%StC_DOF_MODE == DOFMode_ForceDLL ) THEN ! Note that the prescribed force is applied the same to all Mesh pts ! that are passed into this instance of the StC - if (p%PrescribedForcesCoordSys == PRESCRIBED_FORCE_GLOBAL) then - ! Global coords - do i_pt=1,p%NumMeshPts - y%Mesh(i_pt)%Force(1:3,1) = m%F_ext(1:3,i_pt) - y%Mesh(i_pt)%Moment(1:3,1) = 0 - enddo - ! Leave in for now just in case we decide there is a use case for a follower force from the DLL - ! elseif (p%PrescribedForcesCoordSys == PRESCRIBED_FORCE_LOCAL) then - ! ! local coords - ! do i_pt=1,p%NumMeshPts - ! y%Mesh(i_pt)%Force(1:3,1) = matmul(transpose(u%Mesh(i_pt)%Orientation(:,:,1)), m%F_P(1:3,i_pt)) - ! y%Mesh(i_pt)%Moment(1:3,1) = matmul(transpose(u%Mesh(i_pt)%Orientation(:,:,1)), m%M_P(1:3,i_pt)) - ! enddo - endif + ! Global coords only + do i_pt=1,p%NumMeshPts + y%Mesh(i_pt)%Force(1:3,1) = m%F_ext(1:3,i_pt) + y%Mesh(i_pt)%Moment(1:3,1) = 0 + enddo END IF ! Set output values for the measured displacements for @@ -2192,6 +2183,9 @@ subroutine StC_ValidatePrimaryData( InputFileData, InitInp, ErrStat, ErrMsg ) if ( InputFileData%StC_CChan(i) < 0 .or. InputFileData%StC_CChan(i) > 10 ) then call SetErrStat( ErrID_Fatal, 'Control channel (StC_CChan) must be between 0 (off) and 10 when StC_CMode=5.', ErrStat, ErrMsg, RoutineName ) endif + if ( InputFileData%StC_CChan(i) == 0 ) then + call SetErrStat( ErrID_Warn, 'Control mode 5 (active with DLL control) requested, but no control channel specified. No external force will be applied.', ErrStat, ErrMsg, RoutineName ) + endif enddo endif From 63a91ef181b17d6dab84d24920d21f9f400d554f Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 20 Jan 2026 11:45:49 -0700 Subject: [PATCH 2/4] StC: add placeholders for moments applied by DLL NOTE: DLL interface does not support moments, but one user added a pipe in this location for applying forces/moments. The addition of this logic makes moments from a pipe possible --- modules/servodyn/src/BladedInterface_EX.f90 | 8 +++++++- modules/servodyn/src/ServoDyn_Registry.txt | 1 + modules/servodyn/src/ServoDyn_Types.f90 | 18 ++++++++++++++++++ modules/servodyn/src/StrucCtrl.f90 | 12 ++++++++---- modules/servodyn/src/StrucCtrl_Registry.txt | 1 + modules/servodyn/src/StrucCtrl_Types.f90 | 18 ++++++++++++++++++ 6 files changed, 53 insertions(+), 5 deletions(-) diff --git a/modules/servodyn/src/BladedInterface_EX.f90 b/modules/servodyn/src/BladedInterface_EX.f90 index 0049dcced5..b8e91cba4f 100644 --- a/modules/servodyn/src/BladedInterface_EX.f90 +++ b/modules/servodyn/src/BladedInterface_EX.f90 @@ -332,6 +332,8 @@ subroutine InitStCCtrl() if (Failed()) return call AllocAry( dll_data%StCCmdForce, 3, p%NumStC_Control, 'StCCmdForce', ErrStat2, ErrMsg2 ) if (Failed()) return + call AllocAry( dll_data%StCCmdMoment, 3, p%NumStC_Control, 'StCCmdMoment', ErrStat2, ErrMsg2 ) + if (Failed()) return ! Initialize to values passed in dll_data%StCMeasDisp = real(StC_CtrlChanInitInfo%InitMeasDisp,SiKi) dll_data%StCMeasVel = real(StC_CtrlChanInitInfo%InitMeasVel ,SiKi) @@ -343,6 +345,7 @@ subroutine InitStCCtrl() dll_data%StCCmdDamp = real(StC_CtrlChanInitInfo%InitDamp ,SiKi) dll_data%StCCmdBrake = real(StC_CtrlChanInitInfo%InitBrake ,SiKi) dll_data%StCCmdForce = real(StC_CtrlChanInitInfo%InitForce ,SiKi) + dll_data%StCCmdMoment = 0.0_SiKi ! not supported at present ! Create info for summary file about channels if (UnSum > 0) then @@ -368,6 +371,7 @@ subroutine InitStCCtrl() call WrSumInfoRcvd( J+18,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- StC_Force_Z (additional force)') call WrSumInfoRcvd( J+19,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- Reserved for future') call WrSumInfoRcvd( J+20,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- Reserved for future') + ! NOTE: Moments are not passed through this interface. Channel allocations will need revision for this to happen (change to 21 or more channels per group) enddo endif end subroutine InitStCCtrl @@ -570,6 +574,7 @@ subroutine SetEXavrStC_Sensors() dll_data%avrswap(J+10:J+12) = dll_data%PrevStCCmdDamp( 1:3,I) ! StC initial damping -- StC_Damp_X, StC_Damp_Y, StC_Damp_Z (N/(m/s)) dll_data%avrswap(J+13:J+15) = dll_data%PrevStCCmdBrake(1:3,I) ! StC initial brake -- StC_Brake_X, StC_Brake_Y, StC_Brake_Z (N) dll_data%avrswap(J+16:J+18) = dll_data%PrevStCCmdForce(1:3,I) ! StC initial brake -- StC_Force_X, StC_Force_Y, StC_Force_Z (N) + ! NOTE: Moments not included in this interface enddo endif end subroutine SetEXavrStC_Sensors @@ -645,7 +650,8 @@ subroutine Retrieve_EXavrSWAP_StControls () dll_data%StCCmdStiff(1:3,I) = dll_data%avrswap(J+ 7:J+ 9) ! StC commanded stiffness -- StC_Stiff_X, StC_Stiff_Y, StC_Stiff_Z (N/m) dll_data%StCCmdDamp( 1:3,I) = dll_data%avrswap(J+10:J+12) ! StC commanded damping -- StC_Damp_X, StC_Damp_Y, StC_Damp_Z (N/(m/s)) dll_data%StCCmdBrake(1:3,I) = dll_data%avrswap(J+13:J+15) ! StC commanded brake -- StC_Brake_X, StC_Brake_Y, StC_Brake_Z (N) - dll_data%StCCmdForce(1:3,I) = dll_data%avrswap(J+16:J+18) ! StC commanded brake -- StC_Force_X, StC_Force_Y, StC_Force_Z (N) + dll_data%StCCmdForce(1:3,I) = dll_data%avrswap(J+16:J+18) ! StC commanded force -- StC_Force_X, StC_Force_Y, StC_Force_Z (N) + dll_data%StCCmdMoment(1:3,I) = 0.0_ReKi ! StC does not allow moments, but placing this here in case a user adds this later enddo end subroutine Retrieve_EXavrSWAP_StControls diff --git a/modules/servodyn/src/ServoDyn_Registry.txt b/modules/servodyn/src/ServoDyn_Registry.txt index 8160192355..cef6387a8c 100644 --- a/modules/servodyn/src/ServoDyn_Registry.txt +++ b/modules/servodyn/src/ServoDyn_Registry.txt @@ -263,6 +263,7 @@ typedef ^ BladedDLLType SiKi StCCmdStiff {:}{:} - - "StC stiffness from contro typedef ^ BladedDLLType SiKi StCCmdDamp {:}{:} - - "StC damping from controller (3,NumStC_Control)" "N/(m/s)" typedef ^ BladedDLLType SiKi StCCmdBrake {:}{:} - - "StC braking signal (3,NumStC_Control)" "N" typedef ^ BladedDLLType SiKi StCCmdForce {:}{:} - - "StC commanded force signal (3,NumStC_Control)" "N" +typedef ^ BladedDLLType SiKi StCCmdMoment {:}{:} - - "StC commanded moment signal (3,NumStC_Control) [NOTE: this is not currently used. Placeholder for later]" "N" typedef ^ BladedDLLType SiKi StCMeasDisp {:}{:} - - "StC measured local displacement signal from StC (3,NumStC_Control)" "m" typedef ^ BladedDLLType SiKi StCMeasVel {:}{:} - - "StC measured local velocity signal from StC (3,NumStC_Control)" "m/s" diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index da5d45358c..d99c1bc925 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -274,6 +274,7 @@ MODULE ServoDyn_Types REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdDamp !< StC damping from controller (3,NumStC_Control) [N/(m/s)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdBrake !< StC braking signal (3,NumStC_Control) [N] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdForce !< StC commanded force signal (3,NumStC_Control) [N] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdMoment !< StC commanded moment signal (3,NumStC_Control) [NOTE: this is not currently used. Placeholder for later] [N] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCMeasDisp !< StC measured local displacement signal from StC (3,NumStC_Control) [m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCMeasVel !< StC measured local velocity signal from StC (3,NumStC_Control) [m/s] END TYPE BladedDLLType @@ -1772,6 +1773,18 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if DstBladedDLLTypeData%StCCmdForce = SrcBladedDLLTypeData%StCCmdForce end if + if (allocated(SrcBladedDLLTypeData%StCCmdMoment)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdMoment) + UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdMoment) + if (.not. allocated(DstBladedDLLTypeData%StCCmdMoment)) then + allocate(DstBladedDLLTypeData%StCCmdMoment(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%StCCmdMoment.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%StCCmdMoment = SrcBladedDLLTypeData%StCCmdMoment + end if if (allocated(SrcBladedDLLTypeData%StCMeasDisp)) then LB(1:2) = lbound(SrcBladedDLLTypeData%StCMeasDisp) UB(1:2) = ubound(SrcBladedDLLTypeData%StCMeasDisp) @@ -1881,6 +1894,9 @@ subroutine SrvD_DestroyBladedDLLType(BladedDLLTypeData, ErrStat, ErrMsg) if (allocated(BladedDLLTypeData%StCCmdForce)) then deallocate(BladedDLLTypeData%StCCmdForce) end if + if (allocated(BladedDLLTypeData%StCCmdMoment)) then + deallocate(BladedDLLTypeData%StCCmdMoment) + end if if (allocated(BladedDLLTypeData%StCMeasDisp)) then deallocate(BladedDLLTypeData%StCMeasDisp) end if @@ -1994,6 +2010,7 @@ subroutine SrvD_PackBladedDLLType(RF, Indata) call RegPackAlloc(RF, InData%StCCmdDamp) call RegPackAlloc(RF, InData%StCCmdBrake) call RegPackAlloc(RF, InData%StCCmdForce) + call RegPackAlloc(RF, InData%StCCmdMoment) call RegPackAlloc(RF, InData%StCMeasDisp) call RegPackAlloc(RF, InData%StCMeasVel) if (RegCheckErr(RF, RoutineName)) return @@ -2110,6 +2127,7 @@ subroutine SrvD_UnPackBladedDLLType(RF, OutData) call RegUnpackAlloc(RF, OutData%StCCmdDamp); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%StCCmdBrake); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%StCCmdForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%StCCmdMoment); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%StCMeasDisp); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%StCMeasVel); if (RegCheckErr(RF, RoutineName)) return end subroutine diff --git a/modules/servodyn/src/StrucCtrl.f90 b/modules/servodyn/src/StrucCtrl.f90 index adf74e536f..8043ac16f9 100644 --- a/modules/servodyn/src/StrucCtrl.f90 +++ b/modules/servodyn/src/StrucCtrl.f90 @@ -388,6 +388,7 @@ subroutine Init_Misc( p, m, ErrStat, ErrMsg ) ! they have been moved into MiscVars so that we don so we don't reallocate all the time. call AllocAry(m%F_stop , 3, p%NumMeshPts, 'F_stop' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; m%F_stop = 0.0_ReKi call AllocAry(m%F_ext , 3, p%NumMeshPts, 'F_ext' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; m%F_ext = 0.0_ReKi + call AllocAry(m%M_ext , 3, p%NumMeshPts, 'M_ext' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; m%M_ext = 0.0_ReKi call AllocAry(m%F_fr , 3, p%NumMeshPts, 'F_fr' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; m%F_fr = 0.0_ReKi call AllocAry(m%C_ctrl , 3, p%NumMeshPts, 'C_ctrl' , ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; m%C_ctrl = 0.0_ReKi call AllocAry(m%C_Brake, 3, p%NumMeshPts, 'C_Brake', ErrStat, ErrMsg); if (ErrStat >= AbortErrLev) return; m%C_Brake = 0.0_ReKi @@ -978,7 +979,7 @@ SUBROUTINE StC_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! Global coords only do i_pt=1,p%NumMeshPts y%Mesh(i_pt)%Force(1:3,1) = m%F_ext(1:3,i_pt) - y%Mesh(i_pt)%Moment(1:3,1) = 0 + y%Mesh(i_pt)%Moment(1:3,1) = m%M_ext(1:3,i_pt) enddo END IF @@ -1165,7 +1166,7 @@ SUBROUTINE StC_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, Er ELSE IF (p%StC_CMODE == CMODE_Semi) THEN ! ground hook control CALL StC_GroundHookDamp(dxdt,x,u,p,m%rdisp_P,m%rdot_P,m%C_ctrl,m%C_Brake,m%F_fr) ELSE IF (p%StC_CMODE == CMODE_ActiveDLL) THEN ! Active control from DLL - call StC_ActiveCtrl_StiffDamp(u,p,m%K,m%C_ctrl,m%C_Brake,m%F_ext) + call StC_ActiveCtrl_StiffDamp(u,p,m%K,m%C_ctrl,m%C_Brake,m%F_ext,m%M_ext) m%F_fr = 0.0_ReKi if (.not. p%Use_F_TBL) then K(1:3,:) = m%K(1:3,:) @@ -1645,13 +1646,14 @@ SUBROUTINE StC_GroundHookDamp(dxdt,x,u,p,rdisp_P,rdot_P,C_ctrl,C_Brake,F_fr) enddo END SUBROUTINE StC_GroundHookDamp !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE StC_ActiveCtrl_StiffDamp(u,p,K_ctrl,C_ctrl,C_Brake,F_ctrl) +SUBROUTINE StC_ActiveCtrl_StiffDamp(u,p,K_ctrl,C_ctrl,C_Brake,F_ctrl,M_ctrl) TYPE(StC_InputType), INTENT(IN ) :: u !< Inputs at Time TYPE(StC_ParameterType), INTENT(IN ) :: p !< The module's parameter data real(ReKi), intent(inout) :: K_ctrl(:,:) !< stiffness commanded by dll -- leave alone if no ctrl real(ReKi), intent(inout) :: C_ctrl(:,:) !< damping commanded by dll real(ReKi), intent(inout) :: C_Brake(:,:) !< brake commanded by dll - real(ReKi), intent(inout) :: F_ctrl(:,:) !< brake commanded by dll + real(ReKi), intent(inout) :: F_ctrl(:,:) !< force commanded by dll + real(ReKi), intent(inout) :: M_ctrl(:,:) !< moment commanded by dll (not supported by DLL interface) integer(IntKi) :: i_pt ! counter for mesh points do i_pt=1,p%NumMeshPts if (p%StC_CChan(i_pt) > 0) then ! This index should have been checked at init, so won't check bounds here @@ -1659,12 +1661,14 @@ SUBROUTINE StC_ActiveCtrl_StiffDamp(u,p,K_ctrl,C_ctrl,C_Brake,F_ctrl) C_ctrl( 1:3,i_pt) = u%CmdDamp( 1:3,p%StC_CChan(i_pt)) C_Brake(1:3,i_pt) = u%CmdBrake(1:3,p%StC_CChan(i_pt)) F_ctrl(1:3,i_pt) = u%CmdForce(1:3,p%StC_CChan(i_pt)) + M_ctrl(1:3,i_pt) = 0.0_ReKi ! not supported. Included for completeness in case someone hooks into the code here later else ! Use parameters from file (as if no control) -- leave K value as that may be set by table prior C_ctrl(1,:) = p%C_X C_ctrl(2,:) = p%C_Y C_ctrl(3,:) = p%C_Z C_Brake = 0.0_ReKi F_ctrl = 0.0_ReKi + M_ctrl = 0.0_ReKi endif enddo END SUBROUTINE StC_ActiveCtrl_StiffDamp diff --git a/modules/servodyn/src/StrucCtrl_Registry.txt b/modules/servodyn/src/StrucCtrl_Registry.txt index 9a791558b3..aad5b2d60d 100644 --- a/modules/servodyn/src/StrucCtrl_Registry.txt +++ b/modules/servodyn/src/StrucCtrl_Registry.txt @@ -124,6 +124,7 @@ typedef ^ OtherStateType Reki DummyOtherState - - - "Remove this variable if # at a given time, etc.) or other data that do not depend on time typedef ^ MiscVarType Reki F_stop {:}{:} - - "Stop forces" - typedef ^ MiscVarType ReKi F_ext {:}{:} - - "External forces (user defined or from controller)" - +typedef ^ MiscVarType ReKi M_ext {:}{:} - - "External moments (user defined; no controller support yet)" - typedef ^ MiscVarType ReKi F_fr {:}{:} - - "Friction forces" - typedef ^ MiscVarType ReKi K {:}{:} - - "Stiffness -- might be changed if controller controls this" N/m typedef ^ MiscVarType ReKi C_ctrl {:}{:} - - "Controlled Damping (On/Off)" - diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index 105e73d1ac..c2087bccc7 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -159,6 +159,7 @@ MODULE StrucCtrl_Types TYPE, PUBLIC :: StC_MiscVarType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_stop !< Stop forces [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_ext !< External forces (user defined or from controller) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: M_ext !< External moments (user defined; no controller support yet) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_fr !< Friction forces [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: K !< Stiffness -- might be changed if controller controls this [N/m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C_ctrl !< Controlled Damping (On/Off) [-] @@ -1095,6 +1096,18 @@ subroutine StC_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%F_ext = SrcMiscData%F_ext end if + if (allocated(SrcMiscData%M_ext)) then + LB(1:2) = lbound(SrcMiscData%M_ext) + UB(1:2) = ubound(SrcMiscData%M_ext) + if (.not. allocated(DstMiscData%M_ext)) then + allocate(DstMiscData%M_ext(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%M_ext.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstMiscData%M_ext = SrcMiscData%M_ext + end if if (allocated(SrcMiscData%F_fr)) then LB(1:2) = lbound(SrcMiscData%F_fr) UB(1:2) = ubound(SrcMiscData%F_fr) @@ -1291,6 +1304,9 @@ subroutine StC_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%F_ext)) then deallocate(MiscData%F_ext) end if + if (allocated(MiscData%M_ext)) then + deallocate(MiscData%M_ext) + end if if (allocated(MiscData%F_fr)) then deallocate(MiscData%F_fr) end if @@ -1345,6 +1361,7 @@ subroutine StC_PackMisc(RF, Indata) if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%F_stop) call RegPackAlloc(RF, InData%F_ext) + call RegPackAlloc(RF, InData%M_ext) call RegPackAlloc(RF, InData%F_fr) call RegPackAlloc(RF, InData%K) call RegPackAlloc(RF, InData%C_ctrl) @@ -1374,6 +1391,7 @@ subroutine StC_UnPackMisc(RF, OutData) if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%F_stop); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%F_ext); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%M_ext); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%F_fr); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%K); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%C_ctrl); if (RegCheckErr(RF, RoutineName)) return From 88fce610b48d2706859e39bf37c977c667acafad Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 20 Jan 2026 12:08:26 -0700 Subject: [PATCH 3/4] StC: add moments for DLL prescribed forces/moments --- modules/servodyn/src/BladedInterface_EX.f90 | 26 ++++++--- modules/servodyn/src/ServoDyn.f90 | 63 +++++++++++++++------ modules/servodyn/src/ServoDyn_Registry.txt | 7 ++- modules/servodyn/src/ServoDyn_Types.f90 | 24 +++++++- modules/servodyn/src/StrucCtrl.f90 | 7 ++- modules/servodyn/src/StrucCtrl_Registry.txt | 4 +- modules/servodyn/src/StrucCtrl_Types.f90 | 44 +++++++++++++- 7 files changed, 140 insertions(+), 35 deletions(-) diff --git a/modules/servodyn/src/BladedInterface_EX.f90 b/modules/servodyn/src/BladedInterface_EX.f90 index b8e91cba4f..13b175651b 100644 --- a/modules/servodyn/src/BladedInterface_EX.f90 +++ b/modules/servodyn/src/BladedInterface_EX.f90 @@ -64,7 +64,7 @@ MODULE BladedInterface_EX integer(IntKi), parameter :: CableCtrl_MaxChan = 200 !< Maximum channels in cable control group integer(IntKi), parameter :: StCCtrl_StartIdx = 2801 !< Starting index for the StC control integer(IntKi), parameter :: StCCtrl_MaxChan = 200 !< Maximum channels in StC control group - integer(IntKi), parameter :: StCCtrl_ChanPerSet = 20 !< Channels needed per set (10 sets for total channels) + integer(IntKi), parameter :: StCCtrl_ChanPerSet = 25 !< Channels needed per set (8 sets for total channels) CONTAINS @@ -293,7 +293,8 @@ subroutine InitStCCtrl() (size(StC_CtrlChanInitInfo%InitStiff ,2) /= p%NumStC_Control) .or. & (size(StC_CtrlChanInitInfo%InitDamp ,2) /= p%NumStC_Control) .or. & (size(StC_CtrlChanInitInfo%InitBrake ,2) /= p%NumStC_Control) .or. & - (size(StC_CtrlChanInitInfo%InitForce ,2) /= p%NumStC_Control) ) then + (size(StC_CtrlChanInitInfo%InitForce ,2) /= p%NumStC_Control) .or. & + (size(StC_CtrlChanInitInfo%InitMoment ,2) /= p%NumStC_Control) ) then ErrStat2=ErrID_Fatal ErrMsg2='Size of StC control initialization arrays (StC_CtrlChanInitInfo%Init*) do not match the number of requested cable control channels. Programming error somewhere.' if (Failed()) return @@ -324,6 +325,8 @@ subroutine InitStCCtrl() if (Failed()) return call AllocAry( dll_data%PrevStCCmdForce, 3, p%NumStC_Control, 'PrevStCCmdForce', ErrStat2, ErrMsg2 ) if (Failed()) return + call AllocAry( dll_data%PrevStCCmdMoment,3, p%NumStC_Control, 'PrevStCCmdMoment', ErrStat2, ErrMsg2 ) + if (Failed()) return call AllocAry( dll_data%StCCmdStiff, 3, p%NumStC_Control, 'StCCmdStiff', ErrStat2, ErrMsg2 ) if (Failed()) return call AllocAry( dll_data%StCCmdDamp, 3, p%NumStC_Control, 'StCCmdDamp', ErrStat2, ErrMsg2 ) @@ -341,11 +344,12 @@ subroutine InitStCCtrl() dll_data%PrevStCCmdDamp = real(StC_CtrlChanInitInfo%InitDamp ,SiKi) dll_data%PrevStCCmdBrake = real(StC_CtrlChanInitInfo%InitBrake ,SiKi) dll_data%PrevStCCmdForce = real(StC_CtrlChanInitInfo%InitForce ,SiKi) + dll_data%PrevStCCmdMoment = real(StC_CtrlChanInitInfo%InitMoment ,SiKi) dll_data%StCCmdStiff = real(StC_CtrlChanInitInfo%InitStiff ,SiKi) dll_data%StCCmdDamp = real(StC_CtrlChanInitInfo%InitDamp ,SiKi) dll_data%StCCmdBrake = real(StC_CtrlChanInitInfo%InitBrake ,SiKi) dll_data%StCCmdForce = real(StC_CtrlChanInitInfo%InitForce ,SiKi) - dll_data%StCCmdMoment = 0.0_SiKi ! not supported at present + dll_data%StCCmdMoment = real(StC_CtrlChanInitInfo%InitMoment ,SiKi) ! Create info for summary file about channels if (UnSum > 0) then @@ -369,9 +373,13 @@ subroutine InitStCCtrl() call WrSumInfoRcvd( J+16,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- StC_Force_X (additional force)') call WrSumInfoRcvd( J+17,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- StC_Force_Y (additional force)') call WrSumInfoRcvd( J+18,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- StC_Force_Z (additional force)') - call WrSumInfoRcvd( J+19,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- Reserved for future') - call WrSumInfoRcvd( J+20,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- Reserved for future') - ! NOTE: Moments are not passed through this interface. Channel allocations will need revision for this to happen (change to 21 or more channels per group) + call WrSumInfoRcvd( J+19,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- StC_Moment_X (additional moment)') + call WrSumInfoRcvd( J+20,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- StC_Moment_Y (additional moment)') + call WrSumInfoRcvd( J+21,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- StC_Moment_Z (additional moment)') + call WrSumInfoRcvd( J+22,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- Reserved for future') + call WrSumInfoRcvd( J+23,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- Reserved for future') + call WrSumInfoRcvd( J+24,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- Reserved for future') + call WrSumInfoRcvd( J+25,StC_CtrlChanInitInfo%Requestor(I),'StC control channel group '//trim(Num2LStr(I))//' -- Reserved for future') enddo endif end subroutine InitStCCtrl @@ -573,8 +581,8 @@ subroutine SetEXavrStC_Sensors() dll_data%avrswap(J+ 7:J+ 9) = dll_data%PrevStCCmdStiff(1:3,I) ! StC initial stiffness -- StC_Stiff_X, StC_Stiff_Y, StC_Stiff_Z (N/m) dll_data%avrswap(J+10:J+12) = dll_data%PrevStCCmdDamp( 1:3,I) ! StC initial damping -- StC_Damp_X, StC_Damp_Y, StC_Damp_Z (N/(m/s)) dll_data%avrswap(J+13:J+15) = dll_data%PrevStCCmdBrake(1:3,I) ! StC initial brake -- StC_Brake_X, StC_Brake_Y, StC_Brake_Z (N) - dll_data%avrswap(J+16:J+18) = dll_data%PrevStCCmdForce(1:3,I) ! StC initial brake -- StC_Force_X, StC_Force_Y, StC_Force_Z (N) - ! NOTE: Moments not included in this interface + dll_data%avrswap(J+16:J+18) = dll_data%PrevStCCmdForce(1:3,I) ! StC initial force -- StC_Force_X, StC_Force_Y, StC_Force_Z (N) + dll_data%avrswap(J+19:J+21) = dll_data%PrevStCCmdMoment(1:3,I) ! StC initial moment -- StC_Moment_X, StC_Moment_Y, StC_Moment_Z (N) enddo endif end subroutine SetEXavrStC_Sensors @@ -651,7 +659,7 @@ subroutine Retrieve_EXavrSWAP_StControls () dll_data%StCCmdDamp( 1:3,I) = dll_data%avrswap(J+10:J+12) ! StC commanded damping -- StC_Damp_X, StC_Damp_Y, StC_Damp_Z (N/(m/s)) dll_data%StCCmdBrake(1:3,I) = dll_data%avrswap(J+13:J+15) ! StC commanded brake -- StC_Brake_X, StC_Brake_Y, StC_Brake_Z (N) dll_data%StCCmdForce(1:3,I) = dll_data%avrswap(J+16:J+18) ! StC commanded force -- StC_Force_X, StC_Force_Y, StC_Force_Z (N) - dll_data%StCCmdMoment(1:3,I) = 0.0_ReKi ! StC does not allow moments, but placing this here in case a user adds this later + dll_data%StCCmdMoment(1:3,I)= dll_data%avrswap(J+19:J+21) ! StC commanded moment -- StC_Moment_X, StC_Moment_Y, StC_Moment_Z (N) enddo end subroutine Retrieve_EXavrSWAP_StControls diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index f8a5a0a0df..5623bcbfcd 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -1668,6 +1668,7 @@ subroutine StC_CtrlChan_Setup(m,p,CtrlChanInitInfo,UnSum,ErrStat,ErrMsg) allocate(CtrlChanInitInfo%InitDamp( 3,p%NumStC_Control), STAT=ErrStat2); if ( AllErr('Could not allocate InitDamp array') ) return; allocate(CtrlChanInitInfo%InitBrake( 3,p%NumStC_Control), STAT=ErrStat2); if ( AllErr('Could not allocate InitBrake array') ) return; allocate(CtrlChanInitInfo%InitForce( 3,p%NumStC_Control), STAT=ErrStat2); if ( AllErr('Could not allocate InitForce array') ) return; + allocate(CtrlChanInitInfo%InitMoment( 3,p%NumStC_Control), STAT=ErrStat2); if ( AllErr('Could not allocate InitMoment array') ) return; allocate(CtrlChanInitInfo%InitMeasDisp(3,p%NumStC_Control), STAT=ErrStat2); if ( AllErr('Could not allocate InitMeasDisp array') ) return; allocate(CtrlChanInitInfo%InitMeasVel( 3,p%NumStC_Control), STAT=ErrStat2); if ( AllErr('Could not allocate InitMeasVel array') ) return; CtrlChanInitInfo%Requestor = "" @@ -1675,6 +1676,7 @@ subroutine StC_CtrlChan_Setup(m,p,CtrlChanInitInfo,UnSum,ErrStat,ErrMsg) CtrlChanInitInfo%InitDamp = 0.0_SiKi CtrlChanInitInfo%InitBrake = 0.0_SiKi CtrlChanInitInfo%InitForce = 0.0_SiKi + CtrlChanInitInfo%InitMoment = 0.0_SiKi CtrlChanInitInfo%InitMeasDisp = 0.0_SiKi CtrlChanInitInfo%InitMeasVel = 0.0_SiKi @@ -1723,7 +1725,7 @@ subroutine StC_CtrlChan_Setup(m,p,CtrlChanInitInfo,UnSum,ErrStat,ErrMsg) ! Set all the initial values to pass to the controller for first call and ensure all inputs/outputs for control are sized same call StC_SetDLLinputs(p,m,CtrlChanInitInfo%InitMeasDisp,CtrlChanInitInfo%InitMeasVel,ErrStat2,ErrMsg2,.TRUE.) ! Do resizing if needed if (Failed()) return; - call StC_SetInitDLLinputs(p,m,CtrlChanInitInfo%InitStiff,CtrlChanInitInfo%InitDamp,CtrlChanInitInfo%InitBrake,CtrlChanInitInfo%InitForce,ErrStat2,ErrMsg2) + call StC_SetInitDLLinputs(p,m,CtrlChanInitInfo%InitStiff,CtrlChanInitInfo%InitDamp,CtrlChanInitInfo%InitBrake,CtrlChanInitInfo%InitForce,CtrlChanInitInfo%InitMoment,ErrStat2,ErrMsg2) if (Failed()) return; ! Duplicates the Cmd channel data (so that they are allocated for first UpdateStates routine) call StC_InitExtrapInputs(p,m,ErrStat2,ErrMsg2) @@ -1861,10 +1863,11 @@ SUBROUTINE SrvD_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, INTEGER(IntKi) :: k ! loop counter for blade in BStC INTEGER(IntKi) :: order TYPE(SrvD_InputType) :: u_interp ! interpolated input - REAL(ReKi), ALLOCATABLE :: StC_CmdStiff(:,:) !< StC_CmdStiff command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 - REAL(ReKi), ALLOCATABLE :: StC_CmdDamp(:,:) !< StC_CmdDamp command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 - REAL(ReKi), ALLOCATABLE :: StC_CmdBrake(:,:) !< StC_CmdBrake command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 - REAL(ReKi), ALLOCATABLE :: StC_CmdForce(:,:) !< StC_CmdForce command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 + REAL(ReKi), ALLOCATABLE :: StC_CmdStiff(:,:) !< StC_CmdStiff command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 + REAL(ReKi), ALLOCATABLE :: StC_CmdDamp(:,:) !< StC_CmdDamp command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 + REAL(ReKi), ALLOCATABLE :: StC_CmdBrake(:,:) !< StC_CmdBrake command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 + REAL(ReKi), ALLOCATABLE :: StC_CmdForce(:,:) !< StC_CmdForce command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 + REAL(ReKi), ALLOCATABLE :: StC_CmdMoment(:,:) !< StC_CmdMoment command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (occurs after initial error) CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None @@ -1936,7 +1939,8 @@ SUBROUTINE SrvD_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, call AllocAry(StC_CmdDamp, 3, p%NumStC_Control, 'StC_CmdDamp' , ErrStat2, ErrMsg2 ); if (Failed()) return; call AllocAry(StC_CmdBrake, 3, p%NumStC_Control, 'StC_CmdBrake', ErrStat2, ErrMsg2 ); if (Failed()) return; call AllocAry(StC_CmdForce, 3, p%NumStC_Control, 'StC_CmdForce', ErrStat2, ErrMsg2 ); if (Failed()) return; - call StCControl_CalcOutput( t_next, p, StC_CmdStiff, StC_CmdDamp, StC_CmdBrake, StC_CmdForce, m, ErrStat2, ErrMsg2 ) + call AllocAry(StC_CmdMoment,3, p%NumStC_Control, 'StC_CmdMoment', ErrStat2, ErrMsg2 ); if (Failed()) return; + call StCControl_CalcOutput( t_next, p, StC_CmdStiff, StC_CmdDamp, StC_CmdBrake, StC_CmdForce, StC_CmdMoment, m, ErrStat2, ErrMsg2 ) if (Failed()) return; endif @@ -2030,11 +2034,12 @@ SUBROUTINE Cleanup() if (allocated(StC_CmdDamp)) deallocate(StC_CmdDamp) if (allocated(StC_CmdBrake)) deallocate(StC_CmdBrake) if (allocated(StC_CmdForce)) deallocate(StC_CmdForce) + if (allocated(StC_CmdMoment)) deallocate(StC_CmdMoment) END SUBROUTINE Cleanup subroutine SetStCInput_CtrlChans(u_StC) type(StC_InputType), intent(inout) :: u_StC(:) !< Inputs at InputTimes ! -- not all StC instances will necessarily be looking for this, so these inputs might not be allocated) - if (allocated(u_StC(1)%CmdStiff) .and. allocated(u_StC(1)%CmdDamp) .and. allocated(u_StC(1)%CmdBrake) .and. allocated(u_StC(1)%CmdForce)) then + if (allocated(u_StC(1)%CmdStiff) .and. allocated(u_StC(1)%CmdDamp) .and. allocated(u_StC(1)%CmdBrake) .and. allocated(u_StC(1)%CmdForce) .and. allocated(u_StC(1)%CmdMoment)) then if ( n > m%PrevTstepNcall ) then ! Cycle u%CmdStiff and others -- we are at a new timestep. do i=p%InterpOrder,1,-1 ! shift back in time in reverse order -- oldest (InterpOrder+1) to newest (1) @@ -2042,6 +2047,7 @@ subroutine SetStCInput_CtrlChans(u_StC) u_StC(i+1)%CmdDamp = u_StC(i)%CmdDamp u_StC(i+1)%CmdBrake = u_StC(i)%CmdBrake u_StC(i+1)%CmdForce = u_StC(i)%CmdForce + u_StC(i+1)%CmdMoment= u_StC(i)%CmdMoment enddo endif ! Now set the current commanded values @@ -2049,6 +2055,7 @@ subroutine SetStCInput_CtrlChans(u_StC) u_StC(1)%CmdDamp( 1:3,1:p%NumStC_Control) = StC_CmdDamp( 1:3,1:p%NumStC_Control) u_StC(1)%CmdBrake(1:3,1:p%NumStC_Control) = StC_CmdBrake(1:3,1:p%NumStC_Control) u_StC(1)%CmdForce(1:3,1:p%NumStC_Control) = StC_CmdForce(1:3,1:p%NumStC_Control) + u_StC(1)%CmdMoment(1:3,1:p%NumStC_Control)= StC_CmdMoment(1:3,1:p%NumStC_Control) endif end subroutine SetStCInput_CtrlChans @@ -2156,6 +2163,7 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg REAL(ReKi), ALLOCATABLE :: StC_CmdDamp(:,:) !< StC_CmdDamp command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 REAL(ReKi), ALLOCATABLE :: StC_CmdBrake(:,:) !< StC_CmdBrake command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 REAL(ReKi), ALLOCATABLE :: StC_CmdForce(:,:) !< StC_CmdForce command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 + REAL(ReKi), ALLOCATABLE :: StC_CmdMoment(:,:) !< StC_CmdMoment command signals (3,p%NumStC_Control) -- used only if p%NumStC_Ctrl > 0 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_CalcOutput' @@ -2223,7 +2231,8 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg call AllocAry(StC_CmdDamp, 3, p%NumStC_Control, 'StC_CmdDamp' , ErrStat2, ErrMsg2 ); if (Failed()) return; call AllocAry(StC_CmdBrake, 3, p%NumStC_Control, 'StC_CmdBrake', ErrStat2, ErrMsg2 ); if (Failed()) return; call AllocAry(StC_CmdForce, 3, p%NumStC_Control, 'StC_CmdForce', ErrStat2, ErrMsg2 ); if (Failed()) return; - call StCControl_CalcOutput( t, p, StC_CmdStiff, StC_CmdDamp, StC_CmdBrake, StC_CmdForce, m, ErrStat2, ErrMsg2 ) + call AllocAry(StC_CmdMoment,3, p%NumStC_Control, 'StC_CmdMoment', ErrStat2, ErrMsg2 ); if (Failed()) return; + call StCControl_CalcOutput( t, p, StC_CmdStiff, StC_CmdDamp, StC_CmdBrake, StC_CmdForce, StC_CmdMoment, m, ErrStat2, ErrMsg2 ) if (Failed()) return; endif do j=1,p%NumBStC ! Blades @@ -2324,15 +2333,17 @@ SUBROUTINE Cleanup() if (allocated(StC_CmdDamp)) deallocate(StC_CmdDamp) if (allocated(StC_CmdBrake)) deallocate(StC_CmdBrake) if (allocated(StC_CmdForce)) deallocate(StC_CmdForce) + if (allocated(StC_CmdMoment)) deallocate(StC_CmdMoment) END SUBROUTINE Cleanup subroutine SetStCInput_CtrlChans(u_StC) type(StC_InputType), intent(inout) :: u_StC !< Inputs at InputTimes ! -- not all StC instances will necessarily be looking for this, so these inputs might not be allocated) - if (allocated(u_StC%CmdStiff) .and. allocated(u_StC%CmdDamp) .and. allocated(u_StC%CmdBrake) .and. allocated(u_StC%CmdForce)) then + if (allocated(u_StC%CmdStiff) .and. allocated(u_StC%CmdDamp) .and. allocated(u_StC%CmdBrake) .and. allocated(u_StC%CmdForce) .and. allocated(u_StC%CmdMoment)) then u_StC%CmdStiff(1:3,1:p%NumStC_Control) = StC_CmdStiff(1:3,1:p%NumStC_Control) u_StC%CmdDamp( 1:3,1:p%NumStC_Control) = StC_CmdDamp( 1:3,1:p%NumStC_Control) u_StC%CmdBrake(1:3,1:p%NumStC_Control) = StC_CmdBrake(1:3,1:p%NumStC_Control) u_StC%CmdForce(1:3,1:p%NumStC_Control) = StC_CmdForce(1:3,1:p%NumStC_Control) + u_StC%CmdMoment(1:3,1:p%NumStC_Control)= StC_CmdMoment(1:3,1:p%NumStC_Control) endif end subroutine SetStCInput_CtrlChans @@ -6346,13 +6357,14 @@ END SUBROUTINE CableControl_CalcOutput ! Commanded Airfoil UserProp for blade (must be same units as given in AD15 airfoil tables) ! This is passed to AD15 to be interpolated with the airfoil table userprop column ! (might be used for airfoil flap angles for example) -SUBROUTINE StCControl_CalcOutput( t, p, StC_CmdStiff, StC_CmdDamp, StC_CmdBrake, StC_CmdForce, m, ErrStat, ErrMsg ) +SUBROUTINE StCControl_CalcOutput( t, p, StC_CmdStiff, StC_CmdDamp, StC_CmdBrake, StC_CmdForce, StC_CmdMoment, m, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters REAL(ReKi), ALLOCATABLE, INTENT(INOUT) :: StC_CmdStiff(:,:) !< StC_CmdStiff command signals (3,p%NumStC_Control) REAL(ReKi), ALLOCATABLE, INTENT(INOUT) :: StC_CmdDamp(:,:) !< StC_CmdDamp command signals (3,p%NumStC_Control) REAL(ReKi), ALLOCATABLE, INTENT(INOUT) :: StC_CmdBrake(:,:) !< StC_CmdBrake command signals (3,p%NumStC_Control) REAL(ReKi), ALLOCATABLE, INTENT(INOUT) :: StC_CmdForce(:,:) !< StC_CmdForce command signals (3,p%NumStC_Control) + REAL(ReKi), ALLOCATABLE, INTENT(INOUT) :: StC_CmdMoment(:,:) !< StC_CmdMoment command signals (3,p%NumStC_Control) TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -6364,7 +6376,7 @@ SUBROUTINE StCControl_CalcOutput( t, p, StC_CmdStiff, StC_CmdDamp, StC_CmdBrake, ! Only proceed if we have have StC controls with the extended swap and legacy interface if ((p%NumStC_Control <= 0) .or. (.not. p%EXavrSWAP)) return - if (.not. allocated(StC_CmdStiff) .or. .not. allocated(StC_CmdDamp) .or. .not. allocated(StC_CmdBrake) .or. .not. allocated(StC_CmdForce)) then + if (.not. allocated(StC_CmdStiff) .or. .not. allocated(StC_CmdDamp) .or. .not. allocated(StC_CmdBrake) .or. .not. allocated(StC_CmdForce) .or. .not. allocated(StC_CmdMoment)) then ErrStat = ErrID_Fatal ErrMsg = "StC control signal matrices not allocated. Programming error somewhere." return @@ -6392,11 +6404,16 @@ SUBROUTINE StCControl_CalcOutput( t, p, StC_CmdStiff, StC_CmdDamp, StC_CmdBrake, StC_CmdForce(1:3,1:p%NumStC_Control) = m%dll_data%PrevStCCmdForce(1:3,1:p%NumStC_Control) + & factor * ( m%dll_data%StCCmdForce(1:3,1:p%NumStC_Control) - m%dll_data%PrevStCCmdForce(1:3,1:p%NumStC_Control) ) endif + if (allocated(StC_CmdMoment)) then + StC_CmdMoment(1:3,1:p%NumStC_Control) = m%dll_data%PrevStCCmdMoment(1:3,1:p%NumStC_Control) + & + factor * ( m%dll_data%StCCmdMoment(1:3,1:p%NumStC_Control) - m%dll_data%PrevStCCmdMoment(1:3,1:p%NumStC_Control) ) + endif else if (allocated(StC_CmdStiff)) StC_CmdStiff(1:3,1:p%NumStC_Control) = m%dll_data%StCCmdStiff(1:3,1:p%NumStC_Control) if (allocated(StC_CmdDamp)) StC_CmdDamp( 1:3,1:p%NumStC_Control) = m%dll_data%StCCmdDamp( 1:3,1:p%NumStC_Control) if (allocated(StC_CmdBrake)) StC_CmdBrake(1:3,1:p%NumStC_Control) = m%dll_data%StCCmdBrake(1:3,1:p%NumStC_Control) if (allocated(StC_CmdForce)) StC_CmdForce(1:3,1:p%NumStC_Control) = m%dll_data%StCCmdForce(1:3,1:p%NumStC_Control) + if (allocated(StC_CmdMoment)) StC_CmdMoment(1:3,1:p%NumStC_Control)= m%dll_data%StCCmdMoment(1:3,1:p%NumStC_Control) end if END SUBROUTINE StCControl_CalcOutput @@ -6531,13 +6548,14 @@ subroutine GetMeas(iNum,CChan,y) ! Assemble info about who requested which ch end subroutine GetMeas end subroutine StC_SetDLLinputs -subroutine StC_SetInitDLLinputs(p,m,InitStiff,InitDamp,InitBrake,InitForce,ErrStat,ErrMsg) +subroutine StC_SetInitDLLinputs(p,m,InitStiff,InitDamp,InitBrake,InitForce,InitMoment,ErrStat,ErrMsg) type(SrvD_ParameterType), intent(in ) :: p !< Parameters type(SrvD_MiscVarType), intent(inout) :: m !< Misc (optimization) variables real(SiKi), allocatable, intent(inout) :: InitStiff(:,:) !< initial stiffness -- from input file normally output of DLL (3,p%NumStC_Control) real(SiKi), allocatable, intent(inout) :: InitDamp(:,:) !< Initial damping -- from input file normally output of DLL (3,p%NumStC_Control) real(SiKi), allocatable, intent(inout) :: InitBrake(:,:) !< Initial brake -- from input file (?) normally output of DLL (3,p%NumStC_Control) - real(SiKi), allocatable, intent(inout) :: InitForce(:,:) !< Initial brake -- from input file (?) normally output of DLL (3,p%NumStC_Control) + real(SiKi), allocatable, intent(inout) :: InitForce(:,:) !< Initial force -- from input file (?) normally output of DLL (3,p%NumStC_Control) + real(SiKi), allocatable, intent(inout) :: InitMoment(:,:) !< Initial moment -- from input file (?) normally output of DLL (3,p%NumStC_Control) integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -6554,7 +6572,7 @@ subroutine StC_SetInitDLLinputs(p,m,InitStiff,InitDamp,InitBrake,InitForce,ErrSt ! Only proceed if we have have StC controls with the extended swap if ((p%NumStC_Control <= 0) .or. (.not. p%EXavrSWAP)) return - if ((.not. allocated(InitStiff)) .or. (.not. allocated(InitDamp)) .or. (.not. allocated(InitBrake)) .or. (.not. allocated(InitForce))) then + if ((.not. allocated(InitStiff)) .or. (.not. allocated(InitDamp)) .or. (.not. allocated(InitBrake)) .or. (.not. allocated(InitForce)) .or. (.not. allocated(InitMoment))) then ErrStat2 = ErrID_Fatal ErrMsg2 = "StC control signal matrices not allocated. Programming error somewhere." if (Failed()) return @@ -6598,6 +6616,7 @@ subroutine StC_SetInitDLLinputs(p,m,InitStiff,InitDamp,InitBrake,InitForce,ErrSt endif enddo InitForce = 0.0_ReKi + InitMoment = 0.0_ReKi contains subroutine ResizeStCinput(iNum,u) ! Assemble info about who requested which channel @@ -6605,8 +6624,8 @@ subroutine ResizeStCinput(iNum,u) ! Assemble info about who requested which c type(StC_InputType), intent(inout) :: u ! inputs from the StC instance -- will contain allocated Cmd input values if used type(StC_InputType) :: u_tmp ! copy of u -- for resizing as needed integer(IntKi) :: i_local - if (allocated(u%CmdStiff) .and. allocated(u%CmdDamp) .and. allocated(u%CmdBrake) .and. allocated(u%CmdForce)) then ! either all or none will be allocated - if (p%NumStC_Control > min(size(u%CmdStiff,2),size(u%CmdDamp,2),size(u%CmdBrake,2),size(u%CmdForce,2))) then + if (allocated(u%CmdStiff) .and. allocated(u%CmdDamp) .and. allocated(u%CmdBrake) .and. allocated(u%CmdForce) .and. allocated(u%CmdMoment)) then ! either all or none will be allocated + if (p%NumStC_Control > min(size(u%CmdStiff,2),size(u%CmdDamp,2),size(u%CmdBrake,2),size(u%CmdForce,2),size(u%CmdMoment,2))) then call StC_CopyInput(u,u_tmp,MESH_NEWCOPY,ErrStat2,ErrMsg2); if (Failed()) return; if (allocated(u%CmdStiff)) deallocate(u%CmdStiff) @@ -6637,6 +6656,13 @@ subroutine ResizeStCinput(iNum,u) ! Assemble info about who requested which c u%CmdForce(1:3,i_local) = u_tmp%CmdForce(1:3,i_local) enddo + if (allocated(u%CmdMoment)) deallocate(u%CmdMoment) + call AllocAry(u%CmdMoment,3,p%NumStC_Control,"u%CmdMoment",ErrStat2,ErrMsg2); if (Failed()) return; + u%CmdMoment = 0.0_ReKi + do i_local=1,min(p%NumStC_Control,size(u_tmp%CmdMoment,2)) + u%CmdMoment(1:3,i_local) = u_tmp%CmdMoment(1:3,i_local) + enddo + call Cleanup() endif else @@ -6656,6 +6682,10 @@ subroutine ResizeStCinput(iNum,u) ! Assemble info about who requested which c call AllocAry(u%CmdForce,3,p%NumStC_Control,"u%CmdForce",ErrStat2,ErrMsg2); if (Failed()) return; u%CmdForce = 0.0_ReKi endif + if (.not. allocated(u%CmdMoment)) then + call AllocAry(u%CmdMoment,3,p%NumStC_Control,"u%CmdMoment",ErrStat2,ErrMsg2); if (Failed()) return; + u%CmdMoment = 0.0_ReKi + endif endif end subroutine ResizeStCinput subroutine GetMeas(iNum,CChan,u) ! Assemble info about who requested which channel @@ -6668,6 +6698,7 @@ subroutine GetMeas(iNum,CChan,u) ! Assemble info about who requested which ch InitDamp( 1:3,CChan(j)) = InitDamp( 1:3,CChan(j)) + real(u%CmdDamp( 1:3,CChan(j)),SiKi) InitBrake(1:3,CChan(j)) = InitBrake(1:3,CChan(j)) + real(u%CmdBrake(1:3,CChan(j)),SiKi) InitForce(1:3,CChan(j)) = InitForce(1:3,CChan(j)) + real(u%CmdForce(1:3,CChan(j)),SiKi) + InitMoment(1:3,CChan(j))= InitMoment(1:3,CChan(j)) + real(u%CmdMoment(1:3,CChan(j)),SiKi) endif enddo end subroutine GetMeas diff --git a/modules/servodyn/src/ServoDyn_Registry.txt b/modules/servodyn/src/ServoDyn_Registry.txt index cef6387a8c..2728e8c769 100644 --- a/modules/servodyn/src/ServoDyn_Registry.txt +++ b/modules/servodyn/src/ServoDyn_Registry.txt @@ -257,13 +257,14 @@ typedef ^ BladedDLLType SiKi CableDeltaL {:} - - "The swap array: used to pass typedef ^ BladedDLLType SiKi CableDeltaLdot {:} - - "The swap array: used to pass data from the DLL controller for cable tensioning DeltaLdot using extended avrSWAP [see EXavrSWAP documentation in BladededInterface_EX]" m/s typedef ^ BladedDLLType SiKi PrevStCCmdStiff {:}{:} - - "Previous value for ramping StC stiffness from controller (3,NumStC_Control)" "N/m" typedef ^ BladedDLLType SiKi PrevStCCmdDamp {:}{:} - - "Previous value for ramping StC damping from controller (3,NumStC_Control)" "N/(m/s)" -typedef ^ BladedDLLType SiKi PrevStCCmdBrake {:}{:} - - "Previous value for ramping StC braking signal (3,NumStC_Control)" "N/(m/s)" -typedef ^ BladedDLLType SiKi PrevStCCmdForce {:}{:} - - "Previous value for ramping StC force signal (3,NumStC_Control)" "N/(m/s)" +typedef ^ BladedDLLType SiKi PrevStCCmdBrake {:}{:} - - "Previous value for ramping StC braking signal (3,NumStC_Control)" "N" +typedef ^ BladedDLLType SiKi PrevStCCmdForce {:}{:} - - "Previous value for ramping StC force signal (3,NumStC_Control)" "N" +typedef ^ BladedDLLType SiKi PrevStCCmdMoment {:}{:} - - "Previous value for ramping StC moment signal (3,NumStC_Control)" "N-m" typedef ^ BladedDLLType SiKi StCCmdStiff {:}{:} - - "StC stiffness from controller (3,NumStC_Control)" "N/m" typedef ^ BladedDLLType SiKi StCCmdDamp {:}{:} - - "StC damping from controller (3,NumStC_Control)" "N/(m/s)" typedef ^ BladedDLLType SiKi StCCmdBrake {:}{:} - - "StC braking signal (3,NumStC_Control)" "N" typedef ^ BladedDLLType SiKi StCCmdForce {:}{:} - - "StC commanded force signal (3,NumStC_Control)" "N" -typedef ^ BladedDLLType SiKi StCCmdMoment {:}{:} - - "StC commanded moment signal (3,NumStC_Control) [NOTE: this is not currently used. Placeholder for later]" "N" +typedef ^ BladedDLLType SiKi StCCmdMoment {:}{:} - - "StC commanded moment signal (3,NumStC_Control)]" "N-m" typedef ^ BladedDLLType SiKi StCMeasDisp {:}{:} - - "StC measured local displacement signal from StC (3,NumStC_Control)" "m" typedef ^ BladedDLLType SiKi StCMeasVel {:}{:} - - "StC measured local velocity signal from StC (3,NumStC_Control)" "m/s" diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index d99c1bc925..a80cdd10f6 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -268,13 +268,14 @@ MODULE ServoDyn_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: CableDeltaLdot !< The swap array: used to pass data from the DLL controller for cable tensioning DeltaLdot using extended avrSWAP [see EXavrSWAP documentation in BladededInterface_EX] [m/s] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: PrevStCCmdStiff !< Previous value for ramping StC stiffness from controller (3,NumStC_Control) [N/m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: PrevStCCmdDamp !< Previous value for ramping StC damping from controller (3,NumStC_Control) [N/(m/s)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: PrevStCCmdBrake !< Previous value for ramping StC braking signal (3,NumStC_Control) [N/(m/s)] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: PrevStCCmdForce !< Previous value for ramping StC force signal (3,NumStC_Control) [N/(m/s)] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: PrevStCCmdBrake !< Previous value for ramping StC braking signal (3,NumStC_Control) [N] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: PrevStCCmdForce !< Previous value for ramping StC force signal (3,NumStC_Control) [N] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: PrevStCCmdMoment !< Previous value for ramping StC moment signal (3,NumStC_Control) [N-m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdStiff !< StC stiffness from controller (3,NumStC_Control) [N/m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdDamp !< StC damping from controller (3,NumStC_Control) [N/(m/s)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdBrake !< StC braking signal (3,NumStC_Control) [N] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdForce !< StC commanded force signal (3,NumStC_Control) [N] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdMoment !< StC commanded moment signal (3,NumStC_Control) [NOTE: this is not currently used. Placeholder for later] [N] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdMoment !< StC commanded moment signal (3,NumStC_Control)] [N-m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCMeasDisp !< StC measured local displacement signal from StC (3,NumStC_Control) [m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCMeasVel !< StC measured local velocity signal from StC (3,NumStC_Control) [m/s] END TYPE BladedDLLType @@ -1725,6 +1726,18 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct end if DstBladedDLLTypeData%PrevStCCmdForce = SrcBladedDLLTypeData%PrevStCCmdForce end if + if (allocated(SrcBladedDLLTypeData%PrevStCCmdMoment)) then + LB(1:2) = lbound(SrcBladedDLLTypeData%PrevStCCmdMoment) + UB(1:2) = ubound(SrcBladedDLLTypeData%PrevStCCmdMoment) + if (.not. allocated(DstBladedDLLTypeData%PrevStCCmdMoment)) then + allocate(DstBladedDLLTypeData%PrevStCCmdMoment(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%PrevStCCmdMoment.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstBladedDLLTypeData%PrevStCCmdMoment = SrcBladedDLLTypeData%PrevStCCmdMoment + end if if (allocated(SrcBladedDLLTypeData%StCCmdStiff)) then LB(1:2) = lbound(SrcBladedDLLTypeData%StCCmdStiff) UB(1:2) = ubound(SrcBladedDLLTypeData%StCCmdStiff) @@ -1882,6 +1895,9 @@ subroutine SrvD_DestroyBladedDLLType(BladedDLLTypeData, ErrStat, ErrMsg) if (allocated(BladedDLLTypeData%PrevStCCmdForce)) then deallocate(BladedDLLTypeData%PrevStCCmdForce) end if + if (allocated(BladedDLLTypeData%PrevStCCmdMoment)) then + deallocate(BladedDLLTypeData%PrevStCCmdMoment) + end if if (allocated(BladedDLLTypeData%StCCmdStiff)) then deallocate(BladedDLLTypeData%StCCmdStiff) end if @@ -2006,6 +2022,7 @@ subroutine SrvD_PackBladedDLLType(RF, Indata) call RegPackAlloc(RF, InData%PrevStCCmdDamp) call RegPackAlloc(RF, InData%PrevStCCmdBrake) call RegPackAlloc(RF, InData%PrevStCCmdForce) + call RegPackAlloc(RF, InData%PrevStCCmdMoment) call RegPackAlloc(RF, InData%StCCmdStiff) call RegPackAlloc(RF, InData%StCCmdDamp) call RegPackAlloc(RF, InData%StCCmdBrake) @@ -2123,6 +2140,7 @@ subroutine SrvD_UnPackBladedDLLType(RF, OutData) call RegUnpackAlloc(RF, OutData%PrevStCCmdDamp); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%PrevStCCmdBrake); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%PrevStCCmdForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%PrevStCCmdMoment); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%StCCmdStiff); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%StCCmdDamp); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%StCCmdBrake); if (RegCheckErr(RF, RoutineName)) return diff --git a/modules/servodyn/src/StrucCtrl.f90 b/modules/servodyn/src/StrucCtrl.f90 index 8043ac16f9..a8112e7909 100644 --- a/modules/servodyn/src/StrucCtrl.f90 +++ b/modules/servodyn/src/StrucCtrl.f90 @@ -328,6 +328,8 @@ SUBROUTINE StC_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOu if (Failed()) return; call AllocAry( u%CmdForce, 3, maxval(p%StC_CChan), 'u%CmdForce', ErrStat2, ErrMsg2 ) if (Failed()) return; + call AllocAry( u%CmdMoment,3, maxval(p%StC_CChan), 'u%CmdMoment', ErrStat2, ErrMsg2 ) + if (Failed()) return; call AllocAry( y%MeasDisp, 3, maxval(p%StC_CChan), 'y%MeasDisp', ErrStat2, ErrMsg2 ) if (Failed()) return; call AllocAry( y%MeasVel, 3, maxval(p%StC_CChan), 'y%MeasVel', ErrStat2, ErrMsg2 ) @@ -337,6 +339,7 @@ SUBROUTINE StC_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOu u%CmdDamp = 0.0_ReKi u%CmdBrake = 0.0_ReKi u%CmdForce = 0.0_ReKi + u%CmdMoment = 0.0_ReKi y%MeasDisp = 0.0_ReKi y%MeasVel = 0.0_ReKi ! Check that dimensions of x are what we expect @@ -350,7 +353,7 @@ SUBROUTINE StC_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOu if (p%StC_CChan(i) > 0) then u%CmdStiff(1:3,p%StC_CChan(i)) = (/ p%K_X, p%K_Y, p%K_Z /) u%CmdDamp( 1:3,p%StC_CChan(i)) = (/ p%C_X, p%C_Y, p%C_Z /) - !u%CmdBrake and u%CmdForce--- leave these at zero for now (no input file method to set it) + !u%CmdBrake, u%CmdForce and u%CmdMoment -- leave these at zero for now (no input file method to set it) ! The states are sized by (6,NumMeshPts). NumMeshPts is then used to set ! size of StC_CChan as well. For safety, we will check it here. y%MeasDisp(1:3,p%StC_CChan(i)) = (/ x%StC_x(1,i), x%StC_x(3,i), x%StC_x(5,i) /) @@ -1661,7 +1664,7 @@ SUBROUTINE StC_ActiveCtrl_StiffDamp(u,p,K_ctrl,C_ctrl,C_Brake,F_ctrl,M_ctrl) C_ctrl( 1:3,i_pt) = u%CmdDamp( 1:3,p%StC_CChan(i_pt)) C_Brake(1:3,i_pt) = u%CmdBrake(1:3,p%StC_CChan(i_pt)) F_ctrl(1:3,i_pt) = u%CmdForce(1:3,p%StC_CChan(i_pt)) - M_ctrl(1:3,i_pt) = 0.0_ReKi ! not supported. Included for completeness in case someone hooks into the code here later + M_ctrl(1:3,i_pt) = u%CmdMoment(1:3,p%StC_CChan(i_pt)) else ! Use parameters from file (as if no control) -- leave K value as that may be set by table prior C_ctrl(1,:) = p%C_X C_ctrl(2,:) = p%C_Y diff --git a/modules/servodyn/src/StrucCtrl_Registry.txt b/modules/servodyn/src/StrucCtrl_Registry.txt index aad5b2d60d..92bbbc3a2b 100644 --- a/modules/servodyn/src/StrucCtrl_Registry.txt +++ b/modules/servodyn/src/StrucCtrl_Registry.txt @@ -103,6 +103,7 @@ typedef ^ StC_CtrlChanInitInfoType SiKi InitStiff {:}{:} - - "StC stiffness at typedef ^ StC_CtrlChanInitInfoType SiKi InitDamp {:}{:} - - "StC damping at initialization (3,NumStC_Control) -- passed from StC to let controller know the value during init" "N/(m/s)" typedef ^ StC_CtrlChanInitInfoType SiKi InitBrake {:}{:} - - "StC braking signal at initialization (3,NumStC_Control) -- passed from StC to let controller know the value during init" "N" typedef ^ StC_CtrlChanInitInfoType SiKi InitForce {:}{:} - - "StC external force signal at initialization (3,NumStC_Control) -- passed from StC to let controller know the value during init (should be zero)" "N" +typedef ^ StC_CtrlChanInitInfoType SiKi InitMoment {:}{:} - - "StC external moment signal at initialization (3,NumStC_Control) -- passed from StC to let controller know the value during init (should be zero)" "N-m" typedef ^ StC_CtrlChanInitInfoType SiKi InitMeasDisp {:}{:} - - "StC measured local displacement signal from StC at initialization (3,NumStC_Control)" "m" typedef ^ StC_CtrlChanInitInfoType SiKi InitMeasVel {:}{:} - - "StC measured local velocity signal from StC at initialization (3,NumStC_Control)" "m/s" @@ -124,7 +125,7 @@ typedef ^ OtherStateType Reki DummyOtherState - - - "Remove this variable if # at a given time, etc.) or other data that do not depend on time typedef ^ MiscVarType Reki F_stop {:}{:} - - "Stop forces" - typedef ^ MiscVarType ReKi F_ext {:}{:} - - "External forces (user defined or from controller)" - -typedef ^ MiscVarType ReKi M_ext {:}{:} - - "External moments (user defined; no controller support yet)" - +typedef ^ MiscVarType ReKi M_ext {:}{:} - - "External moments (user defined or from controller)" - typedef ^ MiscVarType ReKi F_fr {:}{:} - - "Friction forces" - typedef ^ MiscVarType ReKi K {:}{:} - - "Stiffness -- might be changed if controller controls this" N/m typedef ^ MiscVarType ReKi C_ctrl {:}{:} - - "Controlled Damping (On/Off)" - @@ -204,6 +205,7 @@ typedef ^ ^ ReKi CmdStiff {:}{:} - - "StC stiffness from controller" "N/m" typedef ^ ^ ReKi CmdDamp {:}{:} - - "StC damping from controller" "N/(m/s)" typedef ^ ^ ReKi CmdBrake {:}{:} - - "StC braking from controller" "N/(m/s)" typedef ^ ^ ReKi CmdForce {:}{:} - - "StC force from controller" "N" +typedef ^ ^ ReKi CmdMoment {:}{:} - - "StC moment from controller" "N-m" # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: typedef ^ OutputType MeshType Mesh {:} - - "Loads at the StC reference points in the inertial frame" - diff --git a/modules/servodyn/src/StrucCtrl_Types.f90 b/modules/servodyn/src/StrucCtrl_Types.f90 index c2087bccc7..98995f861a 100644 --- a/modules/servodyn/src/StrucCtrl_Types.f90 +++ b/modules/servodyn/src/StrucCtrl_Types.f90 @@ -126,6 +126,7 @@ MODULE StrucCtrl_Types REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: InitDamp !< StC damping at initialization (3,NumStC_Control) -- passed from StC to let controller know the value during init [N/(m/s)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: InitBrake !< StC braking signal at initialization (3,NumStC_Control) -- passed from StC to let controller know the value during init [N] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: InitForce !< StC external force signal at initialization (3,NumStC_Control) -- passed from StC to let controller know the value during init (should be zero) [N] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: InitMoment !< StC external moment signal at initialization (3,NumStC_Control) -- passed from StC to let controller know the value during init (should be zero) [N-m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: InitMeasDisp !< StC measured local displacement signal from StC at initialization (3,NumStC_Control) [m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: InitMeasVel !< StC measured local velocity signal from StC at initialization (3,NumStC_Control) [m/s] END TYPE StC_CtrlChanInitInfoType @@ -159,7 +160,7 @@ MODULE StrucCtrl_Types TYPE, PUBLIC :: StC_MiscVarType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_stop !< Stop forces [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_ext !< External forces (user defined or from controller) [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: M_ext !< External moments (user defined; no controller support yet) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: M_ext !< External moments (user defined or from controller) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: F_fr !< Friction forces [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: K !< Stiffness -- might be changed if controller controls this [N/m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: C_ctrl !< Controlled Damping (On/Off) [-] @@ -240,6 +241,7 @@ MODULE StrucCtrl_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CmdDamp !< StC damping from controller [N/(m/s)] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CmdBrake !< StC braking from controller [N/(m/s)] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CmdForce !< StC force from controller [N] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CmdMoment !< StC moment from controller [N-m] END TYPE StC_InputType ! ======================= ! ========= StC_OutputType ======= @@ -745,6 +747,18 @@ subroutine StC_CopyCtrlChanInitInfoType(SrcCtrlChanInitInfoTypeData, DstCtrlChan end if DstCtrlChanInitInfoTypeData%InitForce = SrcCtrlChanInitInfoTypeData%InitForce end if + if (allocated(SrcCtrlChanInitInfoTypeData%InitMoment)) then + LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMoment) + UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMoment) + if (.not. allocated(DstCtrlChanInitInfoTypeData%InitMoment)) then + allocate(DstCtrlChanInitInfoTypeData%InitMoment(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstCtrlChanInitInfoTypeData%InitMoment.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstCtrlChanInitInfoTypeData%InitMoment = SrcCtrlChanInitInfoTypeData%InitMoment + end if if (allocated(SrcCtrlChanInitInfoTypeData%InitMeasDisp)) then LB(1:2) = lbound(SrcCtrlChanInitInfoTypeData%InitMeasDisp) UB(1:2) = ubound(SrcCtrlChanInitInfoTypeData%InitMeasDisp) @@ -793,6 +807,9 @@ subroutine StC_DestroyCtrlChanInitInfoType(CtrlChanInitInfoTypeData, ErrStat, Er if (allocated(CtrlChanInitInfoTypeData%InitForce)) then deallocate(CtrlChanInitInfoTypeData%InitForce) end if + if (allocated(CtrlChanInitInfoTypeData%InitMoment)) then + deallocate(CtrlChanInitInfoTypeData%InitMoment) + end if if (allocated(CtrlChanInitInfoTypeData%InitMeasDisp)) then deallocate(CtrlChanInitInfoTypeData%InitMeasDisp) end if @@ -811,6 +828,7 @@ subroutine StC_PackCtrlChanInitInfoType(RF, Indata) call RegPackAlloc(RF, InData%InitDamp) call RegPackAlloc(RF, InData%InitBrake) call RegPackAlloc(RF, InData%InitForce) + call RegPackAlloc(RF, InData%InitMoment) call RegPackAlloc(RF, InData%InitMeasDisp) call RegPackAlloc(RF, InData%InitMeasVel) if (RegCheckErr(RF, RoutineName)) return @@ -829,6 +847,7 @@ subroutine StC_UnPackCtrlChanInitInfoType(RF, OutData) call RegUnpackAlloc(RF, OutData%InitDamp); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%InitBrake); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%InitForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%InitMoment); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%InitMeasDisp); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%InitMeasVel); if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1722,6 +1741,18 @@ subroutine StC_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) end if DstInputData%CmdForce = SrcInputData%CmdForce end if + if (allocated(SrcInputData%CmdMoment)) then + LB(1:2) = lbound(SrcInputData%CmdMoment) + UB(1:2) = ubound(SrcInputData%CmdMoment) + if (.not. allocated(DstInputData%CmdMoment)) then + allocate(DstInputData%CmdMoment(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CmdMoment.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInputData%CmdMoment = SrcInputData%CmdMoment + end if end subroutine subroutine StC_DestroyInput(InputData, ErrStat, ErrMsg) @@ -1756,6 +1787,9 @@ subroutine StC_DestroyInput(InputData, ErrStat, ErrMsg) if (allocated(InputData%CmdForce)) then deallocate(InputData%CmdForce) end if + if (allocated(InputData%CmdMoment)) then + deallocate(InputData%CmdMoment) + end if end subroutine subroutine StC_PackInput(RF, Indata) @@ -1778,6 +1812,7 @@ subroutine StC_PackInput(RF, Indata) call RegPackAlloc(RF, InData%CmdDamp) call RegPackAlloc(RF, InData%CmdBrake) call RegPackAlloc(RF, InData%CmdForce) + call RegPackAlloc(RF, InData%CmdMoment) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1807,6 +1842,7 @@ subroutine StC_UnPackInput(RF, OutData) call RegUnpackAlloc(RF, OutData%CmdDamp); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%CmdBrake); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%CmdForce); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%CmdMoment); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine StC_CopyOutput(SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg) @@ -2056,6 +2092,9 @@ SUBROUTINE StC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg IF (ALLOCATED(u_out%CmdForce) .AND. ALLOCATED(u1%CmdForce)) THEN u_out%CmdForce = a1*u1%CmdForce + a2*u2%CmdForce END IF ! check if allocated + IF (ALLOCATED(u_out%CmdMoment) .AND. ALLOCATED(u1%CmdMoment)) THEN + u_out%CmdMoment = a1*u1%CmdMoment + a2*u2%CmdMoment + END IF ! check if allocated END SUBROUTINE SUBROUTINE StC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) @@ -2133,6 +2172,9 @@ SUBROUTINE StC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err IF (ALLOCATED(u_out%CmdForce) .AND. ALLOCATED(u1%CmdForce)) THEN u_out%CmdForce = a1*u1%CmdForce + a2*u2%CmdForce + a3*u3%CmdForce END IF ! check if allocated + IF (ALLOCATED(u_out%CmdMoment) .AND. ALLOCATED(u1%CmdMoment)) THEN + u_out%CmdMoment = a1*u1%CmdMoment + a2*u2%CmdMoment + a3*u3%CmdMoment + END IF ! check if allocated END SUBROUTINE subroutine StC_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg) From 7795154b862e44687b8cf4aae545365121ecc19e Mon Sep 17 00:00:00 2001 From: andrew-platt Date: Tue, 20 Jan 2026 12:52:06 -0700 Subject: [PATCH 4/4] StC: address comments from GH copilot and minor format fixes --- modules/servodyn/src/BladedInterface_EX.f90 | 6 +++--- modules/servodyn/src/ServoDyn.f90 | 6 +++--- modules/servodyn/src/ServoDyn_Registry.txt | 2 +- modules/servodyn/src/ServoDyn_Types.f90 | 2 +- modules/servodyn/src/StrucCtrl.f90 | 2 +- 5 files changed, 9 insertions(+), 9 deletions(-) diff --git a/modules/servodyn/src/BladedInterface_EX.f90 b/modules/servodyn/src/BladedInterface_EX.f90 index 13b175651b..b4f3b8383d 100644 --- a/modules/servodyn/src/BladedInterface_EX.f90 +++ b/modules/servodyn/src/BladedInterface_EX.f90 @@ -296,7 +296,7 @@ subroutine InitStCCtrl() (size(StC_CtrlChanInitInfo%InitForce ,2) /= p%NumStC_Control) .or. & (size(StC_CtrlChanInitInfo%InitMoment ,2) /= p%NumStC_Control) ) then ErrStat2=ErrID_Fatal - ErrMsg2='Size of StC control initialization arrays (StC_CtrlChanInitInfo%Init*) do not match the number of requested cable control channels. Programming error somewhere.' + ErrMsg2='Size of StC control initialization arrays (StC_CtrlChanInitInfo%Init*) do not match the number of requested StC control channels. Programming error somewhere.' if (Failed()) return endif if ( p%NumStC_Control*StCCtrl_ChanPerSet > StCCtrl_MaxChan ) then @@ -325,7 +325,7 @@ subroutine InitStCCtrl() if (Failed()) return call AllocAry( dll_data%PrevStCCmdForce, 3, p%NumStC_Control, 'PrevStCCmdForce', ErrStat2, ErrMsg2 ) if (Failed()) return - call AllocAry( dll_data%PrevStCCmdMoment,3, p%NumStC_Control, 'PrevStCCmdMoment', ErrStat2, ErrMsg2 ) + call AllocAry( dll_data%PrevStCCmdMoment,3, p%NumStC_Control, 'PrevStCCmdMoment',ErrStat2, ErrMsg2 ) if (Failed()) return call AllocAry( dll_data%StCCmdStiff, 3, p%NumStC_Control, 'StCCmdStiff', ErrStat2, ErrMsg2 ) if (Failed()) return @@ -344,7 +344,7 @@ subroutine InitStCCtrl() dll_data%PrevStCCmdDamp = real(StC_CtrlChanInitInfo%InitDamp ,SiKi) dll_data%PrevStCCmdBrake = real(StC_CtrlChanInitInfo%InitBrake ,SiKi) dll_data%PrevStCCmdForce = real(StC_CtrlChanInitInfo%InitForce ,SiKi) - dll_data%PrevStCCmdMoment = real(StC_CtrlChanInitInfo%InitMoment ,SiKi) + dll_data%PrevStCCmdMoment = real(StC_CtrlChanInitInfo%InitMoment ,SiKi) dll_data%StCCmdStiff = real(StC_CtrlChanInitInfo%InitStiff ,SiKi) dll_data%StCCmdDamp = real(StC_CtrlChanInitInfo%InitDamp ,SiKi) dll_data%StCCmdBrake = real(StC_CtrlChanInitInfo%InitBrake ,SiKi) diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index 5623bcbfcd..e88e37ee82 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -1939,7 +1939,7 @@ SUBROUTINE SrvD_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, call AllocAry(StC_CmdDamp, 3, p%NumStC_Control, 'StC_CmdDamp' , ErrStat2, ErrMsg2 ); if (Failed()) return; call AllocAry(StC_CmdBrake, 3, p%NumStC_Control, 'StC_CmdBrake', ErrStat2, ErrMsg2 ); if (Failed()) return; call AllocAry(StC_CmdForce, 3, p%NumStC_Control, 'StC_CmdForce', ErrStat2, ErrMsg2 ); if (Failed()) return; - call AllocAry(StC_CmdMoment,3, p%NumStC_Control, 'StC_CmdMoment', ErrStat2, ErrMsg2 ); if (Failed()) return; + call AllocAry(StC_CmdMoment,3, p%NumStC_Control, 'StC_CmdMoment',ErrStat2, ErrMsg2 ); if (Failed()) return; call StCControl_CalcOutput( t_next, p, StC_CmdStiff, StC_CmdDamp, StC_CmdBrake, StC_CmdForce, StC_CmdMoment, m, ErrStat2, ErrMsg2 ) if (Failed()) return; endif @@ -2231,7 +2231,7 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg call AllocAry(StC_CmdDamp, 3, p%NumStC_Control, 'StC_CmdDamp' , ErrStat2, ErrMsg2 ); if (Failed()) return; call AllocAry(StC_CmdBrake, 3, p%NumStC_Control, 'StC_CmdBrake', ErrStat2, ErrMsg2 ); if (Failed()) return; call AllocAry(StC_CmdForce, 3, p%NumStC_Control, 'StC_CmdForce', ErrStat2, ErrMsg2 ); if (Failed()) return; - call AllocAry(StC_CmdMoment,3, p%NumStC_Control, 'StC_CmdMoment', ErrStat2, ErrMsg2 ); if (Failed()) return; + call AllocAry(StC_CmdMoment,3, p%NumStC_Control, 'StC_CmdMoment',ErrStat2, ErrMsg2 ); if (Failed()) return; call StCControl_CalcOutput( t, p, StC_CmdStiff, StC_CmdDamp, StC_CmdBrake, StC_CmdForce, StC_CmdMoment, m, ErrStat2, ErrMsg2 ) if (Failed()) return; endif @@ -6698,7 +6698,7 @@ subroutine GetMeas(iNum,CChan,u) ! Assemble info about who requested which ch InitDamp( 1:3,CChan(j)) = InitDamp( 1:3,CChan(j)) + real(u%CmdDamp( 1:3,CChan(j)),SiKi) InitBrake(1:3,CChan(j)) = InitBrake(1:3,CChan(j)) + real(u%CmdBrake(1:3,CChan(j)),SiKi) InitForce(1:3,CChan(j)) = InitForce(1:3,CChan(j)) + real(u%CmdForce(1:3,CChan(j)),SiKi) - InitMoment(1:3,CChan(j))= InitMoment(1:3,CChan(j)) + real(u%CmdMoment(1:3,CChan(j)),SiKi) + InitMoment(1:3,CChan(j))= InitMoment(1:3,CChan(j))+ real(u%CmdMoment(1:3,CChan(j)),SiKi) endif enddo end subroutine GetMeas diff --git a/modules/servodyn/src/ServoDyn_Registry.txt b/modules/servodyn/src/ServoDyn_Registry.txt index 2728e8c769..c752d57c97 100644 --- a/modules/servodyn/src/ServoDyn_Registry.txt +++ b/modules/servodyn/src/ServoDyn_Registry.txt @@ -264,7 +264,7 @@ typedef ^ BladedDLLType SiKi StCCmdStiff {:}{:} - - "StC stiffness from contro typedef ^ BladedDLLType SiKi StCCmdDamp {:}{:} - - "StC damping from controller (3,NumStC_Control)" "N/(m/s)" typedef ^ BladedDLLType SiKi StCCmdBrake {:}{:} - - "StC braking signal (3,NumStC_Control)" "N" typedef ^ BladedDLLType SiKi StCCmdForce {:}{:} - - "StC commanded force signal (3,NumStC_Control)" "N" -typedef ^ BladedDLLType SiKi StCCmdMoment {:}{:} - - "StC commanded moment signal (3,NumStC_Control)]" "N-m" +typedef ^ BladedDLLType SiKi StCCmdMoment {:}{:} - - "StC commanded moment signal (3,NumStC_Control)" "N-m" typedef ^ BladedDLLType SiKi StCMeasDisp {:}{:} - - "StC measured local displacement signal from StC (3,NumStC_Control)" "m" typedef ^ BladedDLLType SiKi StCMeasVel {:}{:} - - "StC measured local velocity signal from StC (3,NumStC_Control)" "m/s" diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index a80cdd10f6..b9fb0a0f40 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -275,7 +275,7 @@ MODULE ServoDyn_Types REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdDamp !< StC damping from controller (3,NumStC_Control) [N/(m/s)] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdBrake !< StC braking signal (3,NumStC_Control) [N] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdForce !< StC commanded force signal (3,NumStC_Control) [N] - REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdMoment !< StC commanded moment signal (3,NumStC_Control)] [N-m] + REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCCmdMoment !< StC commanded moment signal (3,NumStC_Control) [N-m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCMeasDisp !< StC measured local displacement signal from StC (3,NumStC_Control) [m] REAL(SiKi) , DIMENSION(:,:), ALLOCATABLE :: StCMeasVel !< StC measured local velocity signal from StC (3,NumStC_Control) [m/s] END TYPE BladedDLLType diff --git a/modules/servodyn/src/StrucCtrl.f90 b/modules/servodyn/src/StrucCtrl.f90 index a8112e7909..d559173750 100644 --- a/modules/servodyn/src/StrucCtrl.f90 +++ b/modules/servodyn/src/StrucCtrl.f90 @@ -1656,7 +1656,7 @@ SUBROUTINE StC_ActiveCtrl_StiffDamp(u,p,K_ctrl,C_ctrl,C_Brake,F_ctrl,M_ctrl) real(ReKi), intent(inout) :: C_ctrl(:,:) !< damping commanded by dll real(ReKi), intent(inout) :: C_Brake(:,:) !< brake commanded by dll real(ReKi), intent(inout) :: F_ctrl(:,:) !< force commanded by dll - real(ReKi), intent(inout) :: M_ctrl(:,:) !< moment commanded by dll (not supported by DLL interface) + real(ReKi), intent(inout) :: M_ctrl(:,:) !< moment commanded by dll integer(IntKi) :: i_pt ! counter for mesh points do i_pt=1,p%NumMeshPts if (p%StC_CChan(i_pt) > 0) then ! This index should have been checked at init, so won't check bounds here