diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 99c5c14a8b..1af216c2d5 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -31,12 +31,11 @@ module AeroDyn use UnsteadyAero use FVW use FVW_Subs, only: FVW_AeroOuts - use IfW_FlowField, only: IfW_FlowField_GetVelAcc + use IfW_FlowField, only: IfW_FlowField_GetVelAcc, IfW_UniformWind_GetOP, IfW_UniformWind_Perturb, IfW_FlowField_CopyFlowFieldType implicit none - private - + ! ..... Public Subroutines ................................................................................................... @@ -342,7 +341,6 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! ----------------------------------------------------------------- ! Read the AeroDyn blade files, or copy from passed input -!FIXME: add handling for passing of blade files and other types of files. call ReadInputFiles( InitInp%InputFile, InputFileData, interval, p%RootName, NumBlades, AeroProjMod, UnEcho, ErrStat2, ErrMsg2 ) if (Failed()) return; @@ -395,6 +393,9 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut p%rotors(iR)%TFin%TFinCDc = InputFileData%rotors(iR)%TFin%TFinCDc enddo + ! Set pointer to FlowField data + if (associated(InitInp%FlowField)) p%FlowField => InitInp%FlowField + !............................................................................................ ! Define and initialize inputs here @@ -1223,6 +1224,7 @@ subroutine Init_u( u, p, p_AD, InputFileData, MHK, WtrDpth, InitInp, errStat, er ,TranslationVel = .true. & ,RotationVel = .true. & ,TranslationAcc = .true. & + ,RotationAcc = .true. & ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) @@ -1701,7 +1703,7 @@ subroutine AD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errStat ! Set wind -- NOTE: this is inneficient since the previous input value resides at m%Inflow(2) do i=1,size(u) - call AD_CalcWind(utimes(i), u(i), p, OtherState, m%Inflow(i), ErrStat2, ErrMsg2) + call AD_CalcWind(utimes(i), u(i), p%FLowField, p, OtherState, m%Inflow(i), ErrStat2, ErrMsg2) if (Failed()) return enddo @@ -1724,7 +1726,7 @@ subroutine AD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errStat if (Failed()) return !Calculate using uInterp -! call AD_CalcWind(utimes(i),uInterp, p, OtherState, m%Inflow(1), ErrStat2, ErrMsg2) +! call AD_CalcWind(utimes(i),uInterp, p%FLowField, p, OtherState, m%Inflow(1), ErrStat2, ErrMsg2) ! if (Failed()) return do iR = 1,size(p%rotors) @@ -1782,15 +1784,15 @@ logical function Failed() end function Failed end subroutine AD_UpdateStates -subroutine AD_CalcWind(t, u, p, o, Inflow, ErrStat, ErrMsg) - - real(DbKi), intent(in ) :: t !< Current simulation time in seconds - type(AD_InputType), intent(in ) :: u !< Inputs at Time t - type(AD_ParameterType), intent(in ) :: p !< Parameters - type(AD_OtherStateType), intent(in ) :: o !< Other states at t - type(AD_InflowType),target,intent(inout) :: Inflow !< calculated inflow - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None +subroutine AD_CalcWind(t, u, FLowField, p, o, Inflow, ErrStat, ErrMsg) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + type(AD_InputType), intent(in ) :: u !< Inputs at Time t + type(FlowFieldType),pointer, intent(in ) :: FlowField + type(AD_ParameterType), intent(in ) :: p !< Parameters + type(AD_OtherStateType), intent(in ) :: o !< Other states at t + type(AD_InflowType),target, intent(inout) :: Inflow !< calculated inflow + 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 @@ -1802,85 +1804,120 @@ subroutine AD_CalcWind(t, u, p, o, Inflow, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" - if (.not. associated(p%FlowField)) return ! use the initial (or input) values for these inputs + if (.not. associated(FlowField)) return ! use the initial (or input) values for these inputs ! bjj: if the previous line is not appropriate, then some other check for if FlowField has been set should be used. - + ! Initialize node. The StartNode is used for OpenFOAM to provide the wind ! velocities. The node ordering in OpenFOAM must match that used in here. StartNode = 1 do iWT = 1, size(u%rotors) - RotInflow => Inflow%RotInflow(iWT) + call AD_CalcWind_Rotor(t, u%rotors(iWT), FLowField, p%rotors(iWT), Inflow%RotInflow(iWT), StartNode, ErrStat2, ErrMsg2) + if(Failed()) return + enddo + ! OLAF points + if (allocated(o%WakeLocationPoints) .and. allocated(Inflow%InflowWakeVel)) then ! If rotor is MHK, add water depth to z coordinate - if (p%rotors(iWT)%MHK > 0) then - PosOffset = [0.0_ReKi, 0.0_ReKi, p%rotors(iWT)%WtrDpth] + if (p%FVW%MHK > 0) then + PosOffset = [0.0_ReKi, 0.0_ReKi, p%FVW%WtrDpth] else PosOffset = 0.0_ReKi end if - ! Hub - if (u%rotors(iWT)%HubMotion%Committed) then - call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & - real(u%rotors(iWT)%HubMotion%TranslationDisp + u%rotors(iWT)%HubMotion%Position, ReKi), & - RotInflow%InflowOnHub, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) - if(Failed()) return - else - RotInflow%InflowOnHub = 0.0_ReKi - end if - StartNode = StartNode + 1 + call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & + o%WakeLocationPoints, & + Inflow%InflowWakeVel, & + NoAcc, ErrStat2, ErrMsg2, & + BoxExceedAllow=.true., PosOffset=PosOffset) + if(Failed()) return + StartNode = StartNode + size(o%WakeLocationPoints) + end if - ! Blade - do k = 1, p%rotors(iWT)%NumBlades - call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & - real(u%rotors(iWT)%BladeMotion(k)%TranslationDisp + u%rotors(iWT)%BladeMotion(k)%Position, ReKi), & - RotInflow%Bld(k)%InflowOnBlade, RotInflow%Bld(k)%AccelOnBlade, ErrStat2, ErrMsg2, PosOffset=PosOffset) - if(Failed()) return - StartNode = StartNode + p%rotors(iWT)%NumBlNds - end do +contains + logical function Failed() + call SetErrStat(errStat2, errMsg2, errStat, errMsg, 'AD_CalcWind') + Failed = errStat >= AbortErrLev + end function Failed +end subroutine - ! Tower - if (u%rotors(iWT)%TowerMotion%Nnodes > 0) then - call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & - real(u%rotors(iWT)%TowerMotion%TranslationDisp + u%rotors(iWT)%TowerMotion%Position, ReKi), & - RotInflow%InflowOnTower, RotInflow%AccelOnTower, ErrStat2, ErrMsg2, PosOffset=PosOffset) - if(Failed()) return - StartNode = StartNode + p%rotors(iWT)%NumTwrNds - end if +subroutine AD_CalcWind_Rotor(t, u, FlowField, p, RotInflow, StartNode, ErrStat, ErrMsg) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + type(RotInputType), intent(in ) :: u !< Inputs at Time t + type(FlowFieldType),pointer, intent(in ) :: FlowField + type(RotParameterType), intent(in ) :: p !< Parameters + type(RotInflowType), intent(inout) :: RotInflow !< calculated inflow for rotor + integer(IntKi), intent(inout) :: StartNode !< starting node for rotor wind + 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 + integer(intKi) :: k + real(ReKi) :: PosOffset(3) + real(ReKi), allocatable :: NoAcc(:,:) - ! Nacelle - if (u%rotors(iWT)%NacelleMotion%Committed) then - call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & - real(u%rotors(iWT)%NacelleMotion%TranslationDisp + u%rotors(iWT)%NacelleMotion%Position, ReKi), & - RotInflow%InflowOnNacelle, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) - if(Failed()) return - StartNode = StartNode + 1 - else - RotInflow%InflowOnNacelle = 0.0_ReKi - end if + ErrStat = ErrID_None + ErrMsg = "" - ! TailFin - if (u%rotors(iWT)%TFinMotion%Committed) then - call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & - real(u%rotors(iWT)%TFinMotion%TranslationDisp + u%rotors(iWT)%TFinMotion%Position, ReKi), & - RotInflow%InflowOnTailFin, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) - if(Failed()) return - StartNode = StartNode + 1 - else - RotInflow%InflowOnTailFin = 0.0_ReKi - end if + if (.not. associated(FlowField)) return ! use the initial (or input) values for these inputs - enddo ! iWT + ! If rotor is MHK, add water depth to z coordinate + if (p%MHK > 0) then + PosOffset = [0.0_ReKi, 0.0_ReKi, p%WtrDpth] + else + PosOffset = 0.0_ReKi + end if - ! OLAF points - if (allocated(o%WakeLocationPoints) .and. allocated(Inflow%InflowWakeVel)) then - call IfW_FlowField_GetVelAcc(p%FlowField, StartNode, t, & - o%WakeLocationPoints, & - Inflow%InflowWakeVel, & - NoAcc, ErrStat2, ErrMsg2, & - BoxExceedAllow=.true., PosOffset=PosOffset) + ! Hub + if (u%HubMotion%Committed) then + call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & + real(u%HubMotion%TranslationDisp + u%HubMotion%Position, ReKi), & + RotInflow%InflowOnHub, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) + if(Failed()) return + else + RotInflow%InflowOnHub = 0.0_ReKi + end if + StartNode = StartNode + 1 + + ! Blade + do k = 1, p%NumBlades + call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & + real(u%BladeMotion(k)%TranslationDisp + u%BladeMotion(k)%Position, ReKi), & + RotInflow%Bld(k)%InflowOnBlade, RotInflow%Bld(k)%AccelOnBlade, ErrStat2, ErrMsg2, PosOffset=PosOffset) if(Failed()) return - StartNode = StartNode + size(o%WakeLocationPoints) + StartNode = StartNode + p%NumBlNds + end do + + ! Tower + if (u%TowerMotion%Nnodes > 0) then + call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & + real(u%TowerMotion%TranslationDisp + u%TowerMotion%Position, ReKi), & + RotInflow%InflowOnTower, RotInflow%AccelOnTower, ErrStat2, ErrMsg2, PosOffset=PosOffset) + if(Failed()) return + StartNode = StartNode + p%NumTwrNds + end if + + ! Nacelle + if (u%NacelleMotion%Committed) then + call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & + real(u%NacelleMotion%TranslationDisp + u%NacelleMotion%Position, ReKi), & + RotInflow%InflowOnNacelle, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) + if(Failed()) return + StartNode = StartNode + 1 + else + RotInflow%InflowOnNacelle = 0.0_ReKi + end if + + ! TailFin + if (u%TFinMotion%Committed) then + call IfW_FlowField_GetVelAcc(FlowField, StartNode, t, & + real(u%TFinMotion%TranslationDisp + u%TFinMotion%Position, ReKi), & + RotInflow%InflowOnTailFin, NoAcc, ErrStat2, ErrMsg2, PosOffset=PosOffset) + if(Failed()) return + StartNode = StartNode + 1 + else + RotInflow%InflowOnTailFin = 0.0_ReKi end if contains @@ -1890,6 +1927,7 @@ logical function Failed() end function Failed end subroutine + !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. !! This subroutine is used to compute the output channels (motions and loads) and place them in the WriteOutput() array. @@ -1931,7 +1969,7 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, end if ! Calculate wind based on current positions - call AD_CalcWind(t, u, p, OtherState, m%Inflow(1), ErrStat2, ErrMsg2) + call AD_CalcWind(t, u, p%FlowField, p, OtherState, m%Inflow(1), ErrStat2, ErrMsg2) if(Failed()) return ! SetInputs, Calc BEM Outputs and Twr Outputs @@ -5517,8 +5555,6 @@ END SUBROUTINE TwrInfl_NearestPoint !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) -!.................................................................................................................................. - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(AD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -5527,38 +5563,32 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point TYPE(AD_OutputType), INTENT(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(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect - !! to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with - !! respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with - !! respect to the inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with - ! integer(IntKi), parameter :: iR =1 ! Rotor index + integer(intKi) :: StartNode + StartNode = 1 ! ignored during linearization since cannot linearize with ExtInflow if (size(p%rotors)>1) then errStat = ErrID_Fatal errMsg = 'Linearization with more than one rotor not supported' return endif + call AD_CalcWind_Rotor( t, u%rotors(iR), p%FLowField, p%rotors(iR), m%Inflow(1)%RotInflow(iR), StartNode, ErrStat, ErrMsg) call Rot_JacobianPInput( t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) END SUBROUTINE AD_JacobianPInput - !! respect to the inputs (u) [intent in to avoid deallocation] + !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) -!.................................................................................................................................. - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(RotInputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor inflow @@ -5569,22 +5599,15 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y TYPE(RotConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point TYPE(RotOtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point TYPE(RotOutputType), 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(RotMiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables TYPE(AD_MiscVarType), INTENT(INOUT) :: m_AD !< misc variables INTEGER, INTENT(IN ) :: iRot !< Rotor index, needed for OLAF INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect - !! to the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with - !! respect to the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with - !! respect to the inputs (u) [intent in to avoid deallocation] - REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with - !! respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) ! local variables TYPE(RotOutputType) :: y_p TYPE(RotOutputType) :: y_m @@ -5595,25 +5618,25 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y TYPE(RotOtherStateType) :: OtherState_copy TYPE(RotOtherStateType) :: OtherState_init TYPE(RotInputType) :: u_perturb + type(FLowFieldType),target :: FlowField_perturb + type(FLowFieldType),pointer :: FlowField_perturb_p ! need a pointer in the CalcWind_Rotor routine + type(RotInflowType) :: RotInflow_perturb !< Rotor inflow, perturbed by FlowField extended inputs REAL(R8Ki) :: delta_p, delta_m ! delta change in input INTEGER(IntKi) :: i integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_JacobianPInput' + character(*), parameter :: RoutineName = 'Rot_JacobianPInput' ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' - ! get OP values here (i.e., set inputs for BEMT): if ( p%DBEMT_Mod == DBEMT_frozen ) then - call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return ! compare m%BEMT_y arguments with call to BEMT_CalcOutput call computeFrozenWake(m%BEMT_u(indx), p%BEMT, m%BEMT_y, m%BEMT ) @@ -5621,114 +5644,78 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y end if - call AD_CopyRotContinuousStateType( x, x_init, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOtherStateType( OtherState, OtherState_init, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - + call AD_CopyRotContinuousStateType( x, x_init, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); if (Failed()) return + call AD_CopyRotOtherStateType( OtherState, OtherState_init, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + ! Copy FlowField data -- ideally we would not do this, but we cannot linearize with turbulent winds + call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FlowField_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + FlowField_perturb_p => FlowField_perturb + call AD_CopyRotInflowType( RotInflow, RotInflow_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + ! initialize x_init so that we get accurrate values for first step if (.not. OtherState%BEMT%nodesInitialized ) then - call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return call BEMT_InitStates(t, m%BEMT_u(indx), p%BEMT, x_init%BEMT, xd%BEMT, z%BEMT, OtherState_init%BEMT, m%BEMT, p_AD%AFI, ErrStat2, ErrMsg2 ) ! changes values only if states haven't been initialized - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if - - + + ! make a copy of the inputs to perturb - call AD_CopyRotInputType( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - + call AD_CopyRotInputType( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + IF ( PRESENT( dYdu ) ) THEN ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - + ! allocate dYdu if (.not. allocated(dYdu) ) then - call AllocAry(dYdu,p%Jac_ny, size(p%Jac_u_indx,1),'dYdu', ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + 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 AD_CopyRotOutputType( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOutputType( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyRotOutputType( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOutputType( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return ! make a copy of the states to perturb - call AD_CopyRotConstraintStateType( z, z_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOtherStateType( OtherState_init, OtherState_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyRotConstraintStateType( z, z_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType( OtherState_init, OtherState_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if do i=1,size(p%Jac_u_indx,1) ! get u_op + delta_p u - call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FlowField_perturb_p, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotInflowType( RotInflow, RotInflow_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return call Perturb_u( p, i, 1, u_perturb, delta_p ) + call Perturb_uExtend( t, u_perturb, FlowField_perturb_p, RotInflow_perturb, p, OtherState, i, 1, u_perturb, delta_p, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotConstraintStateType( z, z_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOtherStateType( OtherState_init, OtherState_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyRotConstraintStateType( z, z_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType( OtherState_init, OtherState_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return ! get updated z%phi values: - !call AD_UpdateStates( t, 1, (/u_perturb/), (/t/), p, x_copy, xd_copy, z_copy, OtherState_copy, m, errStat2, errMsg2 ) - ! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - !bjj: this is what we want to do instead of the overkill of calling AD_UpdateStates - call SetInputs(t, p, p_AD, u_perturb, RotInflow, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call UpdatePhi( m%BEMT_u(indx), p%BEMT, z_copy%BEMT%phi, p_AD%AFI, m%BEMT, OtherState_copy%BEMT%ValidPhi, errStat2, errMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call SetInputs(t, p, p_AD, u_perturb, RotInflow_perturb, m, indx, errStat2, errMsg2); if (Failed()) return + call UpdatePhi( m%BEMT_u(indx), p%BEMT, z_copy%BEMT%phi, p_AD%AFI, m%BEMT, OtherState_copy%BEMT%ValidPhi, errStat2, errMsg2 ); if (Failed()) return ! compute y at u_op + delta_p u - call RotCalcOutput( t, u_perturb, RotInflow, p, p_AD, x_init, xd, z_copy, OtherState_copy, y_p, m, m_AD, iRot, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call RotCalcOutput( t, u_perturb, RotInflow_perturb, p, p_AD, x_init, xd, z_copy, OtherState_copy, y_p, m, m_AD, iRot, ErrStat2, ErrMsg2 ); if (Failed()) return ! get u_op - delta_m u - call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FlowField_perturb_p, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotInflowType( RotInflow, RotInflow_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return call Perturb_u( p, i, -1, u_perturb, delta_m ) + call Perturb_uExtend( t, u_perturb, FlowField_perturb_p, RotInflow_perturb, p, OtherState, i, -1, u_perturb, delta_m, ErrStat2, ErrMsg2); if (Failed()) return - call AD_CopyRotConstraintStateType( z, z_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOtherStateType( OtherState, OtherState_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyRotConstraintStateType( z, z_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotOtherStateType( OtherState, OtherState_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return ! get updated z%phi values: - !call RotUpdateStates( t, 1, (/u_perturb/), (/t/), p, x_copy, xd_copy, z_copy, OtherState_copy, m, errStat2, errMsg2 ) - ! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call SetInputs(t, p, p_AD, u_perturb, RotInflow, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call UpdatePhi( m%BEMT_u(indx), p%BEMT, z_copy%BEMT%phi, p_AD%AFI, m%BEMT, OtherState_copy%BEMT%ValidPhi, errStat2, errMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call SetInputs(t, p, p_AD, u_perturb, RotInflow_perturb, m, indx, errStat2, errMsg2); if (Failed()) return + call UpdatePhi( m%BEMT_u(indx), p%BEMT, z_copy%BEMT%phi, p_AD%AFI, m%BEMT, OtherState_copy%BEMT%ValidPhi, errStat2, errMsg2 ); if (Failed()) return ! compute y at u_op - delta_m u - call RotCalcOutput( t, u_perturb, RotInflow, p, p_AD, x_init, xd, z_copy, OtherState_copy, y_m, m, m_AD, iRot, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call RotCalcOutput( t, u_perturb, RotInflow_perturb, p, p_AD, x_init, xd, z_copy, OtherState_copy, y_m, m, m_AD, iRot, ErrStat2, ErrMsg2 ); if (Failed()) return - ! get central difference: call Compute_dY( p, p_AD, y_p, y_m, delta_p, delta_m, dYdu(:,i) ) @@ -5748,37 +5735,33 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y ! allocate dXdu if necessary if (.not. allocated(dXdu)) then - call AllocAry(dXdu, size(p%dx), size(p%Jac_u_indx,1), 'dXdu', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dXdu, size(p%dx), size(p%Jac_u_indx,1), 'dXdu', ErrStat2, ErrMsg2); if (Failed()) return end if do i=1,size(p%Jac_u_indx,1) ! get u_op + delta u - call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FlowField_perturb_p, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotInflowType( RotInflow, RotInflow_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return call Perturb_u( p, i, 1, u_perturb, delta_p ) + call Perturb_uExtend( t, u_perturb, FlowField_perturb_p, RotInflow_perturb, p, OtherState, i, 1, u_perturb, delta_p, ErrStat2, ErrMsg2); if (Failed()) return ! compute x at u_op + delta u ! note that this routine updates z%phi instead of using the actual state value, so we don't need to call UpdateStates/UpdatePhi here to get z_op + delta_z: - call RotCalcContStateDeriv( t, u_perturb, RotInflow, p, p_AD, x_init, xd, z, OtherState_init, m, x_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + call RotCalcContStateDeriv( t, u_perturb, RotInflow_perturb, p, p_AD, x_init, xd, z, OtherState_init, m, x_p, ErrStat2, ErrMsg2 ); if (Failed()) return ! get u_op - delta u - call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call IfW_FlowField_CopyFlowFieldType(p_AD%FlowField, FlowField_perturb_p, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotInflowType( RotInflow, RotInflow_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return + call AD_CopyRotInputType( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return call Perturb_u( p, i, -1, u_perturb, delta_m ) - + call Perturb_uExtend( t, u_perturb, FlowField_perturb_p, RotInflow_perturb, p, OtherState, i, -1, u_perturb, delta_m, ErrStat2, ErrMsg2); if (Failed()) return + ! compute x at u_op - delta u ! note that this routine updates z%phi instead of using the actual state value, so we don't need to call UpdateStates here to get z_op + delta_z: - call RotCalcContStateDeriv( t, u_perturb, RotInflow, p, p_AD, x_init, xd, z, OtherState_init, m, x_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call RotCalcContStateDeriv( t, u_perturb, RotInflow_perturb, p, p_AD, x_init, xd, z, OtherState_init, m, x_m, ErrStat2, ErrMsg2 ); if (Failed()) return ! get central difference: @@ -5808,21 +5791,26 @@ SUBROUTINE Rot_JacobianPInput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y 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() m%BEMT%UseFrozenWake = .false. - call AD_DestroyRotOutputType( y_p, ErrStat2, ErrMsg2) call AD_DestroyRotOutputType( y_m, ErrStat2, ErrMsg2) - call AD_DestroyRotContinuousStateType( x_p, ErrStat2, ErrMsg2) - call AD_DestroyRotContinuousStateType( x_m, ErrStat2, ErrMsg2) - call AD_DestroyRotContinuousStateType( x_init, ErrStat2, ErrMsg2) - call AD_DestroyRotConstraintStateType( z_copy, ErrStat2, ErrMsg2) + call AD_DestroyRotContinuousStateType( x_p, ErrStat2, ErrMsg2) + call AD_DestroyRotContinuousStateType( x_m, ErrStat2, ErrMsg2) + call AD_DestroyRotContinuousStateType( x_init, ErrStat2, ErrMsg2) + call AD_DestroyRotConstraintStateType( z_copy, ErrStat2, ErrMsg2) call AD_DestroyRotOtherStateType( OtherState_copy, ErrStat2, ErrMsg2) call AD_DestroyRotOtherStateType( OtherState_init, ErrStat2, ErrMsg2) - call AD_DestroyRotInputType( u_perturb, ErrStat2, ErrMsg2 ) + call AD_DestroyRotInflowType( RotInflow_perturb, ErrStat2, ErrMsg2 ) + call IfW_FlowField_DestroyFlowFieldType( FlowField_perturb, ErrStat2, ErrMsg2 ) end subroutine cleanup - END SUBROUTINE Rot_JacobianPInput !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions @@ -5931,8 +5919,7 @@ SUBROUTINE RotJacobianPContState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState if ( p%DBEMT_Mod == DBEMT_frozen ) then - call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return; ! compare arguments with call to BEMT_CalcOutput call computeFrozenWake(m%BEMT_u(indx), p%BEMT, m%BEMT_y, m%BEMT ) @@ -5940,13 +5927,9 @@ SUBROUTINE RotJacobianPContState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState end if - call AD_CopyRotContinuousStateType( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call AD_CopyRotContinuousStateType( x, x_init, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOtherStateType( OtherState, OtherState_init, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyRotContinuousStateType( x, x_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; + call AD_CopyRotContinuousStateType( x, x_init, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; + call AD_CopyRotOtherStateType( OtherState, OtherState_init, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return; if (ErrStat>=AbortErrLev) then call cleanup() @@ -5955,11 +5938,8 @@ SUBROUTINE RotJacobianPContState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState ! initialize x_init so that we get accurrate values for if (.not. OtherState%BEMT%nodesInitialized ) then - call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call BEMT_InitStates(t, m%BEMT_u(indx), p%BEMT, x_init%BEMT, xd%BEMT, z%BEMT, OtherState_init%BEMT, m%BEMT, p_AD%AFI, ErrStat2, ErrMsg2 ) ! changes values only if states haven't been initialized - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return; + call BEMT_InitStates(t, m%BEMT_u(indx), p%BEMT, x_init%BEMT, xd%BEMT, z%BEMT, OtherState_init%BEMT, m%BEMT, p_AD%AFI, ErrStat2, ErrMsg2 ); if (Failed()) return; ! changes values only if states haven't been initialized end if @@ -5969,145 +5949,88 @@ SUBROUTINE RotJacobianPContState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState ! allocate dYdx if necessary if (.not. allocated(dYdx)) then - call AllocAry(dYdx, p%Jac_ny, size(p%dx), 'dYdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dYdx, p%Jac_ny, size(p%dx), 'dYdx', ErrStat2, ErrMsg2); if (Failed()) return; end if ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call AD_CopyRotOutputType( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOutputType( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AD_CopyRotOutputType( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return; + call AD_CopyRotOutputType( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return; do i=1,size(p%dx) ! get x_op + delta_p x - call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; call Perturb_x( p, i, 1, x_perturb, delta_p ) ! compute y at x_op + delta_p x ! NOTE: z_op is the same as z because x_perturb does not affect the values of phi, thus I am not updating the states or calling UpdatePhi to get z_perturb. - call RotCalcOutput( t, u, RotInflow, p, p_AD, x_perturb, xd, z, OtherState_init, y_p, m, m_AD, iRot, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call RotCalcOutput( t, u, RotInflow, p, p_AD, x_perturb, xd, z, OtherState_init, y_p, m, m_AD, iRot, ErrStat2, ErrMsg2 ) ; if (Failed()) return; ! get x_op - delta_m x - call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; call Perturb_x( p, i, -1, x_perturb, delta_m ) ! compute y at x_op - delta_m x ! NOTE: z_op is the same as z because x_perturb does not affect the values of phi, thus I am not updating the states or calling UpdatePhi to get z_perturb. - call RotCalcOutput( t, u, RotInflow, p, p_AD, x_perturb, xd, z, OtherState_init, y_m, m, m_AD, iRot, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call RotCalcOutput( t, u, RotInflow, p, p_AD, x_perturb, xd, z, OtherState_init, y_m, m, m_AD, iRot, ErrStat2, ErrMsg2 ); if (Failed()) return; ! get central difference: call Compute_dY( p, p_AD, y_p, y_m, delta_p, delta_m, dYdx(:,i) ) end do - - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call AD_DestroyRotOutputType( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyRotOutputType( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - END IF IF ( PRESENT( dXdx ) ) THEN - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - - ! allocate and set dXdx - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the inputs (u) here: - ! allocate dXdx if necessary if (.not. allocated(dXdx)) then - call AllocAry(dXdx, size(p%dx), size(p%dx), 'dXdx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dXdx, size(p%dx), size(p%dx), 'dXdx', ErrStat2, ErrMsg2); if (Failed()) return; end if do i=1,size(p%dx,1) ! get x_op + delta x - call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; call Perturb_x( p, i, 1, x_perturb, delta_p ) ! compute X at x_op + delta x ! NOTE: z_op is the same as z because x_perturb does not affect the values of phi, thus I am not updating the states or calling UpdatePhi to get z_perturb. - call RotCalcContStateDeriv( t, u, RotInflow, p, p_AD, x_perturb, xd, z, OtherState_init, m, x_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call RotCalcContStateDeriv( t, u, RotInflow, p, p_AD, x_perturb, xd, z, OtherState_init, m, x_p, ErrStat2, ErrMsg2 ); if (Failed()) return; ! get x_op - delta x - call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call AD_CopyRotContinuousStateType( x_init, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; call Perturb_x( p, i, -1, x_perturb, delta_m ) ! compute x at u_op - delta u ! NOTE: z_op is the same as z because x_perturb does not affect the values of phi, thus I am not updating the states or calling UpdatePhi to get z_perturb. - call RotCalcContStateDeriv( t, u, RotInflow, p, p_AD, x_perturb, xd, z, OtherState_init, m, x_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + call RotCalcContStateDeriv( t, u, RotInflow, p, p_AD, x_perturb, xd, z, OtherState_init, m, x_m, ErrStat2, ErrMsg2 ); if (Failed()) return; - ! get central difference: - ! we may have had an error allocating memory, so we'll check - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - ! get central difference: call Compute_dX( p, x_p, x_m, delta_p, delta_m, dXdx(:,i) ) end do - - call AD_DestroyRotContinuousStateType( x_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyRotContinuousStateType( x_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - - END IF - - IF ( PRESENT( dXddx ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the continuous states (x) here: - - ! allocate and set dXddx - END IF - IF ( PRESENT( dZdx ) ) THEN - - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the continuous states (x) here: - - ! allocate and set dZdx +! IF ( PRESENT( dXddx ) ) THEN +! END IF - END IF +! IF ( PRESENT( dZdx ) ) THEN +! 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() m%BEMT%UseFrozenWake = .false. @@ -6120,14 +6043,13 @@ subroutine cleanup() call AD_DestroyRotContinuousStateType( x_init, ErrStat2, ErrMsg2 ) call AD_DestroyRotOtherStateType( OtherState_init, ErrStat2, ErrMsg2 ) end subroutine cleanup - END SUBROUTINE RotJacobianPContState + + !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd are returned. SUBROUTINE AD_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) -!.................................................................................................................................. - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -6136,72 +6058,38 @@ SUBROUTINE AD_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point TYPE(AD_OutputType), INTENT(IN ) :: y !< Output (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 dYdxd. TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdxd(:,:) !< Partial derivatives of output functions - !! (Y) with respect to the discrete - !! states (xd) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdxd(:,:) !< Partial derivatives of continuous state - !! functions (X) with respect to the - !! discrete states (xd) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddxd(:,:)!< Partial derivatives of discrete state - !! functions (Xd) with respect to the - !! discrete states (xd) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdxd(:,:) !< Partial derivatives of constraint state - !! functions (Z) with respect to the - !! discrete states (xd) [intent in to avoid deallocation] - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' + return; ! nothing to do here - IF ( PRESENT( dYdxd ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd) here: - - ! allocate and set dYdxd - - END IF - - IF ( PRESENT( dXdxd ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd) here: - - ! allocate and set dXdxd - - END IF - - IF ( PRESENT( dXddxd ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd) here: - - ! allocate and set dXddxd - - END IF - - IF ( PRESENT( dZdxd ) ) THEN - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd) here: - - ! allocate and set dZdxd - - END IF +! 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 AD_JacobianPDiscState -END SUBROUTINE AD_JacobianPDiscState !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and dZ/dz are returned. SUBROUTINE AD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) -!.................................................................................................................................. - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -6210,25 +6098,14 @@ SUBROUTINE AD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point TYPE(AD_OutputType), INTENT(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 dYdz. TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: 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] - ! + integer(IntKi), parameter :: iR =1 ! Rotor index if (size(p%rotors)>1) then @@ -6240,12 +6117,12 @@ SUBROUTINE AD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat call RotJacobianPConstrState( t, u%rotors(iR), m%Inflow(1)%RotInflow(iR), p%rotors(iR), p, x%rotors(iR), xd%rotors(iR), z%rotors(iR), OtherState%rotors(iR), y%rotors(iR), m%rotors(iR), m, iR, errStat, errMsg, dYdz, dXdz, dXddz, dZdz ) END SUBROUTINE AD_JacobianPConstrState + + !---------------------------------------------------------------------------------------------------------------------------------- !> 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 RotJacobianPConstrState( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) -!.................................................................................................................................. - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Inflow on rotor @@ -6256,26 +6133,15 @@ SUBROUTINE RotJacobianPConstrState( t, u, RotInflow, p, p_AD, x, xd, z, OtherSta TYPE(RotConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point TYPE(RotOtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point TYPE(RotOutputType), 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 dYdz. TYPE(RotMiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables TYPE(AD_MiscVarType), INTENT(INOUT) :: m_AD !< misc variables INTEGER, INTENT(IN ) :: iRot !< Rotor index, needed for OLAF INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: 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 TYPE(RotOutputType) :: y_p @@ -6292,21 +6158,14 @@ SUBROUTINE RotJacobianPConstrState( t, u, RotInflow, p, p_AD, x, xd, z, OtherSta character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_JacobianPConstrState' - - ! local variables - - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' ! get OP values here: !call AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) ! (bjj: is this necessary? if not, still need to get BEMT inputs) - call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call BEMT_CopyInput( m%BEMT_u(indx), m%BEMT_u(op_indx), MESH_UPDATECOPY, ErrStat2, ErrMsg2) ! copy the BEMT OP inputs to a temporary location that won't be overwritten - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call SetInputs(t, p, p_AD, u, RotInflow, m, indx, errStat2, errMsg2); if (Failed()) return; + call BEMT_CopyInput( m%BEMT_u(indx), m%BEMT_u(op_indx), MESH_UPDATECOPY, ErrStat2, ErrMsg2); if (Failed()) return; ! copy the BEMT OP inputs to a temporary location that won't be overwritten if ( p%DBEMT_Mod == DBEMT_frozen ) then @@ -6317,39 +6176,21 @@ SUBROUTINE RotJacobianPConstrState( t, u, RotInflow, p, p_AD, x, xd, z, OtherSta ! make a copy of the constraint states to perturb - call AD_CopyRotConstraintStateType( z, z_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AD_CopyRotConstraintStateType( z, z_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return; - - IF ( PRESENT( dYdz ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here: + ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z): + IF ( PRESENT( dYdz ) ) THEN ! allocate and set dYdz if (.not. allocated(dYdz) ) then - call AllocAry(dYdz,p%Jac_ny, size(z%BEMT%phi),'dYdz', ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dYdz,p%Jac_ny, size(z%BEMT%phi),'dYdz', ErrStat2, ErrMsg2); if (Failed()) return; end if ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call AD_CopyRotOutputType( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyRotOutputType( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - + call AD_CopyRotOutputType( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return; + call AD_CopyRotOutputType( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2); if (Failed()) return; do k=1,p%NumBlades ! size(z%BEMT%Phi,2) do j=1,p%NumBlNds ! size(z%BEMT%Phi,1) @@ -6368,37 +6209,22 @@ SUBROUTINE RotJacobianPConstrState( t, u, RotInflow, p, p_AD, x, xd, z, OtherSta z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) + delta_p ! compute y at z_op + delta_p z - call RotCalcOutput( t, u, RotInflow, p, p_AD, x, xd, z_perturb, OtherState, y_p, m, m_AD, iRot, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - + call RotCalcOutput( t, u, RotInflow, p, p_AD, x, xd, z_perturb, OtherState, y_p, m, m_AD, iRot, ErrStat2, ErrMsg2 ) ; if (Failed()) return; ! get z_op - delta_m z z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) - delta_m ! compute y at z_op - delta_m z - call RotCalcOutput( t, u, RotInflow, p, p_AD, x, xd, z_perturb, OtherState, y_m, m, m_AD, iRot, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - + call RotCalcOutput( t, u, RotInflow, p, p_AD, x, xd, z_perturb, OtherState, y_m, m, m_AD, iRot, ErrStat2, ErrMsg2 ) ; if (Failed()) return; ! get central difference: call Compute_dY( p, p_AD, y_p, y_m, delta_p, delta_m, dYdz(:,i) ) - ! put z_perturb back (for next iteration): z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) end if - end do end do - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call AD_DestroyRotOutputType( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyRotOutputType( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - END IF IF ( PRESENT( dXdz ) ) THEN @@ -6409,29 +6235,18 @@ SUBROUTINE RotJacobianPConstrState( t, u, RotInflow, p, p_AD, x, xd, z, OtherSta if (allocated(dXddz)) deallocate(dXddz) END IF + + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z): IF ( PRESENT(dZdz) ) THEN - call CheckLinearizationInput(p%BEMT, m%BEMT_u(op_indx), z%BEMT, m%BEMT, OtherState%BEMT, ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here: + call CheckLinearizationInput(p%BEMT, m%BEMT_u(op_indx), z%BEMT, m%BEMT, OtherState%BEMT, ErrStat2, ErrMsg2) ; if (Failed()) return; ! allocate and set dZdz if (.not. allocated(dZdz)) then - call AllocAry(dZdz,size(z%BEMT%phi), size(z%BEMT%phi),'dZdz', ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call AllocAry(dZdz,size(z%BEMT%phi), size(z%BEMT%phi),'dZdz', ErrStat2, ErrMsg2); if (Failed()) return; end if - - call AD_CopyRotConstraintStateType( z, z_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + call AD_CopyRotConstraintStateType( z, z_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); if (Failed()) return; do k=1,p%NumBlades ! size(z%BEMT%Phi,2) do j=1,p%NumBlNds ! size(z%BEMT%Phi,1) @@ -6449,23 +6264,15 @@ SUBROUTINE RotJacobianPConstrState( t, u, RotInflow, p, p_AD, x, xd, z, OtherSta z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) + delta_p ! compute z_p at z_op + delta_p z - call RotCalcConstrStateResidual( t, u, RotInflow, p, p_AD, x, xd, z_perturb, OtherState, m, z_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + call RotCalcConstrStateResidual( t, u, RotInflow, p, p_AD, x, xd, z_perturb, OtherState, m, z_p, ErrStat2, ErrMsg2 ) ; if (Failed()) return; ! get z_op - delta_m z z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) - delta_m ! compute z_m at u_op - delta_m u - call RotCalcConstrStateResidual( t, u, RotInflow, p, p_AD, x, xd, z_perturb, OtherState, m, z_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if + call RotCalcConstrStateResidual( t, u, RotInflow, p, p_AD, x, xd, z_perturb, OtherState, m, z_m, ErrStat2, ErrMsg2 ) ; if (Failed()) return; ! get central difference: - do k2=1,p%NumBlades ! size(z%BEMT%Phi,2) do j2=1,p%NumBlNds ! size(z%BEMT%Phi,1) n = (k2-1)*p%NumBlNds + j2 @@ -6482,15 +6289,17 @@ SUBROUTINE RotJacobianPConstrState( t, u, RotInflow, p, p_AD, x, xd, z, OtherSta end do end do - - call AD_DestroyRotConstraintStateType( z_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyRotConstraintStateType( z_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - 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() m%BEMT%UseFrozenWake = .false. @@ -6502,10 +6311,10 @@ subroutine cleanup() end subroutine cleanup END SUBROUTINE RotJacobianPConstrState + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. SUBROUTINE AD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters @@ -6538,8 +6347,8 @@ END SUBROUTINE AD_GetOP !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. +!! NOTE: the order here needs to exactly match the order in Init_Jacobian_u. SUBROUTINE RotGetOP( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(RotInputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(RotInflowType), INTENT(IN ) :: RotInflow !< Rotor Inflow at operating point (may change to inout if a mesh copy is required) @@ -6567,8 +6376,9 @@ SUBROUTINE RotGetOP( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrSt CHARACTER(*), PARAMETER :: RoutineName = 'AD_GetOP' LOGICAL :: FieldMask(FIELDMASK_SIZE) TYPE(RotContinuousStateType) :: dxdt + real(ReKi) :: OP_out(3) !< operating point of wind (HWindSpeed, PLexp, and AngleH) + - ! Initialize ErrStat ErrStat = ErrID_None @@ -6577,141 +6387,170 @@ SUBROUTINE RotGetOP( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrSt IF ( PRESENT( u_op ) ) THEN nu = size(p%Jac_u_indx,1) do i=1,p%NumBl_Lin - nu = nu + u%BladeMotion(i)%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - end do + nu = nu + u%BladeMotion(i)%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM + end do if (.not. p_AD%CompAeroMaps) then - nu = nu + u%TowerMotion%NNodes * 6 & ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - + u%hubMotion%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM + nu = nu + u%NacelleMotion%NNodes * 6 & ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM + + u%HubMotion%NNodes * 6 & ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM + + u%TowerMotion%NNodes * 6 & ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM + + u%TFinMotion%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM do i=1,p%NumBlades nu = nu + u%BladeRootMotion(i)%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - end do + end do end if - + if (.not. allocated(u_op)) then - call AllocAry(u_op, nu, 'u_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call AllocAry(u_op, nu, 'u_op', ErrStat2, ErrMsg2); if (Failed()) return end if - + index = 1 if (.not. p_AD%CompAeroMaps) then + !------------------------------ + ! Nacelle + ! Module/Mesh/Field: u%NacelleMotion%TranslationDisp + ! Module/Mesh/Field: u%NacelleMotion%Orientation FieldMask = .false. FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - call PackMotionMesh(u%TowerMotion, u_op, index, FieldMask=FieldMask) - - FieldMask(MASKID_TRANSLATIONVel) = .false. - FieldMask(MASKID_RotationVel) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + call PackMotionMesh(u%NacelleMotion, u_op, index, FieldMask=FieldMask) + + !------------------------------ + ! Hub + ! Module/Mesh/Field: u%HubMotion%TranslationDisp + ! Module/Mesh/Field: u%HubMotion%Orientation + ! Module/Mesh/Field: u%HubMotion%RotationVel + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + FieldMask(MASKID_ROTATIONVEL) = .true. call PackMotionMesh(u%HubMotion, u_op, index, FieldMask=FieldMask) - + + !------------------------------ + ! TailFin + ! Module/Mesh/Field: u%TFinMotion%TranslationDisp + ! Module/Mesh/Field: u%TFinMotion%Orientation + ! Module/Mesh/Field: u%TFinMotion%TranslationVel + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + FieldMask(MASKID_TRANSLATIONVEL) = .true. + call PackMotionMesh(u%TFinMotion, u_op, index, FieldMask=FieldMask) + + !------------------------------ + ! Tower + ! Module/Mesh/Field: u%TowerMotion%TranslationDisp + ! Module/Mesh/Field: u%TowerMotion%Orientation + ! Module/Mesh/Field: u%TowerMotion%TranslationVel + ! Module/Mesh/Field: u%TowerMotion%TranslationAcc FieldMask = .false. - FieldMask(MASKID_Orientation) = .true. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + FieldMask(MASKID_TRANSLATIONVEL) = .true. + FieldMask(MASKID_TRANSLATIONACC) = .true. + call PackMotionMesh(u%TowerMotion, u_op, index, FieldMask=FieldMask) + + !------------------------------ + ! Blade Root + ! Module/Mesh/Field: u%BladeRootMotion(1)%Orientation + ! Module/Mesh/Field: u%BladeRootMotion(2)%Orientation + ! Module/Mesh/Field: u%BladeRootMotion(3)%Orientation + FieldMask = .false. + FieldMask(MASKID_ORIENTATION) = .true. do k = 1,p%NumBlades call PackMotionMesh(u%BladeRootMotion(k), u_op, index, FieldMask=FieldMask) end do - + endif + + + !------------------------------ + ! Blade + ! Module/Mesh/Field: u%BladeMotion(k)%TranslationDisp + ! Module/Mesh/Field: u%BladeMotion(k)%Orientation + ! Module/Mesh/Field: u%BladeMotion(k)%TranslationVel + ! Module/Mesh/Field: u%BladeMotion(k)%RotationVel + ! Module/Mesh/Field: u%BladeMotion(k)%TranslationAcc + ! Module/Mesh/Field: u%BladeMotion(k)%RotationalAcc + if (.not. p_AD%CompAeroMaps) then + FieldMask = .false. FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TRANSLATIONAcc) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + FieldMask(MASKID_TRANSLATIONVEL) = .true. + FieldMask(MASKID_ROTATIONVEL) = .true. + FieldMask(MASKID_TRANSLATIONACC) = .true. + FieldMask(MASKID_ROTATIONACC) = .true. else FieldMask = .false. FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. + FieldMask(MASKID_ORIENTATION) = .true. FieldMask(MASKID_TRANSLATIONVel) = .true. end if - do k=1,p%NumBl_Lin call PackMotionMesh(u%BladeMotion(k), u_op, index, FieldMask=FieldMask) end do - - if (.not. p_AD%CompAeroMaps) then - do k=1,p%NumBlades - do i=1,p%NumBlNds - do j=1,3 - u_op(index) = RotInflow%Bld(k)%InflowOnBlade(j,i) - index = index + 1 - end do - end do - end do - do i=1,p%NumTwrNds - do j=1,3 - u_op(index) = RotInflow%InflowOnTower(j,i) - index = index + 1 - end do - end do + if (.not. p_AD%CompAeroMaps) then + !------------------------------ ! UserProp + ! Module/Mesh/Field: u%UserProp(:,:) do k=1,p%NumBlades do j = 1, size(u%UserProp,1) ! Number of nodes for a blade u_op(index) = u%UserProp(j,k) index = index + 1 end do end do - - ! AvgDiskVel - !do i=1,3 - ! u_op(index) = RotInflow%AvgDiskVel(i) - ! index = index + 1 - !end do - - ! I'm not including this in the linearization yet - !do i=1,u%NacelleMotion%NNodes ! 1 or 0 - ! do j=1,3 - ! u_op(index) = RotInflow%InflowOnNacelle(j) - ! index = index + 1 - ! end do - !end do - ! - !do i=1,u%HubMotion%NNodes ! 1 - ! do j=1,3 - ! u_op(index) = RotInflow%InflowOnHub(j) - ! index = index + 1 - ! end do - !end do + + !------------------------------ + ! Extended inputs -- Linearization is only possible with Steady or Uniform Wind, so take advantage of that here + ! Module/Mesh/Field: HWindSpeed = 37 + ! Module/Mesh/Field: PLexp = 38 + ! Module/Mesh/Field: PropagationDir = 39 + call IfW_UniformWind_GetOP(p_AD%FlowField%Uniform, t, .false. , OP_out) + ! HWindSpeed + u_op(index) = OP_out(1); index = index + 1 + ! PLexp + u_op(index) = OP_out(2); index = index + 1 + ! PropagationDir (include AngleH in calculation if any) + u_op(index) = OP_out(3) + p_AD%FlowField%PropagationDir; index = index + 1 end if END IF IF ( PRESENT( y_op ) ) THEN - + if (.not. allocated(y_op)) then - call AllocAry(y_op, p%Jac_ny, 'y_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call AllocAry(y_op, p%Jac_ny, 'y_op', ErrStat2, ErrMsg2); if (Failed()) return end if - - index = 1 - if (.not. p_AD%CompAeroMaps) call PackLoadMesh(y%TowerLoad, y_op, index) + if (.not. p_AD%CompAeroMaps) then + call PackLoadMesh(y%NacelleLoad, y_op, index) + call PackLoadMesh(y%HubLoad, y_op, index) + call PackLoadMesh(y%TFinLoad, y_op, index) + call PackLoadMesh(y%TowerLoad, y_op, index) + endif do k=1,p%NumBl_Lin - call PackLoadMesh(y%BladeLoad(k), y_op, index) + call PackLoadMesh(y%BladeLoad(k), y_op, index) end do - + if (.not. p_AD%CompAeroMaps) then index = index - 1 do i=1,p%NumOuts + p%BldNd_TotNumOuts y_op(i+index) = y%WriteOutput(i) - end do + end do end if - + END IF IF ( PRESENT( x_op ) ) THEN - + if (.not. allocated(x_op)) then - call AllocAry(x_op, p%BEMT%DBEMT%lin_nx + p%BEMT%UA%lin_nx + p%BEMT%lin_nx,'x_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return + call AllocAry(x_op, p%BEMT%DBEMT%lin_nx + p%BEMT%UA%lin_nx + p%BEMT%lin_nx,'x_op',ErrStat2,ErrMsg2); if (Failed()) return end if index = 1 - ! set linearization operating points: + ! set linearization operating points: if (p%BEMT%DBEMT%lin_nx>0) then do j=1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) do i=1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) @@ -6721,7 +6560,7 @@ SUBROUTINE RotGetOP( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrSt end do end do end do - + do j=1,p%NumBlades ! size(x%BEMT%DBEMT%element,2) do i=1,p%NumBlNds ! size(x%BEMT%DBEMT%element,1) do k=1,size(x%BEMT%DBEMT%element(i,j)%vind_1) @@ -6730,8 +6569,8 @@ SUBROUTINE RotGetOP( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrSt end do end do end do - end if + ! UA states if (p%BEMT%UA%lin_nx>0) then do n=1,p%BEMT%UA%lin_nx @@ -6739,11 +6578,11 @@ SUBROUTINE RotGetOP( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrSt j = p%BEMT%UA%lin_xIndx(n,2) k = p%BEMT%UA%lin_xIndx(n,3) x_op(index) = x%BEMT%UA%element(i,j)%x(k) - + index = index + 1 end do - end if + ! BEMT states if (p%BEMT%lin_nx>0) then !do k = 1,size(x%BEMT%V_w) @@ -6751,24 +6590,17 @@ SUBROUTINE RotGetOP( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrSt ! index = index + 1 !end do end if - + END IF IF ( PRESENT( dx_op ) ) THEN - + if (.not. allocated(dx_op)) then - call AllocAry(dx_op, p%BEMT%DBEMT%lin_nx + p%BEMT%UA%lin_nx + p%BEMT%lin_nx,'dx_op',ErrStat2,ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) return + call AllocAry(dx_op, p%BEMT%DBEMT%lin_nx + p%BEMT%UA%lin_nx + p%BEMT%lin_nx,'dx_op',ErrStat2,ErrMsg2); if (Failed()) return end if - call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call AD_DestroyRotContinuousStateType( dxdt, ErrStat2, ErrMsg2) - return - end if - + call RotCalcContStateDeriv(t, u, RotInflow, p, p_AD, x, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2); if (Failed()) return + index = 1 ! set linearization operating points: if (p%BEMT%DBEMT%lin_nx>0) then @@ -6781,7 +6613,7 @@ SUBROUTINE RotGetOP( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrSt end do end do end do - + do j=1,p%NumBlades ! size(dxdt%BEMT%DBEMT%element,2) do i=1,p%NumBlNds ! size(dxdt%BEMT%DBEMT%element,1) do k=1,size(dxdt%BEMT%DBEMT%element(i,j)%vind_1) @@ -6790,7 +6622,7 @@ SUBROUTINE RotGetOP( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrSt end do end do end do - + end if ! UA states derivatives if (p%BEMT%UA%lin_nx>0) then @@ -6799,37 +6631,35 @@ SUBROUTINE RotGetOP( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrSt j = p%BEMT%UA%lin_xIndx(n,2) k = p%BEMT%UA%lin_xIndx(n,3) dx_op(index) = dxdt%BEMT%UA%element(i,j)%x(k) - + index = index + 1 end do end if - ! BEMT states derivatives + ! BEMT states derivatives if (p%BEMT%lin_nx>0) then - call SetErrStat(ErrID_Fatal,'Number of lin states for bem should be zero for now.', ErrStat, ErrMsg, RoutineName) - return + ErrStat2=ErrID_Fatal + ErrMsg2='Number of lin states for bem should be zero for now.' + if (Failed()) return !do k = 1,size(x%BEMT%V_w) ! dx_op(index) = dxdt%BEMT%v_w(k) ! index = index + 1 !end do end if - - call AD_DestroyRotContinuousStateType( dxdt, ErrStat2, ErrMsg2) - + + END IF IF ( PRESENT( xd_op ) ) THEN END IF - + IF ( PRESENT( z_op ) ) THEN if (.not. allocated(z_op)) then - call AllocAry(z_op, p%NumBlades*p%NumBlNds, 'z_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + call AllocAry(z_op, p%NumBlades*p%NumBlNds, 'z_op', ErrStat2, ErrMsg2); if (Failed()) return end if - - + + index = 1 do k=1,p%NumBlades ! size(z%BEMT%Phi,2) do i=1,p%NumBlNds ! size(z%BEMT%Phi,1) @@ -6837,23 +6667,33 @@ SUBROUTINE RotGetOP( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ErrSt index = index + 1 end do end do - + END IF +contains + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) call Cleanup() + end function Failed + + subroutine cleanup() + call AD_DestroyRotContinuousStateType( dxdt, ErrStat2, ErrMsg2) + end subroutine cleanup END SUBROUTINE RotGetOP + + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ SUBROUTINE Init_Jacobian_y( p, p_AD, y, InitOut, ErrStat, ErrMsg) - TYPE(RotParameterType) , INTENT(INOUT) :: p !< parameters TYPE(AD_ParameterType) , INTENT(INOUT) :: p_AD !< parameters TYPE(RotOutputType) , INTENT(IN ) :: y !< outputs TYPE(RotInitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! local variables: - INTEGER(IntKi) :: i, j, k, indx_next, indx_last + INTEGER(IntKi) :: i, j, k, indx_next, indx_last INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian_y' @@ -6868,7 +6708,10 @@ SUBROUTINE Init_Jacobian_y( p, p_AD, y, InitOut, ErrStat, ErrMsg) if (p_AD%CompAeroMaps) then p%Jac_ny = 0 ! we skip tower and writeOutput values in the solve (note: y%TowerLoad%NNodes=0) else - p%Jac_ny = y%TowerLoad%NNodes * 6 & ! 3 forces + 3 moments at each node + p%Jac_ny = y%NacelleLoad%NNodes * 6 & ! 3 forces + 3 moments at each node + + y%HubLoad%NNodes * 6 & ! 3 forces + 3 moments at each node + + y%TFinLoad%NNodes * 6 & ! 3 forces + 3 moments at each node + + y%TowerLoad%NNodes * 6 & ! 3 forces + 3 moments at each node + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values end if @@ -6878,23 +6721,28 @@ SUBROUTINE Init_Jacobian_y( p, p_AD, y, InitOut, ErrStat, ErrMsg) ! get the names of the linearized outputs: - call AllocAry(InitOut%LinNames_y, p%Jac_ny,'LinNames_y',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(InitOut%RotFrame_y, p%Jac_ny,'RotFrame_y',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return + call AllocAry(InitOut%LinNames_y, p%Jac_ny,'LinNames_y',ErrStat2,ErrMsg2); if (Failed()) return + call AllocAry(InitOut%RotFrame_y, p%Jac_ny,'RotFrame_y',ErrStat2,ErrMsg2); if (Failed()) return InitOut%RotFrame_y = .false. ! default all to false, then set the true ones below indx_next = 1 - if (.not. p_AD%CompAeroMaps) call PackLoadMesh_Names(y%TowerLoad, 'Tower', InitOut%LinNames_y, indx_next) ! note: y%TowerLoad%NNodes=0 for aeroMaps + if (.not. p_AD%CompAeroMaps) then + p%Jac_y_idxStartList%NacelleLoad = indx_next; call PackLoadMesh_Names(y%NacelleLoad, 'Nacelle', InitOut%LinNames_y, indx_next) + p%Jac_y_idxStartList%HubLoad = indx_next; call PackLoadMesh_Names(y%HubLoad, 'Hub', InitOut%LinNames_y, indx_next) + p%Jac_y_idxStartList%TFinLoad = indx_next; call PackLoadMesh_Names(y%TFinLoad, 'TailFin', InitOut%LinNames_y, indx_next) + p%Jac_y_idxStartList%TowerLoad = indx_next; call PackLoadMesh_Names(y%TowerLoad, 'Tower', InitOut%LinNames_y, indx_next) ! note: y%TowerLoad%NNodes=0 for aeroMaps + endif indx_last = indx_next + p%Jac_y_idxStartList%BladeLoad = indx_next; do k=1,p%NumBl_Lin call PackLoadMesh_Names(y%BladeLoad(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_y, indx_next) end do ! InitOut%RotFrame_y(indx_last:indx_next-1) = .true. ! The mesh fields are in the global frame, so are not in the rotating frame if (.not. p_AD%CompAeroMaps) then - + ! Outputs do i=1,p%NumOuts + p%BldNd_TotNumOuts InitOut%LinNames_y(i+indx_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) !trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units end do @@ -6902,8 +6750,9 @@ SUBROUTINE Init_Jacobian_y( p, p_AD, y, InitOut, ErrStat, ErrMsg) ! check for all the WriteOutput values that are functions of blade number: allocate( AllOut(0:MaxOutPts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels if (ErrStat2 /=0 ) then - call SetErrStat(ErrID_Info, 'error allocating temporary space for AllOut',ErrStat,ErrMsg,RoutineName) - return; + ErrStat2 = ErrID_Info + ErrMsg2 = 'error allocating temporary space for AllOut' + if (Failed()) return end if AllOut = .false. @@ -6969,27 +6818,35 @@ SUBROUTINE Init_Jacobian_y( p, p_AD, y, InitOut, ErrStat, ErrMsg) !AbsCant, AbsToe, AbsTwist should probably be set to .false. end do - - deallocate(AllOut) - end if - + + call Cleanup() + +contains + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + if (Failed) call Cleanup() + end function Failed + + subroutine Cleanup() + if (allocated(AllOut)) deallocate(AllOut) + end subroutine Cleanup END SUBROUTINE Init_Jacobian_y + + !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE Init_Jacobian_u( InputFileData, p, p_AD, u, InitOut, ErrStat, ErrMsg) - TYPE(RotInputFile) , INTENT(IN ) :: InputFileData !< input file data (for default blade perturbation) TYPE(RotParameterType) , INTENT(INOUT) :: p !< parameters TYPE(AD_ParameterType) , INTENT(INOUT) :: p_AD !< parameters TYPE(RotInputType) , INTENT(IN ) :: u !< inputs -! TYPE(RotInflowType) , INTENT(IN ) :: RotInflow !< rotor inflow TYPE(RotInitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - + ! local variables: - INTEGER(IntKi) :: i, j, k, index, index_last, nu, i_meshField + INTEGER(IntKi) :: i, j, k, index, indexNames, index_last, nu, i_meshField INTEGER(IntKi) :: NumFieldsForLinearization REAL(ReKi) :: perturb, perturb_t, perturb_b(MaxBl) LOGICAL :: FieldMask(FIELDMASK_SIZE) @@ -6997,321 +6854,303 @@ SUBROUTINE Init_Jacobian_u( InputFileData, p, p_AD, u, InitOut, ErrStat, ErrMsg) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian_u' - + ErrStat = ErrID_None ErrMsg = "" - - + + p%NumExtendedInputs = 3 ! Extended inputs from InflowWind: HWindSpeed, PLexp, PropagationDir + ! determine how many inputs there are in the Jacobians if (p_AD%CompAeroMaps) then nu = 0 - + NumFieldsForLinearization = 3 ! Translation Displacements + orientations + Translation velocities at each node on the blade mesh else - nu = u%TowerMotion%NNodes * 9 & ! 3 Translation Displacements + 3 orientations + 3 Translation velocities at each node - + u%hubMotion%NNodes * 9 & ! 3 Translation Displacements + 3 orientations + 3 Rotation velocities at each node -! + size( RotInflow%InflowOnTower) & !note that we are not passing the inflow on nacelle or hub here - + size( u%UserProp) - !+ 3 ! 3 velocity components in AvgDiskVel; note that we are not passing the inflow on nacelle or hub here - -! do k=1,size(RotInflow%Bld) ! hopefully this is allocated -! nu = nu + size(RotInflow%Bld(k)%InflowOnBlade) -! end do - - NumFieldsForLinearization = 5 ! Translation Displacements + orientations + Translation velocities + Rotation velocities + TranslationAcc at each node on the blade mesh + nu = u%NacelleMotion%NNodes * 6 & ! 3 Translation Displacements + 3 orientations + + u%hubMotion%NNodes * 9 & ! 3 Translation Displacements + 3 orientations + 3 Rotation velocities + + u%TowerMotion%NNodes * 12 & ! 3 Translation Displacements + 3 orientations + 3 Translation velocities + 3 Translation Accelerations + + u%TFinMotion%NNodes * 9 & ! 3 Translation Displacements + 3 orientations + 3 Translation velocities + + size( u%UserProp) & ! typically number of blades + + p%NumExtendedInputs + + NumFieldsForLinearization = 6 ! Translation Displacements + orientations + Translation velocities + Rotation velocities + TranslationAcc + RotationAcc at each node on the blade mesh do i=1,p%NumBlades nu = nu + u%BladeRootMotion(i)%NNodes * 3 ! 3 orientations at each node end do end if - + do i=1,p%NumBl_Lin - nu = nu + u%BladeMotion(i)%NNodes * 3*NumFieldsForLinearization ! 3 components per field + nu = nu + u%BladeMotion(i)%NNodes * 3*NumFieldsForLinearization ! 3 components per additional field end do ! all other inputs ignored - - !............................ + + !............................ ! fill matrix to store index to help us figure out what the ith value of the u vector really means ! (see aerodyn::perturb_u ... these MUST match ) ! column 1 indicates module's mesh and field ! column 2 indicates the first index (x-y-z component) of the field ! column 3 is the node - !............................ - - call allocAry( p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - !............... - ! AD input mappings stored in p%Jac_u_indx: - !............... - index = 1 - - if (.not. p_AD%CompAeroMaps) then - - !Module/Mesh/Field: u%TowerMotion%TranslationDisp = 1; - !Module/Mesh/Field: u%TowerMotion%Orientation = 2; - !Module/Mesh/Field: u%TowerMotion%TranslationVel = 3; - do i_meshField = 1,3 - do i=1,u%TowerMotion%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - !Module/Mesh/Field: u%HubMotion%TranslationDisp = 4; - !Module/Mesh/Field: u%HubMotion%Orientation = 5; - !Module/Mesh/Field: u%HubMotion%RotationVel = 6; - do i_meshField = 4,6 - do i=1,u%HubMotion%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - !bjj: if MaxBl (max blades) changes, we need to modify this - !Module/Mesh/Field: u%BladeRootMotion(1)%Orientation = 7; - !Module/Mesh/Field: u%BladeRootMotion(2)%Orientation = 8; - !Module/Mesh/Field: u%BladeRootMotion(3)%Orientation = 9; - do k=1,p%NumBlades - do i_meshField = 6,6 - do i=1,u%BladeRootMotion(k)%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField + k - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - - end do !i_meshField - end do !k - - end if ! .not. compAeroMaps - - !bjj: if MaxBl (max blades) changes, we need to modify this - !Module/Mesh/Field: u%BladeMotion(1)%TranslationDisp = 10; - !Module/Mesh/Field: u%BladeMotion(1)%Orientation = 11; - !Module/Mesh/Field: u%BladeMotion(1)%TranslationVel = 12; - !Module/Mesh/Field: u%BladeMotion(1)%RotationVel = 13; - !Module/Mesh/Field: u%BladeMotion(1)%TranslationAcc = 14; - - !Module/Mesh/Field: u%BladeMotion(2)%TranslationDisp = 15; - !Module/Mesh/Field: u%BladeMotion(2)%Orientation = 16; - !Module/Mesh/Field: u%BladeMotion(2)%TranslationVel = 17; - !Module/Mesh/Field: u%BladeMotion(2)%RotationVel = 18; - !Module/Mesh/Field: u%BladeMotion(2)%TranslationAcc = 19; - - !Module/Mesh/Field: u%BladeMotion(3)%TranslationDisp = 20; - !Module/Mesh/Field: u%BladeMotion(3)%Orientation = 21; - !Module/Mesh/Field: u%BladeMotion(3)%TranslationVel = 22; - !Module/Mesh/Field: u%BladeMotion(3)%RotationVel = 23; - !Module/Mesh/Field: u%BladeMotion(3)%TranslationAcc = 24; - do k=1,p%NumBl_Lin - do i_meshField = 1,NumFieldsForLinearization - do i=1,u%BladeMotion(k)%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = 9 + i_meshField + (k-1)*5 ! this should use the MAX possible NumFieldsForLinearization = 5 (so that it's consistent for all cases) - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - - end do !i_meshField - end do !k - - if (.not. p_AD%CompAeroMaps) then - -!FIXME: move to extended inputs -! !Module/Mesh/Field: u%InflowOnBlade(:,:,1) = 25; -! !Module/Mesh/Field: u%InflowOnBlade(:,:,2) = 26; -! !Module/Mesh/Field: u%InflowOnBlade(:,:,3) = 27; -! do k=1,size(RotInflow%Bld) ! p%NumBlades -! do i=1,size(RotInflow%Bld(k)%InflowOnBlade,2) ! numNodes -! do j=1,3 -! p%Jac_u_indx(index,1) = 24 + k -! p%Jac_u_indx(index,2) = j !component index: j -! p%Jac_u_indx(index,3) = i !Node: i -! index = index + 1 -! end do !j -! end do !i -! end do !k -! -! !Module/Mesh/Field: u%InflowOnTower(:,:) = 28; -! do i=1,size(RotInflow%InflowOnTower,2) ! numNodes -! do j=1,3 -! p%Jac_u_indx(index,1) = 28 -! p%Jac_u_indx(index,2) = j !component index: j -! p%Jac_u_indx(index,3) = i !Node: i -! index = index + 1 -! end do !j -! end do !i -! -! !Module/Mesh/Field: u%UserProp(:,:) = 29,30,31; -! do k=1,size(u%UserProp,2) ! p%NumBlades -! do i=1,size(u%UserProp,1) ! numNodes -! p%Jac_u_indx(index,1) = 28 + k -! p%Jac_u_indx(index,2) = 1 !component index: this is a scalar, so 1, but is never used -! p%Jac_u_indx(index,3) = i !Node: i -! index = index + 1 -! end do !i -! end do !k -! -! !Module/Mesh/Field: u%AvgDiskVel(:,:) = 32; - !do j=1,3 - ! p%Jac_u_indx(index,1) = 32 - ! p%Jac_u_indx(index,2) = j !component index: j - ! p%Jac_u_indx(index,3) = 1 !Node: 1 (not really necessary here, since we have only a 1 dimensional array) - ! index = index + 1 - !end do !j - - - end if ! .not. compAeroMaps - - !...................................... - ! default perturbations, p%du: - !...................................... - call allocAry( p%du, 31, 'p%du', ErrStat2, ErrMsg2) ! 31 = number of unique values in p%Jac_u_indx(:,1) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + !............................ + call allocAry( p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%RotFrame_u, nu, 'RotFrame_u', ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%IsLoad_u, nu, 'IsLoad_u', ErrStat2, ErrMsg2); if (Failed()) return + + ! perturbations + call allocAry( p%du, 39, 'p%du', ErrStat2, ErrMsg2); if (Failed()) return ! number of unique values in p%Jac_u_indx(:,1) (check below) perturb = 2*D2R - - do k=1,p%NumBlades + do k=1,p%NumBl_Lin perturb_b(k) = 0.2_ReKi*D2R * InputFileData%BladeProps(k)%BlSpn( InputFileData%BladeProps(k)%NumBlNds ) end do - if ( u%TowerMotion%NNodes > 0) then perturb_t = 0.2_ReKi*D2R * u%TowerMotion%Position( 3, u%TowerMotion%NNodes ) else perturb_t = 0.0_ReKi - end if - - p%du(1) = perturb_t ! u%TowerMotion%TranslationDisp = 1 - p%du(2) = perturb ! u%TowerMotion%Orientation = 2 - p%du(3) = perturb_t ! u%TowerMotion%TranslationVel = 3 - p%du(4) = perturb_b(1) ! u%HubMotion%TranslationDisp = 4 - p%du(5) = perturb ! u%HubMotion%Orientation = 5 - p%du(6) = perturb ! u%HubMotion%RotationVel = 6 - do i_meshField = 7,9 - p%du(i_meshField) = perturb ! u%BladeRootMotion(k)%Orientation = 6+k, for k in [1, 3] - end do - do k=1,p%NumBlades - p%du(10 + (k-1)*5) = perturb_b(k) ! u%BladeMotion(k)%TranslationDisp = 10 + (k-1)*5 - p%du(11 + (k-1)*5) = perturb ! u%BladeMotion(k)%Orientation = 11 + (k-1)*5 - p%du(12 + (k-1)*5) = perturb_b(k) ! u%BladeMotion(k)%TranslationVel = 12 + (k-1)*5 - p%du(13 + (k-1)*5) = perturb ! u%BladeMotion(k)%RotationVel = 13 + (k-1)*5 - p%du(14 + (k-1)*5) = perturb_b(k) ! u%BladeMotion(k)%TranslationAcc = 14 + (k-1)*5 !bjj: is the correct???? - end do - do k=1,p%NumBlades - p%du(24 + k) = perturb_b(k) ! u%InflowOnBlade(:,:,k) = 24 + k - end do - p%du(28) = perturb_t ! u%InflowOnTower(:,:) = 28 - do k=1,p%NumBl_Lin - p%du(28+k) = perturb ! u%UserProp(:,:) = 29,30,31 - end do - !p%du(32) = minval(perturb_b(1:p%numBlades)) ! u%AvgDiskVel(:) = 32 - - - !..................... - ! get names of linearized inputs - !..................... - call AllocAry(InitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%RotFrame_u, nu, 'RotFrame_u', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%IsLoad_u, nu, 'IsLoad_u', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + end if + ! initialize + p%Jac_u_indx = 0 + p%du = 0.0_R8Ki InitOut%IsLoad_u = .false. ! None of AeroDyn's inputs are loads InitOut%RotFrame_u = .false. - if (.not. p_AD%CompAeroMaps) then - do k=0,p%NumBl_Lin*p%NumBlNds-1 - InitOut%RotFrame_u(nu - k ) = .true. ! UserProp(:,:) ! TODO TODO TODO add -3 due to DiskAvgVel - end do - endif + + !=========================================================================== + ! AD input mappings stored in p%Jac_u_indx, perturbations in p%du + !=========================================================================== index = 1 - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - if (.not. p_AD%CompAeroMaps) call PackMotionMesh_Names(u%TowerMotion, 'Tower', InitOut%LinNames_u, index, FieldMask=FieldMask) - - FieldMask(MASKID_TRANSLATIONVel) = .false. - FieldMask(MASKID_RotationVel) = .true. - if (.not. p_AD%CompAeroMaps) call PackMotionMesh_Names(u%HubMotion, 'Hub', InitOut%LinNames_u, index, FieldMask=FieldMask) - - index_last = index - FieldMask = .false. - FieldMask(MASKID_Orientation) = .true. + if (.not. p_AD%CompAeroMaps) then - do k = 1,p%NumBlades - call PackMotionMesh_Names(u%BladeRootMotion(k), 'Blade root '//trim(num2lstr(k)), InitOut%LinNames_u, index, FieldMask=FieldMask) + !------------------------------ + ! Nacelle + ! Module/Mesh/Field: u%NacelleMotion%TranslationDisp = 1; + ! Module/Mesh/Field: u%NacelleMotion%Orientation = 2; + indexNames=index + p%Jac_u_idxStartList%Nacelle = index + call SetJac_u_idx(1,2,u%NacelleMotion%NNodes,index) + ! Perturbations + p%du(1) = perturb_b(1) + p%du(2) = perturb + ! Names + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + call PackMotionMesh_Names(u%NacelleMotion, 'Nacelle', InitOut%LinNames_u, indexNames, FieldMask=FieldMask) + + !------------------------------ + ! Hub + ! Module/Mesh/Field: u%HubMotion%TranslationDisp = 3; + ! Module/Mesh/Field: u%HubMotion%Orientation = 4; + ! Module/Mesh/Field: u%HubMotion%RotationVel = 5; + indexNames=index + p%Jac_u_idxStartList%Hub = index + call SetJac_u_idx(3,5,u%HubMotion%NNodes,index) + ! Perturbations + p%du(3) = perturb_b(1) + p%du(4) = perturb + p%du(5) = perturb + ! Names + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + FieldMask(MASKID_ROTATIONVEL) = .true. + call PackMotionMesh_Names(u%HubMotion, 'Hub', InitOut%LinNames_u, indexNames, FieldMask=FieldMask) + + + !------------------------------ + ! TailFin + ! Module/Mesh/Field: u%TFinMotion%TranslationDisp = 6; + ! Module/Mesh/Field: u%TFinMotion%Orientation = 7; + ! Module/Mesh/Field: u%TFinMotion%TranslationVel = 8; + indexNames=index + p%Jac_u_idxStartList%TFin = index + call SetJac_u_idx(6,8,u%TFinMotion%NNodes,index) + ! Perturbations + p%du(6) = perturb + p%du(7) = perturb + p%du(8) = perturb + ! Names + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + FieldMask(MASKID_TRANSLATIONVEL) = .true. + call PackMotionMesh_Names(u%TFinMotion, 'TailFin', InitOut%LinNames_u, indexNames, FieldMask=FieldMask) + + + !------------------------------ + ! Tower + ! Module/Mesh/Field: u%TowerMotion%TranslationDisp = 9; + ! Module/Mesh/Field: u%TowerMotion%Orientation = 10; + ! Module/Mesh/Field: u%TowerMotion%TranslationVel = 11; + ! Module/Mesh/Field: u%TowerMotion%TranslationAcc = 12; + indexNames=index + p%Jac_u_idxStartList%Tower = index + call SetJac_u_idx(9,12,u%TowerMotion%NNodes,index) + ! Perturbations + p%du( 9) = perturb_t + p%du(10) = perturb + p%du(11) = perturb_t + p%du(12) = perturb_t + ! Names + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + FieldMask(MASKID_TRANSLATIONVEL) = .true. + FieldMask(MASKID_TRANSLATIONACC) = .true. + call PackMotionMesh_Names(u%TowerMotion, 'Tower', InitOut%LinNames_u, indexNames, FieldMask=FieldMask) + + + !------------------------------ + ! Blade root (3 blade limit!!!!) + ! Module/Mesh/Field: u%BladeRootMotion(1)%Orientation = 13; + ! Module/Mesh/Field: u%BladeRootMotion(2)%Orientation = 14; + ! Module/Mesh/Field: u%BladeRootMotion(3)%Orientation = 15; + indexNames=index + p%Jac_u_idxStartList%BladeRoot = index + do k = 1,p%NumBl_Lin + call SetJac_u_idx(13+k-1,13+k-1,u%BladeRootMotion(k)%NNodes,index) end do - - - FieldMask(MASKID_RotationVel) = .true. - FieldMask(MASKID_TRANSLATIONAcc) = .true. - end if - - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - do k=1,p%NumBl_Lin - call PackMotionMesh_Names(u%BladeMotion(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_u, index, FieldMask=FieldMask) - end do - - if (.not. p_AD%CompAeroMaps) then - do k=1,p%NumBlades - do i=1,p%NumBlNds - do j=1,3 - InitOut%LinNames_u(index) = UVW(j)//'-component inflow on blade '//trim(num2lstr(k))//', node '//trim(num2lstr(i))//', m/s' - index = index + 1 - end do - end do + ! Perturbations + p%du(13) = perturb + p%du(14) = perturb + p%du(15) = perturb + ! Names + FieldMask = .false. + FieldMask(MASKID_Orientation) = .true. + do k = 1,p%NumBl_Lin + call PackMotionMesh_Names(u%BladeRootMotion(k), 'Blade root '//trim(num2lstr(k)), InitOut%LinNames_u, indexNames, FieldMask=FieldMask) end do - !InitOut%RotFrame_u(index_last:index-1) = .true. ! values on the mesh (and from IfW) are in global coordinates, thus not in the rotating frame + end if ! .not. compAeroMaps - do i=1,p%NumTwrNds - do j=1,3 - InitOut%LinNames_u(index) = UVW(j)//'-component inflow on tower node '//trim(num2lstr(i))//', m/s' - index = index + 1 - end do + + !------------------------------ + ! Blades (3 blade limit!!!!!) + ! Module/Mesh/Field: u%BladeMotion(1)%TranslationDisp = 16 + (bladenum-1)*6; + ! Module/Mesh/Field: u%BladeMotion(1)%Orientation = 17 + (bladenum-1)*6; + ! Module/Mesh/Field: u%BladeMotion(1)%TranslationVel = 18 + (bladenum-1)*6; + ! Module/Mesh/Field: u%BladeMotion(1)%RotationVel = 19 + (bladenum-1)*6; full lin only + ! Module/Mesh/Field: u%BladeMotion(1)%TranslationAcc = 20 + (bladenum-1)*6; full lin only + ! Module/Mesh/Field: u%BladeMotion(1)%RotationalAcc = 21 + (bladenum-1)*6; full lin only + if (.not. p_AD%CompAeroMaps) then ! full linearization + indexNames=index + p%Jac_u_idxStartList%Blade = index + call SetJac_u_idx(16,21,u%BladeMotion(1)%NNodes,index) + if (p%NumBl_Lin > 1) call SetJac_u_idx(22,27,u%BladeMotion(2)%NNodes,index) + if (p%NumBl_Lin > 2) call SetJac_u_idx(28,33,u%BladeMotion(3)%NNodes,index) + ! Perturbations + do k=1,p%NumBl_Lin + p%du(16 + (k-1)*6) = perturb_b(k) + p%du(17 + (k-1)*6) = perturb + p%du(18 + (k-1)*6) = perturb_b(k) + p%du(19 + (k-1)*6) = perturb + p%du(20 + (k-1)*6) = perturb_b(k) + p%du(21 + (k-1)*6) = perturb end do - - ! UserProp + ! Names + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + FieldMask(MASKID_TRANSLATIONVEL) = .true. + FieldMask(MASKID_ROTATIONVEL) = .true. + FieldMask(MASKID_TRANSLATIONACC) = .true. + FieldMask(MASKID_ROTATIONACC) = .true. do k=1,p%NumBl_Lin - do i=1,p%NumBlNds - InitOut%LinNames_u(index) = 'User property on blade '//trim(num2lstr(k))//', node '//trim(num2lstr(i))//', -' - index = index + 1 - end do + call PackMotionMesh_Names(u%BladeMotion(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_u, indexNames, FieldMask=FieldMask) end do - - ! AvgDiskVel - !do j=1,3 - ! InitOut%LinNames_u(index) = UVW(j)//'-component inflow of average disk velocity, m/s' - ! index = index + 1 - !end do - - end if - + else + indexNames=index + p%Jac_u_idxStartList%Blade = index + call SetJac_u_idx(16,18,u%BladeMotion(1)%NNodes,index) + if (p%NumBl_Lin > 1) call SetJac_u_idx(22,24,u%BladeMotion(2)%NNodes,index) + if (p%NumBl_Lin > 2) call SetJac_u_idx(28,30,u%BladeMotion(3)%NNodes,index) + ! Perturbations + do k=1,p%NumBl_Lin + p%du(16 + (k-1)*6) = perturb_b(k) + p%du(17 + (k-1)*6) = perturb + p%du(18 + (k-1)*6) = perturb_b(k) + end do + ! Names + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + FieldMask(MASKID_TRANSLATIONVEL) = .true. + do k=1,p%NumBl_Lin + call PackMotionMesh_Names(u%BladeMotion(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_u, indexNames, FieldMask=FieldMask) + end do + endif + + + if (.not. p_AD%CompAeroMaps) then + !------------------------------ + ! UserProp + ! Module/Mesh/Field: u%UserProp(:,:) = 34,35,36; + p%Jac_u_idxStartList%UserProp = index + do k=1,size(u%UserProp,2) ! p%NumBlades + do i=1,size(u%UserProp,1) ! numNodes + p%Jac_u_indx(index,1) = 34 + k-1 + p%Jac_u_indx(index,2) = 1 !component index: this is a scalar, so 1, but is never used + p%Jac_u_indx(index,3) = i !Node: i + ! Names + InitOut%LinNames_u(index) = 'User property on blade '//trim(num2lstr(k))//', node '//trim(num2lstr(i))//', -' + ! RotFrame + InitOut%RotFrame_u(index) = .true. + index = index + 1 + end do !i + ! Perturbations + p%du(34 + k-1) = perturb + end do ! + + + !------------------------------ + ! Extended inputs (number of these must be exactly p%NumExtendedInputs) + ! Module/Mesh/Field: HWindSpeed = 37 + ! Module/Mesh/Field: PLexp = 38 + ! Module/Mesh/Field: PropagationDir = 39 + p%Jac_u_idxStartList%Extended = index + p%Jac_u_indx(index,1)=37; p%Jac_u_indx(index,2)=1; p%Jac_u_indx(index,3)=1; InitOut%LinNames_u(index) = 'Extended input: horizontal wind speed (steady/uniform wind), m/s'; index=index+1 + p%Jac_u_indx(index,1)=38; p%Jac_u_indx(index,2)=1; p%Jac_u_indx(index,3)=1; InitOut%LinNames_u(index) = 'Extended input: vertical power-law shear exponent, -'; index=index+1 + p%Jac_u_indx(index,1)=39; p%Jac_u_indx(index,2)=1; p%Jac_u_indx(index,3)=1; InitOut%LinNames_u(index) = 'Extended input: propagation direction, rad'; index=index+1 + ! Perturbations + p%du(37) = perturb + p%du(38) = perturb + p%du(39) = perturb + + end if ! .not. compAeroMaps + +contains + subroutine SetJac_u_idx(FieldIdxStart,FieldIdxEnd,nNodes,idx) + integer, intent(in ) :: FieldIdxStart + integer, intent(in ) :: FieldIdxEnd + integer, intent(in ) :: nNodes + integer, intent(inout) :: idx + integer :: i_meshField,i,j + do i_meshField = FieldIdxStart,FieldIdxEnd + do i=1,nNodes + do j=1,3 + p%Jac_u_indx(idx,1) = i_meshField + p%Jac_u_indx(idx,2) = j !component index: j + p%Jac_u_indx(idx,3) = i !Node: i + idx = idx + 1 + end do !j + end do !i + end do + end subroutine + + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + !if (Failed) call Cleanup() + end function Failed END SUBROUTINE Init_Jacobian_u + + !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) - TYPE(RotParameterType) , INTENT(INOUT) :: p !< parameters TYPE(RotInitOutputType) , INTENT(INOUT) :: InitOut !< Output for initialization routine - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -7333,13 +7172,12 @@ SUBROUTINE Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) ! allocate space for the row/column names and for perturbation sizes ! always allocate this in case it is size zero ... (we use size(p%dx) for many calculations) - CALL AllocAry(p%dx, nx, 'p%dx', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL AllocAry(p%dx, nx, 'p%dx', ErrStat2, ErrMsg2); if (Failed()) return if (nx==0) return - CALL AllocAry(InitOut%LinNames_x, nx, 'LinNames_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%RotFrame_x, nx, 'RotFrame_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL AllocAry(InitOut%DerivOrder_x, nx, 'DerivOrder_x', ErrStat2, ErrMsg2); CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return + CALL AllocAry(InitOut%LinNames_x, nx, 'LinNames_x', ErrStat2, ErrMsg2); if (Failed()) return + CALL AllocAry(InitOut%RotFrame_x, nx, 'RotFrame_x', ErrStat2, ErrMsg2); if (Failed()) return + CALL AllocAry(InitOut%DerivOrder_x, nx, 'DerivOrder_x', ErrStat2, ErrMsg2); if (Failed()) return ! All DBEMT continuous states are order = 2; UA states are order 1 @@ -7369,6 +7207,7 @@ SUBROUTINE Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) InitOut%RotFrame_x(i+nx1) = InitOut%RotFrame_x(i) end do end if + ! UA states if (p%BEMT%UA%lin_nx>0) then InitOut%DerivOrder_x(1+p%BEMT%DBEMT%lin_nx:nx) = 1 @@ -7393,8 +7232,8 @@ SUBROUTINE Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) k = k + 1 end do - end if + ! BEMT states if (p%BEMT%lin_nx>0) then call SetErrStat(ErrID_Fatal,'Number of lin states for bem should be zero for now.', ErrStat, ErrMsg, RoutineName) @@ -7408,14 +7247,19 @@ SUBROUTINE Init_Jacobian_x( p, InitOut, ErrStat, ErrMsg) !InitOut%LinNames_x(k+1) = 'Y-component of wake velocity, m/s' !InitOut%LinNames_x(k+2) = 'Z-component of wake velocity, m/s' end if - - +contains + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + !if (Failed) call Cleanup() + end function Failed END SUBROUTINE Init_Jacobian_x + + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. !! Do not change the order of this packing without changing corresponding parts of AD linearization ! SUBROUTINE Init_Jacobian( InputFileData, p, p_AD, u, y, m, InitOut, ErrStat, ErrMsg) - type(RotInputFile) , intent(in ) :: InputFileData !< input file data (for default blade perturbation) TYPE(RotParameterType) , INTENT(INOUT) :: p !< parameters TYPE(AD_ParameterType) , INTENT(INOUT) :: p_AD !< parameters @@ -7423,7 +7267,6 @@ SUBROUTINE Init_Jacobian( InputFileData, p, p_AD, u, y, m, InitOut, ErrStat, Err TYPE(RotOutputType) , INTENT(IN ) :: y !< outputs TYPE(RotMiscVarType) , INTENT(INOUT) :: m !< miscellaneous variable TYPE(RotInitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -7445,132 +7288,198 @@ SUBROUTINE Init_Jacobian( InputFileData, p, p_AD, u, y, m, InitOut, ErrStat, Err ! these matrices will be needed for linearization with frozen wake feature if ( p%DBEMT_Mod == DBEMT_frozen ) then - call AllocAry(m%BEMT%AxInd_op,p%NumBlNds,p%numBlades,'m%BEMT%AxInd_op', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(m%BEMT%TnInd_op,p%NumBlNds,p%numBlades,'m%BEMT%TnInd_op', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry(m%BEMT%AxInd_op,p%NumBlNds,p%numBlades,'m%BEMT%AxInd_op', ErrStat2,ErrMsg2); if (Failed()) return + call AllocAry(m%BEMT%TnInd_op,p%NumBlNds,p%numBlades,'m%BEMT%TnInd_op', ErrStat2,ErrMsg2); if (Failed()) return end if - call Init_Jacobian_u( InputFileData, p, p_AD, u, InitOut, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Init_Jacobian_u( InputFileData, p, p_AD, u, InitOut, ErrStat2, ErrMsg2); if (Failed()) return - call Init_Jacobian_x( p, InitOut, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call Init_Jacobian_x( p, InitOut, ErrStat2, ErrMsg2); if (Failed()) return +contains + logical function Failed() + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + !if (Failed) call Cleanup() + end function Failed END SUBROUTINE Init_Jacobian + + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) !! Do not change this without making sure subroutine aerodyn::init_jacobian is consistant with this routine! SUBROUTINE Perturb_u( p, n, perturb_sign, u, du ) - TYPE(RotParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use + INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) TYPE(RotInputType) , INTENT(INOUT) :: u !< perturbed AD inputs REAL( R8Ki ) , INTENT( OUT) :: du !< amount that specific input was perturbed - ! local variables INTEGER :: fieldIndx INTEGER :: node - - fieldIndx = p%Jac_u_indx(n,2) - node = p%Jac_u_indx(n,3) - + + fieldIndx = p%Jac_u_indx(n,2) + node = p%Jac_u_indx(n,3) du = p%du( p%Jac_u_indx(n,1) ) - + ! determine which mesh we're trying to perturb and perturb the input: SELECT CASE( p%Jac_u_indx(n,1) ) - - CASE ( 1) !Module/Mesh/Field: u%TowerMotion%TranslationDisp = 1; - u%TowerMotion%TranslationDisp( fieldIndx,node) = u%TowerMotion%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE ( 2) !Module/Mesh/Field: u%TowerMotion%Orientation = 2; - CALL PerturbOrientationMatrix( u%TowerMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) - CASE ( 3) !Module/Mesh/Field: u%TowerMotion%TranslationVel = 3; - u%TowerMotion%TranslationVel( fieldIndx,node ) = u%TowerMotion%TranslationVel( fieldIndx,node) + du * perturb_sign - - CASE ( 4) !Module/Mesh/Field: u%HubMotion%TranslationDisp = 4; - u%HubMotion%TranslationDisp(fieldIndx,node) = u%HubMotion%TranslationDisp(fieldIndx,node) + du * perturb_sign - CASE ( 5) !Module/Mesh/Field: u%HubMotion%Orientation = 5; - CALL PerturbOrientationMatrix( u%HubMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - CASE ( 6) !Module/Mesh/Field: u%HubMotion%RotationVel = 6; - u%HubMotion%RotationVel(fieldIndx,node) = u%HubMotion%RotationVel(fieldIndx,node) + du * perturb_sign - - CASE ( 7) !Module/Mesh/Field: u%BladeRootMotion(1)%Orientation = 7; - CALL PerturbOrientationMatrix( u%BladeRootMotion(1)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - - CASE ( 8) !Module/Mesh/Field: u%BladeRootMotion(2)%Orientation = 8; - CALL PerturbOrientationMatrix( u%BladeRootMotion(2)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - - CASE ( 9) !Module/Mesh/Field: u%BladeRootMotion(3)%Orientation = 9; - CALL PerturbOrientationMatrix( u%BladeRootMotion(3)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - - CASE (10) !Module/Mesh/Field: u%BladeMotion(1)%TranslationDisp = 10; - u%BladeMotion(1)%TranslationDisp(fieldIndx,node) = u%BladeMotion(1)%TranslationDisp(fieldIndx,node) + du * perturb_sign - CASE (11) !Module/Mesh/Field: u%BladeMotion(1)%Orientation = 11; - CALL PerturbOrientationMatrix( u%BladeMotion(1)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - CASE (12) !Module/Mesh/Field: u%BladeMotion(1)%TranslationVel = 12; - u%BladeMotion(1)%TranslationVel(fieldIndx,node) = u%BladeMotion(1)%TranslationVel(fieldIndx,node) + du * perturb_sign - CASE (13) !Module/Mesh/Field: u%BladeMotion(1)%RotationVel = 13; - u%BladeMotion(1)%RotationVel(fieldIndx,node) = u%BladeMotion(1)%RotationVel(fieldIndx,node) + du * perturb_sign - CASE (14) !Module/Mesh/Field: u%BladeMotion(1)%TranslationAcc = 14; - u%BladeMotion(1)%TranslationAcc(fieldIndx,node) = u%BladeMotion(1)%TranslationAcc(fieldIndx,node) + du * perturb_sign - - CASE (15) !Module/Mesh/Field: u%BladeMotion(2)%TranslationDisp = 15; - u%BladeMotion(2)%TranslationDisp( fieldIndx,node) = u%BladeMotion(2)%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE (16) !Module/Mesh/Field: u%BladeMotion(2)%Orientation = 16; - CALL PerturbOrientationMatrix( u%BladeMotion(2)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - CASE (17) !Module/Mesh/Field: u%BladeMotion(2)%TranslationVel = 17; - u%BladeMotion(2)%TranslationVel(fieldIndx,node) = u%BladeMotion(2)%TranslationVel(fieldIndx,node) + du * perturb_sign - CASE (18) !Module/Mesh/Field: u%BladeMotion(2)%RotationVel = 18; - u%BladeMotion(2)%RotationVel(fieldIndx,node) = u%BladeMotion(2)%RotationVel(fieldIndx,node) + du * perturb_sign - CASE (19) !Module/Mesh/Field: u%BladeMotion(2)%TranslationAcc = 19; - u%BladeMotion(2)%TranslationAcc(fieldIndx,node) = u%BladeMotion(2)%TranslationAcc(fieldIndx,node) + du * perturb_sign - - CASE (20) !Module/Mesh/Field: u%BladeMotion(3)%TranslationDisp = 20; - u%BladeMotion(3)%TranslationDisp( fieldIndx,node) = u%BladeMotion(3)%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE (21) !Module/Mesh/Field: u%BladeMotion(3)%Orientation = 21; - CALL PerturbOrientationMatrix( u%BladeMotion(3)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) - CASE (22) !Module/Mesh/Field: u%BladeMotion(3)%TranslationVel = 22; - u%BladeMotion(3)%TranslationVel(fieldIndx,node) = u%BladeMotion(3)%TranslationVel(fieldIndx,node) + du * perturb_sign - CASE (23) !Module/Mesh/Field: u%BladeMotion(3)%RotationVel = 23; - u%BladeMotion(3)%RotationVel(fieldIndx,node) = u%BladeMotion(3)%RotationVel(fieldIndx,node) + du * perturb_sign - CASE (24) !Module/Mesh/Field: u%BladeMotion(3)%TranslationAcc = 24; - u%BladeMotion(3)%TranslationAcc(fieldIndx,node) = u%BladeMotion(3)%TranslationAcc(fieldIndx,node) + du * perturb_sign - -!FIXME: move these to extended inputs -! CASE (25) !Module/Mesh/Field: u%Bld(1)%InflowOnBlade(:,:) = 25; -! RotInflow%Bld(1)%InflowOnBlade(fieldIndx,node) = u%Bld(1)%InflowOnBlade(fieldIndx,node) + du * perturb_sign -! CASE (26) !Module/Mesh/Field: u%Bld(2)%InflowOnBlade(:,:) = 26; -! RotInflow%Bld(2)%InflowOnBlade(fieldIndx,node) = u%Bld(2)%InflowOnBlade(fieldIndx,node) + du * perturb_sign -! CASE (27) !Module/Mesh/Field: u%Bld(3)%InflowOnBlade(:,:) = 27; -! RotInflow%Bld(3)%InflowOnBlade(fieldIndx,node) = u%Bld(3)%InflowOnBlade(fieldIndx,node) + du * perturb_sign -! -!FIXME: move to extended inputs -! CASE (28) !Module/Mesh/Field: u%InflowOnTower(:,:) = 28; -! u%InflowOnTower(fieldIndx,node) = u%InflowOnTower(fieldIndx,node) + du * perturb_sign - - CASE (29) !Module/Mesh/Field: u%UserProp(:,1) = 29; - u%UserProp(node,1) = u%UserProp(node,1) + du * perturb_sign - CASE (30) !Module/Mesh/Field: u%UserProp(:,2) = 30; - u%UserProp(node,2) = u%UserProp(node,2) + du * perturb_sign - CASE (31) !Module/Mesh/Field: u%UserProp(:,3) = 31; - u%UserProp(node,3) = u%UserProp(node,3) + du * perturb_sign - - !CASE (32) !Module/Mesh/Field: u%AvgDiskVel(:) = 32; - ! u%AvgDiskVel(fieldIndx) = u%AvgDiskVel(fieldIndx) + du * perturb_sign - + + ! Nacelle + ! Module/Mesh/Field: u%NacelleMotion%TranslationDisp = 1; + ! Module/Mesh/Field: u%NacelleMotion%Orientation = 2; + case( 1); u%NacelleMotion%TranslationDisp(fieldIndx,node) = u%NacelleMotion%TranslationDisp(fieldIndx,node) + du * perturb_sign + case( 2); call PerturbOrientationMatrix( u%NacelleMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + + ! Hub + ! Module/Mesh/Field: u%HubMotion%TranslationDisp = 3; + ! Module/Mesh/Field: u%HubMotion%Orientation = 4; + ! Module/Mesh/Field: u%HubMotion%RotationVel = 5; + case( 3); u%HubMotion%TranslationDisp(fieldIndx,node) = u%HubMotion%TranslationDisp(fieldIndx,node) + du * perturb_sign + case( 4); call PerturbOrientationMatrix( u%HubMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + case( 5); u%HubMotion%RotationVel( fieldIndx,node) = u%HubMotion%RotationVel(fieldIndx,node) + du * perturb_sign + + ! TailFin + ! Module/Mesh/Field: u%TFinMotion%TranslationDisp = 6; + ! Module/Mesh/Field: u%TFinMotion%Orientation = 7; + ! Module/Mesh/Field: u%TFinMotion%TranslationVel = 8; + case( 6); u%TFinMotion%TranslationDisp(fieldIndx,node) = u%TFinMotion%TranslationDisp(fieldIndx,node) + du * perturb_sign + case( 7); call PerturbOrientationMatrix( u%TFinMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + case( 8); u%TFinMotion%TranslationVel( fieldIndx,node) = u%TFinMotion%TranslationVel(fieldIndx,node) + du * perturb_sign + + ! Tower + ! Module/Mesh/Field: u%TowerMotion%TranslationDisp = 9; + ! Module/Mesh/Field: u%TowerMotion%Orientation = 10; + ! Module/Mesh/Field: u%TowerMotion%TranslationVel = 11; + ! Module/Mesh/Field: u%TowerMotion%TranslationAcc = 12; + case( 9); u%TowerMotion%TranslationDisp(fieldIndx,node) = u%TowerMotion%TranslationDisp( fieldIndx,node) + du * perturb_sign + case(10); CALL PerturbOrientationMatrix( u%TowerMotion%Orientation(:,:,node), du * perturb_sign, fieldIndx, UseSmlAngle=.true. ) + case(11); u%TowerMotion%TranslationVel( fieldIndx,node) = u%TowerMotion%TranslationVel( fieldIndx,node) + du * perturb_sign + case(12); u%TowerMotion%TranslationAcc( fieldIndx,node) = u%TowerMotion%TranslationAcc(fieldIndx,node) + du * perturb_sign + + ! BladeRoot + ! Module/Mesh/Field: u%BladeRootMotion(1)%Orientation = 13; + ! Module/Mesh/Field: u%BladeRootMotion(2)%Orientation = 14; + ! Module/Mesh/Field: u%BladeRootMotion(3)%Orientation = 15; + case(13); call PerturbOrientationMatrix( u%BladeRootMotion(1)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + case(14); call PerturbOrientationMatrix( u%BladeRootMotion(2)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + case(15); call PerturbOrientationMatrix( u%BladeRootMotion(3)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + + ! Blade 1 + ! Module/Mesh/Field: u%BladeMotion(1)%TranslationDisp = 16; + ! Module/Mesh/Field: u%BladeMotion(1)%Orientation = 17; + ! Module/Mesh/Field: u%BladeMotion(1)%TranslationVel = 18; + ! Module/Mesh/Field: u%BladeMotion(1)%RotationVel = 19; + ! Module/Mesh/Field: u%BladeMotion(1)%TranslationAcc = 20; + ! Module/Mesh/Field: u%BladeMotion(1)%RotationalAcc = 21; + case(16); u%BladeMotion(1)%TranslationDisp(fieldIndx,node) = u%BladeMotion(1)%TranslationDisp(fieldIndx,node) + du * perturb_sign + case(17); call PerturbOrientationMatrix( u%BladeMotion(1)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + case(18); u%BladeMotion(1)%TranslationVel( fieldIndx,node) = u%BladeMotion(1)%TranslationVel(fieldIndx,node) + du * perturb_sign + case(19); u%BladeMotion(1)%RotationVel( fieldIndx,node) = u%BladeMotion(1)%RotationVel( fieldIndx,node) + du * perturb_sign + case(20); u%BladeMotion(1)%TranslationAcc( fieldIndx,node) = u%BladeMotion(1)%TranslationAcc(fieldIndx,node) + du * perturb_sign + case(21); u%BladeMotion(1)%RotationAcc( fieldIndx,node) = u%BladeMotion(1)%RotationAcc( fieldIndx,node) + du * perturb_sign + + ! Blade 2 + ! Module/Mesh/Field: u%BladeMotion(2)%TranslationDisp = 22; + ! Module/Mesh/Field: u%BladeMotion(2)%Orientation = 23; + ! Module/Mesh/Field: u%BladeMotion(2)%TranslationVel = 24; + ! Module/Mesh/Field: u%BladeMotion(2)%RotationVel = 25; + ! Module/Mesh/Field: u%BladeMotion(2)%TranslationAcc = 26; + ! Module/Mesh/Field: u%BladeMotion(2)%RotationalAcc = 27; + case(22); u%BladeMotion(2)%TranslationDisp(fieldIndx,node) = u%BladeMotion(2)%TranslationDisp(fieldIndx,node) + du * perturb_sign + case(23); call PerturbOrientationMatrix( u%BladeMotion(2)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + case(24); u%BladeMotion(2)%TranslationVel( fieldIndx,node) = u%BladeMotion(2)%TranslationVel(fieldIndx,node) + du * perturb_sign + case(25); u%BladeMotion(2)%RotationVel( fieldIndx,node) = u%BladeMotion(2)%RotationVel( fieldIndx,node) + du * perturb_sign + case(26); u%BladeMotion(2)%TranslationAcc( fieldIndx,node) = u%BladeMotion(2)%TranslationAcc(fieldIndx,node) + du * perturb_sign + case(27); u%BladeMotion(2)%RotationAcc( fieldIndx,node) = u%BladeMotion(2)%RotationAcc( fieldIndx,node) + du * perturb_sign + + ! Blade 3 + ! Module/Mesh/Field: u%BladeMotion(3)%TranslationDisp = 28; + ! Module/Mesh/Field: u%BladeMotion(3)%Orientation = 29; + ! Module/Mesh/Field: u%BladeMotion(3)%TranslationVel = 30; + ! Module/Mesh/Field: u%BladeMotion(3)%RotationVel = 31; + ! Module/Mesh/Field: u%BladeMotion(3)%TranslationAcc = 32; + ! Module/Mesh/Field: u%BladeMotion(3)%RotationalAcc = 33; + case(28); u%BladeMotion(3)%TranslationDisp(fieldIndx,node) = u%BladeMotion(3)%TranslationDisp(fieldIndx,node) + du * perturb_sign + case(29); call PerturbOrientationMatrix( u%BladeMotion(3)%Orientation(:,:,node), du * perturb_sign, fieldIndx ) + case(30); u%BladeMotion(3)%TranslationVel( fieldIndx,node) = u%BladeMotion(3)%TranslationVel(fieldIndx,node) + du * perturb_sign + case(31); u%BladeMotion(3)%RotationVel( fieldIndx,node) = u%BladeMotion(3)%RotationVel( fieldIndx,node) + du * perturb_sign + case(32); u%BladeMotion(3)%TranslationAcc( fieldIndx,node) = u%BladeMotion(3)%TranslationAcc(fieldIndx,node) + du * perturb_sign + case(33); u%BladeMotion(3)%RotationAcc( fieldIndx,node) = u%BladeMotion(3)%RotationAcc( fieldIndx,node) + du * perturb_sign + + ! UserProp + ! Module/Mesh/Field: u%UserProp(:,:) = 34,35,36; + case(34); u%UserProp(node,1) = u%UserProp(node,1) + du * perturb_sign + case(35); u%UserProp(node,2) = u%UserProp(node,2) + du * perturb_sign + case(36); u%UserProp(node,3) = u%UserProp(node,3) + du * perturb_sign + END SELECT - + END SUBROUTINE Perturb_u + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine perturbs the nth element of the u array extended inputs (and mesh/field it corresponds to) +!! Do not change this without making sure subroutine aerodyn::init_jacobian is consistant with this routine! +subroutine Perturb_uExtend( t, u_perturb, FlowField_perturb, RotInflow_perturb, p, OtherState, n, perturb_sign, u, du, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: t !< Time in seconds at operating point + type(RotInputType), intent(inout) :: u_perturb + type(FLowFieldType),pointer, intent(inout) :: FlowField_perturb !< perturbed flowfield (only the uniform wind) + type(RotInflowType), intent(inout) :: RotInflow_perturb !< Rotor inflow, perturbed by FlowField extended inputs + type(RotParameterType), intent(in ) :: p !< parameters + type(RotOtherStateType), intent(in ) :: OtherState !< Other states at operating point + integer( IntKi ), intent(in ) :: n !< number of array element to use + integer( IntKi ), intent(in ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) + type(RotInputType), intent(inout) :: u !< perturbed AD inputs + real( R8Ki ), intent( out) :: du !< amount that specific input was perturbed + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + integer :: fieldIndx + integer :: node + real(R8Ki) :: FlowField_du(3) !< vector of perturbations to apply to flow field + integer(intKi) :: StartNode + + ! Error handling + ErrStat = ErrID_None + ErrMsg = "" + + fieldIndx = p%Jac_u_indx(n,2) + node = p%Jac_u_indx(n,3) + du = p%du( p%Jac_u_indx(n,1) ) + StartNode = 1 ! ignored during linearization since cannot linearize with ExtInflow + + ! determine which mesh we're trying to perturb and perturb the input: + select case( p%Jac_u_indx(n,1) ) + ! Extended inputs + ! Module/Mesh/Field: HWindSpeed = 37 + ! Module/Mesh/Field: PLexp = 38 + ! Module/Mesh/Field: PropagationDir = 39 + case(37,38,39) + FlowField_du = 0.0_R8Ki + select case( p%Jac_u_indx(n,1) ) + case (37); FlowField_du(1) = du *perturb_sign + case (38); FlowField_du(2) = du *perturb_sign + case (39); FlowField_du(3) = du *perturb_sign + end select + call IfW_UniformWind_Perturb(FlowField_perturb, FlowField_du) + end select + call AD_CalcWind_Rotor(t, u_perturb, FlowField_perturb, p, RotInflow_perturb, StartNode, ErrStat, ErrMsg) +end subroutine Perturb_uExtend + + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) !! Do not change this without making sure subroutine aerodyn::init_jacobian is consistant with this routine! SUBROUTINE Perturb_x( p, n, perturb_sign, x, dx ) - TYPE(RotParameterType) , INTENT(IN ) :: p !< parameters INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) TYPE(RotContinuousStateType) , INTENT(INOUT) :: x !< perturbed AD continuous states REAL( R8Ki ) , INTENT( OUT) :: dx !< amount that specific input was perturbed - ! local variables INTEGER(IntKi) :: Blade ! loop over blade nodes INTEGER(IntKi) :: BladeNode ! loop over blades @@ -7630,11 +7539,12 @@ subroutine GetStateIndices( Indx, NumberOfBlades, NumberOfElementsPerBlade, Numb end subroutine GetStateIndices END SUBROUTINE Perturb_x + + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine uses values of two output types to compute an array of differences. !! Do not change this packing without making sure subroutine aerodyn::init_jacobian is consistant with this routine! SUBROUTINE Compute_dY(p, p_AD, y_p, y_m, delta_p, delta_m, dY) - TYPE(RotParameterType) , INTENT(IN ) :: p !< parameters TYPE(AD_ParameterType) , INTENT(IN ) :: p_AD !< parameters TYPE(RotOutputType) , INTENT(IN ) :: y_p !< AD outputs at \f$ u + \Delta_p u \f$ or \f$ x + \Delta_p x \f$ (p=plus) @@ -7646,11 +7556,15 @@ SUBROUTINE Compute_dY(p, p_AD, y_p, y_m, delta_p, delta_m, dY) ! local variables: INTEGER(IntKi) :: k ! loop over blades INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - indx_first = 1 - if (.not. p_AD%CompAeroMaps) call PackLoadMesh_dY(y_p%TowerLoad, y_m%TowerLoad, dY, indx_first) + if (.not. p_AD%CompAeroMaps) then + call PackLoadMesh_dY(y_p%NacelleLoad, y_m%NacelleLoad, dY, indx_first) + call PackLoadMesh_dY(y_p%HubLoad, y_m%HubLoad, dY, indx_first) + call PackLoadMesh_dY(y_p%TFinLoad, y_m%TFinLoad, dY, indx_first) + call PackLoadMesh_dY(y_p%TowerLoad, y_m%TowerLoad, dY, indx_first) + endif do k=1,p%NumBl_Lin call PackLoadMesh_dY(y_p%BladeLoad(k), y_m%BladeLoad(k), dY, indx_first) @@ -7665,11 +7579,12 @@ SUBROUTINE Compute_dY(p, p_AD, y_p, y_m, delta_p, delta_m, dY) dY = dY / (delta_p + delta_m) END SUBROUTINE Compute_dY + + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine uses values of two continuous state types to compute an array of differences. !! Do not change this packing without making sure subroutine aerodyn::init_jacobian is consistant with this routine! SUBROUTINE Compute_dX(p, x_p, x_m, delta_p, delta_m, dX) - TYPE(RotParameterType) , INTENT(IN ) :: p !< parameters TYPE(RotContinuousStateType) , INTENT(IN ) :: x_p !< AD continuous states at \f$ u + \Delta_p u \f$ or \f$ x + \Delta_p x \f$ (p=plus) TYPE(RotContinuousStateType) , INTENT(IN ) :: x_m !< AD continuous states at \f$ u - \Delta_m u \f$ or \f$ x - \Delta_m x \f$ (m=minus) diff --git a/modules/aerodyn/src/AeroDyn_Inflow.f90 b/modules/aerodyn/src/AeroDyn_Inflow.f90 index 16dac6bd5b..1f0677dacd 100644 --- a/modules/aerodyn/src/AeroDyn_Inflow.f90 +++ b/modules/aerodyn/src/AeroDyn_Inflow.f90 @@ -62,6 +62,10 @@ subroutine ADI_Init(InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Display the module information call DispNVD( ADI_Ver ) + ! Clear writeoutputs + if (allocated(InitOut%WriteOutputHdr)) deallocate(InitOut%WriteOutputHdr) + if (allocated(InitOut%WriteOutputUnt)) deallocate(InitOut%WriteOutputUnt) + ! Set parameters p%dt = interval p%storeHHVel = InitInp%storeHHVel @@ -69,9 +73,14 @@ subroutine ADI_Init(InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut p%MHK = InitInp%AD%MHK p%WtrDpth = InitInp%AD%WtrDpth + ! --- Initialize Inflow Wind + call ADI_InitInflowWind(InitInp%RootName, InitInp%IW_InitInp, u%AD, OtherState%AD, m%IW, Interval, InitOut_IW, errStat2, errMsg2); if (Failed()) return + ! Concatenate AD outputs to IW outputs + call concatOutputHeaders(InitOut%WriteOutputHdr, InitOut%WriteOutputUnt, InitOut_IW%WriteOutputHdr, InitOut_IW%WriteOutputUnt, errStat2, errMsg2); if(Failed()) return + ! --- Initialize AeroDyn - if (allocated(InitOut%WriteOutputHdr)) deallocate(InitOut%WriteOutputHdr) - if (allocated(InitOut%WriteOutputUnt)) deallocate(InitOut%WriteOutputUnt) + ! Link InflowWind's FlowField to AeroDyn's FlowField + InitInp%AD%FlowField => InitOut_IW%FlowField call AD_Init(InitInp%AD, u%AD, p%AD, x%AD, xd%AD, z%AD, OtherState%AD, y%AD, m%AD, Interval, InitOut_AD, errStat2, errMsg2); if (Failed()) return InitOut%Ver = InitOut_AD%ver @@ -79,13 +88,6 @@ subroutine ADI_Init(InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut !TODO: this header is too short if we add more rotors. Should also add a rotor identifier call concatOutputHeaders(InitOut%WriteOutputHdr, InitOut%WriteOutputUnt, InitOut_AD%rotors(1)%WriteOutputHdr, InitOut_AD%rotors(1)%WriteOutputUnt, errStat2, errMsg2); if(Failed()) return - ! --- Initialize Inflow Wind - call ADI_InitInflowWind(InitInp%RootName, InitInp%IW_InitInp, u%AD, OtherState%AD, m%IW, Interval, InitOut_IW, errStat2, errMsg2); if (Failed()) return - ! Concatenate AD outputs to IW outputs - call concatOutputHeaders(InitOut%WriteOutputHdr, InitOut%WriteOutputUnt, InitOut_IW%WriteOutputHdr, InitOut_IW%WriteOutputUnt, errStat2, errMsg2); if(Failed()) return - ! Link InflowWind's FlowField to AeroDyn's FlowField - p%AD%FlowField => InitOut_IW%FlowField - ! --- Initialize grouped outputs !TODO: assumes one rotor p%NumOuts = p%AD%rotors(1)%NumOuts + p%AD%rotors(1)%BldNd_TotNumOuts + m%IW%p%NumOuts @@ -235,7 +237,7 @@ subroutine ADI_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errSta subroutine CleanUp() !call ADI_DestroyConstrState(z_guess, errStat2, errMsg2); if(Failed()) return do it=1,size(utimes) - call AD_DestroyInput(u_AD(it), errStat2, errMsg2); if(Failed()) return + call AD_DestroyInput(u_AD(it), errStat2, errMsg2) ! ignore errors here enddo end subroutine @@ -367,7 +369,7 @@ subroutine ADI_InitInflowWind(Root, i_IW, u_AD, o_AD, IW, dt, InitOutData, errSt call IfW_SteadyWind_Init(Steady_InitInput, 0, IW%p%FlowField%Uniform, & FileDat, errStat2, errMsg2) if(Failed()) return - if (i_IW%MHK == 1 .or. i_IW%MHK == 2) then + if (i_IW%MHK == MHK_FixedBottom .or. i_IW%MHK == MHK_FLoating) then call IfW_UniformField_CalcAccel(IW%p%FlowField%Uniform, errStat2, errMsg2) if(Failed()) return IW%p%FlowField%AccFieldValid = .true. diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 4e64367304..277ab74517 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -113,6 +113,7 @@ typedef ^ InitInputType ReKi defPatm - - - "Default atmospheric typedef ^ InitInputType ReKi defPvap - - - "Default vapor pressure from the driver; may be overwritten" Pa typedef ^ InitInputType ReKi WtrDpth - - - "Water depth" m typedef ^ InitInputType ReKi MSL2SWL - - - "Offset between still-water level and mean sea level" m +typedef ^ InitInputType FlowFieldType *FlowField - - - "Pointer of InflowWinds flow field data type" - # This is data defined in the Input File for this module (or could otherwise be passed in) # ..... Blade Input file data ..................................................................................................... @@ -214,7 +215,7 @@ typedef ^ AD_InputFile ReKi InCol_Cl - - - "The column in the airfoil tables tha typedef ^ AD_InputFile ReKi InCol_Cd - - - "The column in the airfoil tables that contains the drag coefficient" - typedef ^ AD_InputFile ReKi InCol_Cm - - - "The column in the airfoil tables that contains the pitching-moment coefficient; use zero if there is no Cm column" - typedef ^ AD_InputFile ReKi InCol_Cpmin - - - "The column in the airfoil tables that contains the drag coefficient; use zero if there is no Cpmin column" - -typedef ^ AD_InputFile INTEGER AFTabMod - - - "Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp}" - +typedef ^ AD_InputFile IntKi AFTabMod - - - "Interpolation method for multiple airfoil tables {1 = 1D on AoA (only first table is used); 2 = 2D on AoA and Re; 3 = 2D on AoA and UserProp}" - typedef ^ AD_InputFile IntKi NumAFfiles - - - "Number of airfoil files used" - typedef ^ AD_InputFile CHARACTER(1024) FVWFileName - - - "FVW input filename" "quoted string" typedef ^ AD_InputFile CHARACTER(1024) AFNames {:} - - "Airfoil file names (NumAF lines)" "quoted strings" @@ -366,6 +367,19 @@ typedef ^ MiscVarType AD_InflowType Inflow {:} - - "Inflow storage (size of u fo # Parameters for each rotor +typedef ^ Jac_u_idxStarts IntKi Nacelle - 1 - "Index to first point in u jacobian for Nacelle" - +typedef ^ Jac_u_idxStarts IntKi Hub - 1 - "Index to first point in u jacobian for Hub" - +typedef ^ Jac_u_idxStarts IntKi TFin - 1 - "Index to first point in u jacobian for TFin" - +typedef ^ Jac_u_idxStarts IntKi Tower - 1 - "Index to first point in u jacobian for Tower" - +typedef ^ Jac_u_idxStarts IntKi BladeRoot - 1 - "Index to first point in u jacobian for BladeRoot" - +typedef ^ Jac_u_idxStarts IntKi Blade - 1 - "Index to first point in u jacobian for Blade" - +typedef ^ Jac_u_idxStarts IntKi UserProp - 1 - "Index to first point in u jacobian for UserProp" - +typedef ^ Jac_u_idxStarts IntKi Extended - 1 - "Index to first point in u jacobian for Extended" - +typedef ^ Jac_y_idxStarts IntKi NacelleLoad - 1 - "Index to first point in y jacobian for NacelleLoad" - +typedef ^ Jac_y_idxStarts IntKi HubLoad - 1 - "Index to first point in y jacobian for HubLoad" - +typedef ^ Jac_y_idxStarts IntKi TFinLoad - 1 - "Index to first point in y jacobian for TFinLoad" - +typedef ^ Jac_y_idxStarts IntKi TowerLoad - 1 - "Index to first point in y jacobian for TowerLoad" - +typedef ^ Jac_y_idxStarts IntKi BladeLoad - 1 - "Index to first point in y jacobian for BladeLoad" - typedef ^ RotParameterType IntKi NumBlades - - - "Number of blades on the turbine" - typedef ^ RotParameterType IntKi NumBlNds - - - "Number of nodes on each blade" - typedef ^ RotParameterType IntKi NumTwrNds - - - "Number of nodes on the tower" - @@ -392,11 +406,14 @@ typedef ^ RotParameterType ReKi TwrTaper {:} - - "Array of tower element t typedef ^ RotParameterType ReKi TwrAxCent {:} - - "Array of tower element axial centroid, used in buoyancy calculation" - typedef ^ RotParameterType BEMT_ParameterType BEMT - - - "Parameters for BEMT module" typedef ^ RotParameterType AA_ParameterType AA - - - "Parameters for AA module" -typedef ^ RotParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - +typedef ^ RotParameterType IntKi Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - +typedef ^ RotParameterType Jac_u_idxStarts Jac_u_idxStartList - - - "Starting indices for all Jac_u components" - +typedef ^ RotParameterType Jac_y_idxStarts Jac_y_idxStartList - - - "Starting indices for all Jac_y components" - +typedef ^ RotParameterType IntKi NumExtendedInputs - - - "number of extended inputs" - typedef ^ RotParameterType ReKi du {:} - - "vector that determines size of perturbation for u (inputs)" typedef ^ RotParameterType ReKi dx {:} - - "vector that determines size of perturbation for x (continuous states)" -typedef ^ RotParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - -typedef ^ RotParameterType Integer NumBl_Lin - - - "number of blades in the jacobian" - +typedef ^ RotParameterType IntKi Jac_ny - - - "number of outputs in jacobian matrix" - +typedef ^ RotParameterType IntKi NumBl_Lin - - - "number of blades in the jacobian" - typedef ^ RotParameterType IntKi TwrPotent - - - "Type of tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - typedef ^ RotParameterType IntKi TwrShadow - - - "Type of tower influence on wind based on downstream tower shadow {0=none, 1=Powles model, 2=Eames model}" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 7d3766a8ed..a168a62e73 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -131,6 +131,7 @@ MODULE AeroDyn_Types REAL(ReKi) :: defPvap = 0.0_ReKi !< Default vapor pressure from the driver; may be overwritten [Pa] REAL(ReKi) :: WtrDpth = 0.0_ReKi !< Water depth [m] REAL(ReKi) :: MSL2SWL = 0.0_ReKi !< Offset between still-water level and mean sea level [m] + TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Pointer of InflowWinds flow field data type [-] END TYPE AD_InitInputType ! ======================= ! ========= AD_BladePropsType ======= @@ -411,6 +412,27 @@ MODULE AeroDyn_Types TYPE(RotInflowType) , DIMENSION(:), ALLOCATABLE :: RotInflow !< Inflow on rotor [-] END TYPE AD_InflowType ! ======================= +! ========= Jac_u_idxStarts ======= + TYPE, PUBLIC :: Jac_u_idxStarts + INTEGER(IntKi) :: Nacelle = 1 !< Index to first point in u jacobian for Nacelle [-] + INTEGER(IntKi) :: Hub = 1 !< Index to first point in u jacobian for Hub [-] + INTEGER(IntKi) :: TFin = 1 !< Index to first point in u jacobian for TFin [-] + INTEGER(IntKi) :: Tower = 1 !< Index to first point in u jacobian for Tower [-] + INTEGER(IntKi) :: BladeRoot = 1 !< Index to first point in u jacobian for BladeRoot [-] + INTEGER(IntKi) :: Blade = 1 !< Index to first point in u jacobian for Blade [-] + INTEGER(IntKi) :: UserProp = 1 !< Index to first point in u jacobian for UserProp [-] + INTEGER(IntKi) :: Extended = 1 !< Index to first point in u jacobian for Extended [-] + END TYPE Jac_u_idxStarts +! ======================= +! ========= Jac_y_idxStarts ======= + TYPE, PUBLIC :: Jac_y_idxStarts + INTEGER(IntKi) :: NacelleLoad = 1 !< Index to first point in y jacobian for NacelleLoad [-] + INTEGER(IntKi) :: HubLoad = 1 !< Index to first point in y jacobian for HubLoad [-] + INTEGER(IntKi) :: TFinLoad = 1 !< Index to first point in y jacobian for TFinLoad [-] + INTEGER(IntKi) :: TowerLoad = 1 !< Index to first point in y jacobian for TowerLoad [-] + INTEGER(IntKi) :: BladeLoad = 1 !< Index to first point in y jacobian for BladeLoad [-] + END TYPE Jac_y_idxStarts +! ======================= ! ========= RotParameterType ======= TYPE, PUBLIC :: RotParameterType INTEGER(IntKi) :: NumBlades = 0_IntKi !< Number of blades on the turbine [-] @@ -440,6 +462,9 @@ MODULE AeroDyn_Types TYPE(BEMT_ParameterType) :: BEMT !< Parameters for BEMT module [-] TYPE(AA_ParameterType) :: AA !< Parameters for AA module [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] + TYPE(Jac_u_idxStarts) :: Jac_u_idxStartList !< Starting indices for all Jac_u components [-] + TYPE(Jac_y_idxStarts) :: Jac_y_idxStartList !< Starting indices for all Jac_y components [-] + INTEGER(IntKi) :: NumExtendedInputs = 0_IntKi !< number of extended inputs [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] @@ -980,6 +1005,7 @@ subroutine AD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta DstInitInputData%defPvap = SrcInitInputData%defPvap DstInitInputData%WtrDpth = SrcInitInputData%WtrDpth DstInitInputData%MSL2SWL = SrcInitInputData%MSL2SWL + DstInitInputData%FlowField => SrcInitInputData%FlowField end subroutine subroutine AD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) @@ -1004,6 +1030,7 @@ subroutine AD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) end if call NWTC_Library_DestroyFileInfoType(InitInputData%PassedPrimaryInputData, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + nullify(InitInputData%FlowField) end subroutine subroutine AD_PackInitInput(RF, Indata) @@ -1012,6 +1039,7 @@ subroutine AD_PackInitInput(RF, Indata) character(*), parameter :: RoutineName = 'AD_PackInitInput' integer(B8Ki) :: i1 integer(B8Ki) :: LB(1), UB(1) + logical :: PtrInIndex if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, allocated(InData%rotors)) if (allocated(InData%rotors)) then @@ -1037,6 +1065,13 @@ subroutine AD_PackInitInput(RF, Indata) call RegPack(RF, InData%defPvap) call RegPack(RF, InData%WtrDpth) call RegPack(RF, InData%MSL2SWL) + call RegPack(RF, associated(InData%FlowField)) + if (associated(InData%FlowField)) then + call RegPackPointer(RF, c_loc(InData%FlowField), PtrInIndex) + if (.not. PtrInIndex) then + call IfW_FlowField_PackFlowFieldType(RF, InData%FlowField) + end if + end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1048,6 +1083,8 @@ subroutine AD_UnPackInitInput(RF, OutData) integer(B8Ki) :: LB(1), UB(1) integer(IntKi) :: stat logical :: IsAllocAssoc + integer(B8Ki) :: PtrIdx + type(c_ptr) :: Ptr if (RF%ErrStat /= ErrID_None) return if (allocated(OutData%rotors)) deallocate(OutData%rotors) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return @@ -1077,6 +1114,24 @@ subroutine AD_UnPackInitInput(RF, OutData) call RegUnpack(RF, OutData%defPvap); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%WtrDpth); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%MSL2SWL); if (RegCheckErr(RF, RoutineName)) return + if (associated(OutData%FlowField)) deallocate(OutData%FlowField) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackPointer(RF, Ptr, PtrIdx); if (RegCheckErr(RF, RoutineName)) return + if (c_associated(Ptr)) then + call c_f_pointer(Ptr, OutData%FlowField) + else + allocate(OutData%FlowField,stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlowField.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + RF%Pointers(PtrIdx) = c_loc(OutData%FlowField) + call IfW_FlowField_UnpackFlowFieldType(RF, OutData%FlowField) ! FlowField + end if + else + OutData%FlowField => null() + end if end subroutine subroutine AD_CopyBladePropsType(SrcBladePropsTypeData, DstBladePropsTypeData, CtrlCode, ErrStat, ErrMsg) @@ -4515,6 +4570,115 @@ subroutine AD_UnPackInflowType(RF, OutData) end if end subroutine +subroutine AD_CopyJac_u_idxStarts(SrcJac_u_idxStartsData, DstJac_u_idxStartsData, CtrlCode, ErrStat, ErrMsg) + type(Jac_u_idxStarts), intent(in) :: SrcJac_u_idxStartsData + type(Jac_u_idxStarts), intent(inout) :: DstJac_u_idxStartsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_CopyJac_u_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' + DstJac_u_idxStartsData%Nacelle = SrcJac_u_idxStartsData%Nacelle + DstJac_u_idxStartsData%Hub = SrcJac_u_idxStartsData%Hub + DstJac_u_idxStartsData%TFin = SrcJac_u_idxStartsData%TFin + DstJac_u_idxStartsData%Tower = SrcJac_u_idxStartsData%Tower + DstJac_u_idxStartsData%BladeRoot = SrcJac_u_idxStartsData%BladeRoot + DstJac_u_idxStartsData%Blade = SrcJac_u_idxStartsData%Blade + DstJac_u_idxStartsData%UserProp = SrcJac_u_idxStartsData%UserProp + DstJac_u_idxStartsData%Extended = SrcJac_u_idxStartsData%Extended +end subroutine + +subroutine AD_DestroyJac_u_idxStarts(Jac_u_idxStartsData, ErrStat, ErrMsg) + type(Jac_u_idxStarts), intent(inout) :: Jac_u_idxStartsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyJac_u_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AD_PackJac_u_idxStarts(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Jac_u_idxStarts), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackJac_u_idxStarts' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Nacelle) + call RegPack(RF, InData%Hub) + call RegPack(RF, InData%TFin) + call RegPack(RF, InData%Tower) + call RegPack(RF, InData%BladeRoot) + call RegPack(RF, InData%Blade) + call RegPack(RF, InData%UserProp) + call RegPack(RF, InData%Extended) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackJac_u_idxStarts(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Jac_u_idxStarts), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackJac_u_idxStarts' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Nacelle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Hub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFin); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BladeRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Blade); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%UserProp); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Extended); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_CopyJac_y_idxStarts(SrcJac_y_idxStartsData, DstJac_y_idxStartsData, CtrlCode, ErrStat, ErrMsg) + type(Jac_y_idxStarts), intent(in) :: SrcJac_y_idxStartsData + type(Jac_y_idxStarts), intent(inout) :: DstJac_y_idxStartsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_CopyJac_y_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' + DstJac_y_idxStartsData%NacelleLoad = SrcJac_y_idxStartsData%NacelleLoad + DstJac_y_idxStartsData%HubLoad = SrcJac_y_idxStartsData%HubLoad + DstJac_y_idxStartsData%TFinLoad = SrcJac_y_idxStartsData%TFinLoad + DstJac_y_idxStartsData%TowerLoad = SrcJac_y_idxStartsData%TowerLoad + DstJac_y_idxStartsData%BladeLoad = SrcJac_y_idxStartsData%BladeLoad +end subroutine + +subroutine AD_DestroyJac_y_idxStarts(Jac_y_idxStartsData, ErrStat, ErrMsg) + type(Jac_y_idxStarts), intent(inout) :: Jac_y_idxStartsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'AD_DestroyJac_y_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine AD_PackJac_y_idxStarts(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Jac_y_idxStarts), intent(in) :: InData + character(*), parameter :: RoutineName = 'AD_PackJac_y_idxStarts' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NacelleLoad) + call RegPack(RF, InData%HubLoad) + call RegPack(RF, InData%TFinLoad) + call RegPack(RF, InData%TowerLoad) + call RegPack(RF, InData%BladeLoad) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine AD_UnPackJac_y_idxStarts(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Jac_y_idxStarts), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'AD_UnPackJac_y_idxStarts' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NacelleLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BladeLoad); if (RegCheckErr(RF, RoutineName)) return +end subroutine + subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeData, CtrlCode, ErrStat, ErrMsg) type(RotParameterType), intent(in) :: SrcRotParameterTypeData type(RotParameterType), intent(inout) :: DstRotParameterTypeData @@ -4735,6 +4899,13 @@ subroutine AD_CopyRotParameterType(SrcRotParameterTypeData, DstRotParameterTypeD end if DstRotParameterTypeData%Jac_u_indx = SrcRotParameterTypeData%Jac_u_indx end if + call AD_CopyJac_u_idxStarts(SrcRotParameterTypeData%Jac_u_idxStartList, DstRotParameterTypeData%Jac_u_idxStartList, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call AD_CopyJac_y_idxStarts(SrcRotParameterTypeData%Jac_y_idxStartList, DstRotParameterTypeData%Jac_y_idxStartList, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + DstRotParameterTypeData%NumExtendedInputs = SrcRotParameterTypeData%NumExtendedInputs if (allocated(SrcRotParameterTypeData%du)) then LB(1:1) = lbound(SrcRotParameterTypeData%du, kind=B8Ki) UB(1:1) = ubound(SrcRotParameterTypeData%du, kind=B8Ki) @@ -4901,6 +5072,10 @@ subroutine AD_DestroyRotParameterType(RotParameterTypeData, ErrStat, ErrMsg) if (allocated(RotParameterTypeData%Jac_u_indx)) then deallocate(RotParameterTypeData%Jac_u_indx) end if + call AD_DestroyJac_u_idxStarts(RotParameterTypeData%Jac_u_idxStartList, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AD_DestroyJac_y_idxStarts(RotParameterTypeData%Jac_y_idxStartList, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(RotParameterTypeData%du)) then deallocate(RotParameterTypeData%du) end if @@ -4966,6 +5141,9 @@ subroutine AD_PackRotParameterType(RF, Indata) call BEMT_PackParam(RF, InData%BEMT) call AA_PackParam(RF, InData%AA) call RegPackAlloc(RF, InData%Jac_u_indx) + call AD_PackJac_u_idxStarts(RF, InData%Jac_u_idxStartList) + call AD_PackJac_y_idxStarts(RF, InData%Jac_y_idxStartList) + call RegPack(RF, InData%NumExtendedInputs) call RegPackAlloc(RF, InData%du) call RegPackAlloc(RF, InData%dx) call RegPack(RF, InData%Jac_ny) @@ -5057,6 +5235,9 @@ subroutine AD_UnPackRotParameterType(RF, OutData) call BEMT_UnpackParam(RF, OutData%BEMT) ! BEMT call AA_UnpackParam(RF, OutData%AA) ! AA call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return + call AD_UnpackJac_u_idxStarts(RF, OutData%Jac_u_idxStartList) ! Jac_u_idxStartList + call AD_UnpackJac_y_idxStarts(RF, OutData%Jac_y_idxStartList) ! Jac_y_idxStartList + call RegUnpack(RF, OutData%NumExtendedInputs); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index 1330a461fc..cf8baa09a0 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -759,8 +759,9 @@ subroutine RollBackPreviousTimeStep() end subroutine RollBackPreviousTimeStep subroutine CleanUp() - call FVW_DestroyConstrState(z_guess, ErrStat2, ErrMsg2); if(Failed()) return - call FVW_DestroyInput(uInterp, ErrStat2, ErrMsg2); if(Failed()) return + ! note: errors not trapped here as leads to recursive use of Failed() + call FVW_DestroyConstrState(z_guess, ErrStat2, ErrMsg2) !; if(Failed()) return + call FVW_DestroyInput(uInterp, ErrStat2, ErrMsg2) !; if(Failed()) return end subroutine logical function Failed() diff --git a/modules/aerodyn/src/FVW_Subs.f90 b/modules/aerodyn/src/FVW_Subs.f90 index f2345493b3..c874f07c8c 100644 --- a/modules/aerodyn/src/FVW_Subs.f90 +++ b/modules/aerodyn/src/FVW_Subs.f90 @@ -394,17 +394,20 @@ end subroutine PropagateWake !> Print the states, useful for debugging -subroutine print_x_NW_FW(p, m, x, label) +subroutine print_x_NW_FW(p, m, x, label, nSteps_in) type(FVW_ParameterType), intent(in) :: p !< Parameters type(FVW_MiscVarType), intent(in) :: m !< Initial misc/optimization variables type(FVW_ContinuousStateType), intent(in) :: x !< Continuous states + integer(IntKi), optional, intent(in) :: nSteps_in !< number of steps to limit to character(len=*),intent(in) :: label - integer(IntKi) :: iAge, iW + integer(IntKi) :: iAge, iW, nSteps character(len=1):: flag + nSteps=99999999 ! big number + if (present(nSteps_in)) nSteps = nSteps_in print*,'------------------------------------------------------------------' print'(A,I0,A,I0)',' NW .....................iNWStart:',p%iNWStart,' nNW:',m%nNW iW=1 - do iAge=1,p%nNWMax+1 + do iAge=1,min(p%nNWMax+1,nSteps) flag='X' if ((iAge)<= m%nNW+1) flag='.' print'(A,A,I0,A)',flag,'iAge ',iAge,' Root Tip' @@ -417,7 +420,7 @@ subroutine print_x_NW_FW(p, m, x, label) endif enddo print'(A,I0)','FW <<<<<<<<<<<<<<<<<<<< nFW:',m%nFW - do iAge=1,p%nFWMax+1 + do iAge=1,min(p%nFWMax+1,nSteps) flag='X' if ((iAge)<= m%nFW+1) flag='.' print'(A,A,I0,A)',flag,'iAge ',iAge,' Root Tip' diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index 4fc2f01560..2b4625b3cd 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -9061,8 +9061,8 @@ SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) , Orientation = .TRUE. & , TranslationVel = .TRUE. & , RotationVel = .TRUE. & - , TranslationAcc = .TRUE. & - , RotationAcc = .TRUE. & + , TranslationAcc = .FALSE. & + , RotationAcc = .FALSE. & , ErrStat = ErrStat2 & , ErrMess = ErrMsg2 ) @@ -11228,10 +11228,11 @@ SUBROUTINE ED_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) end if p%Jac_ny = p%Jac_ny & - + y%PlatformPtMesh%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node - + y%TowerLn2Mesh%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node - + y%HubPtMotion%NNodes * 9 & ! 3 TranslationDisp, Orientation, and RotationVel at each node - + y%NacelleMotion%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node + + y%PlatformPtMesh%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, RotationAcc at each node + + y%TowerLn2Mesh%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, RotationAcc at each node + + y%HubPtMotion%NNodes * 9 & ! 3 TranslationDisp, Orientation, RotationVel at each node + + y%NacelleMotion%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, RotationAcc at each node + + y%TFinCMMotion%NNodes * 12 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel at each node + 3 & ! Yaw, YawRate, and HSS_Spd + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values @@ -11254,13 +11255,16 @@ SUBROUTINE ED_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) index_next = 1 if (allocated(y%BladeLn2Mesh)) then index_last = index_next + p%Jac_y_idxStartList%Blade = index_next do i=1,p%NumBl_Lin call PackMotionMesh_Names(y%BladeLn2Mesh(i), 'Blade '//trim(num2lstr(i)), InitOut%LinNames_y, index_next, FieldMask=BladeMask) end do end if if (.not. p%CompAeroMaps) then + p%Jac_y_idxStartList%Platform = index_next call PackMotionMesh_Names(y%PlatformPtMesh, 'Platform', InitOut%LinNames_y, index_next) + p%Jac_y_idxStartList%Tower = index_next call PackMotionMesh_Names(y%TowerLn2Mesh, 'Tower', InitOut%LinNames_y, index_next) ! note that this Mask is for the y%HubPtMotion mesh ONLY. The others pack *all* of the motion fields @@ -11269,13 +11273,25 @@ SUBROUTINE ED_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) Mask(MASKID_ORIENTATION) = .true. Mask(MASKID_ROTATIONVEL) = .true. + p%Jac_y_idxStartList%Hub = index_next call PackMotionMesh_Names(y%HubPtMotion, 'Hub', InitOut%LinNames_y, index_next, FieldMask=Mask) index_last = index_next + p%Jac_y_idxStartList%BladeRoot = index_next do i=1,p%NumBl_Lin call PackMotionMesh_Names(y%BladeRootMotion(i), 'Blade root '//trim(num2lstr(i)), InitOut%LinNames_y, index_next) end do + p%Jac_y_idxStartList%Nacelle = index_next call PackMotionMesh_Names(y%NacelleMotion, 'Nacelle', InitOut%LinNames_y, index_next) + + Mask = .false. + Mask(MASKID_TRANSLATIONDISP) = .true. + Mask(MASKID_ORIENTATION) = .true. + Mask(MASKID_TRANSLATIONVEL) = .true. + Mask(MASKID_ROTATIONVEL) = .true. + p%Jac_y_idxStartList%TFin = index_next + call PackMotionMesh_Names(y%TFinCMMotion, 'TailFin', InitOut%LinNames_y, index_next, FieldMask=Mask) + InitOut%LinNames_y(index_next) = 'Yaw, rad'; index_next = index_next+1 InitOut%LinNames_y(index_next) = 'YawRate, rad/s'; index_next = index_next+1 InitOut%LinNames_y(index_next) = 'HSS_Spd, rad/s' @@ -11498,6 +11514,7 @@ SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) + u%TowerPtLoads%NNodes * 6 & ! 3 forces + 3 moments at each node + u%HubPtLoad%NNodes * 6 & ! 3 forces + 3 moments at each node + u%NacelleLoads%NNodes * 6 & ! 3 forces + 3 moments at each node + + u%TFinCMLoads%NNodes * 6 & ! 3 forces + 3 moments at each node + p%NumBl & ! blade pitch command (BlPitchCom) + 2 ! YawMom and GenTrq p%NumExtendedInputs = 1 @@ -11522,6 +11539,7 @@ SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) index = 1 if (allocated(u%BladePtLoads)) then + p%Jac_u_idxStartList%BladeLoad = index !Module/Mesh/Field: u%BladePtLoads(1)%Force = 1; !Module/Mesh/Field: u%BladePtLoads(1)%Moment = 2; !Module/Mesh/Field: u%BladePtLoads(2)%Force = 3; @@ -11544,9 +11562,9 @@ SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) end do !k end if - + if (.not. p%CompAeroMaps) then - !if MaxBl ever changes (i.e., MaxBl /=3), we need to modify this accordingly: + p%Jac_u_idxStartList%PlatformLoad = index do i_meshField = 7,8 do i=1,u%PlatformPtMesh%NNodes do j=1,3 @@ -11557,7 +11575,8 @@ SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) end do !j end do !i end do - + + p%Jac_u_idxStartList%TowerLoad = index do i_meshField = 9,10 do i=1,u%TowerPtLoads%NNodes do j=1,3 @@ -11568,7 +11587,8 @@ SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) end do !j end do !i end do - + + p%Jac_u_idxStartList%HubLoad = index do i_meshField = 11,12 do i=1,u%HubPtLoad%NNodes do j=1,3 @@ -11579,7 +11599,8 @@ SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) end do !j end do !i end do - + + p%Jac_u_idxStartList%NacelleLoad = index do i_meshField = 13,14 do i=1,u%NacelleLoads%NNodes do j=1,3 @@ -11590,16 +11611,29 @@ SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) end do !j end do !i end do + + p%Jac_u_idxStartList%TFinLoad = index + do i_meshField = 15,16 + do i=1,u%TFinCMLoads%NNodes + do j=1,3 + p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%TFinCMLoads%Force = 15; u%TFinCMLoads%Moment = 16; + p%Jac_u_indx(index,2) = j !index: j + p%Jac_u_indx(index,3) = i !Node: i + index = index + 1 + end do !j + end do !i + end do + p%Jac_u_idxStartList%BlPitchCom = index do i_meshField = 1,p%NumBl ! scalars - p%Jac_u_indx(index,1) = 15 !Module/Mesh/Field: u%BlPitchCom = 15; + p%Jac_u_indx(index,1) = 17 !Module/Mesh/Field: u%BlPitchCom = 17; p%Jac_u_indx(index,2) = 1 !index: n/a p%Jac_u_indx(index,3) = i_meshField !Node: blade index = index + 1 end do - - do i_meshField = 16,17 ! scalars - p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%YawMom = 16; u%GenTrq = 17; + + do i_meshField = 18,19 ! scalars + p%Jac_u_indx(index,1) = i_meshField !Module/Mesh/Field: u%YawMom = 18; u%GenTrq = 19; p%Jac_u_indx(index,2) = 1 !index: j p%Jac_u_indx(index,3) = 1 !Node: i index = index + 1 @@ -11609,7 +11643,7 @@ SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) !................ ! input perturbations, du: !................ - call AllocAry(p%du, 17, 'p%du', ErrStat2, ErrMsg2) ! 17 = number of unique values in p%Jac_u_indx(:,1) + call AllocAry(p%du, 19, 'p%du', ErrStat2, ErrMsg2) ! 19 = number of unique values in p%Jac_u_indx(:,1) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -11635,9 +11669,11 @@ SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) p%du(12) = MaxTorque / 100.0_R8Ki ! u%HubPtLoad%Moment = 12 p%du(13) = MaxThrust / 100.0_R8Ki ! u%NacelleLoads%Force = 13 p%du(14) = MaxTorque / 100.0_R8Ki ! u%NacelleLoads%Moment = 14 - p%du(15) = 2.0_R8Ki * D2R_D ! u%BlPitchCom = 15 - p%du(16) = MaxTorque / 100.0_R8Ki ! u%YawMom = 16 - p%du(17) = MaxTorque / (100.0_R8Ki*p%GBRatio) ! u%GenTrq = 17 + p%du(15) = MaxThrust / 100.0_R8Ki ! u%TFinCMLoads%Force = 15 + p%du(16) = MaxTorque / 100.0_R8Ki ! u%TFinCMLoads%Moment = 16 + p%du(17) = 2.0_R8Ki * D2R_D ! u%BlPitchCom = 17 + p%du(18) = MaxTorque / 100.0_R8Ki ! u%YawMom = 18 + p%du(19) = MaxTorque / (100.0_R8Ki*p%GBRatio) ! u%GenTrq = 19 !Set some limits in case perturbation is very small do i=1,size(p%du) @@ -11667,6 +11703,7 @@ SUBROUTINE ED_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) call PackLoadMesh_Names(u%TowerPtLoads, 'Tower', InitOut%LinNames_u, index) call PackLoadMesh_Names(u%HubPtLoad, 'Hub', InitOut%LinNames_u, index) call PackLoadMesh_Names(u%NacelleLoads, 'Nacelle', InitOut%LinNames_u, index) + call PackLoadMesh_Names(u%TFinCMLoads, 'Tailfin', InitOut%LinNames_u, index) do k = 1,p%NumBl ! scalars InitOut%LinNames_u(index) = 'Blade '//trim(num2lstr(k))//' pitch command, rad' @@ -11707,45 +11744,57 @@ SUBROUTINE ED_Perturb_u( p, n, perturb_sign, u, du ) ! determine which mesh we're trying to perturb and perturb the input: SELECT CASE( p%Jac_u_indx(n,1) ) - CASE ( 1) !Module/Mesh/Field: u%BladePtLoads(1)%Force = 1 - u%BladePtLoads(1)%Force( fieldIndx,node) = u%BladePtLoads(1)%Force( fieldIndx,node) + du * perturb_sign - CASE ( 2) !Module/Mesh/Field: u%BladePtLoads(1)%Moment = 2 - u%BladePtLoads(1)%Moment(fieldIndx,node) = u%BladePtLoads(1)%Moment(fieldIndx,node) + du * perturb_sign - CASE ( 3) !Module/Mesh/Field: u%BladePtLoads(2)%Force = 3 - u%BladePtLoads(2)%Force( fieldIndx,node) = u%BladePtLoads(2)%Force( fieldIndx,node) + du * perturb_sign - CASE ( 4) !Module/Mesh/Field: u%BladePtLoads(2)%Moment = 4 - u%BladePtLoads(2)%Moment(fieldIndx,node) = u%BladePtLoads(2)%Moment(fieldIndx,node) + du * perturb_sign - CASE ( 5) !Module/Mesh/Field: u%BladePtLoads(2)%Force = 5 - u%BladePtLoads(3)%Force( fieldIndx,node) = u%BladePtLoads(3)%Force( fieldIndx,node) + du * perturb_sign - CASE ( 6) !Module/Mesh/Field: u%BladePtLoads(2)%Moment = 6 - u%BladePtLoads(3)%Moment(fieldIndx,node) = u%BladePtLoads(3)%Moment(fieldIndx,node) + du * perturb_sign - - CASE ( 7) !Module/Mesh/Field: u%PlatformPtMesh%Force = 7 - u%PlatformPtMesh%Force( fieldIndx,node) = u%PlatformPtMesh%Force( fieldIndx,node) + du * perturb_sign - CASE ( 8) !Module/Mesh/Field: u%PlatformPtMesh%Moment = 8 - u%PlatformPtMesh%Moment(fieldIndx,node) = u%PlatformPtMesh%Moment(fieldIndx,node) + du * perturb_sign + ! BladePtLoads + ! Module/Mesh/Field: u%BladePtLoads(1)%Force = 1 + ! Module/Mesh/Field: u%BladePtLoads(1)%Moment = 2 + ! Module/Mesh/Field: u%BladePtLoads(2)%Force = 3 + ! Module/Mesh/Field: u%BladePtLoads(2)%Moment = 4 + ! Module/Mesh/Field: u%BladePtLoads(3)%Force = 5 + ! Module/Mesh/Field: u%BladePtLoads(3)%Moment = 6 + CASE ( 1); u%BladePtLoads(1)%Force( fieldIndx,node) = u%BladePtLoads(1)%Force( fieldIndx,node) + du * perturb_sign + CASE ( 2); u%BladePtLoads(1)%Moment(fieldIndx,node) = u%BladePtLoads(1)%Moment(fieldIndx,node) + du * perturb_sign + CASE ( 3); u%BladePtLoads(2)%Force( fieldIndx,node) = u%BladePtLoads(2)%Force( fieldIndx,node) + du * perturb_sign + CASE ( 4); u%BladePtLoads(2)%Moment(fieldIndx,node) = u%BladePtLoads(2)%Moment(fieldIndx,node) + du * perturb_sign + CASE ( 5); u%BladePtLoads(3)%Force( fieldIndx,node) = u%BladePtLoads(3)%Force( fieldIndx,node) + du * perturb_sign + CASE ( 6); u%BladePtLoads(3)%Moment(fieldIndx,node) = u%BladePtLoads(3)%Moment(fieldIndx,node) + du * perturb_sign + + ! PlatformPtMesh + ! Module/Mesh/Field: u%PlatformPtMesh%Force = 7 + ! Module/Mesh/Field: u%PlatformPtMesh%Moment = 8 + CASE ( 7); u%PlatformPtMesh%Force( fieldIndx,node) = u%PlatformPtMesh%Force( fieldIndx,node) + du * perturb_sign + CASE ( 8); u%PlatformPtMesh%Moment(fieldIndx,node) = u%PlatformPtMesh%Moment(fieldIndx,node) + du * perturb_sign - CASE ( 9) !Module/Mesh/Field: u%TowerPtLoads%Force = 9 - u%TowerPtLoads%Force( fieldIndx,node) = u%TowerPtLoads%Force( fieldIndx,node) + du * perturb_sign - CASE (10) !Module/Mesh/Field: u%TowerPtLoads%Moment = 10 - u%TowerPtLoads%Moment(fieldIndx,node) = u%TowerPtLoads%Moment(fieldIndx,node) + du * perturb_sign - - CASE (11) !Module/Mesh/Field: u%HubPtLoad%Force = 11 - u%HubPtLoad%Force( fieldIndx,node) = u%HubPtLoad%Force( fieldIndx,node) + du * perturb_sign - CASE (12) !Module/Mesh/Field: u%HubPtLoad%Moment = 12 - u%HubPtLoad%Moment(fieldIndx,node) = u%HubPtLoad%Moment(fieldIndx,node) + du * perturb_sign - - CASE (13) !Module/Mesh/Field: u%NacelleLoads%Force = 13 - u%NacelleLoads%Force( fieldIndx,node) = u%NacelleLoads%Force( fieldIndx,node) + du * perturb_sign - CASE (14) !Module/Mesh/Field: u%NacelleLoads%Moment = 14 - u%NacelleLoads%Moment(fieldIndx,node) = u%NacelleLoads%Moment(fieldIndx,node) + du * perturb_sign - - CASE (15) !Module/Mesh/Field: u%BlPitchCom = 15 - u%BlPitchCom(node) = u%BlPitchCom(node) + du * perturb_sign - CASE (16) !Module/Mesh/Field: u%YawMom = 16 - u%YawMom = u%YawMom + du * perturb_sign - CASE (17) !Module/Mesh/Field: u%GenTrq = 17 - u%GenTrq = u%GenTrq + du * perturb_sign + ! TowerPtLoads + ! Module/Mesh/Field: u%TowerPtLoads%Force = 9 + ! Module/Mesh/Field: u%TowerPtLoads%Moment = 10 + CASE ( 9); u%TowerPtLoads%Force( fieldIndx,node) = u%TowerPtLoads%Force( fieldIndx,node) + du * perturb_sign + CASE (10); u%TowerPtLoads%Moment(fieldIndx,node) = u%TowerPtLoads%Moment(fieldIndx,node) + du * perturb_sign + + ! HubPtLoad + ! Module/Mesh/Field: u%HubPtLoad%Force = 11 + ! Module/Mesh/Field: u%HubPtLoad%Moment = 12 + CASE (11); u%HubPtLoad%Force( fieldIndx,node) = u%HubPtLoad%Force( fieldIndx,node) + du * perturb_sign + CASE (12); u%HubPtLoad%Moment(fieldIndx,node) = u%HubPtLoad%Moment(fieldIndx,node) + du * perturb_sign + + ! NacelleLoads + ! Module/Mesh/Field: u%NacelleLoads%Force = 13 + ! Module/Mesh/Field: u%NacelleLoads%Moment = 14 + CASE (13); u%NacelleLoads%Force( fieldIndx,node) = u%NacelleLoads%Force( fieldIndx,node) + du * perturb_sign + CASE (14); u%NacelleLoads%Moment(fieldIndx,node) = u%NacelleLoads%Moment(fieldIndx,node) + du * perturb_sign + + ! TFinCMLoads + ! Module/Mesh/Field: u%TFinCMLoads%Force = 15 + ! Module/Mesh/Field: u%TFinCMLoads%Moment = 16 + CASE (15); u%TFinCMLoads%Force( fieldIndx,node) = u%TFinCMLoads%Force( fieldIndx,node) + du * perturb_sign + CASE (16); u%TFinCMLoads%Moment(fieldIndx,node) = u%TFinCMLoads%Moment(fieldIndx,node) + du * perturb_sign + + ! Controller inputs + ! Module/Mesh/Field: u%BlPitchCom = 17 + ! Module/Mesh/Field: u%YawMom = 18 + ! Module/Mesh/Field: u%GenTrq = 19 + CASE (17); u%BlPitchCom(node) = u%BlPitchCom(node) + du * perturb_sign + CASE (18); u%YawMom = u%YawMom + du * perturb_sign + CASE (19); u%GenTrq = u%GenTrq + du * perturb_sign END SELECT @@ -11815,8 +11864,8 @@ SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) end if if (.not. p%CompAeroMaps) then - call PackMotionMesh_dY(y_p%PlatformPtMesh, y_m%PlatformPtMesh, dY, indx_first, UseSmlAngle=.true.) - call PackMotionMesh_dY(y_p%TowerLn2Mesh, y_m%TowerLn2Mesh, dY, indx_first, UseSmlAngle=.true.) + call PackMotionMesh_dY(y_p%PlatformPtMesh, y_m%PlatformPtMesh, dY, indx_first, UseSmlAngle=.true.) ! all fields + call PackMotionMesh_dY(y_p%TowerLn2Mesh, y_m%TowerLn2Mesh, dY, indx_first, UseSmlAngle=.true.) ! all fields Mask = .false. Mask(MASKID_TRANSLATIONDISP) = .true. @@ -11828,6 +11877,13 @@ SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) call PackMotionMesh_dY(y_p%BladeRootMotion(k), y_m%BladeRootMotion(k), dY, indx_first) end do call PackMotionMesh_dY(y_p%NacelleMotion, y_m%NacelleMotion, dY, indx_first) + + Mask = .false. + Mask(MASKID_TRANSLATIONDISP) = .true. + Mask(MASKID_ORIENTATION) = .true. + Mask(MASKID_TRANSLATIONVEL) = .true. + Mask(MASKID_ROTATIONVEL) = .true. + call PackMotionMesh_dY(y_p%TFinCMMotion, y_m%TFinCMMotion, dY, indx_first, FieldMask=Mask) dY(indx_first) = y_p%Yaw - y_m%Yaw; indx_first = indx_first + 1 dY(indx_first) = y_p%YawRate - y_m%YawRate; indx_first = indx_first + 1 @@ -11934,6 +11990,7 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, call PackLoadMesh(u%TowerPtLoads, u_op, index) call PackLoadMesh(u%HubPtLoad, u_op, index) call PackLoadMesh(u%NacelleLoads, u_op, index) + call PackLoadMesh(u%TFinCMLoads, u_op, index) do k = 1,p%NumBl_Lin ! scalars u_op(index) = u%BlPitchCom(k) @@ -11972,7 +12029,8 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, ny = p%Jac_ny + y%PlatformPtMesh%NNodes * 6 & ! Jac_ny has 3 for Orientation, but we need 9 at each node + y%TowerLn2Mesh%NNodes * 6 & ! Jac_ny has 3 for Orientation, but we need 9 at each node + y%HubPtMotion%NNodes * 6 & ! Jac_ny has 3 for Orientation, but we need 9 at each node - + y%NacelleMotion%NNodes * 6 ! Jac_ny has 3 for Orientation, but we need 9 at each node + + y%NacelleMotion%NNodes * 6 & ! Jac_ny has 3 for Orientation, but we need 9 at each node + + y%TFinCMMotion%NNodes * 6 ! Jac_ny has 3 for Orientation, but we need 9 at each node do k=1,p%NumBl_Lin ny = ny + y%BladeRootMotion(k)%NNodes * 6 ! Jac_ny has 3 for Orientation, but we need 9 at each node on each blade @@ -12011,18 +12069,26 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, end do end if if (.not. p%CompAeroMaps) then + call PackMotionMesh(y%PlatformPtMesh, y_op, index, TrimOP=ReturnTrimOP) + call PackMotionMesh(y%TowerLn2Mesh, y_op, index, TrimOP=ReturnTrimOP) + Mask = .false. Mask(MASKID_TRANSLATIONDISP) = .true. Mask(MASKID_ORIENTATION) = .true. Mask(MASKID_ROTATIONVEL) = .true. - - call PackMotionMesh(y%PlatformPtMesh, y_op, index, TrimOP=ReturnTrimOP) - call PackMotionMesh(y%TowerLn2Mesh, y_op, index, TrimOP=ReturnTrimOP) call PackMotionMesh(y%HubPtMotion, y_op, index, FieldMask=Mask, TrimOP=ReturnTrimOP) + do k=1,p%NumBl_Lin call PackMotionMesh(y%BladeRootMotion(k), y_op, index, TrimOP=ReturnTrimOP) end do call PackMotionMesh(y%NacelleMotion, y_op, index, TrimOP=ReturnTrimOP) + + Mask = .false. + Mask(MASKID_TRANSLATIONDISP) = .true. + Mask(MASKID_ORIENTATION) = .true. + Mask(MASKID_TRANSLATIONVEL) = .true. + Mask(MASKID_ROTATIONVEL) = .true. + call PackMotionMesh(y%TFinCMMotion, y_op, index, FieldMask=Mask, TrimOP=ReturnTrimOP) y_op(index) = y%Yaw ; index = index + 1 y_op(index) = y%YawRate ; index = index + 1 diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index c8bdd12b08..1381c8e383 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -540,6 +540,21 @@ typedef ^ MiscVarType ReKi YawFriMz - - - "E # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: +typedef ^ Jac_u_idxStarts IntKi BladeLoad - 1 - "Index to first point in y jacobian for BladeLoad" - +typedef ^ Jac_u_idxStarts IntKi PlatformLoad - 1 - "Index to first point in y jacobian for PlatformLoad" - +typedef ^ Jac_u_idxStarts IntKi TowerLoad - 1 - "Index to first point in y jacobian for TowerLoad" - +typedef ^ Jac_u_idxStarts IntKi HubLoad - 1 - "Index to first point in y jacobian for HubLoad" - +typedef ^ Jac_u_idxStarts IntKi NacelleLoad - 1 - "Index to first point in y jacobian for NacelleLoad" - +typedef ^ Jac_u_idxStarts IntKi TFinLoad - 1 - "Index to first point in y jacobian for TFinLoad" - +typedef ^ Jac_u_idxStarts IntKi BlPitchCom - 1 - "Index to first point in y jacobian for BlPitchCom" - +typedef ^ Jac_y_idxStarts IntKi Blade - 1 - "Index to first point in u jacobian for Blade" - +typedef ^ Jac_y_idxStarts IntKi Platform - 1 - "Index to first point in u jacobian for Platform" - +typedef ^ Jac_y_idxStarts IntKi Tower - 1 - "Index to first point in u jacobian for Tower" - +typedef ^ Jac_y_idxStarts IntKi Hub - 1 - "Index to first point in u jacobian for Hub" - +typedef ^ Jac_y_idxStarts IntKi BladeRoot - 1 - "Index to first point in u jacobian for BladeRoot" - +typedef ^ Jac_y_idxStarts IntKi Nacelle - 1 - "Index to first point in u jacobian for Nacelle" - +typedef ^ Jac_y_idxStarts IntKi TFin - 1 - "Index to first point in u jacobian for TFin" - + typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds typedef ^ ParameterType DbKi DT24 - - - "=DT/24 (used in loose coupling)" seconds typedef ^ ParameterType IntKi BldNodes - - - "Number of blade nodes used in the analysis" - @@ -766,6 +781,8 @@ typedef ^ ParameterType OutParmType BldNd_OutParam {:} - - "Names and unit #typedef ^ ParameterType IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (ED_AllBldNdOuts)" - typedef ^ ParameterType IntKi BldNd_BladesOut - - - "The blades to output (ED_AllBldNdOuts)" - +typedef ^ ParameterType Jac_u_idxStarts Jac_u_idxStartList - - - "Starting indices for all Jac_u compenents" - +typedef ^ ParameterType Jac_y_idxStarts Jac_y_idxStartList - - - "Starting indices for all Jac_u compenents" - typedef ^ ParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - typedef ^ ParameterType R8Ki du {:} - - "vector that determines size of perturbation for u (inputs)" typedef ^ ParameterType R8Ki dx {:} - - "vector that determines size of perturbation for x (continuous states)" diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 99c18e3276..72c3f10730 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -547,6 +547,28 @@ MODULE ElastoDyn_Types REAL(ReKi) :: YawFriMz = 0.0_ReKi !< External loading on yaw bearing not including inertial contributions [N-m] END TYPE ED_MiscVarType ! ======================= +! ========= Jac_u_idxStarts ======= + TYPE, PUBLIC :: Jac_u_idxStarts + INTEGER(IntKi) :: BladeLoad = 1 !< Index to first point in y jacobian for BladeLoad [-] + INTEGER(IntKi) :: PlatformLoad = 1 !< Index to first point in y jacobian for PlatformLoad [-] + INTEGER(IntKi) :: TowerLoad = 1 !< Index to first point in y jacobian for TowerLoad [-] + INTEGER(IntKi) :: HubLoad = 1 !< Index to first point in y jacobian for HubLoad [-] + INTEGER(IntKi) :: NacelleLoad = 1 !< Index to first point in y jacobian for NacelleLoad [-] + INTEGER(IntKi) :: TFinLoad = 1 !< Index to first point in y jacobian for TFinLoad [-] + INTEGER(IntKi) :: BlPitchCom = 1 !< Index to first point in y jacobian for BlPitchCom [-] + END TYPE Jac_u_idxStarts +! ======================= +! ========= Jac_y_idxStarts ======= + TYPE, PUBLIC :: Jac_y_idxStarts + INTEGER(IntKi) :: Blade = 1 !< Index to first point in u jacobian for Blade [-] + INTEGER(IntKi) :: Platform = 1 !< Index to first point in u jacobian for Platform [-] + INTEGER(IntKi) :: Tower = 1 !< Index to first point in u jacobian for Tower [-] + INTEGER(IntKi) :: Hub = 1 !< Index to first point in u jacobian for Hub [-] + INTEGER(IntKi) :: BladeRoot = 1 !< Index to first point in u jacobian for BladeRoot [-] + INTEGER(IntKi) :: Nacelle = 1 !< Index to first point in u jacobian for Nacelle [-] + INTEGER(IntKi) :: TFin = 1 !< Index to first point in u jacobian for TFin [-] + END TYPE Jac_y_idxStarts +! ======================= ! ========= ED_ParameterType ======= TYPE, PUBLIC :: ED_ParameterType REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] @@ -767,6 +789,8 @@ MODULE ElastoDyn_Types INTEGER(IntKi) :: BldNd_TotNumOuts = 0_IntKi !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- ED_AllBldNdOuts) [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< Names and units (and other characteristics) of all requested output parameters [-] INTEGER(IntKi) :: BldNd_BladesOut = 0_IntKi !< The blades to output (ED_AllBldNdOuts) [-] + TYPE(Jac_u_idxStarts) :: Jac_u_idxStartList !< Starting indices for all Jac_u compenents [-] + TYPE(Jac_y_idxStarts) :: Jac_y_idxStartList !< Starting indices for all Jac_u compenents [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] @@ -4986,6 +5010,118 @@ subroutine ED_UnPackMisc(RF, OutData) call RegUnpack(RF, OutData%YawFriMz); if (RegCheckErr(RF, RoutineName)) return end subroutine +subroutine ED_CopyJac_u_idxStarts(SrcJac_u_idxStartsData, DstJac_u_idxStartsData, CtrlCode, ErrStat, ErrMsg) + type(Jac_u_idxStarts), intent(in) :: SrcJac_u_idxStartsData + type(Jac_u_idxStarts), intent(inout) :: DstJac_u_idxStartsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_CopyJac_u_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' + DstJac_u_idxStartsData%BladeLoad = SrcJac_u_idxStartsData%BladeLoad + DstJac_u_idxStartsData%PlatformLoad = SrcJac_u_idxStartsData%PlatformLoad + DstJac_u_idxStartsData%TowerLoad = SrcJac_u_idxStartsData%TowerLoad + DstJac_u_idxStartsData%HubLoad = SrcJac_u_idxStartsData%HubLoad + DstJac_u_idxStartsData%NacelleLoad = SrcJac_u_idxStartsData%NacelleLoad + DstJac_u_idxStartsData%TFinLoad = SrcJac_u_idxStartsData%TFinLoad + DstJac_u_idxStartsData%BlPitchCom = SrcJac_u_idxStartsData%BlPitchCom +end subroutine + +subroutine ED_DestroyJac_u_idxStarts(Jac_u_idxStartsData, ErrStat, ErrMsg) + type(Jac_u_idxStarts), intent(inout) :: Jac_u_idxStartsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyJac_u_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ED_PackJac_u_idxStarts(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Jac_u_idxStarts), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackJac_u_idxStarts' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%BladeLoad) + call RegPack(RF, InData%PlatformLoad) + call RegPack(RF, InData%TowerLoad) + call RegPack(RF, InData%HubLoad) + call RegPack(RF, InData%NacelleLoad) + call RegPack(RF, InData%TFinLoad) + call RegPack(RF, InData%BlPitchCom) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackJac_u_idxStarts(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Jac_u_idxStarts), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackJac_u_idxStarts' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%BladeLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%PlatformLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TowerLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%HubLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NacelleLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFinLoad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BlPitchCom); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_CopyJac_y_idxStarts(SrcJac_y_idxStartsData, DstJac_y_idxStartsData, CtrlCode, ErrStat, ErrMsg) + type(Jac_y_idxStarts), intent(in) :: SrcJac_y_idxStartsData + type(Jac_y_idxStarts), intent(inout) :: DstJac_y_idxStartsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_CopyJac_y_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' + DstJac_y_idxStartsData%Blade = SrcJac_y_idxStartsData%Blade + DstJac_y_idxStartsData%Platform = SrcJac_y_idxStartsData%Platform + DstJac_y_idxStartsData%Tower = SrcJac_y_idxStartsData%Tower + DstJac_y_idxStartsData%Hub = SrcJac_y_idxStartsData%Hub + DstJac_y_idxStartsData%BladeRoot = SrcJac_y_idxStartsData%BladeRoot + DstJac_y_idxStartsData%Nacelle = SrcJac_y_idxStartsData%Nacelle + DstJac_y_idxStartsData%TFin = SrcJac_y_idxStartsData%TFin +end subroutine + +subroutine ED_DestroyJac_y_idxStarts(Jac_y_idxStartsData, ErrStat, ErrMsg) + type(Jac_y_idxStarts), intent(inout) :: Jac_y_idxStartsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'ED_DestroyJac_y_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine ED_PackJac_y_idxStarts(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Jac_y_idxStarts), intent(in) :: InData + character(*), parameter :: RoutineName = 'ED_PackJac_y_idxStarts' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Blade) + call RegPack(RF, InData%Platform) + call RegPack(RF, InData%Tower) + call RegPack(RF, InData%Hub) + call RegPack(RF, InData%BladeRoot) + call RegPack(RF, InData%Nacelle) + call RegPack(RF, InData%TFin) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine ED_UnPackJac_y_idxStarts(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Jac_y_idxStarts), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'ED_UnPackJac_y_idxStarts' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Blade); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Platform); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Tower); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Hub); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%BladeRoot); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Nacelle); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%TFin); if (RegCheckErr(RF, RoutineName)) return +end subroutine + subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) type(ED_ParameterType), intent(in) :: SrcParamData type(ED_ParameterType), intent(inout) :: DstParamData @@ -5832,6 +5968,12 @@ subroutine ED_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end do end if DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut + call ED_CopyJac_u_idxStarts(SrcParamData%Jac_u_idxStartList, DstParamData%Jac_u_idxStartList, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call ED_CopyJac_y_idxStarts(SrcParamData%Jac_y_idxStartList, DstParamData%Jac_y_idxStartList, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return if (allocated(SrcParamData%Jac_u_indx)) then LB(1:2) = lbound(SrcParamData%Jac_u_indx, kind=B8Ki) UB(1:2) = ubound(SrcParamData%Jac_u_indx, kind=B8Ki) @@ -6067,6 +6209,10 @@ subroutine ED_DestroyParam(ParamData, ErrStat, ErrMsg) end do deallocate(ParamData%BldNd_OutParam) end if + call ED_DestroyJac_u_idxStarts(ParamData%Jac_u_idxStartList, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call ED_DestroyJac_y_idxStarts(ParamData%Jac_y_idxStartList, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (allocated(ParamData%Jac_u_indx)) then deallocate(ParamData%Jac_u_indx) end if @@ -6319,6 +6465,8 @@ subroutine ED_PackParam(RF, Indata) end do end if call RegPack(RF, InData%BldNd_BladesOut) + call ED_PackJac_u_idxStarts(RF, InData%Jac_u_idxStartList) + call ED_PackJac_y_idxStarts(RF, InData%Jac_y_idxStartList) call RegPackAlloc(RF, InData%Jac_u_indx) call RegPackAlloc(RF, InData%du) call RegPackAlloc(RF, InData%dx) @@ -6583,6 +6731,8 @@ subroutine ED_UnPackParam(RF, OutData) end do end if call RegUnpack(RF, OutData%BldNd_BladesOut); if (RegCheckErr(RF, RoutineName)) return + call ED_UnpackJac_u_idxStarts(RF, OutData%Jac_u_idxStartList) ! Jac_u_idxStartList + call ED_UnpackJac_y_idxStarts(RF, OutData%Jac_y_idxStartList) ! Jac_y_idxStartList call RegUnpackAlloc(RF, OutData%Jac_u_indx); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%dx); if (RegCheckErr(RF, RoutineName)) return diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 45ac59bf48..fcb538e2fb 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -1541,7 +1541,8 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(HydroDyn_ContinuousStateType) :: x_m TYPE(HydroDyn_InputType) :: u_perturb REAL(R8Ki) :: delta ! delta change in input or state - INTEGER(IntKi) :: i, j, k, startingI, startingJ, bOffset, offsetI, n_du_plus1 + INTEGER(IntKi) :: i, j, k, startingI, startingJ, bOffset, offsetI, n_du_extend, n_du_norm + integer(IntKi), parameter :: nu_extended = 4 ! 4 total extended inputs: WaveElev0 from SeaSt, HWindSpeed / PLexp / PropagationDir from IfW (turbulent sea current) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1553,7 +1554,8 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ErrStat = ErrID_None ErrMsg = '' - n_du_plus1 = size(p%Jac_u_indx,1)+1 + n_du_norm = size(p%Jac_u_indx,1) + n_du_extend = n_du_norm + nu_extended ! make a copy of the inputs to perturb call HydroDyn_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) @@ -1571,7 +1573,7 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! allocate dYdu if necessary if (.not. allocated(dYdu)) then - call AllocAry(dYdu, p%Jac_ny, n_du_plus1, 'dYdu', ErrStat2, ErrMsg2) + call AllocAry(dYdu, p%Jac_ny, n_du_extend, 'dYdu', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) then call cleanup() @@ -1589,7 +1591,7 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM return end if - do i=1,size(p%Jac_u_indx,1) + do i=1,size(p%Jac_u_indx,1) ! NOTE: extended inputs are not included in p%Jac_u_indx ! get u_op + delta u call HydroDyn_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) @@ -1616,8 +1618,14 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM end do - ! p%WaveElev0 column - dYdu(:,n_du_plus1) = 0 + + !------------------- + ! extended inputs + ! WaveElev0 column -- from SeaState + dYdu(:,n_du_norm+1) = 0.0_ReKi + + ! HWindSpeed / PLexp / PropagationDir -- from Ifw/FlowField for turbulent sea current + dYdu(:,n_du_norm+2:n_du_norm+4) = 0.0_ReKi if (ErrStat>=AbortErrLev) then @@ -1640,7 +1648,7 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! allocate dXdu if necessary if (.not. allocated(dXdu)) then - call AllocAry(dXdu, p%totalStates, n_du_plus1, 'dXdu', ErrStat2, ErrMsg2) + call AllocAry(dXdu, p%totalStates, n_du_extend, 'dXdu', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat>=AbortErrLev) then call cleanup() @@ -1653,13 +1661,13 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM do j = 1,p%nWAMITObj do i = 1,p%WAMIT(j)%SS_Exctn%numStates - dXdu(offsetI+i,n_du_plus1) = p%WAMIT(j)%SS_Exctn%B(i) ! B is numStates by 1 + dXdu(offsetI+i,n_du_extend) = p%WAMIT(j)%SS_Exctn%B(i) ! B is numStates by 1 end do offsetI = offsetI + p%WAMIT(j)%SS_Exctn%numStates end do startingI = p%totalStates - p%totalRdtnStates - startingJ = n_du_plus1 - 1 - 18 - 4*3*p%NBody ! subtract 1 for WaveElev0, then 6*3 for PRPMesh and then 4*3*NBody to place us at the beginning of the velocity inputs + startingJ = n_du_norm - 18 - 4*3*p%NBody ! subtract 6*3 for PRPMesh and then 4*3*NBody to place us at the beginning of the velocity inputs ! B is numStates by 6*NBody where NBody =1 if NBodyMod=2 or 3, but could be >1 for NBodyMod=1 if ( p%NBodyMod == 1 ) then ! Example for NBodyMod=1 and NBody = 2, @@ -2274,6 +2282,7 @@ SUBROUTINE HD_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) ! local variables: INTEGER(IntKi) :: i, j, index, nu, i_meshField, m, meshFieldCount + integer(IntKi), parameter :: nu_extended = 4 ! 4 total extended inputs: WaveElev0 from SeaSt, HWindSpeed / PLexp / PropagationDir from IfW (turbulent sea current) REAL(R8Ki) :: perturb_t, perturb LOGICAL :: FieldMask(FIELDMASK_SIZE) ! flags to determine if this field is part of the packing @@ -2302,7 +2311,8 @@ SUBROUTINE HD_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) nu = nu + u%PRPMesh%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node - ! DO NOT Add the extended input WaveElev0 when computing the size of p%Jac_u_indx + ! DO NOT Add the extended inputs WaveElev0, HWindSpeed / PLexp / PropagationDir when computing the size of p%Jac_u_indx +!FIXME: extended inputs will need to be added later to get HWindSpeed / PLexp / PropagationDir from sea currents from IfW/FlowField in ! note: all other inputs are ignored @@ -2429,11 +2439,11 @@ SUBROUTINE HD_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) !................ ! names of the columns, InitOut%LinNames_u: !................ - call AllocAry(InitOut%LinNames_u, nu+1, 'LinNames_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AllocAry(InitOut%LinNames_u, nu+nu_extended, 'LinNames_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! We do not need RotFrame_u for this module and the glue code with handle the fact that we did not allocate the array and hence set all values to false at the glue-code level - !call AllocAry(InitOut%RotFrame_u, nu+1, 'RotFrame_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + !call AllocAry(InitOut%RotFrame_u, nu+nu_extended, 'RotFrame_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%IsLoad_u, nu+1, 'IsLoad_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call AllocAry(InitOut%IsLoad_u, nu+nu_extended, 'IsLoad_u', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return InitOut%IsLoad_u = .false. ! HD's inputs are NOT loads @@ -2470,9 +2480,13 @@ SUBROUTINE HD_Init_Jacobian( p, u, y, InitOut, ErrStat, ErrMsg) FieldMask(MASKID_TRANSLATIONACC) = .true. FieldMask(MASKID_ROTATIONACC) = .true. call PackMotionMesh_Names(u%PRPMesh, 'Platform-RefPt', InitOut%LinNames_u, index, FieldMask=FieldMask) - - InitOut%LinNames_u(index) = 'Extended input: wave elevation at platform ref point, m' - + + ! Extended inputs + InitOut%LinNames_u(index) = 'Extended input: wave elevation at platform ref point, m'; index=index+1 + InitOut%LinNames_u(index) = 'Extended input: horizontal current speed (steady/uniform wind), m/s'; index=index+1 + InitOut%LinNames_u(index) = 'Extended input: vertical power-law shear exponent, -'; index=index+1 + InitOut%LinNames_u(index) = 'Extended input: propagation direction, rad'; index=index+1 + END SUBROUTINE HD_Init_Jacobian !---------------------------------------------------------------------------------------------------------------------------------- !> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) @@ -2604,7 +2618,27 @@ SUBROUTINE HD_Perturb_u( p, n, perturb_sign, u, du ) u%PRPMesh%RotationAcc(fieldIndx,node) = u%PRPMesh%RotationAcc(fieldIndx,node) + du * perturb_sign END SELECT end if - + +!FIXME: when SeaState superposition with IfW/FlowField for current is enabled, we must also add in the perturbations of those extended inputs (HWindSpeed/PLexp/PropagationDir) +! Some revisions needed at that time: +! - expand p%Jac_u_indx to include the extended inputs (currently ignores them) +! - copy what was done in AD15 for perturbing these extended inputs (may require extensive modifications to data management) +! Until then, we should add a warning that linearization with IfW/FlowField currents in HD is not allowed for MHK turbines (no warning at present). +! +! Example code chunk from AD15. May be superceded by new linearization system later +! ! Extended inputs +! ! Module/Mesh/Field: HWindSpeed = 37 +! ! Module/Mesh/Field: PLexp = 38 +! ! Module/Mesh/Field: PropagationDir = 39 +! case(37,38,39) +! FlowField_du = 0.0_R8Ki +! select case( p%Jac_u_indx(n,1) ) +! case (37); FlowField_du(1) = du *perturb_sign +! case (38); FlowField_du(2) = du *perturb_sign +! case (39); FlowField_du(3) = du *perturb_sign +! end select +! call IfW_UniformWind_Perturb(FlowField_perturb, FlowField_du) +! call AD_CalcWind_Rotor(t, u_perturb, FlowField_perturb, p, RotInflow_perturb, StartNode, ErrStat, ErrMsg) END SUBROUTINE HD_Perturb_u !---------------------------------------------------------------------------------------------------------------------------------- !> This routine perturbs the nth element of the continuous state array. @@ -2713,6 +2747,7 @@ SUBROUTINE HD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, INTEGER(IntKi) :: i, j, index, nu + integer(IntKi), parameter :: nu_extended = 4 ! 4 total extended inputs: WaveElev0 from SeaSt, HWindSpeed / PLexp / PropagationDir from IfW (turbulent sea current) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HD_GetOP' @@ -2741,7 +2776,7 @@ SUBROUTINE HD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, end if nu = nu + u%PRPMesh%NNodes * 6 ! p%Jac_u_indx has 3 for Orientation, but we need 9 at each node - nu = nu + 1 ! Extended input + nu = nu + nu_extended ! Extended input call AllocAry(u_op, nu,'u_op',ErrStat2,ErrMsg2) ! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -2768,10 +2803,27 @@ SUBROUTINE HD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, call PackMotionMesh(u%PRPMesh, u_op, index, FieldMask=Mask) - ! extended input: - u_op(index) = 0.0_R8Ki - - + ! extended inputs: + u_op(index) = 0.0_R8Ki; index=index+1 ! WaveElev0 -- linearization not allowed for non-zero + u_op(index) = 0.0_R8Ki; index=index+1 ! HWindSpeed + u_op(index) = 0.0_R8Ki; index=index+1 ! PLexp + u_op(index) = 0.0_R8Ki; index=index+1 ! PropagationDir + +!FIXME: when sea current from IfW/FlowField is enabled, this code must be updated and enabled +! !------------------------------ +! ! Extended inputs -- Linearization is only possible with Steady or Uniform Wind, so take advantage of that here +! ! Module/Mesh/Field: HWindSpeed = 37 +! ! Module/Mesh/Field: PLexp = 38 +! ! Module/Mesh/Field: PropagationDir = 39 +! call IfW_UniformWind_GetOP(p_AD%FlowField%Uniform, t, .false. , OP_out) +! ! HWindSpeed +! u_op(index) = OP_out(1); index = index + 1 +! ! PLexp +! u_op(index) = OP_out(2); index = index + 1 +! ! PropagationDir (include AngleH in calculation if any) +! u_op(index) = OP_out(3) + p_AD%FlowField%PropagationDir; index = index + 1 + + END IF !.................................. diff --git a/modules/inflowwind/src/IfW_FlowField.f90 b/modules/inflowwind/src/IfW_FlowField.f90 index 4232dca0c2..9861a9692c 100644 --- a/modules/inflowwind/src/IfW_FlowField.f90 +++ b/modules/inflowwind/src/IfW_FlowField.f90 @@ -26,7 +26,7 @@ module IfW_FlowField public IfW_FlowField_GetVelAcc public IfW_UniformField_CalcAccel, IfW_Grid3DField_CalcAccel -public IfW_UniformWind_GetOP +public IfW_UniformWind_GetOP, IfW_UniformWind_Perturb ! for linearization public Grid3D_to_Uniform, Uniform_to_Grid3D integer(IntKi), parameter :: WindProfileType_None = -1 !< don't add wind profile; already included in input @@ -716,7 +716,7 @@ subroutine IfW_UniformWind_GetOP(UF, t, InterpCubic, OP_out) type(UniformFieldType), intent(IN) :: UF !< Parameters real(DbKi), intent(IN) :: t !< Current simulation time in seconds logical, intent(in) :: InterpCubic !< flag for using cubic interpolation - real(ReKi), intent(OUT) :: OP_out(2) !< operating point (HWindSpeed and PLexp + real(ReKi), intent(OUT) :: OP_out(3) !< operating point (HWindSpeed, PLexp, and AngleH) type(UniformField_Interp) :: op ! interpolated values of InterpParams @@ -729,9 +729,22 @@ subroutine IfW_UniformWind_GetOP(UF, t, InterpCubic, OP_out) OP_out(1) = op%VelH OP_out(2) = op%ShrV + OP_out(3) = op%AngleH +end subroutine + +!> Routine to perturb the wind extended outputs (needed by AeroDyn) +!! NOTE: we are not passing the pointer here, but doing pass by reference to the FlowField since +!! this can only be used with linearization, and linearization requires using Uniform winds. +subroutine IfW_UniformWind_Perturb(FF_perturb, du) + type(FlowFieldType), intent(INOUT) :: FF_perturb !< Parameters to be modified + real(R8Ki), intent(IN ) :: du(3) !< perturbations to apply + FF_perturb%Uniform%VelH(:) = FF_perturb%Uniform%VelH(:) + du(1) + FF_perturb%Uniform%ShrV(:) = FF_perturb%Uniform%ShrV(:) + du(2) + FF_perturb%PropagationDir = FF_perturb%PropagationDir + du(3) end subroutine + subroutine Grid3DField_GetCell(G3D, Time, Position, CalcAccel, AllowExtrap, & VelCell, AccCell, Xi, Is3D, ErrStat, ErrMsg) diff --git a/modules/inflowwind/src/InflowWind.f90 b/modules/inflowwind/src/InflowWind.f90 index 29f0f93fa4..f006867e9f 100644 --- a/modules/inflowwind/src/InflowWind.f90 +++ b/modules/inflowwind/src/InflowWind.f90 @@ -45,12 +45,7 @@ MODULE InflowWind PRIVATE TYPE(ProgDesc), PARAMETER :: IfW_Ver = ProgDesc( 'InflowWind', '', '' ) - integer, parameter :: NumExtendedInputs = 3 !: V, VShr, PropDir - - - - - ! ..... Public Subroutines ................................................................................................... + integer, parameter :: NumExtendedIO = 3 ! Number of extended inputs or outputs (same set): HWindSpeed, PlExp, PropDir ! ..... Public Subroutines ................................................................................................... PUBLIC :: InflowWind_Init !< Initialization routine @@ -571,58 +566,45 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, Cons end if ! also need to add InputGuess%HubOrientation to the u%Linear items - CALL AllocAry(InitOutData%LinNames_u, InitInp%NumWindPoints*3 + size(InputGuess%HubPosition) + 3 + NumExtendedInputs, 'LinNames_u', TmpErrStat, TmpErrMsg) ! add hub position, orientation(3) + extended inputs + CALL AllocAry(InitOutData%LinNames_u, NumExtendedIO, 'LinNames_u', TmpErrStat, TmpErrMsg) CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(InitOutData%RotFrame_u, InitInp%NumWindPoints*3 + size(InputGuess%HubPosition) + 3 + NumExtendedInputs, 'RotFrame_u', TmpErrStat, TmpErrMsg) + CALL AllocAry(InitOutData%RotFrame_u, NumExtendedIO, 'RotFrame_u', TmpErrStat, TmpErrMsg) CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(InitOutData%IsLoad_u, InitInp%NumWindPoints*3 + size(InputGuess%HubPosition) + 3 + NumExtendedInputs, 'IsLoad_u', TmpErrStat, TmpErrMsg) + CALL AllocAry(InitOutData%IsLoad_u, NumExtendedIO, 'IsLoad_u', TmpErrStat, TmpErrMsg) CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(InitOutData%LinNames_y, InitInp%NumWindPoints*3 + size(y%DiskVel) + p%NumOuts, 'LinNames_y', TmpErrStat, TmpErrMsg) + CALL AllocAry(InitOutData%LinNames_y, NumExtendedIO + p%NumOuts, 'LinNames_y', TmpErrStat, TmpErrMsg) CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) - CALL AllocAry(InitOutData%RotFrame_y, InitInp%NumWindPoints*3 + size(y%DiskVel) + p%NumOuts, 'RotFrame_y', TmpErrStat, TmpErrMsg) + CALL AllocAry(InitOutData%RotFrame_y, NumExtendedIO + p%NumOuts, 'RotFrame_y', TmpErrStat, TmpErrMsg) CALL SetErrStat(TmpErrStat,TmpErrMsg,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN ENDIF - do i=1,InitInp%NumWindPoints - do j=1,3 - InitOutData%LinNames_y((i-1)*3+j) = UVW(j)//'-component inflow velocity at node '//trim(num2lstr(i))//', m/s' - InitOutData%LinNames_u((i-1)*3+j) = XYZ(j)//'-component position of node '//trim(num2lstr(i))//', m' - end do - end do - - ! hub position - Lin_Indx = InitInp%NumWindPoints*3 - do j=1,3 - InitOutData%LinNames_y(Lin_Indx+j) = 'average '//UVW(j)//'-component rotor-disk velocity, m/s' - InitOutData%LinNames_u(Lin_Indx+j) = XYZ(j)//'-component position of moving hub, m' - end do - Lin_Indx = Lin_Indx + 3 - - ! hub orientation angles - do j=1,3 - InitOutData%LinNames_u(Lin_Indx+j) = XYZ(j)//' orientation of moving hub, rad' - end do - Lin_Indx = Lin_Indx + 3 - + ! Extended Inputs + Lin_Indx = 0 InitOutData%LinNames_u(Lin_Indx + 1) = 'Extended input: horizontal wind speed (steady/uniform wind), m/s' InitOutData%LinNames_u(Lin_Indx + 2) = 'Extended input: vertical power-law shear exponent, -' - InitOutData%LinNames_u(Lin_Indx + 3) = 'Extended input: propagation direction, rad' - + InitOutData%LinNames_u(Lin_Indx + 3) = 'Extended input: propagation direction, rad' + + ! Extended Outputs + Lin_Indx = 0 + InitOutData%LinNames_y(Lin_Indx + 1) = 'Extended output: horizontal wind speed (steady/uniform wind), m/s' + InitOutData%LinNames_y(Lin_Indx + 2) = 'Extended output: vertical power-law shear exponent, -' + InitOutData%LinNames_y(Lin_Indx + 3) = 'Extended output: propagation direction, rad' + + ! Outputs do i=1,p%NumOuts - InitOutData%LinNames_y(i+3*InitInp%NumWindPoints+size(y%DiskVel)) = trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units + InitOutData%LinNames_y(i+NumExtendedIO) = trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units end do ! IfW inputs and outputs are in the global, not rotating frame - InitOutData%RotFrame_u = .false. - InitOutData%RotFrame_y = .false. + InitOutData%RotFrame_u = .false. + InitOutData%RotFrame_y = .false. + InitOutData%IsLoad_u = .false. ! IfW inputs for linearization are not loads - InitOutData%IsLoad_u = .false. ! IfW inputs for linearization are not loads - end if - + ! Set the version information in InitOutData InitOutData%Ver = IfW_Ver @@ -800,8 +782,6 @@ END SUBROUTINE InflowWind_End !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. SUBROUTINE InflowWind_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu ) -!.................................................................................................................................. - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(InflowWind_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) TYPE(InflowWind_ParameterType), INTENT(IN ) :: p !< Parameters @@ -809,127 +789,67 @@ SUBROUTINE InflowWind_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrSt TYPE(InflowWind_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point TYPE(InflowWind_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point TYPE(InflowWind_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(InflowWind_OutputType), INTENT(IN ) :: y !< Output (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(InflowWind_OutputType), INTENT(IN ) :: y !< Output TYPE(InflowWind_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) - !! with respect to inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) - !! with respect to inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) - !! with respect to inputs (u) [intent in to avoid deallocation] REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) - !! with respect to inputs (u) [intent in to avoid deallocation] ! local variables: INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary error message CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_JacobianPInput' - - - REAL(R8Ki) :: local_dYdu(3,3+NumExtendedInputs) - integer :: i, n + REAL(R8Ki) :: local_dYdu(3,NumExtendedIO) + integer :: i,j, n integer :: i_start, i_end ! indices for input/output start and end integer :: node, comp - integer :: n_inputs - integer :: n_outputs - integer :: i_ExtendedInput_start - integer :: i_WriteOutput - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = '' - IF ( PRESENT( dYdu ) ) THEN - n_outputs = SIZE(u%PositionXYZ)+p%NumOuts + size(y%DiskVel) - n_inputs = SIZE(u%PositionXYZ)+size(u%HubPosition) + 3 + NumExtendedInputs ! need to add 3 for u%HubOrientation - i_ExtendedInput_start = n_inputs - NumExtendedInputs + 1 ! index for extended inputs starts 2 from end (encompasses 3 values: V, VShr, PropDir) - i_WriteOutput = n_outputs - p%NumOuts ! index for where write outputs begin is i_WriteOutput + 1 - + ! If dYdu is allocated, make sure it is the correct size + if (allocated(dYdu)) then + if (size(dYdu,1) /= NumExtendedIO + p%NumOuts) deallocate (dYdu) + if (size(dYdu,2) /= NumExtendedIO) deallocate (dYdu) + endif + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - - ! outputs are all velocities at all positions plus the WriteOutput values - ! + ! - inputs are extended inputs only + ! - outputs are the extended outputs and the WriteOutput values if (.not. ALLOCATED(dYdu)) then - CALL AllocAry( dYdu, n_outputs, n_inputs, 'dYdu', ErrStat2, ErrMsg2 ) + CALL AllocAry( dYdu, NumExtendedIO + p%NumOuts, NumExtendedIO, 'dYdu', ErrStat2, ErrMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return end if SELECT CASE ( p%FlowField%FieldType ) CASE (Uniform_FieldType) - - ! note that we are including the propagation direction in the analytical derivative calculated - ! inside IfW_UniformWind_JacobianPInput, so no need to transform input position vectors first - dYdu = 0.0_R8Ki ! initialize all non-diagonal entries to zero (position of node effects the output of only that node) - - n = SIZE(u%PositionXYZ,2) - ! these are the positions used in the module coupling - do i=1,n - ! note that p%FlowField%RotToWind(1,1) = cos(p%PropagationDir) and p%FlowField%RotToWind(2,1) = sin(p%PropagationDir), which are the - ! values we need to compute the jacobian. -!!!FIX ME with the propagation values!!!! - call IfW_UniformWind_JacobianPInput( p%FlowField%Uniform, t, u%PositionXYZ(:,i), p%FlowField%RotToWind(1,1), p%FlowField%RotToWind(2,1), local_dYdu ) - - i_end = 3*i - i_start= i_end - 2 - - dYdu(i_start:i_end,i_start:i_end) = local_dYdu(:,1:3) - - dYdu(i_start:i_end, i_ExtendedInput_start:) = local_dYdu(:,4:6) ! extended inputs - - end do - - - ! see InflowWind_GetRotorSpatialAverage(): - - ! location of y%DiskAvg - i_start = 3*n + 1 - i_end = i_start + 2 - - dYdu(i_start:i_end,:) = 0.0_R8Ki ! initialize because we're going to create averages - - do i=1,IfW_NumPtsAvg - m%u_Avg%PositionXYZ(:,i) = matmul(u%HubOrientation,p%PositionAvg(:,i)) + u%HubPosition -!!!FIX ME with the propagation values!!!! - call IfW_UniformWind_JacobianPInput( p%FlowField%Uniform, t, m%u_Avg%PositionXYZ(:,i), p%FlowField%RotToWind(1,1), p%FlowField%RotToWind(2,1), local_dYdu ) - - ! y%DiskAvg has the same index as u%HubPosition - ! Also note that partial_(m%u_Avg%PositionXYZ) / partial_(u%HubPosition) is identity, so we can skip that part of the chain rule for these derivatives: - dYdu(i_start:i_end,i_start:i_end) = dYdu(i_start:i_end, i_start:i_end) + local_dYdu(:,1:3) - dYdu(i_start:i_end, i_ExtendedInput_start:) = dYdu(i_start:i_end, i_ExtendedInput_start:) + local_dYdu(:,4:6) ! extended inputs - end do - dYdu(i_start:i_end,i_start:i_end) = dYdu(i_start:i_end, i_start:i_end) / REAL(IfW_NumPtsAvg,R8Ki) - dYdu(i_start:i_end,i_ExtendedInput_start:) = dYdu(i_start:i_end, i_ExtendedInput_start:) / REAL(IfW_NumPtsAvg,R8Ki) -!FIX ME: - ! need to calculate dXYZdHubOrient = partial_(m%u_Avg%PositionXYZ) / partial_(u%HubOrientation) - !dYdu(i_start:i_end,(i_start+3):(i_end+3)) = matmul( dYdu(i_start:i_end,i_start:i_end), dXYZdHubOrient ) + ! Extended inputs to extended outputs (direct pass-through) + do i=1,NumExtendedIO + dYdu(i,i) = 1.0_R8Ki + enddo - ! these are the InflowWind WriteOutput velocities (and note that we may not have all of the components of each point) - ! they do not depend on the inputs, so the derivatives w.r.t. X, Y, Z are all zero + ! WriteOutput velocities (note: may not have all of the components of each point) do i=1, p%NumOuts node = p%OutParamLinIndx(1,i) ! output node comp = p%OutParamLinIndx(2,i) ! component of output node if (node > 0) then -!!!FIX ME with the propagation values!!!! call IfW_UniformWind_JacobianPInput( p%FlowField%Uniform, t, p%WindViXYZ(:,node), p%FlowField%RotToWind(1,1), p%FlowField%RotToWind(2,1), local_dYdu ) else local_dYdu = 0.0_R8Ki comp = 1 end if - - dYdu(i_WriteOutput+i, i_ExtendedInput_start:) = p%OutParam(i)%SignM * local_dYdu( comp , 4:6) + dYdu(NumExtendedIO+i, 1:NumExtendedIO) = p%OutParam(i)%SignM * local_dYdu( comp , 1:NumExtendedIO) end do CASE DEFAULT @@ -947,9 +867,9 @@ SUBROUTINE InflowWind_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrSt IF ( PRESENT( dZdu ) ) THEN if (allocated(dZdu)) deallocate(dZdu) END IF +END SUBROUTINE InflowWind_JacobianPInput -END SUBROUTINE InflowWind_JacobianPInput !.................................................................................................................................. !> Routine to compute the Jacobians of the output (Y) function with respect to the inputs (u). The partial !! derivative dY/du is returned. This submodule does not follow the modularization framework. @@ -961,19 +881,16 @@ SUBROUTINE IfW_UniformWind_JacobianPInput(UF, t, Position, CosPropDir, SinPropDi REAL(ReKi), INTENT(IN ) :: Position(3) !< XYZ Position at which to find velocity (operating point) REAL(ReKi), INTENT(IN ) :: CosPropDir !< cosine of InflowWind propagation direction REAL(ReKi), INTENT(IN ) :: SinPropDir !< sine of InflowWind propagation direction - REAL(R8Ki), INTENT(INOUT) :: dYdu(3,6) !< Partial derivatives of output functions (Y) with respect to the inputs (u) + REAL(R8Ki), INTENT(INOUT) :: dYdu(3,NumExtendedIO) !< Partial derivatives of output functions (Y) with respect to the inputs (u) TYPE(UniformField_Interp) :: op ! interpolated values of InterpParams REAL(R8Ki) :: RotatePosition(3) !< rotated position - REAL(R8Ki) :: dVhdx ! temporary value to hold partial v_h partial X - REAL(R8Ki) :: dVhdy ! temporary value to hold partial v_h partial Y - REAL(R8Ki) :: dVhdz ! temporary value to hold partial v_h partial Z - REAL(R8Ki) :: tmp_du ! temporary value to hold calculations that are part of multiple components - REAL(R8Ki) :: tmp_dv ! temporary value to hold calculations that are part of multiple components + REAL(R8Ki) :: tmp_du ! temporary value to hold calculations that are part of multiple components + REAL(R8Ki) :: tmp_dv ! temporary value to hold calculations that are part of multiple components REAL(R8Ki) :: dVhdPD ! temporary value to hold partial v_h partial propagation direction - REAL(R8Ki) :: dVhdV ! temporary value to hold partial v_h partial V - REAL(R8Ki) :: Vh ! temporary value to hold v_h - REAL(R8Ki) :: dVhdVShr ! temporary value to hold partial v_h partial VShr + REAL(R8Ki) :: dVhdV ! temporary value to hold partial v_h partial V + REAL(R8Ki) :: Vh ! temporary value to hold v_h + REAL(R8Ki) :: dVhdVShr ! temporary value to hold partial v_h partial VShr REAL(R8Ki) :: zr if ( Position(3) < 0.0_ReKi .or. EqualRealNos(Position(3), 0.0_ReKi)) then @@ -993,17 +910,13 @@ SUBROUTINE IfW_UniformWind_JacobianPInput(UF, t, Position, CosPropDir, SinPropDi !------------------------------------------------------------------------------------------------- !> 2. Calculate \f$ \frac{\partial Y_{Output \, Equations}}{\partial u_{inputs}} = \begin{bmatrix} - !! \frac{\partial Vt_u}{\partial X} & \frac{\partial Vt_u}{\partial Y} & \frac{\partial Vt_u}{\partial Z} \\ - !! \frac{\partial Vt_v}{\partial X} & \frac{\partial Vt_v}{\partial Y} & \frac{\partial Vt_v}{\partial Z} \\ - !! \frac{\partial Vt_w}{\partial X} & \frac{\partial Vt_w}{\partial Y} & \frac{\partial Vt_w}{\partial Z} \\ + !! \frac{\partial Vt_u}{\partial V} & \frac{\partial Vt_u}{\partial VShr} & \frac{\partial Vt_u}{\partial PropDir} \\ + !! \frac{\partial Vt_v}{\partial V} & \frac{\partial Vt_v}{\partial VShr} & \frac{\partial Vt_v}{\partial PropDir} \\ + !! \frac{\partial Vt_w}{\partial V} & \frac{\partial Vt_w}{\partial VShr} & \frac{\partial Vt_w}{\partial PropDir} \\ !! \end{bmatrix} \f$ !------------------------------------------------------------------------------------------------- zr = RotatePosition(3)/UF%RefHeight - tmp_du = op%VelH * op%ShrH / UF%RefLength * CosPropDir - dVhdx = tmp_du * op%SinAngleH - dVhdy = tmp_du * op%CosAngleH - dVhdz = op%VelH * ( op%ShrV / UF%RefHeight * zr**(op%ShrV-1.0_R8Ki) + op%LinShrV/UF%RefLength) dVhdV = ( ( RotatePosition(3)/UF%RefHeight ) ** op%ShrV & ! power-law wind shear + ( op%ShrH * ( RotatePosition(2) * op%CosAngleH + RotatePosition(1) * op%SinAngleH ) & ! horizontal linear shear @@ -1016,53 +929,26 @@ SUBROUTINE IfW_UniformWind_JacobianPInput(UF, t, Position, CosPropDir, SinPropDi tmp_du = CosPropDir*op%CosAngleH - SinPropDir*op%SinAngleH tmp_dv = -SinPropDir*op%CosAngleH - CosPropDir*op%SinAngleH - !> \f$ \frac{\partial Vt_u}{\partial X} = \left[\cos(PropagationDir)\cos(Delta) - \sin(PropagationDir)\sin(Delta) \right] - !! V \, \frac{H_{LinShr}}{RefWid} \, \sin(Delta) \cos(PropagationDir) \f$ - dYdu(1,1) = tmp_du*dVhdx - !> \f$ \frac{\partial Vt_v}{\partial X} = \left[-\sin(PropagationDir)\cos(Delta) - \cos(PropagationDir)\sin(Delta) \right] - !! V \, \frac{H_{LinShr}}{RefWid} \, \sin(Delta) \cos(PropagationDir) \f$ - dYdu(2,1) = tmp_dv*dVhdx - !> \f$ \frac{\partial Vt_w}{\partial X} = 0 \f$ - dYdu(3,1) = 0.0_R8Ki - - !> \f$ \frac{\partial Vt_u}{\partial Y} = \left[\cos(PropagationDir)\cos(Delta) - \sin(PropagationDir)\sin(Delta) \right] - !! V \, \frac{H_{LinShr}}{RefWid} \, \cos(Delta) \cos(PropagationDir) \f$ - dYdu(1,2) = tmp_du*dVhdy - !> \f$ \frac{\partial Vt_v}{\partial Y} = \left[-\sin(PropagationDir)\cos(Delta) - \cos(PropagationDir)\sin(Delta) \right] - !! V \, \frac{H_{LinShr}}{RefWid} \, \cos(Delta) \cos(PropagationDir) \f$ - dYdu(2,2) = tmp_dv*dVhdy - !> \f$ \frac{\partial Vt_w}{\partial Y} = 0 \f$ - dYdu(3,2) = 0.0_R8Ki - - !> \f$ \frac{\partial Vt_u}{\partial Z} = \left[\cos(PropagationDir)\cos(Delta) - \sin(PropagationDir)\sin(Delta) \right] - !! V \, \left[ \frac{V_{shr}}{Z_{ref}} \left( \frac{Z}{Z_{ref}} \right) ^ {V_{shr}-1} + \frac{V_{LinShr}}{RefWid} \right] \f$ - dYdu(1,3) = tmp_du*dVhdz - !> \f$ \frac{\partial Vt_v}{\partial Z} = \left[-\sin(PropagationDir)\cos(Delta) - \cos(PropagationDir)\sin(Delta) \right] - !! V \, \left[ \frac{V_{shr}}{Z_{ref}} \left( \frac{Z}{Z_{ref}} \right) ^ {V_{shr}-1} + \frac{V_{LinShr}}{RefWid} \right] \f$ - dYdu(2,3) = tmp_dv*dVhdz - !> \f$ \frac{\partial Vt_w}{\partial Z} = 0 \f$ - dYdu(3,3) = 0.0_R8Ki - ! \f$ \frac{\partial Vt_u}{\partial V} = \f$ - dYdu(1,4) = tmp_du*dVhdV + dYdu(1,1) = tmp_du*dVhdV ! \f$ \frac{\partial Vt_v}{\partial V} = \f$ - dYdu(2,4) = tmp_dv*dVhdV + dYdu(2,1) = tmp_dv*dVhdV !> \f$ \frac{\partial Vt_w}{\partial V} = 0 \f$ - dYdu(3,4) = 0.0_R8Ki + dYdu(3,1) = 0.0_R8Ki ! \f$ \frac{\partial Vt_u}{\partial VShr} = \f$ - dYdu(1,5) = tmp_du*dVhdVShr + dYdu(1,2) = tmp_du*dVhdVShr ! \f$ \frac{\partial Vt_v}{\partial VShr} = \f$ - dYdu(2,5) = tmp_dv*dVhdVShr + dYdu(2,2) = tmp_dv*dVhdVShr !> \f$ \frac{\partial Vt_w}{\partial VShr} = 0 \f$ - dYdu(3,5) = 0.0_R8Ki + dYdu(3,2) = 0.0_R8Ki ! \f$ \frac{\partial Vt_u}{\partial PropDir} = \f$ - dYdu(1,6) = tmp_dv*Vh + tmp_du*dVhdPD + dYdu(1,3) = tmp_dv*Vh + tmp_du*dVhdPD ! \f$ \frac{\partial Vt_v}{\partial PropDir} = \f$ - dYdu(2,6) = -tmp_du*Vh + tmp_dv*dVhdPD + dYdu(2,3) = -tmp_du*Vh + tmp_dv*dVhdPD !> \f$ \frac{\partial Vt_w}{\partial PropDir} = 0 \f$ - dYdu(3,6) = 0.0_R8Ki + dYdu(3,3) = 0.0_R8Ki END SUBROUTINE IfW_UniformWind_JacobianPInput !---------------------------------------------------------------------------------------------------------------------------------- @@ -1193,7 +1079,8 @@ SUBROUTINE InflowWind_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - INTEGER(IntKi) :: index, i, j + INTEGER(IntKi) :: i + real(ReKi) :: tmp_op(NumExtendedIO) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_GetOP' @@ -1203,55 +1090,33 @@ SUBROUTINE InflowWind_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs ErrStat = ErrID_None ErrMsg = '' + ! Since both u_op and y_op need this, calculate it up front + if (present(u_op) .or. present(y_op)) then + call IfW_UniformWind_GetOP( p%FlowField%Uniform, t, p%FlowField%VelInterpCubic, tmp_op ) + tmp_op(3) = p%FlowField%PropagationDir + tmp_op(3) ! include the AngleH from Uniform Wind input files + endif + if ( PRESENT( u_op ) ) then if (.not. allocated(u_op)) then - call AllocAry(u_op, size(u%PositionXYZ) + size(u%HubPosition) + 3 + NumExtendedInputs, 'u_op', ErrStat2, ErrMsg2) + call AllocAry(u_op, NumExtendedIO, 'u_op', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) return end if - - index = 0 - do i=1,size(u%PositionXYZ,2) - do j=1,size(u%PositionXYZ,1) - index = index + 1 !(i-1)*size(u%PositionXYZ,1)+j - u_op(index) = u%PositionXYZ(j,i) - end do - end do - - do i=1,3 - index = index + 1 - u_op(index) = u%HubPosition(i) - end do - - u_op((index+1):(index+3)) = EulerExtract(u%HubOrientation) - index = index + 3 - - call IfW_UniformWind_GetOP( p%FlowField%Uniform, t, p%FlowField%VelInterpCubic, u_op(index+1:index+2) ) - u_op(index + 3) = p%FlowField%PropagationDir + + u_op(1:NumExtendedIO) = tmp_op(1:NumExtendedIO) + end if if ( PRESENT( y_op ) ) then if (.not. allocated(y_op)) then - call AllocAry(y_op, size(u%PositionXYZ)+p%NumOuts+3, 'y_op', ErrStat2, ErrMsg2) + call AllocAry(y_op, NumExtendedIO + p%NumOuts, 'y_op', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) return end if - - index = 0 - do i=1,size(u%PositionXYZ,2) - do j=1,size(u%PositionXYZ,1) - index = index + 1 !(i-1)*size(u%PositionXYZ,1)+j - y_op(index) = y%VelocityUVW(j,i) - end do - end do - - do j=1,size(y%DiskVel) - index = index + 1 - y_op(index) = y%DiskVel(j) - end do - + + y_op(1:NumExtendedIO) = tmp_op(1:NumExtendedIO) do i=1,p%NumOuts - y_op(i+index) = y%WriteOutput( i ) + y_op(NumExtendedIO + i) = y%WriteOutput( i ) end do end if diff --git a/modules/moordyn/src/MoorDyn.f90 b/modules/moordyn/src/MoorDyn.f90 index e3304fdd48..43d5c2a3a5 100644 --- a/modules/moordyn/src/MoorDyn.f90 +++ b/modules/moordyn/src/MoorDyn.f90 @@ -3606,12 +3606,12 @@ SUBROUTINE MD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, 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 ) + call MD_perturb_x(p, i, 1, x_perturb, delta ) ! compute y at x_op + delta x call MD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! get x_op - delta x call MD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_perturb_x(p, p%dxIdx_map2_xStateIdx(i), -1, x_perturb, delta ) + call MD_perturb_x(p, i, -1, x_perturb, delta ) ! compute y at x_op - delta x call MD_CalcOutput( t, u, p, x_perturb, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! get central difference: @@ -3631,12 +3631,12 @@ SUBROUTINE MD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, 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 ) + call MD_perturb_x(p, i, 1, x_perturb, delta ) ! compute x at x_op + delta x call MD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_p, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! get x_op - delta x call MD_CopyContState( x, x_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call MD_perturb_x(p, p%dxIdx_map2_xStateIdx(i), -1, x_perturb, delta ) + call MD_perturb_x(p, i, -1, x_perturb, delta ) ! compute x at x_op - delta x call MD_CalcContStateDeriv( t, u, p, x_perturb, xd, z, OtherState, m, x_m, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if(Failed()) return @@ -4317,9 +4317,10 @@ SUBROUTINE MD_Perturb_x( p, i, perturb_sign, x, dx ) 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 + integer(IntKi) :: j + dx = p%dx(i) + j = p%dxIdx_map2_xStateIdx(i) + x%states(j) = x%states(j) + dx * perturb_sign END SUBROUTINE MD_Perturb_x !---------------------------------------------------------------------------------------------------------------------------------- !> This routine uses values of two output types to compute an array of differences. diff --git a/modules/openfast-library/src/FAST_Lin.f90 b/modules/openfast-library/src/FAST_Lin.f90 index 2eb01b9eda..7f4a9bf929 100644 --- a/modules/openfast-library/src/FAST_Lin.f90 +++ b/modules/openfast-library/src/FAST_Lin.f90 @@ -70,11 +70,15 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, NumBlNodes, ErrStat, if ( p_FAST%CompInflow == Module_IfW ) then p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_IfW - call Init_Lin_IfW( p_FAST, y_FAST, AD%Input(1) ) ! overwrite some variables based on knowledge from glue code - end if - + + ! SeaState next, if activated: + if ( p_FAST%CompSeaSt == Module_SeaSt ) then + p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 + p_FAST%Lin_ModOrder( p_FAST%Lin_NumMods ) = Module_SeaSt + end if + ! ServoDyn is next, if activated: if ( p_FAST%CompServo == Module_SrvD ) then p_FAST%Lin_NumMods = p_FAST%Lin_NumMods + 1 @@ -384,52 +388,6 @@ SUBROUTINE Init_Lin_IfW( p_FAST, y_FAST, u_AD ) end do end if - ! BJJ: SINCE INFLOWWIND NOW DOES NOT GET INITIALIZED WITH THE NUMBER OF POINTS, THIS CODE DOES NOT APPLY: - !IF (p_FAST%CompAero == MODULE_AD) THEN - ! - ! DO K = 1,SIZE(u_AD%rotors(1)%BladeMotion) - ! DO J = 1,u_AD%rotors(1)%BladeMotion(k)%Nnodes - ! Node = Node + 1 ! InflowWind node - ! NodeDesc = ' (blade '//trim(num2lstr(k))//', node '//trim(num2lstr(j))//')' - ! - ! do i=1,3 !XYZ components of this node - ! i2 = (Node-1)*3 + i - ! position = index(y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2), ',') - 1 - ! y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2) = y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2)(1:position)//trim(NodeDesc)//& - ! y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2)(position+1:) - ! - ! position = index(y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2), ',') - 1 - ! y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2) = y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2)(1:position)//trim(NodeDesc)//& - ! y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2)(position+1:) - ! - ! ! IfW has inputs and outputs in the global frame - ! !y_FAST%Lin%Modules(Module_IfW)%Instance(1)%RotFrame_u(i2) = .true. - ! !y_FAST%Lin%Modules(Module_IfW)%Instance(1)%RotFrame_y(i2) = .true. - ! - ! end do - ! END DO !J = 1,p%BldNodes ! Loop through the blade nodes / elements - ! END DO !K = 1,p%NumBl - ! - ! ! tower: - ! DO J=1,u_AD%rotors(1)%TowerMotion%nnodes - ! Node = Node + 1 - ! NodeDesc = ' (Tower node '//trim(num2lstr(j))//')' - ! - ! do i=1,3 !XYZ components of this node - ! i2 = (Node-1)*3 + i - ! - ! position = index(y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2), ',') - 1 - ! y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2) = y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2)(1:position)//trim(NodeDesc)//& - ! y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_u(i2)(position+1:) - ! - ! position = index(y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2), ',') - 1 - ! y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2) = y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2)(1:position)//trim(NodeDesc)//& - ! y_FAST%Lin%Modules(Module_IfW)%Instance(1)%Names_y(i2)(position+1:) - ! end do - ! END DO - ! - !END IF - END SUBROUTINE Init_Lin_IfW !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that initializes some use_u and use_y, which determine which, if any, inputs and outputs are output in the linearization file. @@ -490,10 +448,11 @@ SUBROUTINE Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, NumBlNodes, ErrStat, ErrM y_FAST%Lin%Modules(ThisModule)%Instance(k)%use_u = .false. end do end do - - ! AD standard inputs: UserProp(NumBlNodes,NumBl) + +!NOTE: we assume that the standard inputs are the last inputs. These would ideally be checked against a stored set of indices so the order could be arbitrary + ! AD standard inputs: UserProp(NumBlNodes,NumBl), and 3 Extended inputs if (p_FAST%CompAero == MODULE_AD) then - do j=1,NumBl*NumBlNodes + do j=1,NumBl*NumBlNodes+3 y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%SizeLin(LIN_INPUT_COL)+1-j) = .true. end do end if @@ -503,16 +462,18 @@ SUBROUTINE Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, NumBlNodes, ErrStat, ErrM y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%SizeLin(LIN_INPUT_COL)+1-j) = .true. end do - ! IfW standard inputs: HWindSpeed, PLexp, PropagationDir + ! IfW standard inputs (extended): HWindSpeed, PLexp, PropagationDir if (p_FAST%CompInflow == MODULE_IfW) then do j = 1,3 y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%SizeLin(LIN_INPUT_COL)+1-j) = .true. end do end if - ! HD standard inputs: WaveElev0 + ! HD standard inputs (extended): WaveElev0, HWindSpeed, PLexp, PropagationDir if (p_FAST%CompHydro == MODULE_HD) then - y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%SizeLin(LIN_INPUT_COL)) = .true. + do j = 1,4 + y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%SizeLin(LIN_INPUT_COL)+1-j) = .true. + end do end if ! SD has no standard inputs @@ -567,16 +528,13 @@ SUBROUTINE Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, NumBlNodes, ErrStat, ErrM END SUBROUTINE Init_Lin_InputOutput !---------------------------------------------------------------------------------------------------------------------------------- -!> Routine that performs lineaization at current operating point for a turbine. -SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +!> Routine that performs lineaization at current operating point for a turbine. +SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, MeshMapData, ErrStat, ErrMsg ) - REAL(DbKi), INTENT(IN ) :: t_global !< current (global) simulation time - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data @@ -584,6 +542,7 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data @@ -592,9 +551,7 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -602,8 +559,8 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, INTEGER(IntKi) :: Un ! unit number for linearization output file (written in two parts) INTEGER(IntKi) :: ErrStat2 ! local error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Linearize_OP' - + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Linearize_OP' + REAL(R8Ki), ALLOCATABLE :: dUdu(:,:), dUdy(:,:) ! variables for glue-code linearization integer(intki) :: NumBl integer(intki) :: k @@ -612,13 +569,13 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, CHARACTER(200) :: SimStr CHARACTER(MaxWrScrLen) :: BlankLine CHARACTER(*), PARAMETER :: Fmt = 'F10.2' - - - + + + ErrStat = ErrID_None ErrMsg = "" Un = -1 - + !..................... SimStr = '(RotSpeed='//trim(num2lstr(ED%y%RotSpeed*RPS2RPM,Fmt))//' rpm, BldPitch1='//trim(num2lstr(ED%y%BlPitch(1)*R2D,Fmt))//' deg)' @@ -626,126 +583,140 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, CALL WrOver( BlankLine ) ! BlankLine contains MaxWrScrLen spaces CALL WrOver ( ' Performing linearization '//trim(num2lstr(m_FAST%Lin%NextLinTimeIndx))//' at simulation time '//TRIM( Num2LStr(t_global) )//' s. '//trim(SimStr) ) CALL WrScr('') - + !..................... - + LinRootName = TRIM(p_FAST%OutFileRoot)//'.'//trim(num2lstr(m_FAST%Lin%NextLinTimeIndx)) - + if (p_FAST%WrVTK == VTK_ModeShapes .and. .not. p_FAST%CalcSteady) then ! we already saved these for the CalcSteady case - call SaveOP(m_FAST%Lin%NextLinTimeIndx, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + call SaveOP(m_FAST%Lin%NextLinTimeIndx, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg, m_FAST%Lin%CopyOP_CtrlCode ) !m_FAST%Lin%CopyOP_CtrlCode = MESH_UPDATECOPY ! we need a new copy for each LinTime end if - - NumBl = size(ED%Input(1)%BlPitchCom) - y_FAST%Lin%RotSpeed = ED%y%RotSpeed - y_FAST%Lin%Azimuth = ED%y%LSSTipPxa - !..................... - ! ElastoDyn - !..................... + + NumBl = size(ED%Input(1)%BlPitchCom) + y_FAST%Lin%RotSpeed = ED%y%RotSpeed + y_FAST%Lin%Azimuth = ED%y%LSSTipPxa + + !..................... + ! ElastoDyn + !..................... + ! get the jacobians + call ED_JacobianPInput( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y, ED%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%B ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + call ED_JacobianPContState( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y, ED%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%A ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! get the operating point + call ED_GetOP( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y, ED%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_u, & + y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, & + x_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_x, & + dx_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_dx ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + + ! write the module matrices: + call WriteModuleLinearMatrices(Module_ED, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) + if(Failed()) return; + + !..................... + ! BeamDyn + !..................... + if ( p_FAST%CompElast == Module_BD ) then + do k=1,p_FAST%nBeams + ! get the jacobians - call ED_JacobianPInput( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%y, ED%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%B ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call ED_JacobianPContState( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%y, ED%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%A ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! get the operating point - call ED_GetOP( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%y, ED%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_u, & - y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, & - x_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_x, & - dx_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_dx ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - - ! write the module matrices: - call WriteModuleLinearMatrices(Module_ED, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) - if(Failed()) return; - - !..................... - ! BeamDyn - !..................... - if ( p_FAST%CompElast == Module_BD ) then - do k=1,p_FAST%nBeams + call BD_JacobianPInput( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & + BD%y(k), BD%m(k), ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%D, & + dXdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%B, & + StateRel_x =y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_x, & + StateRel_xdot=y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_xdot ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! get the jacobians - call BD_JacobianPInput( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & - BD%y(k), BD%m(k), ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%D, & - dXdu=y_FAST%Lin%Modules(Module_BD)%Instance(k)%B, & - StateRel_x =y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_x, & - StateRel_xdot=y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRel_xdot ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - call BD_JacobianPContState( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & - BD%y(k), BD%m(k), ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_BD)%Instance(k)%C, dXdx=y_FAST%Lin%Modules(Module_BD)%Instance(k)%A, & - StateRotation=y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRotation) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! get the operating point - call BD_GetOP( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & - BD%y(k), BD%m(k), ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_u, y_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_y, & - x_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_x, dx_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_dx ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - - ! write the module matrices: - call WriteModuleLinearMatrices(Module_BD, k, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) - if(Failed()) return; + call BD_JacobianPContState( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & + BD%y(k), BD%m(k), ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_BD)%Instance(k)%C, dXdx=y_FAST%Lin%Modules(Module_BD)%Instance(k)%A, & + StateRotation=y_FAST%Lin%Modules(Module_BD)%Instance(k)%StateRotation) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! get the operating point + call BD_GetOP( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & + BD%y(k), BD%m(k), ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_u, y_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_y, & + x_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_x, dx_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_dx ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) then + call cleanup() + return + end if + + + ! write the module matrices: + call WriteModuleLinearMatrices(Module_BD, k, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) + if(Failed()) return; + + end do + end if !BeamDyn - end do - end if !BeamDyn - !..................... ! InflowWind - !..................... - if ( p_FAST%CompInflow == Module_IfW ) then - - ! get the jacobians + !..................... + if ( p_FAST%CompInflow == Module_IfW ) then + ! get the jacobians call InflowWind_JacobianPInput( t_global, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), & IfW%OtherSt(STATE_CURR), IfW%y, IfW%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_IfW)%Instance(1)%D ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + if(Failed()) return; + ! get the operating point call InflowWind_GetOP( t_global, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), & IfW%OtherSt(STATE_CURR), IfW%y, IfW%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_IfW)%Instance(1)%op_u, & y_op=y_FAST%Lin%Modules(Module_IfW)%Instance(1)%op_y ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - - - ! write the module matrices: + if(Failed()) return; + + ! write the module matrices: call WriteModuleLinearMatrices(Module_IfW, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) if(Failed()) return; - end if - + + !..................... + ! SeaState + !..................... + if ( p_FAST%CompSeaSt == Module_SeaSt ) then + ! get the jacobians + call SeaSt_JacobianPInput( t_global, SeaSt%Input(1), SeaSt%p, SeaSt%x(STATE_CURR), SeaSt%xd(STATE_CURR), SeaSt%z(STATE_CURR), & + SeaSt%OtherSt(STATE_CURR), SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_SeaSt)%Instance(1)%D ) + if(Failed()) return; + + ! get the operating point + call SeaSt_GetOP( t_global, SeaSt%Input(1), SeaSt%p, SeaSt%x(STATE_CURR), SeaSt%xd(STATE_CURR), SeaSt%z(STATE_CURR), & + SeaSt%OtherSt(STATE_CURR), SeaSt%y, SeaSt%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_SeaSt)%Instance(1)%op_u, & + y_op=y_FAST%Lin%Modules(Module_SeaSt)%Instance(1)%op_y ) + if(Failed()) return; + + ! write the module matrices: + call WriteModuleLinearMatrices(Module_SeaSt, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) + if(Failed()) return; + end if + !..................... ! ServoDyn - !..................... - if ( p_FAST%CompServo == Module_SrvD ) then + !..................... + if ( p_FAST%CompServo == Module_SrvD ) then ! get the jacobians call SrvD_JacobianPInput( t_global, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), & SrvD%OtherSt(STATE_CURR), SrvD%y, SrvD%m, ErrStat2, ErrMsg2, & dXdu=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%B, & dYdu=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%D ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + call SrvD_JacobianPContState( t_global, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), & SrvD%OtherSt(STATE_CURR), SrvD%y, SrvD%m, ErrStat2, ErrMsg2, & dYdx=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%C, & @@ -764,7 +735,7 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, call cleanup() return end if - + call WriteModuleLinearMatrices(Module_SrvD, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) if(Failed()) return; end if @@ -772,20 +743,20 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, !..................... ! AeroDyn !..................... - if ( p_FAST%CompAero == Module_AD ) then + if ( p_FAST%CompAero == Module_AD ) then ! get the jacobians call AD_JacobianPInput( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, & dXdu=y_FAST%Lin%Modules(Module_AD)%Instance(1)%B, & dYdu=y_FAST%Lin%Modules(Module_AD)%Instance(1)%D ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if(Failed()) return; call AD_JacobianPContState( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, & dXdx=y_FAST%Lin%Modules(Module_AD)%Instance(1)%A, & dYdx=y_FAST%Lin%Modules(Module_AD)%Instance(1)%C ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + if(Failed()) return; + ! get the operating point call AD_GetOP( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, & @@ -793,52 +764,41 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, y_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_y, & x_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_x, & dx_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_dx ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >=AbortErrLev) then - call cleanup() - return - end if - + if(Failed()) return; + ! write the module matrices: call WriteModuleLinearMatrices(Module_AD, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) if(Failed()) return; - end if - + !..................... ! HydroDyn !..................... - if ( p_FAST%CompHydro == Module_HD ) then - ! get the jacobians + if ( p_FAST%CompHydro == Module_HD ) then + ! get the jacobians call HD_JacobianPInput( t_global, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & HD%y, HD%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_HD)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_HD)%Instance(1)%B ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + if(Failed()) return; + call HD_JacobianPContState( t_global, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & HD%y, HD%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_HD)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_HD)%Instance(1)%A ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! get the operating point + if(Failed()) return; + + ! get the operating point call HD_GetOP( t_global, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & HD%y, HD%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_u, y_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_y, & x_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_x, dx_op=y_FAST%Lin%Modules(Module_HD)%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(Failed()) return; + + ! write the module matrices: call WriteModuleLinearMatrices(Module_HD, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) if(Failed()) return; end if + !..................... ! SubDyn / ExtPtfm !..................... - - if ( p_FAST%CompSub == Module_SD ) then + if ( p_FAST%CompSub == Module_SD ) then ! get the jacobians call SD_JacobianPInput( t_global, SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), & SD%z(STATE_CURR), SD%OtherSt(STATE_CURR), SD%y, SD%m, ErrStat2, ErrMsg2, & @@ -861,7 +821,7 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, call WriteModuleLinearMatrices(Module_SD, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) if(Failed()) return; - elseif ( p_FAST%CompSub == Module_ExtPtfm ) then + elseif ( p_FAST%CompSub == Module_ExtPtfm ) then ! get the jacobians call ExtPtfm_JacobianPInput( t_global, ExtPtfm%Input(1), ExtPtfm%p, ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), & ExtPtfm%z(STATE_CURR), ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%y, ExtPtfm%m, ErrStat2, ErrMsg2, & @@ -885,8 +845,8 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, if(Failed()) return; end if ! SubDyn/ExtPtfm - - + + !..................... ! MAP !..................... @@ -895,7 +855,7 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, call MAP_JacobianPInput( t_global, MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), & MAPp%OtherSt, MAPp%y, ErrStat2, ErrMsg2, y_FAST%Lin%Modules(Module_MAP)%Instance(1)%D ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + ! get the operating point !LIN-TODO: template uses OtherSt(STATE_CURR), but the FAST MAP DATA has OtherSt as a scalar ! email bonnie for a discussion on this. @@ -907,50 +867,50 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, call cleanup() return end if - + ! write the module matrices: call WriteModuleLinearMatrices(Module_MAP, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) if(Failed()) return; 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 ) + 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: call WriteModuleLinearMatrices(Module_MD, 1, t_global, p_FAST, y_FAST, LinRootName, ErrStat2, ErrMsg2) if(Failed()) return; end if ! if ( p_FAST%CompMooring == Module_MD ) - + !..................... ! Linearization of glue code Input/Output solve: !..................... - + !..................... ! Glue code (currently a linearization of SolveOption2): ! Make sure we avoid any case where the operating point values change earlier in this routine (e.g., by calling the module Jacobian routines). @@ -962,33 +922,33 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, call cleanup() return end if - + ! get the dUdu and dUdy matrices, which linearize SolveOption2 for the modules we've included in linearization - call Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, MAPp, FEAM, MD, Orca, & + call Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, MAPp, FEAM, MD, Orca, & IceF, IceD, MeshMapData, dUdu, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >=AbortErrLev) then call cleanup() return end if - - - - call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Glue, LinRootName, Un, ErrStat2, ErrMsg2 ) + + + + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Glue, LinRootName, 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 call WrPartialMatrix( dUdu, Un, p_FAST%OutFmt, 'dUdu', UseRow=y_FAST%Lin%Glue%use_u, UseCol=y_FAST%Lin%Glue%use_u ) call WrPartialMatrix( dUdy, Un, p_FAST%OutFmt, 'dUdy', UseRow=y_FAST%Lin%Glue%use_u, UseCol=y_FAST%Lin%Glue%use_y ) end if - - + + ! calculate the glue-code state matrices call Glue_StateMatrices( p_FAST, y_FAST, dUdu, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -996,9 +956,9 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, call cleanup() return end if - + ! Write the results to the file: - call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Glue ) + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Glue ) m_FAST%Lin%NextLinTimeIndx = m_FAST%Lin%NextLinTimeIndx + 1 @@ -1009,14 +969,14 @@ logical function Failed() if(Failed) call cleanup() end function Failed subroutine cleanup() - + if (allocated(dUdu)) deallocate(dUdu) if (allocated(dUdy)) deallocate(dUdy) - + if (Un > 0) close(Un) - + end subroutine cleanup -END SUBROUTINE FAST_Linearize_OP +END SUBROUTINE FAST_Linearize_OP !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that writes the A,B,C,D matrices from linearization to a text file. SUBROUTINE WrLinFile_txt_Head(t_global, p_FAST, y_FAST, LinData, FileName, Un, ErrStat, ErrMsg) @@ -1460,7 +1420,7 @@ END SUBROUTINE Glue_GetOP !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the Jacobian for the glue-code input-output solves. -SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, MAPp, FEAM, MD, Orca, & +SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, MAPp, FEAM, MD, Orca, & IceF, IceD, MeshMapData, dUdu, dUdy, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code @@ -1474,6 +1434,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInf TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data @@ -1560,13 +1521,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInf end do - !............ - ! \f$ \frac{\partial U_\Lambda^{IfW}}{\partial u^{AD}} \end{bmatrix} = \f$ (dUdu block row 1=IfW) - !............ - IF (p_FAST%CompInflow == MODULE_IfW .and. p_FAST%CompAero == MODULE_AD) THEN - call Linear_IfW_InputSolve_du_AD( p_FAST, y_FAST, AD%Input(1), dUdu ) - end if ! we're using the InflowWind module - + !............ ! \f$ \frac{\partial U_\Lambda^{SrvD}}{\partial u^{SrvD}} \end{bmatrix} = \f$ (dUdu block row 2=SrvD) !............ @@ -1585,7 +1540,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInf !............ ! 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, MD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, ED%p, ED%Input(1), ED%y, AD%p, AD%Input(1), AD%y, BD, HD, SD, MAPp, MD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !............ @@ -1593,7 +1548,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInf ! \f$ \frac{\partial U_\Lambda^{BD}}{\partial u^{AD}} \end{bmatrix} = \f$ (dUdu block row 4=BD) !............ IF (p_FAST%CompElast == Module_BD) THEN - call Linear_BD_InputSolve_du( p_FAST, y_FAST, SrvD, ED%y, AD%y, AD%Input(1), BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call Linear_BD_InputSolve_du( p_FAST, y_FAST, SrvD, ED%y, AD%p, AD%Input(1), AD%y, BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END IF @@ -1601,7 +1556,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInf ! \f$ \frac{\partial U_\Lambda^{AD}}{\partial u^{AD}} \end{bmatrix} = \f$ (dUdu block row 5=AD) !............ IF (p_FAST%CompAero == MODULE_AD) THEN - call Linear_AD_InputSolve_du( p_FAST, y_FAST, AD%Input(1), ED%y, BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call Linear_AD_InputSolve_du( p_FAST, y_FAST, AD%p, AD%Input(1), ED%y, BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END IF @@ -1669,7 +1624,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInf ! \f$ \frac{\partial U_\Lambda^{SrvD}}{\partial y^{ED}} \end{bmatrix} = \f$ (dUdy block row 2=SrvD) !............ if (p_FAST%CompServo == MODULE_SrvD) then ! need to do this regardless of CompElast - call Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, SrvD%p, SrvD%Input(1), ED%y, BD, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, SrvD%p, SrvD%Input(1), ED%p, ED%y, BD, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1684,7 +1639,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInf ! \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, MD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, ED%p, ED%Input(1), ED%y, AD%p, AD%Input(1), AD%y, BD, HD, SD, MAPp, MD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !............ @@ -1693,7 +1648,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInf ! \f$ \frac{\partial U_\Lambda^{BD}}{\partial y^{AD}} \end{bmatrix} = \f$ (dUdy block row 4=BD) !............ if (p_FAST%CompElast == MODULE_BD) then - call Linear_BD_InputSolve_dy( p_FAST, y_FAST, SrvD, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_BD_InputSolve_dy( p_FAST, y_FAST, SrvD, ED%p, ED%Input(1), ED%y, AD%p, AD%Input(1), AD%y, BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1705,10 +1660,10 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInf if (p_FAST%CompAero == MODULE_AD) then ! need to do this regardless of CompElast if (p_FAST%CompInflow == MODULE_IfW) then - call Linear_AD_InputSolve_IfW_dy( p_FAST, y_FAST, AD%Input(1), dUdy ) + call Linear_AD_InputSolve_IfW_dy( p_FAST, y_FAST, AD%p, AD%Input(1), dUdy ) end if - call Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, AD%Input(1), ED%y, BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, AD%p, AD%Input(1), ED%p, ED%y, BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1721,13 +1676,21 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInf ! \f$ \frac{\partial U_\Lambda^{SD}}{\partial y^{MAP}} \end{bmatrix} = \f$ (dUdy block row 7=SD) !............ if (p_FAST%CompHydro == MODULE_HD) then - call Linear_HD_InputSolve_dy( p_FAST, y_FAST, HD%Input(1), ED%y, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_HD_InputSolve_dy( p_FAST, y_FAST, HD%Input(1), ED%p, ED%y, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + if (p_FAST%CompSeaSt == MODULE_SeaSt) then + call Linear_HD_InputSolve_SeaSt_dy( p_FAST, y_FAST, SeaSt%p, HD%p, HD%Input(1), dUdy ) + end if + + if (p_FAST%CompInflow == MODULE_IfW .and. p_FAST%MHK /= MHK_None) then + call Linear_HD_InputSolve_IfW_dy( p_FAST, y_FAST, HD%p, HD%Input(1), dUdy ) + end if end if !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, MD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, SD%Input(1), SD%y, ED%p, ED%y, HD, MAPp, MD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ELSE IF (p_FAST%CompSub == Module_ExtPtfm) THEN CALL WrScr('>>> FAST_LIN: Linear_ExtPtfm_InputSolve_dy, TODO') @@ -1738,7 +1701,7 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInf ! \f$ \frac{\partial U_\Lambda^{MAP}}{\partial y^{SD}} \end{bmatrix} = \f$ (dUdy block row 8=MAP) !............ if (p_FAST%CompMooring == MODULE_MAP) then - call Linear_MAP_InputSolve_dy( p_FAST, y_FAST, MAPp%Input(1), ED%y, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_MAP_InputSolve_dy( p_FAST, y_FAST, MAPp%Input(1), ED%p, ED%y, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if !............ @@ -1746,86 +1709,25 @@ SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInf ! \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 Linear_MD_InputSolve_dy( p_FAST, y_FAST, MD%Input(1), ED%p, ED%y, SD%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if END SUBROUTINE Glue_Jacobians - !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine forms the dU^{IfW}/du^{AD} block of dUdu. (i.e., how do changes in the AD inputs affect IfW inputs?) -SUBROUTINE Linear_IfW_InputSolve_du_AD( p_FAST, y_FAST, u_AD, dUdu ) - - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output data (for linearization) - TYPE(AD_InputType), INTENT(IN) :: u_AD !< The input meshes (already calculated) from AeroDyn - REAL(R8Ki), INTENT(INOUT) :: dUdu(:,:) !< Jacobian matrix of which we are computing the dU^(IfW)/du^(AD) block - - - INTEGER(IntKi) :: i, j, k ! loop counters - INTEGER(IntKi) :: i2, j2 ! loop counters - INTEGER(IntKi) :: AD_Start_Bl ! starting index of dUdu (column) where AD blade motion inputs are located - INTEGER(IntKi) :: Node ! InflowWind node number - - - ! compare with IfW_InputSolve(): - - Node = 0 !InflowWind node - if (p_FAST%CompServo == MODULE_SrvD) Node = Node + 1 - - IF (p_FAST%CompAero == MODULE_AD) THEN - - ! blades: - AD_Start_Bl = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) & - + u_AD%rotors(1)%TowerMotion%NNodes * 9 & ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel) with 3 components - + u_AD%rotors(1)%HubMotion%NNodes * 9 ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_RotationVel) with 3 components - - do k = 1,size(u_AD%rotors(1)%BladeRootMotion) - AD_Start_Bl = AD_Start_Bl + u_AD%rotors(1)%BladeRootMotion(k)%NNodes * 3 ! 1 field (MASKID_Orientation) with 3 components - end do - ! next is u_AD%rotors(1)%BladeMotion(k): - - DO K = 1,SIZE(u_AD%rotors(1)%BladeMotion) - DO J = 1,u_AD%rotors(1)%BladeMotion(k)%Nnodes - Node = Node + 1 ! InflowWind node - do i=1,3 !XYZ components of this node - i2 = y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (Node-1)*3 + i - 1 - j2 = AD_Start_Bl + (j-1)*3 + i - 1 - dUdu( i2, j2 ) = -1.0_R8Ki - end do - END DO !J = 1,p%BldNodes ! Loop through the blade nodes / elements - - ! get starting AD index of BladeMotion for next blade - AD_Start_Bl = AD_Start_Bl + u_AD%rotors(1)%BladeMotion(k)%Nnodes * 9 ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel) with 3 components - END DO !K = 1,p%NumBl - - ! tower: - DO J=1,u_AD%rotors(1)%TowerMotion%nnodes - Node = Node + 1 - do i=1,3 !XYZ components of this node - i2 = y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (Node-1)*3 + i - 1 - j2 = y_FAST%Lin%Modules(MODULE_AD )%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (j-1)*3 + i - 1 - dUdu( i2, j2 ) = -1.0_R8Ki - end do - END DO - - ! HubPosition and HubOrientation from ElastoDyn are missing from this - END IF -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, MD, MeshMapData, dUdu, ErrStat, ErrMsg ) +!> 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, p_ED, u_ED, y_ED, p_AD, u_AD, y_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) type(ServoDyn_Data), intent(in ) :: SrvD !< SrvD parameters + TYPE(ED_ParameterType), intent(in ) :: p_ED !< ED Inputs at t TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) - TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AD parameters (for AD-ED load linerization) TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) + TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HD data at t TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SD data at t @@ -1841,7 +1743,7 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD INTEGER(IntKi) :: K ! Loops through blades INTEGER(IntKi) :: SrvD_Start ! starting index of dUdu (column) where SrvD StC load is INTEGER(IntKi) :: BD_Start ! starting index of dUdu (column) where BD root motion inputs are located - INTEGER(IntKi) :: AD_Start_Bl ! starting index of dUdu (column) where AD blade motion inputs are located + INTEGER(IntKi) :: AD_Start ! starting index of dUdu (column) where AD motion inputs are located INTEGER(IntKi) :: ED_Start_mt ! starting index of dUdu (row) where ED blade/tower or hub moment inputs are located 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 @@ -1894,7 +1796,7 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD call Linearize_Point_to_Point( SrvD%y%NStCLoadMesh(j), u_ED%NacelleLoads, MeshMapData%NStC_P_2_ED_P_N(j), ErrStat2, ErrMsg2, SrvD%Input(1)%NStCMotionMesh(j), y_ED%NacelleMotion ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ED_Start_mt = Indx_u_ED_Nacelle_Start(u_ED, y_FAST) & + ED_Start_mt = Indx_u_ED_Nacelle_Start(p_ED, u_ED, y_FAST) & + u_ED%NacelleLoads%NNodes * 3 ! 3 forces at the nacelle (so we start at the moments) SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_NStC_u(1,j) ! SrvD is source in the mapping, so we want M_{uSm} (moments) @@ -1912,7 +1814,7 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD call Linearize_Point_to_Point( SrvD%y%TStCLoadMesh(j), u_ED%TowerPtLoads, MeshMapData%TStC_P_2_ED_P_T(j), ErrStat2, ErrMsg2, SrvD%Input(1)%TStCMotionMesh(j), y_ED%TowerLn2Mesh ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ED_Start_mt = Indx_u_ED_Tower_Start(u_ED, y_FAST) & + ED_Start_mt = Indx_u_ED_Tower_Start(p_ED, u_ED, y_FAST) & + u_ED%TowerPtLoads%NNodes * 3 ! 3 forces at the nacelle (so we start at the moments) SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_TStC_u(1,j) ! SrvD is source in the mapping, so we want M_{uSm} (moments) @@ -1931,7 +1833,7 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD call Linearize_Point_to_Point( SrvD%y%SStCLoadMesh(j), u_ED%PlatformPtMesh, MeshMapData%SStC_P_P_2_SubStructure(j), ErrStat2, ErrMsg2, SrvD%Input(1)%SStCMotionMesh(j), y_ED%PlatformPtMesh ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ED_Start_mt = Indx_u_ED_Platform_Start(u_ED, y_FAST) & + ED_Start_mt = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) & + u_ED%PlatformPtMesh%NNodes * 3 ! 3 forces at the nacelle (so we start at the moments) SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_SStC_u(1,j) ! SrvD is source in the mapping, so we want M_{uSm} (moments) @@ -1957,14 +1859,14 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD DO K = 1,SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) ED_Start_mt = ED_Start_mt + u_ED%BladePtLoads(k)%NNodes*3 ! skip the forces on this blade - AD_Start_Bl = Indx_u_AD_Blade_Start(u_AD, y_FAST, k) + AD_Start = Indx_u_AD_Blade_Start(p_AD, u_AD, y_FAST, k) CALL Linearize_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! AD is source in the mapping, so we want M_{uSm} if (allocated(MeshMapData%AD_L_2_BDED_B(k)%dM%m_us )) then - call SetBlockMatrix( dUdu, MeshMapData%AD_L_2_BDED_B(k)%dM%m_us, ED_Start_mt, AD_Start_Bl ) + call SetBlockMatrix( dUdu, MeshMapData%AD_L_2_BDED_B(k)%dM%m_us, ED_Start_mt, AD_Start ) end if ! get starting index of next blade @@ -1975,17 +1877,58 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD END IF ! ED inputs on tower from AD: - IF ( y_AD%rotors(1)%TowerLoad%Committed ) THEN - ED_Start_mt = Indx_u_ED_Tower_Start(u_ED, y_FAST) & - + u_ED%TowerPtLoads%NNodes * 3 ! 3 forces at each node (we're going to start at the moments) + ED_Start_mt = Indx_u_ED_Tower_Start(p_ED, u_ED, y_FAST) + u_ED%TowerPtLoads%NNodes * 3 ! skip 3 forces at each node + AD_Start = Indx_u_AD_Tower_Start(p_AD, u_AD, y_FAST) CALL Linearize_Line2_to_Point( y_AD%rotors(1)%TowerLoad, u_ED%TowerPtLoads, MeshMapData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, u_AD%rotors(1)%TowerMotion, y_ED%TowerLn2Mesh ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! AD is source in the mapping, so we want M_{uSm} if (allocated(MeshMapData%AD_L_2_ED_P_T%dM%m_us )) then - call SetBlockMatrix( dUdu, MeshMapData%AD_L_2_ED_P_T%dM%m_us, ED_Start_mt, y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) ) + call SetBlockMatrix( dUdu, MeshMapData%AD_L_2_ED_P_T%dM%m_us, ED_Start_mt, AD_Start ) + end if + END IF + + ! ED inputs on Hub from AD: + IF ( y_AD%rotors(1)%HubLoad%Committed ) THEN + ED_Start_mt = Indx_u_ED_Hub_Start(p_ED, u_ED, y_FAST) + u_ED%HubPtLoad%NNodes * 3 ! skip 3 forces at each node + AD_Start = Indx_u_AD_Hub_Start(p_AD, u_AD, y_FAST) + + CALL Linearize_Point_to_Point( y_AD%rotors(1)%HubLoad, u_ED%HubPtLoad, MeshMapData%AD_P_2_ED_P_H, ErrStat2, ErrMsg2, u_AD%rotors(1)%HubMotion, y_ED%HubPtMotion ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! AD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%AD_P_2_ED_P_H%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%AD_P_2_ED_P_H%dM%m_us, ED_Start_mt, AD_Start ) + end if + END IF + + ! ED inputs on Nacelle from AD: + IF ( y_AD%rotors(1)%NacelleLoad%Committed ) THEN + ED_Start_mt = Indx_u_ED_Nacelle_Start(p_ED, u_ED, y_FAST) + u_ED%NacelleLoads%NNodes * 3 ! skip 3 forces at each node + AD_Start = Indx_u_AD_Nacelle_Start(p_AD, u_AD, y_FAST) + + CALL Linearize_Point_to_Point( y_AD%rotors(1)%NacelleLoad, u_ED%NacelleLoads, MeshMapData%AD_P_2_ED_P_N, ErrStat2, ErrMsg2, u_AD%rotors(1)%NacelleMotion, y_ED%NacelleMotion ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! AD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%AD_P_2_ED_P_N%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%AD_P_2_ED_P_N%dM%m_us, ED_Start_mt, AD_Start ) + end if + END IF + + ! ED inputs on Tailfin from AD: + IF ( y_AD%rotors(1)%TFinLoad%Committed ) THEN + ED_Start_mt = Indx_u_ED_TFin_Start(p_ED, u_ED, y_FAST) + u_ED%TFinCMLoads%NNodes * 3 ! skip 3 forces at each node + AD_Start = Indx_u_AD_TFin_Start(p_AD, u_AD, y_FAST) + + CALL Linearize_Point_to_Point( y_AD%rotors(1)%TFinLoad, u_ED%TFinCMLoads, MeshMapData%AD_P_2_ED_P_TF, ErrStat2, ErrMsg2, u_AD%rotors(1)%TFinMotion, y_ED%TFinCMMotion ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! AD is source in the mapping, so we want M_{uSm} + if (allocated(MeshMapData%AD_L_2_ED_P_T%dM%m_us )) then + call SetBlockMatrix( dUdu, MeshMapData%AD_P_2_ED_P_TF%dM%m_us, ED_Start_mt, AD_Start ) end if END IF @@ -1997,7 +1940,7 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD !.......... IF ( p_FAST%CompElast == Module_BD ) THEN ! see routine U_ED_SD_HD_BD_Orca_Residual() in SolveOption1 - ED_Start_mt = Indx_u_ED_Hub_Start(u_ED, y_FAST) & + ED_Start_mt = Indx_u_ED_Hub_Start(p_ED, u_ED, y_FAST) & + u_ED%HubPtLoad%NNodes * 3 ! 3 forces at the hub (so we start at the moments) ! Transfer BD loads to ED hub input: @@ -2017,7 +1960,7 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD END IF - ED_Start_mt = Indx_u_ED_Platform_Start(u_ED, y_FAST) & + ED_Start_mt = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) & + u_ED%PlatformPtMesh%NNodes * 3 ! 3 forces at each node (we're going to start at the moments) if ( p_FAST%CompSub == Module_SD ) then @@ -2083,7 +2026,7 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD if ( p_FAST%CompMooring == Module_MAP ) then - ED_Start_mt = Indx_u_ED_Platform_Start(u_ED, y_FAST) & + ED_Start_mt = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) & + u_ED%PlatformPtMesh%NNodes * 3 ! 3 forces at each node (we're going to start at the moments) ! Transfer MAP loads to ED PlatformPtmesh input: @@ -2106,7 +2049,7 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD !.......... else if ( p_FAST%CompMooring == Module_MD ) then - ED_Start_mt = Indx_u_ED_Platform_Start(u_ED, y_FAST) & + ED_Start_mt = Indx_u_ED_Platform_Start(p_ED, 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: @@ -2315,13 +2258,14 @@ 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, MD, MeshMapData, dUdy, ErrStat, ErrMsg ) +SUBROUTINE Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_SD, y_SD, p_ED, 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) type(ServoDyn_Data), intent(in ) :: SrvD !< SrvD parameters TYPE(SD_InputType), INTENT(INOUT) :: u_SD !< SD Inputs at t TYPE(SD_OutputType), INTENT(IN ) :: y_SD !< SubDyn outputs (need translation displacement on meshes for loads mapping) + TYPE(ED_ParameterType), intent(in ) :: p_ED !< ED Inputs at t 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 @@ -2372,8 +2316,8 @@ SUBROUTINE Linear_SD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_SD, y_SD, y_ED, HD, !!!call Linearize_Point_to_Line2( y_ED%PlatformPtMesh, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) SD_Start = Indx_u_SD_TPMesh_Start(u_SD, y_FAST) ! start of u_SD%MTPMesh%TranslationDisp field - 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_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, SD_Start, ED_Out_Start, dUdy, .false.) + ED_Out_Start = Indx_y_ED_Platform_Start(p_ED, y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, SD_Start, ED_Out_Start, dUdy) !.......... ! dU^{SD}/dy^{HD} @@ -2452,14 +2396,15 @@ END SUBROUTINE Linear_SD_InputSolve_dy !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{BD}/du^{BD} and dU^{BD}/du^{AD} blocks (BD row) of dUdu. (i.e., how do changes in the AD and BD inputs !! affect the BD inputs?) This should be called only when p_FAST%CompElast == Module_BD. -SUBROUTINE Linear_BD_InputSolve_du( p_FAST, y_FAST, SrvD, y_ED, y_AD, u_AD, BD, MeshMapData, dUdu, ErrStat, ErrMsg ) +SUBROUTINE Linear_BD_InputSolve_du( p_FAST, y_FAST, SrvD, y_ED, p_AD, u_AD, y_AD, BD, 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) type(ServoDyn_Data), intent(in ) :: SrvD !< SrvD parameters TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) - TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AD paraemters (for AD-ED load linerization) TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) + TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -2546,7 +2491,7 @@ SUBROUTINE Linear_BD_InputSolve_du( p_FAST, y_FAST, SrvD, y_ED, y_AD, u_AD, BD, ! AD is source in the mapping, so we want M_{uSm} if (allocated(MeshMapData%AD_L_2_BDED_B(k)%dM%m_us )) then - AD_Start = Indx_u_AD_Blade_Start(u_AD, y_FAST, k) ! index for the start of u_AD%rotors(1)%BladeMotion(k)%translationDisp field + AD_Start = Indx_u_AD_Blade_Start(p_AD, u_AD, y_FAST, k) ! index for the start of u_AD%rotors(1)%BladeMotion(k)%translationDisp field BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) & + BD%Input(1,k)%RootMotion%NNodes *18 & ! displacement, rotation, & acceleration fields for each node @@ -2594,12 +2539,11 @@ SUBROUTINE Linear_BD_InputSolve_du( p_FAST, y_FAST, SrvD, y_ED, y_AD, u_AD, BD, END SUBROUTINE Linear_BD_InputSolve_du !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{AD}/du^{AD} block of dUdu. (i.e., how do changes in the AD inputs affect the AD inputs?) -SUBROUTINE Linear_AD_InputSolve_du( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMapData, dUdu, ErrStat, ErrMsg ) - - ! Passed variables +SUBROUTINE Linear_AD_InputSolve_du( p_FAST, y_FAST, p_AD, u_AD, y_ED, BD, MeshMapData, dUdu, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn15 + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< The parameters of AD15 TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -2629,61 +2573,84 @@ SUBROUTINE Linear_AD_InputSolve_du( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMapData, ! Set the inputs from ElastoDyn and/or BeamDyn: !------------------------------------------------------------------------------------------------- - ! tower - IF (u_AD%rotors(1)%TowerMotion%Committed) THEN + !----------------------------------- + ! Nacelle - Disp, Orient + ! NOTE: no velocity or acceleration terms, so nothing to do here. + if (u_AD%rotors(1)%NacelleMotion%Committed) then + call Linearize_Point_to_Point( y_ED%NacelleMotion, u_AD%rotors(1)%NacelleMotion, MeshMapData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%NacelleMotion' ) + end if + + + !----------------------------------- + ! Hub - Disp, Orient, RotVel + if (u_AD%rotors(1)%HubMotion%Committed) then + call Linearize_Point_to_Point( y_ED%HubPtMotion, u_AD%rotors(1)%HubMotion, MeshMapData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%HubMotion' ) + end if + - CALL Linearize_Line2_to_Line2( y_ED%TowerLn2Mesh, u_AD%rotors(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%TowerMotion' ) + !----------------------------------- + ! TailFin - Disp, Orient, TransVel, TransAcc + if (u_AD%rotors(1)%TFinMotion%Committed) then + call Linearize_Point_to_Point( y_ED%TFinCMMotion, u_AD%rotors(1)%TFinMotion, MeshMapData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%TFinMotion' ) + + !AD is the destination here, so we need tv_ud + if (allocated( MeshMapData%ED_P_2_AD_P_TF%dM%tv_ud)) then + AD_Start_td = Indx_u_AD_TFin_Start(p_AD, u_AD, y_FAST) ! index for u_AD%rotors(1)%TFinMotion(k)%translationDisp field + AD_Start_tv = AD_Start_td + u_AD%rotors(1)%TFinMotion%NNodes * 6 ! 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field + call SetBlockMatrix( dUdu, MeshMapData%ED_P_2_AD_P_TF%dM%tv_ud, AD_Start_tv, AD_Start_td ) + end if + end if + !----------------------------------- + ! tower - Disp, Orient, TransVel, TransAcc + IF (u_AD%rotors(1)%TowerMotion%Committed) THEN + CALL Linearize_Line2_to_Line2( y_ED%TowerLn2Mesh, u_AD%rotors(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%TowerMotion' ) + AD_Start_td = Indx_u_AD_Tower_Start(p_AD, u_AD, y_FAST) ! index for u_AD%rotors(1)%TowerMotion(k)%translationDisp field !AD is the destination here, so we need tv_ud if (allocated( MeshMapData%ED_L_2_AD_L_T%dM%tv_ud)) then - AD_Start_td = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - AD_Start_tv = AD_Start_td + u_AD%rotors(1)%TowerMotion%NNodes * 6 ! 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field - + AD_Start_tv = AD_Start_td + u_AD%rotors(1)%TowerMotion%NNodes * 6 ! 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field call SetBlockMatrix( dUdu, MeshMapData%ED_L_2_AD_L_T%dM%tv_ud, AD_Start_tv, AD_Start_td ) end if - - + if (allocated( MeshMapData%ED_L_2_AD_L_T%dM%ta_ud)) then + AD_Start_ta = AD_Start_td + u_AD%rotors(1)%TowerMotion%NNodes * 9 ! 3 fields (TranslationDisp and Orientation, transVel) with 3 components before translational accel + call SetBlockMatrix( dUdu, MeshMapData%ED_L_2_AD_L_T%dM%ta_ud, AD_Start_ta, AD_Start_td ) + end if END IF ! blades IF (p_FAST%CompElast == Module_ED ) THEN - DO k=1,size(u_AD%rotors(1)%BladeMotion) CALL Linearize_Line2_to_Line2( y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeMotion('//trim(num2lstr(k))//')' ) END DO - ELSEIF (p_FAST%CompElast == Module_BD ) THEN - DO k=1,size(u_AD%rotors(1)%BladeMotion) CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeMotion('//trim(num2lstr(k))//')' ) END DO - END IF DO k=1,size(u_AD%rotors(1)%BladeMotion) - AD_Start_td = Indx_u_AD_Blade_Start(u_AD, y_FAST, k) ! index for u_AD%rotors(1)%BladeMotion(k)%translationDisp field - + AD_Start_td = Indx_u_AD_Blade_Start(p_AD, u_AD, y_FAST, k) ! index for u_AD%rotors(1)%BladeMotion(k)%translationDisp field !AD is the destination here, so we need tv_ud if (allocated( MeshMapData%BDED_L_2_AD_L_B(k)%dM%tv_ud)) then ! index for u_AD%rotors(1)%BladeMotion(k+1)%translationVel field AD_Start_tv = AD_Start_td + u_AD%rotors(1)%BladeMotion(k)%NNodes * 6 ! 2 fields (TranslationDisp and Orientation) with 3 components before translational velocity field - call SetBlockMatrix( dUdu, MeshMapData%BDED_L_2_AD_L_B(k)%dM%tv_ud, AD_Start_tv, AD_Start_td ) end if - + if (allocated( MeshMapData%BDED_L_2_AD_L_B(k)%dM%ta_ud)) then - AD_Start_ta = AD_Start_td + u_AD%rotors(1)%BladeMotion(k)%NNodes * 12 ! 4 fields (TranslationDisp, Orientation, TranslationVel, and RotationVel) with 3 components before translational velocity field - + AD_Start_ta = AD_Start_td + u_AD%rotors(1)%BladeMotion(k)%NNodes * 12 ! 4 fields (TranslationDisp, Orientation, TranslationVel, and RotationVel) with 3 components before translational acceleration field call SetBlockMatrix( dUdu, MeshMapData%BDED_L_2_AD_L_B(k)%dM%ta_ud, AD_Start_ta, AD_Start_td ) end if - END DO END SUBROUTINE Linear_AD_InputSolve_du @@ -2868,12 +2835,12 @@ END SUBROUTINE Linear_SrvD_InputSolve_du !> This routine forms the dU^{SrvD}/dy^{ED}, dU^{SrvD}/dy^{BD}, dU^{SrvD}/dy^{SD} block of dUdy. !! (i.e., how do changes in the ED, SD, BD outputs affect the SrvD inputs?) !! NOTE: Linearze_Point_to_Point routines done in Linear_SrvD_InputSolve_du -SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, p_SrvD, u_SrvD, y_ED, BD, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) -!.................................................................................................................................. +SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, p_SrvD, u_SrvD, p_ED, y_ED, BD, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) type(FAST_ParameterType), intent(in ) :: p_FAST !< Glue-code simulation parameters type(FAST_OutputFileType), intent(in ) :: y_FAST !< Output variables for the glue code type(SrvD_ParameterType), intent(in ) :: p_SrvD !< SrvD parameters (holds indices for jacobian entries for each StC) type(SrvD_InputType), intent(inout) :: u_SrvD !< SrvD Inputs at t + TYPE(ED_ParameterType), intent(in ) :: p_ED !< ED Inputs at t type(ED_OutputType), intent(in ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) type(BeamDyn_Data), intent(in ) :: BD !< BeamDyn data type(SD_OutputType), intent(in ) :: y_SD !< SubDyn outputs (need translation displacement on meshes for loads mapping) @@ -2913,8 +2880,8 @@ SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, p_SrvD, u_SrvD, y_ED, BD, do K = 1,size(y_ED%BladeLn2Mesh) if (u_SrvD%BStCMotionMesh(K,j)%Committed) then SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_BStC_u(1,k,j)) - ED_Out_Start = Indx_y_ED_Blade_Start(y_ED, y_FAST, k) ! start of %TranslationDisp field - call Assemble_dUdy_Motions( y_ED%BladeLn2Mesh(K), u_SrvD%BStCMotionMesh(K,j), MeshMapData%ED_L_2_BStC_P_B(K,j), SrvD_Start, ED_Out_Start, dUdy, .false.) + ED_Out_Start = Indx_y_ED_Blade_Start(p_ED, y_ED, y_FAST, k) ! start of %TranslationDisp field + call Assemble_dUdy_Motions( y_ED%BladeLn2Mesh(K), u_SrvD%BStCMotionMesh(K,j), MeshMapData%ED_L_2_BStC_P_B(K,j), SrvD_Start, ED_Out_Start, dUdy) endif enddo enddo @@ -2929,7 +2896,7 @@ SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, p_SrvD, u_SrvD, y_ED, BD, if (u_SrvD%BStCMotionMesh(K,j)%Committed) then SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_BStC_u(1,k,j)) BD_Out_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_OUTPUT_COL) ! start of %TranslationDisp field - call Assemble_dUdy_Motions( BD%y(k)%BldMotion, u_SrvD%BStCMotionMesh(K,j), MeshMapData%BD_L_2_BStC_P_B(K,j), SrvD_Start, BD_Out_Start, dUdy, .false.) + call Assemble_dUdy_Motions( BD%y(k)%BldMotion, u_SrvD%BStCMotionMesh(K,j), MeshMapData%BD_L_2_BStC_P_B(K,j), SrvD_Start, BD_Out_Start, dUdy) endif enddo enddo @@ -2943,8 +2910,8 @@ SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, p_SrvD, u_SrvD, y_ED, BD, do j = 1,size(u_SrvD%NStCMotionMesh) if (u_SrvD%NStCMotionMesh(j)%Committed) then SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_NStC_u(1,j)) - ED_Out_Start = Indx_y_ED_Nacelle_Start(y_ED, y_FAST) ! start of %TranslationDisp field - call Assemble_dUdy_Motions( y_ED%NacelleMotion, u_SrvD%NStCMotionMesh(j), MeshMapData%ED_P_2_NStC_P_N(j), SrvD_Start, ED_Out_Start, dUdy, .false.) + ED_Out_Start = Indx_y_ED_Nacelle_Start(p_ED, y_ED, y_FAST) ! start of %TranslationDisp field + call Assemble_dUdy_Motions( y_ED%NacelleMotion, u_SrvD%NStCMotionMesh(j), MeshMapData%ED_P_2_NStC_P_N(j), SrvD_Start, ED_Out_Start, dUdy) endif enddo endif @@ -2956,8 +2923,8 @@ SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, p_SrvD, u_SrvD, y_ED, BD, do j = 1,size(u_SrvD%TStCMotionMesh) if (u_SrvD%TStCMotionMesh(j)%Committed) then SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_TStC_u(1,j)) - ED_Out_Start = Indx_y_ED_Tower_Start(y_ED, y_FAST) ! start of %TranslationDisp field - call Assemble_dUdy_Motions( y_ED%TowerLn2Mesh, u_SrvD%TStCMotionMesh(j), MeshMapData%ED_L_2_TStC_P_T(j), SrvD_Start, ED_Out_Start, dUdy, .false.) + ED_Out_Start = Indx_y_ED_Tower_Start(p_ED, y_ED, y_FAST) ! start of %TranslationDisp field + call Assemble_dUdy_Motions( y_ED%TowerLn2Mesh, u_SrvD%TStCMotionMesh(j), MeshMapData%ED_L_2_TStC_P_T(j), SrvD_Start, ED_Out_Start, dUdy) endif enddo endif @@ -2973,8 +2940,8 @@ SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, p_SrvD, u_SrvD, y_ED, BD, do j=1,size(u_SrvD%SStCMotionMesh) if (u_SrvD%SStCMotionMesh(j)%Committed) then SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_SStC_u(1,j)) - ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of %TranslationDisp field - call Assemble_dUdy_Motions( y_ED%PlatformPtMesh, u_SrvD%SStCMotionMesh(j), MeshMapData%Substructure_2_SStC_P_P(j), SrvD_Start, ED_Out_Start, dUdy, .false.) + ED_Out_Start = Indx_y_ED_Platform_Start(p_ED, y_ED, y_FAST) ! start of %TranslationDisp field + call Assemble_dUdy_Motions( y_ED%PlatformPtMesh, u_SrvD%SStCMotionMesh(j), MeshMapData%Substructure_2_SStC_P_P(j), SrvD_Start, ED_Out_Start, dUdy) endif enddo endif @@ -2987,7 +2954,7 @@ SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, p_SrvD, u_SrvD, y_ED, BD, if (u_SrvD%SStCMotionMesh(j)%Committed) then SrvD_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + (p_SrvD%Jac_Idx_SStC_u(1,j)) SD_Out_Start = Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) ! start of %TranslationDisp field - call Assemble_dUdy_Motions( y_SD%y3Mesh, u_SrvD%SStCMotionMesh(j), MeshMapData%SubStructure_2_SStC_P_P(j), SrvD_Start, SD_Out_Start, dUdy, .false.) + call Assemble_dUdy_Motions( y_SD%y3Mesh, u_SrvD%SStCMotionMesh(j), MeshMapData%SubStructure_2_SStC_P_P(j), SrvD_Start, SD_Out_Start, dUdy) endif enddo endif @@ -2999,15 +2966,16 @@ 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, MD, MeshMapData, dUdy, ErrStat, ErrMsg ) - +SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, p_ED, u_ED, y_ED, p_AD, u_AD, y_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) type(ServoDyn_Data), intent(in ) :: SrvD !< SrvD parameters TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ElastoDyn parameters TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) - TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AeroDyn outputs TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) + TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD data at t TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HD data at t TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SD data at t @@ -3025,6 +2993,7 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD INTEGER(IntKi) :: K ! Loops through blades INTEGER(IntKi) :: SrvD_Out_Start ! starting index of dUdy (column) where the StC motion inputs are located INTEGER(IntKi) :: AD_Out_Start ! starting index of dUdy (column) where particular AD fields are located + INTEGER(IntKi) :: AD_Block_Start ! starting index of dUdy (column) for all AD outputs INTEGER(IntKi) :: BD_Out_Start ! starting index of dUdy (column) where particular BD fields are located INTEGER(IntKi) :: ED_Start ! starting index of dUdy (row) where ED input fields are located INTEGER(IntKi) :: ED_Out_Start ! starting index of dUdy (column) where ED output fields are located @@ -3047,7 +3016,7 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD IF ( p_FAST%CompServo == Module_SrvD ) THEN ! BlPitchCom, YawMom, GenTrq - ED_Start = Indx_u_ED_BlPitchCom_Start(u_ED, y_FAST) + ED_Start = Indx_u_ED_BlPitchCom_Start(p_ED, u_ED, y_FAST) do i=1,size(u_ED%BlPitchCom)+2 ! BlPitchCom, YawMom, GenTrq (NOT collective pitch) dUdy(ED_Start + i - 1, y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + i - 1) = -1.0_ReKi !SrvD_Indx_Y_BlPitchCom end do @@ -3058,13 +3027,13 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD do j=1,size(SrvD%y%BStCLoadMesh,2) do K = 1,SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) if (SrvD%y%BStCLoadMesh(K,j)%Committed) then - ED_Start = Indx_u_ED_Blade_Start(u_ED, y_FAST, k) ! start of u_ED%BladePtLoads(k)%Force field + ED_Start = Indx_u_ED_Blade_Start(p_ED, u_ED, y_FAST, k) ! start of u_ED%BladePtLoads(k)%Force field SrvD_Out_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_BStC_y(1,k,j) call Assemble_dUdy_Loads(SrvD%y%BStCLoadMesh(k,j), u_ED%BladePtLoads(k), MeshMapData%BStC_P_2_ED_P_B(k,j), ED_Start, SrvD_Out_Start, dUdy) ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): - ED_Start = Indx_u_ED_Blade_Start(u_ED, y_FAST, k) + u_ED%BladePtLoads(k)%NNodes*3 ! start of u_ED%BladePtLoads(k)%Moment field (skip the ED forces) - ED_Out_Start = Indx_y_ED_Blade_Start(y_ED, y_FAST, k) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field + ED_Start = Indx_u_ED_Blade_Start(p_ED, u_ED, y_FAST, k) + u_ED%BladePtLoads(k)%NNodes*3 ! start of u_ED%BladePtLoads(k)%Moment field (skip the ED forces) + ED_Out_Start = Indx_y_ED_Blade_Start(p_ED, y_ED, y_FAST, k) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field call SumBlockMatrix( dUdy, MeshMapData%BStC_P_2_ED_P_B(k,j)%dM%m_uD, ED_Start, ED_Out_Start ) endif enddo @@ -3076,13 +3045,13 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD if ( allocated(SrvD%y%NStCLoadMesh) ) then do j = 1,size(SrvD%y%NStCLoadMesh) if (SrvD%y%NStCLoadMesh(j)%Committed) then - ED_Start = Indx_u_ED_Nacelle_Start(u_ED, y_FAST) + ED_Start = Indx_u_ED_Nacelle_Start(p_ED, u_ED, y_FAST) SrvD_Out_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_NStC_y(1,j) call Assemble_dUdy_Loads(SrvD%y%NStCLoadMesh(j), u_ED%NacelleLoads, MeshMapData%NStC_P_2_ED_P_N(j), ED_Start, SrvD_Out_Start, dUdy) ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): - ED_Start = Indx_u_ED_Nacelle_Start(u_ED, y_FAST) + u_ED%NacelleLoads%NNodes*3 ! start of u_ED%NacelleLoads%Moment field (skip the ED forces) - ED_Out_Start = Indx_y_ED_Nacelle_Start(y_ED, y_FAST) ! start of y_ED%NacelleMotion%TranslationDisp field + ED_Start = Indx_u_ED_Nacelle_Start(p_ED, u_ED, y_FAST) + u_ED%NacelleLoads%NNodes*3 ! start of u_ED%NacelleLoads%Moment field (skip the ED forces) + ED_Out_Start = Indx_y_ED_Nacelle_Start(p_ED, y_ED, y_FAST) ! start of y_ED%NacelleMotion%TranslationDisp field call SumBlockMatrix( dUdy, MeshMapData%NStC_P_2_ED_P_N(j)%dM%m_uD, ED_Start, ED_Out_Start ) endif enddo @@ -3092,13 +3061,13 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD if ( allocated(SrvD%y%TStCLoadMesh) ) then do j = 1,size(SrvD%y%TStCLoadMesh) if (SrvD%y%TStCLoadMesh(j)%Committed) then - ED_Start = Indx_u_ED_Tower_Start(u_ED, y_FAST) + ED_Start = Indx_u_ED_Tower_Start(p_ED, u_ED, y_FAST) SrvD_Out_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_TStC_y(1,j) call Assemble_dUdy_Loads(SrvD%y%TStCLoadMesh(j), u_ED%TowerPtLoads, MeshMapData%TStC_P_2_ED_P_T(j), ED_Start, SrvD_Out_Start, dUdy) ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): - ED_Start = Indx_u_ED_Tower_Start(u_ED, y_FAST) + u_ED%TowerPtLoads%NNodes*3 ! start of u_ED%TowerPtLoads%Moment field [skip the ED forces to get to the moments] - ED_Out_Start = Indx_y_ED_Tower_Start(y_ED, y_FAST) ! start of y_ED%TowerLn2Mesh%TranslationDisp field + ED_Start = Indx_u_ED_Tower_Start(p_ED, u_ED, y_FAST) + u_ED%TowerPtLoads%NNodes*3 ! start of u_ED%TowerPtLoads%Moment field [skip the ED forces to get to the moments] + ED_Out_Start = Indx_y_ED_Tower_Start(p_ED, y_ED, y_FAST) ! start of y_ED%TowerLn2Mesh%TranslationDisp field call SumBlockMatrix( dUdy, MeshMapData%TStC_P_2_ED_P_T(j)%dM%m_uD, ED_Start, ED_Out_Start ) endif enddo @@ -3109,13 +3078,13 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD if ( allocated(SrvD%y%SStCLoadMesh) ) then do j=1,size(SrvD%y%SStCLoadMesh) if (SrvD%y%SStCLoadMesh(j)%Committed) then - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) + ED_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) SrvD_Out_Start = y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - 1 + SrvD%p%Jac_Idx_SStC_y(1,j) call Assemble_dUdy_Loads(SrvD%y%SStCLoadMesh(j), u_ED%PlatformPtMesh, MeshMapData%SStC_P_P_2_SubStructure(j), ED_Start, SrvD_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 + ED_Start = Indx_u_ED_Platform_Start(p_ED, 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(p_ED, y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field call SumBlockMatrix( dUdy, MeshMapData%HD_M_P_2_SubStructure%dM%m_uD, ED_Start, ED_Out_Start ) endif enddo @@ -3128,8 +3097,10 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD ! ElastoDyn inputs on blade from AeroDyn and ElastoDyn IF ( p_FAST%CompAero == Module_AD ) THEN + AD_Block_Start = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + IF (p_FAST%CompElast == Module_ED) THEN - AD_Out_Start = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + y_AD%rotors(1)%TowerLoad%NNodes * 6 ! start of y_AD%rotors(1)%BladeLoad(1)%Force field [2 fields (force, moment) with 3 components] + AD_Out_Start = AD_Block_Start + p_AD%rotors(1)%Jac_y_idxStartList%BladeLoad - 1 DO K = 1,SIZE(u_ED%BladePtLoads,1) ! Loop through all blades (p_ED%NumBl) !!! ! This linearization was done in forming dUdu (see Linear_ED_InputSolve_du()), so we don't need to re-calculate these matrices @@ -3137,12 +3108,12 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD !CALL Linearize_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) ! AD loads-to-ED loads transfer (dU^{ED}/dy^{AD}): - ED_Start = Indx_u_ED_Blade_Start(u_ED, y_FAST, k) ! start of u_ED%BladePtLoads(k)%Force field + ED_Start = Indx_u_ED_Blade_Start(p_ED, u_ED, y_FAST, k) call Assemble_dUdy_Loads(y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ED_Start, AD_Out_Start, dUdy) ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): - ED_Start = Indx_u_ED_Blade_Start(u_ED, y_FAST, k) + u_ED%BladePtLoads(k)%NNodes*3 ! start of u_ED%BladePtLoads(k)%Moment field (skip the ED forces) - ED_Out_Start = Indx_y_ED_Blade_Start(y_ED, y_FAST, k) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field + ED_Start = Indx_u_ED_Blade_Start(p_ED, u_ED, y_FAST, k) + u_ED%BladePtLoads(k)%NNodes*3 ! start of u_ED%BladePtLoads(k)%Moment field (skip the ED forces) + ED_Out_Start = Indx_y_ED_Blade_Start(p_ED, y_ED, y_FAST, k) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field call SumBlockMatrix( dUdy, MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD, ED_Start, ED_Out_Start ) AD_Out_Start = AD_Out_Start + y_AD%rotors(1)%BladeLoad(k)%NNodes*6 ! start of y_AD%rotors(1)%BladeLoad(k+1)%Force field [skip 2 fields to forces on next blade] @@ -3156,17 +3127,65 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD !CALL Linearize_Line2_to_Point( y_AD%rotors(1)%TowerLoad, u_ED%TowerPtLoads, MeshMapData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, u_AD%rotors(1)%TowerMotion, y_ED%TowerLn2Mesh ) ! AD loads-to-ED loads transfer (dU^{ED}/dy^{AD}): - ED_Start = Indx_u_ED_Tower_Start(u_ED, y_FAST) ! u_ED%TowerPtLoads%Force field - AD_Out_Start = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) ! start of y_AD%rotors(1)%Tower%Force + ED_Start = Indx_u_ED_Tower_Start(p_ED, u_ED, y_FAST) ! u_ED%TowerPtLoads%Force field + AD_Out_Start = AD_Block_Start + p_AD%rotors(1)%Jac_y_idxStartList%TowerLoad - 1 call Assemble_dUdy_Loads(y_AD%rotors(1)%TowerLoad, u_ED%TowerPtLoads, MeshMapData%AD_L_2_ED_P_T, ED_Start, AD_Out_Start, dUdy) ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): ED_Start = ED_Start + u_ED%TowerPtLoads%NNodes*3 ! start of u_ED%TowerPtLoads%Moment field [skip the ED forces to get to the moments] - ED_Out_Start = Indx_y_ED_Tower_Start(y_ED, y_FAST) ! start of y_ED%TowerLn2Mesh%TranslationDisp field + ED_Out_Start = Indx_y_ED_Tower_Start(p_ED, y_ED, y_FAST) ! start of y_ED%TowerLn2Mesh%TranslationDisp field call SumBlockMatrix( dUdy, MeshMapData%AD_L_2_ED_P_T%dM%m_uD, ED_Start, ED_Out_Start ) END IF ! tower - + + IF ( y_AD%rotors(1)%TFinLoad%Committed ) THEN + !!! ! 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. + !CALL Linearize_Line2_to_Point( y_AD%rotors(1)%TFinLoad, u_ED%TFinCMLoads, MeshMapData%AD_L_2_ED_P_TF, ErrStat2, ErrMsg2, u_AD%rotors(1)%TFinMotion, y_ED%TFinCMMotion ) + + ! AD loads-to-ED loads transfer (dU^{ED}/dy^{AD}): + ED_Start = Indx_u_ED_TFin_Start(p_ED, u_ED, y_FAST) ! u_ED%TFinCMLoads%Force field + AD_Out_Start = AD_Block_Start + p_AD%rotors(1)%Jac_y_idxStartList%TFinLoad - 1 + call Assemble_dUdy_Loads(y_AD%rotors(1)%TFinLoad, u_ED%TFinCMLoads, MeshMapData%AD_P_2_ED_P_TF, ED_Start, AD_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = ED_Start + u_ED%TFinCMLoads%NNodes*3 ! start of u_ED%TFinCMLoads%Moment field [skip the ED forces to get to the moments] + ED_Out_Start = Indx_y_ED_TFin_Start(p_ED, y_ED, y_FAST) ! start of y_ED%TFinCMMotion%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%AD_P_2_ED_P_TF%dM%m_uD, ED_Start, ED_Out_Start ) + END IF ! tailfin + + IF ( y_AD%rotors(1)%NacelleLoad%Committed ) THEN + !!! ! 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. + !CALL Linearize_Point_to_Point( y_AD%rotors(1)%NacelleLoad, u_ED%NacelleLoads, MeshMapData%AD_L_2_ED_P_N, ErrStat2, ErrMsg2, u_AD%rotors(1)%NacelleMotion, y_ED%NacelleMotion ) + + ! AD loads-to-ED loads transfer (dU^{ED}/dy^{AD}): + ED_Start = Indx_u_ED_Nacelle_Start(p_ED, u_ED, y_FAST) ! u_ED%NacelleLoads%Force field + AD_Out_Start = AD_Block_Start + p_AD%rotors(1)%Jac_y_idxStartList%NacelleLoad - 1 + call Assemble_dUdy_Loads(y_AD%rotors(1)%NacelleLoad, u_ED%NacelleLoads, MeshMapData%AD_P_2_ED_P_N, ED_Start, AD_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = ED_Start + u_ED%NacelleLoads%NNodes*3 ! start of u_ED%NacelleLoads%Moment field [skip the ED forces to get to the moments] + ED_Out_Start = Indx_y_ED_Nacelle_Start(p_ED, y_ED, y_FAST) ! start of y_ED%NacelleMotion%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%AD_P_2_ED_P_N%dM%m_uD, ED_Start, ED_Out_Start ) + END IF ! nacelle + + IF ( y_AD%rotors(1)%HubLoad%Committed ) THEN + !!! ! 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. + !CALL Linearize_Point_to_Point( y_AD%rotors(1)%HubLoad, u_ED%HubLoads, MeshMapData%AD_L_2_ED_P_H, ErrStat2, ErrMsg2, u_AD%rotors(1)%HubMotion, y_ED%HubMotion ) + + ! AD loads-to-ED loads transfer (dU^{ED}/dy^{AD}): + ED_Start = Indx_u_ED_Hub_Start(p_ED, u_ED, y_FAST) ! u_ED%HubLoads%Force field + AD_Out_Start = AD_Block_Start + p_AD%rotors(1)%Jac_y_idxStartList%HubLoad - 1 + call Assemble_dUdy_Loads(y_AD%rotors(1)%HubLoad, u_ED%HubPtLoad, MeshMapData%AD_P_2_ED_P_H, ED_Start, AD_Out_Start, dUdy) + + ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): + ED_Start = ED_Start + u_ED%HubPtLoad%NNodes*3 ! start of u_ED%HubLoads%Moment field [skip the ED forces to get to the moments] + ED_Out_Start = Indx_y_ED_Hub_Start(p_ED, y_ED, y_FAST) ! start of y_ED%HubMotion%TranslationDisp field + call SumBlockMatrix( dUdy, MeshMapData%AD_P_2_ED_P_H%dM%m_uD, ED_Start, ED_Out_Start ) + END IF ! hub + END IF ! aero loads ! U_ED_SD_HD_BD_Orca_Residual() in InputSolve Option 1 @@ -3179,15 +3198,15 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD !!!END DO ! BD Reaction force-to-ED force transfer (dU^{ED}/dy^{BD}) from BD root-to-ED hub load transfer: - ED_Start = Indx_u_ED_Hub_Start(u_ED, y_FAST) ! start of u_ED%HubPtLoad%Force field + ED_Start = Indx_u_ED_Hub_Start(p_ED, u_ED, y_FAST) ! start of u_ED%HubPtLoad%Force field DO k=1,p_FAST%nBeams BD_Out_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_OUTPUT_COL) ! BD%y(k)%ReactionForce%Force field call Assemble_dUdy_Loads(BD%y(k)%ReactionForce, u_ED%HubPtLoad, MeshMapData%BD_P_2_ED_P(k), ED_Start, BD_Out_Start, dUdy) END DO ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}) from BD root-to-ED hub load transfer: - ED_Start = Indx_u_ED_Hub_Start(u_ED, y_FAST) + u_ED%HubPtLoad%NNodes*3 ! start of u_ED%HubPtLoad%Moment field (skip forces) - ED_Out_Start = Indx_y_ED_Hub_Start(y_ED, y_FAST) ! start of y_ED%HubMotion%TranslationDisp field + ED_Start = Indx_u_ED_Hub_Start(p_ED, u_ED, y_FAST) + u_ED%HubPtLoad%NNodes*3 ! start of u_ED%HubPtLoad%Moment field (skip forces) + ED_Out_Start = Indx_y_ED_Hub_Start(p_ED, y_ED, y_FAST) ! start of y_ED%HubMotion%TranslationDisp field DO k=1,p_FAST%nBeams call SumBlockMatrix( dUdy, MeshMapData%BD_P_2_ED_P(k)%dM%m_ud, ED_Start, ED_Out_Start) END DO @@ -3198,18 +3217,18 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD ! HD ! parts of dU^{ED}/dy^{HD} and dU^{ED}/dy^{ED}: if ( p_FAST%CompHydro == Module_HD ) then ! HydroDyn-{ElastoDyn or SubDyn} - ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + ED_Out_Start = Indx_y_ED_Platform_Start(p_ED, y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field ! we're just going to assume u_ED%PlatformPtMesh is committed if ( HD%y%Morison%Mesh%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. ! call Linearize_Point_to_Point( HD%y%Morison, u_ED%PlatformPtMesh, MeshMapData%HD_M_P_2_SubStructure, ErrStat2, ErrMsg2, HD%Input(1)%Morison, y_ED%PlatformPtMesh) !HD%Input(1)%Morison and y_ED%PlatformPtMesh contain the displaced positions for load calculations HD_Out_Start = Indx_y_HD_Morison_Start(HD%y, y_FAST) - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Force field + ED_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Force field call Assemble_dUdy_Loads(HD%y%Morison%Mesh, u_ED%PlatformPtMesh, MeshMapData%HD_M_P_2_SubStructure, ED_Start, HD_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_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) call SumBlockMatrix( dUdy, MeshMapData%HD_M_P_2_SubStructure%dM%m_uD, ED_Start, ED_Out_Start ) end if @@ -3218,11 +3237,11 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD !!! ! while forming dUdy, too. ! call Linearize_Point_to_Point( HD%y%WAMITMesh, u_ED%PlatformPtMesh, MeshMapData%HD_W_P_2_SubStructure, ErrStat2, ErrMsg2, HD%Input(1)%WAMITMesh, y_ED%PlatformPtMesh) !HD%Input(1)%WAMITMesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations HD_Out_Start = Indx_y_HD_WAMIT_Start(HD%y, y_FAST) - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Force field + ED_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Force field call Assemble_dUdy_Loads(HD%y%WAMITMesh, u_ED%PlatformPtMesh, MeshMapData%HD_W_P_2_SubStructure, ED_Start, HD_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_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) + u_ED%PlatformPtMesh%NNodes*3 ! start of u_ED%PlatformPtMesh%Moment field (skip the ED forces) call SumBlockMatrix( dUdy, MeshMapData%HD_W_P_2_SubStructure%dM%m_uD, ED_Start, ED_Out_Start ) end if @@ -3238,12 +3257,12 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD !!! ! while forming dUdy, too. ! CALL Linearize_Point_to_Point( MAPp%y%ptFairleadLoad, u_ED%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ErrStat2, ErrMsg2, MAPp%Input(1)%PtFairDisplacement, y_ED%PlatformPtMesh) !MAPp%Input(1)%ptFairleadLoad and y_ED%PlatformPtMesh contain the displaced positions for load calculations MAP_Out_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Force field + ED_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Force field call Assemble_dUdy_Loads(MAPp%y%ptFairLeadLoad, u_ED%PlatformPtMesh, MeshMapData%Mooring_2_Structure, ED_Start, MAP_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 + ED_Start = Indx_u_ED_Platform_Start(p_ED, 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(p_ED, y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field call SumBlockMatrix( dUdy, MeshMapData%Mooring_2_Structure%dM%m_uD, ED_Start, ED_Out_Start ) end if ! MoorDyn @@ -3253,12 +3272,12 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD !!! ! 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%Force field + ED_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Force field call Assemble_dUdy_Loads(MD%y%CoupledLoads(1), u_ED%PlatformPtMesh, MeshMapData%Mooring_2_Structure, 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 + ED_Start = Indx_u_ED_Platform_Start(p_ED, 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(p_ED, y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field call SumBlockMatrix( dUdy, MeshMapData%Mooring_2_Structure%dM%m_uD, ED_Start, ED_Out_Start ) end if end if @@ -3269,12 +3288,12 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD !!! ! while forming dUdy, too. ! CALL Linearize_Point_to_Point( SD%y%Y1Mesh, u_ED%PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, SD%Input(1)%TPMesh, y_ED%PlatformPtMesh) !SD%Input(1)%TPMesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations SD_Out_Start = y_FAST%Lin%Modules(MODULE_SD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Force field + ED_Start = Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Force field call Assemble_dUdy_Loads(SD%y%Y1Mesh, u_ED%PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ED_Start, SD_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 + ED_Start = Indx_u_ED_Platform_Start(p_ED, 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(p_ED, y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field call SetBlockMatrix( dUdy, MeshMapData%SD_TP_2_ED_P%dM%m_uD, ED_Start, ED_Out_Start ) !Mooring gets set in the Linear_SD_InputSolve_ routines @@ -3283,15 +3302,16 @@ END SUBROUTINE Linear_ED_InputSolve_dy !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{BD}/dy^{ED}, dU^{BD}/dy^{BD}, and dU^{BD}/dy^{AD} blocks of dUdy. (i.e., how do !! changes in the ED, BD, and AD outputs effect the BD inputs?) -SUBROUTINE Linear_BD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD, BD, MeshMapData, dUdy, ErrStat, ErrMsg ) - +SUBROUTINE Linear_BD_InputSolve_dy( p_FAST, y_FAST, SrvD, p_ED, u_ED, y_ED, p_AD, u_AD, y_AD, BD, 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) type(ServoDyn_Data), intent(in ) :: SrvD !< SrvD parameters + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ElastoDyn parameters TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) - TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AeroDyn parameters TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linearization) + TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BD data at t TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -3354,8 +3374,7 @@ SUBROUTINE Linear_BD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD !!! CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, MeshMapData%y_BD_BldMotion_4Loads(k), MeshMapData%BD_L_2_BD_L(k), ErrStat2, ErrMsg2 ) !!! CALL Linearize_Line2_to_Line2( y_AD%rotors(1)%BladeLoad(k), BD%Input(1,k)%DistrLoad, MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%rotors(1)%BladeMotion(k), MeshMapData%y_BD_BldMotion_4Loads(k) ) !!!end if - - AD_Out_Start = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + y_AD%rotors(1)%TowerLoad%NNodes * 6 ! start of y_AD%rotors(1)%BladeLoad(1)%Force field [2 fields (force, moment) with 3 components] + AD_Out_Start = y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + p_AD%rotors(1)%Jac_y_idxStartList%BladeLoad - 1 DO K = 1,p_FAST%nBeams ! Loop through all blades BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) & ! start of BD%Input(1,k)%DistrLoad%Force field @@ -3404,99 +3423,59 @@ SUBROUTINE Linear_BD_InputSolve_dy( p_FAST, y_FAST, SrvD, u_ED, y_ED, y_AD, u_AD !!!CALL Linearize_Point_to_Point( y_ED%BladeRootMotion(k), BD%Input(1,k)%RootMotion, MeshMapData%ED_P_2_BD_P(k), ErrStat2, ErrMsg2 ) BD_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_INPUT_COL) ! ! start of BD%Input(1,k)%RootMotion%TranslationDisp field - ED_Out_Start = Indx_y_ED_BladeRoot_Start(y_ED, y_FAST, k) ! start of y_ED%BladeRootMotion(k)%TranslationDisp field + ED_Out_Start = Indx_y_ED_BladeRoot_Start(p_ED, y_ED, y_FAST, k) ! start of y_ED%BladeRootMotion(k)%TranslationDisp field call Assemble_dUdy_Motions(y_ED%BladeRootMotion(k), BD%Input(1,k)%RootMotion, MeshMapData%ED_P_2_BD_P(k), BD_Start, ED_Out_Start, dUdy) end do - END SUBROUTINE Linear_BD_InputSolve_dy + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{AD}/dy^{IfW} block of dUdy. (i.e., how do changes in the IfW outputs affect the AD inputs?) -SUBROUTINE Linear_AD_InputSolve_IfW_dy( p_FAST, y_FAST, u_AD, dUdy ) - - ! 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(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn - REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{AD}/dy^{IfW} block - - ! Local variables: - - INTEGER(IntKi) :: I ! Loops through components - INTEGER(IntKi) :: J ! Loops through nodes / elements - INTEGER(IntKi) :: K ! Loops through blades +SUBROUTINE Linear_AD_InputSolve_IfW_dy( p_FAST, y_FAST, p_AD, u_AD, dUdy ) + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< The parameters of AeroDyn + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn + REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{AD}/dy^{IfW} block + INTEGER(IntKi) :: I ! Loops through components INTEGER(IntKi) :: node - INTEGER(IntKi) :: AD_Start ! starting index of dUdy (row) where AD input equations (for specific fields) are located - - + INTEGER(IntKi) :: AD_Start ! starting index of dUdy (row) where AD input equations (for specific fields) are located + INTEGER(IntKi) :: Ifw_Start ! starting index of dUdy (col) where IfW output equations (for specific fields) are located !------------------------------------------------------------------------------------------------- - ! Set the inputs from inflow wind: + ! Set the inputs from inflow wind (IfW only has 3 extended outputs): !------------------------------------------------------------------------------------------------- - !IF (p_FAST%CompInflow == MODULE_IfW) THEN !already checked in calling routine - - if (p_FAST%CompServo == MODULE_SrvD) then - node = 2 - else - node = 1 - end if - - - AD_Start = Indx_u_AD_BladeInflow_Start(u_AD, y_FAST) ! start of u_AD%rotors(1)%InflowOnBlade array - -!FIXME: move these to extended inputs! -! do k=1,size(o_AD%RotInflow(1)%Bld) ! blades -! do j=1,size(o_AD%RotInflow(1)%Bld(k)%InflowOnBlade,2) ! nodes -! do i=1,3 !velocity component -! dUdy( AD_Start + i - 1, y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (node-1)*3 + i - 1 ) = -1.0_R8Ki -! end do -! node = node + 1 -! AD_Start = AD_Start + 3 -! end do -! end do -! -! if ( allocated(o_AD%RotInflow(1)%InflowOnTower) ) then -! do j=1,size(o_AD%RotInflow(1)%InflowOnTower,2) !nodes -! do i=1,3 !velocity component -! dUdy( AD_Start + i - 1, y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (node-1)*3 + i - 1 ) = -1.0_R8Ki -! end do -! node = node + 1 -! AD_Start = AD_Start + 3 -! end do -! end if -! -! do i=1,3 !rotor-disk velocity component (DiskVel) -! dUdy( AD_Start + i - 1, y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (node-1)*3 + i - 1 ) = -1.0_R8Ki -! end do -! node = node + 1 -! AD_Start = AD_Start + 3 + AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + p_AD%rotors(1)%Jac_u_idxStartList%Extended - 1 ! index starts at 1 + IfW_Start = y_FAST%Lin%Modules(Module_IfW)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) - !END IF - - + do i=1,p_AD%rotors(1)%NumExtendedInputs ! extended inputs -- direct mapping. Extended outputs of IfW are exactly the same number as AD15 extended inputs + dUdy( AD_Start + i - 1, IfW_Start + i - 1 ) = -1.0_R8Ki + end do END SUBROUTINE Linear_AD_InputSolve_IfW_dy + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{AD}/dy^{ED} and dU^{AD}/dy^{BD} blocks of dUdy. (i.e., how do changes in the ED and BD outputs affect !! the AD inputs?) -SUBROUTINE Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMapData, dUdy, ErrStat, ErrMsg ) - - ! Passed variables +SUBROUTINE Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, p_AD, u_AD, p_ED, y_ED, BD, MeshMapData, dUdy, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< The parameters of AeroDyn + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn15 + TYPE(ED_ParameterType), INTENT(IN) :: p_ED !< ElastoDyn parameters TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BD 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^{AD}/dy^{ED} block - INTEGER(IntKi) :: ErrStat !< Error status of the operation - CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local variables: - INTEGER(IntKi) :: K ! Loops through blades INTEGER(IntKi) :: AD_Start ! starting index of dUdy (column) where particular AD fields are located INTEGER(IntKi) :: ED_Out_Start! starting index of dUdy (row) where particular ED fields are located INTEGER(IntKi) :: BD_Out_Start! starting index of dUdy (row) where particular BD fields are located + LOGICAL :: uFieldMask(FIELDMASK_SIZE) !< which destinationfields from u to assemble + LOGICAL :: yFieldMask(FIELDMASK_SIZE) !< which fields from y to assemble INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Linear_AD_InputSolve_NoIfW_dy' @@ -3508,64 +3487,109 @@ SUBROUTINE Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMa !------------------------------------------------------------------------------------------------- ! Set the inputs from ElastoDyn and/or BeamDyn: !------------------------------------------------------------------------------------------------- - !................................... - ! tower - !................................... + + !----------------------------------- + ! Nacelle -- disp, orient + if (u_AD%rotors(1)%NacelleMotion%Committed) then + ! Linearize done in dUdu (see Linear_AD_InputSolve_du()) + !CALL Linearize_Point_to_Point( y_ED%NacelleMotion, u_AD%rotors(1)%NacelleMotion, MeshMapData%ED_P_2_AD_P_N, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%NacelleMotion' ) + ! if (errStat>=AbortErrLev) return + + ! *** AD translational displacement: from ED translational displacement (MeshMapData%ED_P_2_AD_P_N%dM%mi) and orientation (MeshMapData%ED_P_2_AD_P_N%dM%fx_p) + AD_Start = Indx_u_AD_Nacelle_Start(p_AD, u_AD, y_FAST) ! start of u_AD%rotors(1)%NacelleMotion%TranslationDisp field + ED_Out_Start = Indx_y_ED_Nacelle_Start(p_ED, y_ED, y_FAST) ! start of y_ED%NacelleMotion%TranslationDisp field + + uFieldMask = .false. + uFieldMask(MASKID_TRANSLATIONDISP) = .true. + uFieldMask(MASKID_ORIENTATION) = .true. + call Assemble_dUdy_Motions(y_ED%NacelleMotion, u_AD%rotors(1)%NacelleMotion, MeshMapData%ED_P_2_AD_P_N, AD_Start, ED_Out_Start, dUdy, uFieldMask) + endif + + + !----------------------------------- + ! Hub -- disp, orient, RV + if (u_AD%rotors(1)%HubMotion%Committed) then + ! Linearize done in dUdu (see Linear_AD_InputSolve_du()) + !CALL Linearize_Point_to_Point( y_ED%HubPtMotion, u_AD%rotors(1)%HubMotion, MeshMapData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%HubMotion' ) + ! if (errStat>=AbortErrLev) return + + ! *** AD translational displacement: from ED translational displacement (MeshMapData%ED_P_2_AD_P_H%dM%mi) and orientation (MeshMapData%ED_P_2_AD_P_H%dM%fx_p) + AD_Start = Indx_u_AD_Hub_Start(p_AD, u_AD, y_FAST) ! start of u_AD%rotors(1)%HubMotion%TranslationDisp field + ED_Out_Start = Indx_y_ED_Hub_Start(p_ED, y_ED, y_FAST) ! start of y_ED%HubPtMotion%TranslationDisp field + + uFieldMask = .false. + uFieldMask(MASKID_TRANSLATIONDISP) = .true. + uFieldMask(MASKID_ORIENTATION) = .true. + uFieldMask(MASKID_ROTATIONVEL) = .true. + yFieldMask = .false. + yFieldMask(MASKID_TRANSLATIONDISP) = .true. + yFieldMask(MASKID_ORIENTATION) = .true. + yFieldMask(MASKID_ROTATIONVEL) = .true. + call Assemble_dUdy_Motions(y_ED%HubPtMotion, u_AD%rotors(1)%HubMotion, MeshMapData%ED_P_2_AD_P_H, AD_Start, ED_Out_Start, dUdy, uFieldMask, yFieldMask) + endif + + + !----------------------------------- + ! TailFin -- disp, orient, TV + if (u_AD%rotors(1)%TFinMotion%Committed) then + ! Linearize done in dUdu (see Linear_AD_InputSolve_du()) + !CALL Linearize_Point_to_Point( y_ED%TFinCMMotion, u_AD%rotors(1)%TFinMotion, MeshMapData%ED_P_2_AD_P_TF, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%TFinMotion' ) + ! if (errStat>=AbortErrLev) return + + ! *** AD translational displacement: from ED translational displacement (MeshMapData%ED_P_2_AD_P_TF%dM%mi) and orientation (MeshMapData%ED_P_2_AD_P_TF%dM%fx_p) + AD_Start = Indx_u_AD_TFin_Start(p_AD, u_AD, y_FAST) ! start of u_AD%rotors(1)%TFinMotion%TranslationDisp field + ED_Out_Start = Indx_y_ED_TFin_Start(p_ED, y_ED, y_FAST) ! start of y_ED%TFinCMMotion%TranslationDisp field + + uFieldMask = .false. + uFieldMask(MASKID_TRANSLATIONDISP) = .true. + uFieldMask(MASKID_ORIENTATION) = .true. + uFieldMask(MASKID_TRANSLATIONVEL) = .true. + call Assemble_dUdy_Motions(y_ED%TFinCMMotion, u_AD%rotors(1)%TFinMotion, MeshMapData%ED_P_2_AD_P_TF, AD_Start, ED_Out_Start, dUdy, uFieldMask) + endif + + + !................................... + ! tower -- Disp, Orient, TransVel, TransAcc IF (u_AD%rotors(1)%TowerMotion%Committed) THEN - !!! ! This linearization was done in forming dUdu (see Linear_AD_InputSolve_du()), so we don't need to re-calculate these matrices !!! ! while forming dUdy, too. !!!CALL Linearize_Line2_to_Line2( y_ED%TowerLn2Mesh, u_AD%rotors(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) - AD_Start = Indx_u_AD_Tower_Start(u_AD, y_FAST) ! start of u_AD%rotors(1)%TowerMotion%TranslationDisp field - - ED_Out_Start = Indx_y_ED_Tower_Start(y_ED, y_FAST) ! start of y_ED%TowerLn2Mesh%TranslationDisp field - call Assemble_dUdy_Motions(y_ED%TowerLn2Mesh, u_AD%rotors(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, AD_Start, ED_Out_Start, dUdy, skipRotVel=.true.) + AD_Start = Indx_u_AD_Tower_Start(p_AD, u_AD, y_FAST) ! start of u_AD%rotors(1)%TowerMotion%TranslationDisp field + ED_Out_Start = Indx_y_ED_Tower_Start(p_ED, y_ED, y_FAST) ! start of y_ED%TowerLn2Mesh%TranslationDisp field + uFieldMask = .false. + uFieldMask(MASKID_TRANSLATIONDISP) = .true. + uFieldMask(MASKID_ORIENTATION) = .true. + uFieldMask(MASKID_TRANSLATIONVEL) = .true. + uFieldMask(MASKID_TRANSLATIONACC) = .true. + call Assemble_dUdy_Motions(y_ED%TowerLn2Mesh, u_AD%rotors(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, AD_Start, ED_Out_Start, dUdy, uFieldMask) END IF - - !................................... - ! hub - !................................... - CALL Linearize_Point_to_Point( y_ED%HubPtMotion, u_AD%rotors(1)%HubMotion, MeshMapData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%HubMotion' ) + + + !................................... + ! blade root + !................................... + DO k=1,size(y_ED%BladeRootMotion) + CALL Linearize_Point_to_Point( y_ED%BladeRootMotion(k), u_AD%rotors(1)%BladeRootMotion(k), MeshMapData%ED_P_2_AD_P_R(k), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeRootMotion('//trim(num2lstr(k))//')' ) if (errStat>=AbortErrLev) return - - ! *** AD translational displacement: from ED translational displacement (MeshMapData%ED_P_2_AD_P_H%dM%mi) and orientation (MeshMapData%ED_P_2_AD_P_H%dM%fx_p) - AD_Start = Indx_u_AD_Hub_Start(u_AD, y_FAST) ! start of u_AD%rotors(1)%HubMotion%TranslationDisp field - ED_Out_Start = Indx_y_ED_Hub_Start(y_ED, y_FAST) ! start of y_ED%HubPtMotion%TranslationDisp field - call SetBlockMatrix( dUdy, MeshMapData%ED_P_2_AD_P_H%dM%mi, AD_Start, ED_Out_Start ) - - ED_Out_Start = Indx_y_ED_Hub_Start(y_ED, y_FAST) + y_ED%HubPtMotion%NNodes * 3 ! start of y_ED%HubPtMotion%Orientation field - call SetBlockMatrix( dUdy, MeshMapData%ED_P_2_AD_P_H%dM%fx_p, AD_Start, ED_Out_Start ) - + ! *** AD orientation: from ED orientation - AD_Start = AD_Start + u_AD%rotors(1)%HubMotion%NNodes * 3 ! move past the AD translation disp field to orientation field - call SetBlockMatrix( dUdy, MeshMapData%ED_P_2_AD_P_H%dM%mi, AD_Start, ED_Out_Start ) - - ! *** AD rotational velocity: from ED rotational velocity - AD_Start = AD_Start + u_AD%rotors(1)%HubMotion%NNodes * 3 ! move past the AD orientation field to rotational velocity field - ED_Out_Start = Indx_y_ED_Hub_Start(y_ED, y_FAST) + y_ED%HubPtMotion%NNodes * 6 ! ! start of y_ED%HubPtMotion%RotationVel field - call SetBlockMatrix( dUdy, MeshMapData%ED_P_2_AD_P_H%dM%mi, AD_Start, ED_Out_Start ) - - - - !................................... - ! blade root - !................................... - DO k=1,size(y_ED%BladeRootMotion) - CALL Linearize_Point_to_Point( y_ED%BladeRootMotion(k), u_AD%rotors(1)%BladeRootMotion(k), MeshMapData%ED_P_2_AD_P_R(k), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%BladeRootMotion('//trim(num2lstr(k))//')' ) - if (errStat>=AbortErrLev) return - - ! *** AD orientation: from ED orientation - AD_Start = Indx_u_AD_BladeRoot_Start(u_AD, y_FAST, k) ! start of u_AD%rotors(1)%BladeRootMotion(k)%Orientation field - - ED_Out_Start = Indx_y_ED_BladeRoot_Start(y_ED, y_FAST, k) & ! start of y_ED%BladeRootMotion(k)%TranslationDisp field - + y_ED%BladeRootMotion(k)%NNodes * 3 ! start of y_ED%BladeRootMotion(k)%Orientation field - call SetBlockMatrix( dUdy, MeshMapData%ED_P_2_AD_P_R(k)%dM%mi, AD_Start, ED_Out_Start ) - - END DO + AD_Start = Indx_u_AD_BladeRoot_Start(p_AD, u_AD, y_FAST, k) ! start of u_AD%rotors(1)%BladeRootMotion(k)%Orientation field + ED_Out_Start = Indx_y_ED_BladeRoot_Start(p_ED, y_ED, y_FAST, k) ! start of y_ED%BladeRootMotion(k)%TranslationDisp field + + uFieldMask = .false. + uFieldMask(MASKID_ORIENTATION) = .true. + yFieldMask = .false. + yFieldMask(MASKID_TRANSLATIONDISP) = .true. + yFieldMask(MASKID_ORIENTATION) = .true. + yFieldMask(MASKID_ROTATIONVEL) = .true. + call Assemble_dUdy_Motions(y_ED%BladeRootMotion(k), u_AD%rotors(1)%BladeRootMotion(k), MeshMapData%ED_P_2_AD_P_R(k), AD_Start, ED_Out_Start, dUdy, uFieldMask, yFieldMask) + END DO !................................... @@ -3573,16 +3597,16 @@ SUBROUTINE Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMa !................................... IF (p_FAST%CompElast == Module_ED ) THEN - DO k=1,size(y_ED%BladeLn2Mesh) !!! ! This linearization was done in forming dUdu (see Linear_AD_InputSolve_du()), so we don't need to re-calculate these matrices !!! ! while forming dUdy, too. !!!CALL Linearize_Line2_to_Line2( y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) - AD_Start = Indx_u_AD_Blade_Start(u_AD, y_FAST, k) ! start of u_AD%rotors(1)%BladeMotion(k)%TranslationDisp field - ED_Out_Start = Indx_y_ED_Blade_Start(y_ED, y_FAST, k) ! start of y_ED%BladeLn2Mesh(k)%TranslationDisp field - CALL Assemble_dUdy_Motions(y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, ED_Out_Start, dUdy, skipRotAcc=.true.) - + AD_Start = Indx_u_AD_Blade_Start(p_AD, u_AD, y_FAST, k) ! start of u_AD%rotors(1)%BladeMotion(k)%TranslationDisp field + ED_Out_Start = Indx_y_ED_Blade_Start(p_ED, y_ED, y_FAST, k) ! start of y_ED%BladeLn2Mesh(k)%TranslationDisp field + + uFieldMask = .true. ! all fields + CALL Assemble_dUdy_Motions(y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, ED_Out_Start, dUdy, uFieldMask) END DO ELSEIF (p_FAST%CompElast == Module_BD ) THEN @@ -3591,11 +3615,12 @@ SUBROUTINE Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMa !!!CALL Linearize_Line2_to_Line2( BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), ErrStat2, ErrMsg2 ) DO k=1,p_FAST%nBeams - AD_Start = Indx_u_AD_Blade_Start(u_AD, y_FAST, k) ! start of u_AD%rotors(1)%BladeMotion(k)%TranslationDisp field + AD_Start = Indx_u_AD_Blade_Start(p_AD, u_AD, y_FAST, k) ! start of u_AD%rotors(1)%BladeMotion(k)%TranslationDisp field BD_Out_Start = y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%LinStartIndx(LIN_OUTPUT_COL) & ! start of BD%y(k)%BldMotion%TranslationDisp field + BD%y(k)%ReactionForce%NNodes * 6 ! 2 fields with 3 components - CALL Assemble_dUdy_Motions(BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, BD_Out_Start, dUdy, skipRotAcc=.true.) + uFieldMask = .true. ! all fields + CALL Assemble_dUdy_Motions(BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, BD_Out_Start, dUdy, uFieldMask) END DO END IF @@ -3731,43 +3756,37 @@ SUBROUTINE Linear_HD_InputSolve_du( p_FAST, y_FAST, u_HD, y_ED, y_SD, MeshMapDat end if end if - - END SUBROUTINE Linear_HD_InputSolve_du + + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{HD}/dy^{ED} block of dUdy. (i.e., how do changes in the ED outputs affect !! the HD inputs?) -SUBROUTINE Linear_HD_InputSolve_dy( p_FAST, y_FAST, u_HD, y_ED, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) - - ! Passed variables +SUBROUTINE Linear_HD_InputSolve_dy( p_FAST, y_FAST, u_HD, p_ED, y_ED, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(HydroDyn_InputType), INTENT(INOUT) :: u_HD !< The inputs to HydroDyn - TYPE(ED_OutputType), TARGET, INTENT(IN) :: y_ED !< The outputs from the ElastoDyn structural dynamics module - TYPE(SD_OutputType), TARGET, INTENT(IN) :: y_SD !< The outputs from the SubDyn structural dynamics module + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ElastoDyn parameters + TYPE(ED_OutputType), TARGET, INTENT(IN ) :: y_ED !< The outputs from the ElastoDyn structural dynamics module + TYPE(SD_OutputType), TARGET, 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^{HD}/dy^{ED} block - - INTEGER(IntKi) :: ErrStat !< Error status of the operation - CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local variables: - INTEGER(IntKi) :: HD_Start ! starting index of dUdy (column) where particular HD fields are located INTEGER(IntKi) :: Platform_Out_Start! starting index of dUdy (row) where particular ED fields are located INTEGER(IntKi) :: SubStructure_Out_Start! starting index of dUdy (row) where particular SD/ED fields are located TYPE(MeshType), POINTER :: PlatformMotion TYPE(MeshType), POINTER :: SubstructureMotion2HD - CHARACTER(*), PARAMETER :: RoutineName = 'Linear_HD_InputSolve_dy' - ErrStat = ErrID_None ErrMsg = "" - - PlatformMotion => y_ED%PlatformPtMesh - Platform_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + PlatformMotion => y_ED%PlatformPtMesh + Platform_Out_Start = Indx_y_ED_Platform_Start(p_ED, y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field IF (p_FAST%CompSub == Module_SD) THEN SubstructureMotion2HD => y_SD%y2Mesh @@ -3782,8 +3801,8 @@ SUBROUTINE Linear_HD_InputSolve_dy( p_FAST, y_FAST, u_HD, y_ED, y_SD, MeshMapDat ! HD PRP Mesh !................................... ! use Indx_u_HD_PRP_Start - HD_Start = Indx_u_HD_PRP_Start(u_HD, y_FAST) ! start of u_HD%Morison%Mesh%TranslationDisp field - call Assemble_dUdy_Motions(PlatformMotion, u_HD%PRPMesh, MeshMapData%ED_P_2_HD_PRP_P, HD_Start, Platform_Out_Start, dUdy, .false.) + HD_Start = Indx_u_HD_PRP_Start(u_HD, y_FAST) ! start of u_HD%Morison%Mesh%TranslationDisp field + call Assemble_dUdy_Motions(PlatformMotion, u_HD%PRPMesh, MeshMapData%ED_P_2_HD_PRP_P, HD_Start, Platform_Out_Start, dUdy) ! dU^{HD}/dy^{ED} or ! dU^{HD}/dy^{SD} @@ -3797,7 +3816,7 @@ SUBROUTINE Linear_HD_InputSolve_dy( p_FAST, y_FAST, u_HD, y_ED, y_SD, MeshMapDat !!!call Linearize_Point_to_Line2( SubstructureMotion2HD, u_HD%Morison%Mesh, MeshMapData%SubStructure_2_HD_M_P, ErrStat2, ErrMsg2 ) HD_Start = Indx_u_HD_Morison_Start(u_HD, y_FAST) ! start of u_HD%Morison%Mesh%TranslationDisp field - call Assemble_dUdy_Motions(SubstructureMotion2HD, u_HD%Morison%Mesh, MeshMapData%SubStructure_2_HD_M_P, HD_Start, SubStructure_Out_Start, dUdy, .false.) + call Assemble_dUdy_Motions(SubstructureMotion2HD, u_HD%Morison%Mesh, MeshMapData%SubStructure_2_HD_M_P, HD_Start, SubStructure_Out_Start, dUdy) END IF !................................... @@ -3810,40 +3829,79 @@ SUBROUTINE Linear_HD_InputSolve_dy( p_FAST, y_FAST, u_HD, y_ED, y_SD, MeshMapDat !!!call Linearize_Point_to_Point( SubstructureMotion2HD, u_HD%Mesh, MeshMapData%SubStructure_2_HD_W_P, ErrStat2, ErrMsg2 ) HD_Start = Indx_u_HD_WAMIT_Start(u_HD, y_FAST) ! start of u_HD%Mesh%TranslationDisp field - call Assemble_dUdy_Motions(SubstructureMotion2HD, u_HD%WAMITMesh, MeshMapData%SubStructure_2_HD_W_P, HD_Start, SubStructure_Out_Start, dUdy, .false.) + call Assemble_dUdy_Motions(SubstructureMotion2HD, u_HD%WAMITMesh, MeshMapData%SubStructure_2_HD_W_P, HD_Start, SubStructure_Out_Start, dUdy) END IF - - END SUBROUTINE Linear_HD_InputSolve_dy +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{HD}/dy^{SeaSt} block of dUdy. (i.e., how do changes in the SeaSt outputs affect the HD inputs?) +subroutine Linear_HD_InputSolve_SeaSt_dy( p_FAST, y_FAST, p_SeaSt, p_HD, u_HD, dUdy ) + type(FAST_ParameterType), intent(in ) :: p_FAST !< FAST parameter data + type(FAST_OutputFileType), intent(in ) :: y_FAST !< FAST output file data (for linearization) + type(SeaSt_ParameterType), intent(in ) :: p_SeaSt !< The parameters of SeaState + type(HydroDyn_ParameterType), intent(in ) :: p_HD !< The parameters of HydroDyn + type(HydroDyn_InputType), intent(inout) :: u_HD !< The inputs to HydroDyn + real(R8Ki), intent(inout) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{HD}/dy^{IfW} block + integer(IntKi) :: I ! Loops through components + integer(IntKi) :: node + integer(IntKi) :: HD_Start ! starting index of dUdy (row) where HD input equations (for specific fields) are located + integer(IntKi) :: SeaSt_Start ! starting index of dUdy (column) where SeaSt output equations (for specific fields) are located + !------------------------------------------------------------------------------------------------- + ! Set the inputs from SeaState (SeaSt only has 1 extended output): + !------------------------------------------------------------------------------------------------- + HD_Start = Indx_u_HD_Ext_Start(u_HD, y_FAST) + SeaSt_Start = y_FAST%Lin%Modules(Module_SeaSt)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + p_SeaSt%LinParams%Jac_y_idxStartList%Extended - 1 ! index starts at 1 + + ! SeaState has one extended output, but HD has multiple extended inputs. WaveElev0 is transferred. + dUdy( HD_Start, SeaSt_Start ) = -1.0_R8Ki +end subroutine Linear_HD_InputSolve_SeaSt_dy + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine forms the dU^{HD}/dy^{IfW} block of dUdy. (i.e., how do changes in the IfW outputs affect the HD inputs?) +subroutine Linear_HD_InputSolve_IfW_dy( p_FAST, y_FAST, p_HD, u_HD, dUdy ) + type(FAST_ParameterType), intent(in ) :: p_FAST !< FAST parameter data + type(FAST_OutputFileType), intent(in ) :: y_FAST !< FAST output file data (for linearization) + type(HydroDyn_ParameterType), intent(in ) :: p_HD !< The parameters of AeroDyn + type(HydroDyn_InputType), intent(inout) :: u_HD !< The inputs to AeroDyn + real(R8Ki), intent(inout) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{HD}/dy^{IfW} block + integer(IntKi) :: I ! Loops through components + integer(IntKi) :: node + integer(IntKi) :: HD_Start ! starting index of dUdy (row) where HD input equations (for specific fields) are located + integer(IntKi) :: IfW_Start ! starting index of dUdy (column) where IfW output equations (for specific fields) are located + !------------------------------------------------------------------------------------------------- + ! Set the inputs from IfW (IfW only has 3 extended output): + !------------------------------------------------------------------------------------------------- + HD_Start = Indx_u_HD_Ext_Start(u_HD, y_FAST) ! skip first Ext input (WaveElev0 from SeaSt) + IfW_Start = y_FAST%Lin%Modules(Module_IfW)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) ! use all IfW extended outputs + + ! IfW has 3 extended outputs, but HD has multiple extended inputs. Transfer HWindSpeed, PLexp, PropagationDir + do i = 0,2 + dUdy( HD_Start + i, IfW_Start + i ) = -1.0_R8Ki + enddo +end subroutine Linear_HD_InputSolve_IfW_dy + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{MAP}/dy^{ED} block of dUdy. (i.e., how do changes in the ED outputs affect !! the MAP inputs?) -SUBROUTINE Linear_MAP_InputSolve_dy( p_FAST, y_FAST, u_MAP, y_ED, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) - - ! Passed variables +SUBROUTINE Linear_MAP_InputSolve_dy( p_FAST, y_FAST, u_MAP, p_ED, y_ED, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(MAP_InputType), INTENT(INOUT) :: u_MAP !< The inputs to MAP - TYPE(ED_OutputType), TARGET, INTENT(IN) :: y_ED !< The outputs from the ElastoDyn structural dynamics module - TYPE(SD_OutputType), TARGET, INTENT(IN) :: y_SD !< The outputs from the SubDyn structural dynamics module + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ElastoDyn parameters + TYPE(ED_OutputType), TARGET, INTENT(IN ) :: y_ED !< The outputs from the ElastoDyn structural dynamics module + TYPE(SD_OutputType), TARGET, 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^{MAP}/dy^{ED} block - - INTEGER(IntKi) :: ErrStat !< Error status of the operation - CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Local variables: + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None INTEGER(IntKi) :: MAP_Start ! starting index of dUdy (column) where particular MAP fields are located - INTEGER(IntKi) :: SubStructure_Out_Start! starting index of dUdy (row) where particular SD/ED fields are located TYPE(MeshType), POINTER :: SubstructureMotion - + LOGICAL :: FieldMask(FIELDMASK_SIZE) !< which source fields to assemble INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Linear_MAP_InputSolve_dy' - ErrStat = ErrID_None ErrMsg = "" @@ -3853,7 +3911,7 @@ SUBROUTINE Linear_MAP_InputSolve_dy( p_FAST, y_FAST, u_MAP, y_ED, y_SD, MeshMapD SubStructure_Out_Start = Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y3Mesh%TranslationDisp field ELSE SubstructureMotion => y_ED%PlatformPtMesh - SubStructure_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + SubStructure_Out_Start = Indx_y_ED_Platform_Start(p_ED, y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field END IF IF (u_MAP%PtFairDisplacement%Committed) THEN @@ -3865,7 +3923,9 @@ SUBROUTINE Linear_MAP_InputSolve_dy( p_FAST, y_FAST, u_MAP, y_ED, y_SD, MeshMapD ! dU^{MAP}/dy^{SD} or ! dU^{MAP}/dy^{ED} call Linearize_Point_to_Point( SubstructureMotion, u_MAP%PtFairDisplacement, MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) - call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_MAP%PtFairDisplacement, MeshMapData%Structure_2_Mooring, MAP_Start, SubStructure_Out_Start, dUdy, OnlyTranslationDisp=.true.) + FieldMask = .false. + FieldMask(MASKID_TRANSLATIONDISP) = .true. + call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_MAP%PtFairDisplacement, MeshMapData%Structure_2_Mooring, MAP_Start, SubStructure_Out_Start, dUdy, FieldMask) END IF END SUBROUTINE Linear_MAP_InputSolve_dy @@ -3874,30 +3934,22 @@ 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), TARGET, INTENT(IN) :: y_ED !< The outputs from the ElastoDyn structural dynamics module - TYPE(SD_OutputType), TARGET, INTENT(IN) :: y_SD !< The outputs from the SubDyn structural dynamics module + TYPE(ED_OutputType), TARGET, INTENT(IN ) :: y_ED !< The outputs from the ElastoDyn structural dynamics module + TYPE(SD_OutputType), TARGET, 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), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None 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 - TYPE(MeshType), POINTER :: SubstructureMotion - INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Linear_MD_InputSolve_du' - ErrStat = ErrID_None ErrMsg = "" @@ -3937,29 +3989,23 @@ 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 +SUBROUTINE Linear_MD_InputSolve_dy( p_FAST, y_FAST, u_MD, p_ED, y_ED, y_SD, MeshMapData, dUdy, ErrStat, ErrMsg ) 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_ParameterType), INTENT(IN) :: p_ED !< ElastoDyn parameters TYPE(ED_OutputType), TARGET, INTENT(IN) :: y_ED !< The outputs from the ElastoDyn structural dynamics module TYPE(SD_OutputType), TARGET, 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), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None INTEGER(IntKi) :: MD_Start ! starting index of dUdy (column) where particular MD fields are located INTEGER(IntKi) :: SubStructure_Out_Start! starting index of dUdy (row) where particular SD/ED fields are located TYPE(MeshType), POINTER :: SubstructureMotion - CHARACTER(*), PARAMETER :: RoutineName = 'Linear_MD_InputSolve_dy' - ErrStat = ErrID_None ErrMsg = "" @@ -3970,7 +4016,7 @@ SUBROUTINE Linear_MD_InputSolve_dy( p_FAST, y_FAST, u_MD, y_ED, y_SD, MeshMapDat SubStructure_Out_Start = Indx_y_SD_Y3Mesh_Start(y_SD, y_FAST) ! start of y_SD%Y3Mesh%TranslationDisp field ELSE SubstructureMotion => y_ED%PlatformPtMesh - SubStructure_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field + SubStructure_Out_Start = Indx_y_ED_Platform_Start(p_ED, y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field END IF !................................... @@ -3985,7 +4031,7 @@ SUBROUTINE Linear_MD_InputSolve_dy( p_FAST, y_FAST, u_MD, y_ED, y_SD, MeshMapDat !!! ! while forming dUdy, too. !!!call Linearize_Point_to_Point( SubstructureMotion, u_MD%CoupledKinematics(1), MeshMapData%Structure_2_Mooring, ErrStat2, ErrMsg2 ) - call Assemble_dUdy_Motions( SubstructureMotion, u_MD%CoupledKinematics(1), MeshMapData%Structure_2_Mooring, MD_Start, SubStructure_Out_Start, dUdy, OnlyTranslationDisp=.false.) + call Assemble_dUdy_Motions( SubstructureMotion, u_MD%CoupledKinematics(1), MeshMapData%Structure_2_Mooring, MD_Start, SubStructure_Out_Start, dUdy) END IF END SUBROUTINE Linear_MD_InputSolve_dy @@ -4484,20 +4530,51 @@ END SUBROUTINE SumBlockMatrix !! \vec{a}^S \\ !! \vec{\alpha}^S \\ !! \end{matrix} \right\} \f$ -SUBROUTINE Assemble_dUdy_Motions(y, u, MeshMap, BlockRowStart, BlockColStart, dUdy, skipRotVel, skipRotAcc, onlyTranslationDisp) +SUBROUTINE Assemble_dUdy_Motions(y, u, MeshMap, BlockRowStart, BlockColStart, dUdy, uFieldMaskIn, yFieldMaskIn) TYPE(MeshType), INTENT(IN) :: y !< the output (source) mesh that is transfering motions TYPE(MeshType), INTENT(IN) :: u !< the input (destination) mesh that is receiving motions TYPE(MeshMapType), INTENT(IN) :: MeshMap !< the mesh mapping from y to u - INTEGER(IntKi), INTENT(IN) :: BlockRowStart !< the index of the row defining the block of dUdy to be set - INTEGER(IntKi), INTENT(IN) :: BlockColStart !< the index of the column defining the block of dUdy to be set + INTEGER(IntKi), INTENT(IN) :: BlockRowStart !< the index of the row defining the block of dUdy to be set (u) + INTEGER(IntKi), INTENT(IN) :: BlockColStart !< the index of the column defining the block of dUdy to be set (y) REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< full Jacobian matrix - LOGICAL, OPTIONAL, INTENT(IN) :: skipRotVel !< if present and true, we skip the rotational velocity and both acceleration fields and return early - LOGICAL, OPTIONAL, INTENT(IN) :: onlyTranslationDisp !< if present and true, we set only the destination translationDisp fields and return early - LOGICAL, OPTIONAL, INTENT(IN) :: skipRotAcc !< if present and true, we skip the rotational acceleration field + LOGICAL, OPTIONAL, INTENT(IN ) :: uFieldMaskIn(FIELDMASK_SIZE) !< which row fields to do + LOGICAL, OPTIONAL, INTENT(IN ) :: yFieldMaskIn(FIELDMASK_SIZE) !< which col fields to do INTEGER(IntKi) :: row INTEGER(IntKi) :: col - + LOGICAL :: uFieldMask(FIELDMASK_SIZE) !< which row fields to do + LOGICAL :: yFieldMask(FIELDMASK_SIZE) !< which row fields to do + + ! Fields: destination u mesh (row) may not have all fields. For some modules, a field may be skipped in + ! the sequence. A separate counting of fields before the current field must be tracked. + ! It is assumed that the source mesh is complete and contains all fields + integer(IntKi) :: uFieldIdx(FIELDMASK_SIZE) ! index 0 based + integer(IntKi) :: yFieldIdx(FIELDMASK_SIZE) ! index 0 based + + if (present(uFieldMaskIn)) then + uFieldMask = uFieldMaskIn + else + uFieldMask(MASKID_TRANSLATIONDISP) = .true. + uFieldMask(MASKID_ORIENTATION) = .true. + uFieldMask(MASKID_TRANSLATIONVEL) = .true. + uFieldMask(MASKID_ROTATIONVEL) = .true. + uFieldMask(MASKID_TRANSLATIONACC) = .true. + uFieldMask(MASKID_ROTATIONACC) = .true. + endif + call SetFieldIdx(uFieldMask,u%NNodes,uFieldIdx) + + if (present(yFieldMaskIn)) then + yFieldMask = yFieldMaskIn + else + yFieldMask(MASKID_TRANSLATIONDISP) = .true. + yFieldMask(MASKID_ORIENTATION) = .true. + yFieldMask(MASKID_TRANSLATIONVEL) = .true. + yFieldMask(MASKID_ROTATIONVEL) = .true. + yFieldMask(MASKID_TRANSLATIONACC) = .true. + yFieldMask(MASKID_ROTATIONACC) = .true. + endif + call SetFieldIdx(yFieldMask,y%NNodes,yFieldIdx) + !! \f$M_{mi}\f$ is modmesh_mapping::meshmaplinearizationtype::mi (motion identity)\n !! \f$M_{f_{\times p}}\f$ is modmesh_mapping::meshmaplinearizationtype::fx_p \n !! \f$M_{tv\_uD}\f$ is modmesh_mapping::meshmaplinearizationtype::tv_uD \n @@ -4506,94 +4583,126 @@ SUBROUTINE Assemble_dUdy_Motions(y, u, MeshMap, BlockRowStart, BlockColStart, dU !! \f$M_{ta\_uS}\f$ is modmesh_mapping::meshmaplinearizationtype::ta_uS \n !! \f$M_{ta\_rv}\f$ is modmesh_mapping::meshmaplinearizationtype::ta_rv \n - !*** row for translational displacement *** - ! source translational displacement to destination translational displacement: - row = BlockRowStart ! start of u%TranslationDisp field - col = BlockColStart ! start of y%TranslationDisp field - call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) - ! source orientation to destination translational displacement: - row = BlockRowStart ! start of u%TranslationDisp field - col = BlockColStart + y%NNodes*3 ! start of y%Orientation field [skip 1 field with 3 components] - call SetBlockMatrix( dUdy, MeshMap%dM%fx_p, row, col ) + !*** row for translational displacement *** + if (uFieldMask(MASKID_TRANSLATIONDISP)) then + row = BlockRowStart + uFieldIdx(MASKID_TRANSLATIONDISP) ! start of u%TranslationDisp field + ! source translational displacement to destination translational displacement: + if (yFieldMask(MASKID_TRANSLATIONDISP)) then + col = BlockColStart + yFieldIdx(MASKID_TRANSLATIONDISP) ! start of y%TranslationDisp field + call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + endif - if (PRESENT(onlyTranslationDisp)) then - if (onlyTranslationDisp) return ! destination includes only the translational displacement field, so we'll just return - end if + ! source orientation to destination translational displacement: + if (yFieldMask(MASKID_ORIENTATION)) then + col = BlockColStart + yFieldIdx(MASKID_ORIENTATION) ! start of y%Orientation field + call SetBlockMatrix( dUdy, MeshMap%dM%fx_p, row, col ) + endif + endif - !*** row for orientation *** - ! source orientation to destination orientation: - row = BlockRowStart + u%NNodes*3 ! start of u%Orientation field [skip 1 field with 3 components] - col = BlockColStart + y%NNodes*3 ! start of y%Orientation field [skip 1 field with 3 components] + + !*** row for orientation *** + if (uFieldMask(MASKID_ORIENTATION) .and. yFieldMask(MASKID_ORIENTATION)) then + ! source orientation to destination orientation: + row = BlockRowStart + uFieldIdx(MASKID_ORIENTATION) ! start of u%Orientation field + col = BlockColStart + yFieldIdx(MASKID_ORIENTATION) ! start of y%Orientation field call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + endif - !*** row for translational velocity *** - ! source translational displacement to destination translational velocity: - row = BlockRowStart + u%NNodes*6 ! start of u%TranslationVel field [skip 2 fields with 3 components] - col = BlockColStart ! start of y%TranslationDisp field - call SetBlockMatrix( dUdy, MeshMap%dM%tv_us, row, col ) + !*** row for translational velocity *** + if (uFieldMask(MASKID_TRANSLATIONVEL)) then + row = BlockRowStart + uFieldIdx(MASKID_TRANSLATIONVEL) ! start of u%TranslationVel field - ! source translational velocity to destination translational velocity: - row = BlockRowStart + u%NNodes*6 ! start of u%TranslationVel field [skip 2 fields with 3 components] - col = BlockColStart + y%NNodes*6 ! start of y%TranslationVel field [skip 2 fields with 3 components] - call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + ! source translational displacement to destination translational velocity: + if (yFieldMask(MASKID_TRANSLATIONDISP)) then + col = BlockColStart + yFieldIdx(MASKID_TRANSLATIONDISP) ! start of y%TranslationDisp field + call SetBlockMatrix( dUdy, MeshMap%dM%tv_us, row, col ) + endif - ! source rotational velocity to destination translational velocity: - row = BlockRowStart + u%NNodes*6 ! start of u%TranslationVel field [skip 2 fields with 3 components] - col = BlockColStart + y%NNodes*9 ! start of y%RotationVel field [skip 3 fields with 3 components] - call SetBlockMatrix( dUdy, MeshMap%dM%fx_p, row, col ) + ! source translational velocity to destination translational velocity: + if (yFieldMask(MASKID_TRANSLATIONVEL)) then + col = BlockColStart + yFieldIdx(MASKID_TRANSLATIONVEL) ! start of y%TranslationVel field + call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + endif + ! source rotational velocity to destination translational velocity: + if (yFieldMask(MASKID_ROTATIONVEL)) then + col = BlockColStart + yFieldIdx(MASKID_ROTATIONVEL) ! start of y%RotationVel field + call SetBlockMatrix( dUdy, MeshMap%dM%fx_p, row, col ) + endif + endif - if (PRESENT(skipRotVel)) then - if (skipRotVel) return ! destination does not include rotational velocities or accelerations, so we'll just return - end if - !*** row for rotational velocity *** - ! source rotational velocity to destination rotational velocity: - row = BlockRowStart + u%NNodes*9 ! start of u%RotationVel field [skip 3 fields with 3 components] - col = BlockColStart + y%NNodes*9 ! start of y%RotationVel field [skip 3 fields with 3 components] + !*** row for rotational velocity *** + if (uFieldMask(MASKID_ROTATIONVEL) .and. yFieldMask(MASKID_ROTATIONVEL)) then + ! source rotational velocity to destination rotational velocity: + row = BlockRowStart + uFieldIdx(MASKID_ROTATIONVEL) ! start of u%RotationVel field + col = BlockColStart + yFieldIdx(MASKID_ROTATIONVEL) ! start of y%RotationVel field call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + endif - !*** row for translational acceleration *** - ! source translational displacement to destination translational acceleration: - row = BlockRowStart + u%NNodes*12 ! start of u%TranslationAcc field [skip 4 fields with 3 components] - col = BlockColStart ! start of y%TranslationDisp field - call SetBlockMatrix( dUdy, MeshMap%dM%ta_us, row, col ) + !*** row for translational acceleration *** + if (uFieldMask(MASKID_TRANSLATIONACC)) then + row = BlockRowStart + uFieldIdx(MASKID_TRANSLATIONACC) ! start of u%TranslationAcc field - ! source rotational velocity to destination translational acceleration: - row = BlockRowStart + u%NNodes*12 ! start of u%TranslationAcc field [skip 4 fields with 3 components] - col = BlockColStart + y%NNodes*9 ! start of y%RotationVel field [skip 3 fields with 3 components] - call SetBlockMatrix( dUdy, MeshMap%dM%ta_rv, row, col ) + ! source translational displacement to destination translational acceleration: + if (yFieldMask(MASKID_TRANSLATIONDISP)) then + col = BlockColStart + yFieldIdx(MASKID_TRANSLATIONDISP) ! start of y%TranslationDisp field + call SetBlockMatrix( dUdy, MeshMap%dM%ta_us, row, col ) + endif - ! source translational acceleration to destination translational acceleration: - row = BlockRowStart + u%NNodes*12 ! start of u%TranslationAcc field [skip 4 fields with 3 components] - col = BlockColStart + y%NNodes*12 ! start of y%TranslationAcc field [skip 4 fields with 3 components] - call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + ! source rotational velocity to destination translational acceleration: + if (yFieldMask(MASKID_ROTATIONVEL)) then + col = BlockColStart + yFieldIdx(MASKID_ROTATIONVEL) ! start of y%RotationVel field + call SetBlockMatrix( dUdy, MeshMap%dM%ta_rv, row, col ) + endif - ! source rotational acceleration to destination translational acceleration: - row = BlockRowStart + u%NNodes*12 ! start of u%TranslationAcc field [skip 4 fields with 3 components] - col = BlockColStart + y%NNodes*15 ! start of y%RotationAcc field [skip 5 fields with 3 components] - call SetBlockMatrix( dUdy, MeshMap%dM%fx_p, row, col ) + ! source translational acceleration to destination translational acceleration: + if (yFieldMask(MASKID_TRANSLATIONACC)) then + col = BlockColStart + yFieldIdx(MASKID_TRANSLATIONACC) ! start of y%TranslationAcc field + call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + endif + ! source rotational acceleration to destination translational acceleration: + if (yFieldMask(MASKID_ROTATIONACC)) then + col = BlockColStart + yFieldIdx(MASKID_ROTATIONACC) ! start of y%RotationAcc field + call SetBlockMatrix( dUdy, MeshMap%dM%fx_p, row, col ) + endif + endif - if (PRESENT(skipRotAcc)) then - if (skipRotAcc) return ! destination does not include rotational accelerations, so we'll just return - end if - - !*** row for rotational acceleration *** - ! source rotational acceleration to destination rotational acceleration - row = BlockRowStart + u%NNodes*15 ! start of u%RotationAcc field [skip 5 fields with 3 components] - col = BlockColStart + y%NNodes*15 ! start of y%RotationAcc field [skip 5 fields with 3 components] + !*** row for rotational acceleration *** + if (uFieldMask(MASKID_ROTATIONACC) .and. yFieldMask(MASKID_ROTATIONACC)) then + ! source rotational acceleration to destination rotational acceleration + row = BlockRowStart + uFieldIdx(MASKID_ROTATIONACC ) ! start of u%RotationAcc field + col = BlockColStart + yFieldIdx(MASKID_ROTATIONACC ) ! start of y%RotationAcc field call SetBlockMatrix( dUdy, MeshMap%dM%mi, row, col ) + endif +contains + subroutine SetFieldIdx(FMask,NNodes,FIdx) + logical, intent(in ) :: FMask(FIELDMASK_SIZE) + integer, intent(in ) :: NNodes + integer, intent( out) :: FIdx(FIELDMASK_SIZE) + integer :: idxNext + FIdx = 0 + idxNext = 0 ! index 0 based + if (FMask(MASKID_TRANSLATIONDISP)) then; FIdx(MASKID_TRANSLATIONDISP) = idxNext; idxNext = FIdx(MASKID_TRANSLATIONDISP) + 3*NNodes; endif ! 3 fields for TRANSLATIONDISP + if (FMask(MASKID_ORIENTATION )) then; FIdx(MASKID_ORIENTATION ) = idxNext; idxNext = FIdx(MASKID_ORIENTATION ) + 3*NNodes; endif ! 3 fields for ORIENTATION + if (FMask(MASKID_TRANSLATIONVEL )) then; FIdx(MASKID_TRANSLATIONVEL ) = idxNext; idxNext = FIdx(MASKID_TRANSLATIONVEL ) + 3*NNodes; endif ! 3 fields for TRANSLATIONVEL + if (FMask(MASKID_ROTATIONVEL )) then; FIdx(MASKID_ROTATIONVEL ) = idxNext; idxNext = FIdx(MASKID_ROTATIONVEL ) + 3*NNodes; endif ! 3 fields for ROTATIONVEL + if (FMask(MASKID_TRANSLATIONACC )) then; FIdx(MASKID_TRANSLATIONACC ) = idxNext; idxNext = FIdx(MASKID_TRANSLATIONACC ) + 3*NNodes; endif ! 3 fields for TRANSLATIONACC + if (FMask(MASKID_ROTATIONACC )) then; FIdx(MASKID_ROTATIONACC ) = idxNext; idxNext = FIdx(MASKID_ROTATIONACC ) + 3*NNodes; endif ! 3 fields for ROTATIONACC + end subroutine SetFieldIdx END SUBROUTINE Assemble_dUdy_Motions + + !---------------------------------------------------------------------------------------------------------------------------------- !> This routine assembles the linearization matrices for transfer of load fields between two meshes. !> It set the following block matrix, which is the dUdy block for transfering output (source) mesh \f$y\f$ to the @@ -4641,204 +4750,221 @@ END SUBROUTINE Assemble_dUdy_Loads !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_ED%BladePtLoads(BladeNum) mesh in the FAST linearization inputs. -FUNCTION Indx_u_ED_Blade_Start(u_ED, y_FAST, BladeNum) RESULT(ED_Start) +FUNCTION Indx_u_ED_Blade_Start(p_ED, u_ED, y_FAST, BladeNum) RESULT(ED_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER, INTENT(IN ) :: BladeNum !< blade number to find index for INTEGER :: k !< blade number loop - INTEGER :: ED_Start !< starting index of this blade mesh in ElastoDyn inputs - - ED_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + ED_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_ED%Jac_u_idxStartList%BladeLoad - 1) ! index starts at 1 if (allocated(u_ED%BladePtLoads)) then do k = 1,min(BladeNum-1, size(u_ED%BladePtLoads)) ED_Start = ED_Start + u_ED%BladePtLoads(k)%NNodes * 6 ! 3 forces + 3 moments at each node on each blade end do end if - END FUNCTION Indx_u_ED_Blade_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_ED%PlatformPtMesh mesh in the FAST linearization inputs. -FUNCTION Indx_u_ED_Platform_Start(u_ED, y_FAST) RESULT(ED_Start) +FUNCTION Indx_u_ED_Platform_Start(p_ED, u_ED, y_FAST) RESULT(ED_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER :: ED_Start !< starting index of this mesh - - ED_Start = Indx_u_ED_Blade_Start(u_ED, y_FAST, MaxNBlades+1) ! skip all of the blades to get to start of platform + ED_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_ED%Jac_u_idxStartList%PlatformLoad - 1) ! index starts at 1 END FUNCTION Indx_u_ED_Platform_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_ED%TowerPtLoads mesh in the FAST linearization inputs. -FUNCTION Indx_u_ED_Tower_Start(u_ED, y_FAST) RESULT(ED_Start) +FUNCTION Indx_u_ED_Tower_Start(p_ED, u_ED, y_FAST) RESULT(ED_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t - + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER :: ED_Start !< starting index of this mesh - - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) - ED_Start = ED_Start + u_ED%PlatformPtMesh%NNodes * 6 ! 3 forces + 3 moments at each node + ED_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_ED%Jac_u_idxStartList%TowerLoad - 1) ! index starts at 1 END FUNCTION Indx_u_ED_Tower_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_ED%HubPtLoad mesh in the FAST linearization inputs. -FUNCTION Indx_u_ED_Hub_Start(u_ED, y_FAST) RESULT(ED_Start) +FUNCTION Indx_u_ED_Hub_Start(p_ED, u_ED, y_FAST) RESULT(ED_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t - + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER :: ED_Start !< starting index of this mesh - - ED_Start = Indx_u_ED_Tower_Start(u_ED, y_FAST) - ED_Start = ED_Start + u_ED%TowerPtLoads%NNodes * 6 ! 3 forces + 3 moments at each node + ED_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_ED%Jac_u_idxStartList%HubLoad - 1) ! index starts at 1 END FUNCTION Indx_u_ED_Hub_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_ED%NacelleLoads mesh in the FAST linearization inputs. -FUNCTION Indx_u_ED_Nacelle_Start(u_ED, y_FAST) RESULT(ED_Start) +FUNCTION Indx_u_ED_Nacelle_Start(p_ED, u_ED, y_FAST) RESULT(ED_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t - + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER :: ED_Start !< starting index of this mesh - - ED_Start = Indx_u_ED_Hub_Start(u_ED, y_FAST) - ED_Start = ED_Start + u_ED%HubPtLoad%NNodes * 6 ! 3 forces + 3 moments at each node + ED_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_ED%Jac_u_idxStartList%NacelleLoad - 1) ! index starts at 1 END FUNCTION Indx_u_ED_Nacelle_Start !---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_ED%NacelleLoads mesh in the FAST linearization inputs. +FUNCTION Indx_u_ED_TFin_Start(p_ED, u_ED, y_FAST) RESULT(ED_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters + INTEGER :: ED_Start !< starting index of this mesh + ED_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_ED%Jac_u_idxStartList%TFinLoad - 1) ! index starts at 1 +END FUNCTION Indx_u_ED_TFin_Start +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_ED%BladePitchCom array in the FAST linearization inputs. -FUNCTION Indx_u_ED_BlPitchCom_Start(u_ED, y_FAST) RESULT(ED_Start) +FUNCTION Indx_u_ED_BlPitchCom_Start(p_ED, u_ED, y_FAST) RESULT(ED_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_InputType), INTENT(IN ) :: u_ED !< ED Inputs at t - + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER :: ED_Start !< starting index of this mesh - - ED_Start = Indx_u_ED_Nacelle_Start(u_ED, y_FAST) - ED_Start = ED_Start + u_ED%NacelleLoads%NNodes * 6 ! 3 forces + 3 moments at each node + ED_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_ED%Jac_u_idxStartList%BlPitchCom - 1) ! index starts at 1 END FUNCTION Indx_u_ED_BlPitchCom_Start !---------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the y_ED%BladeLn2Mesh(BladeNum) mesh in the FAST linearization outputs. -FUNCTION Indx_y_ED_Blade_Start(y_ED, y_FAST, BladeNum) RESULT(ED_Out_Start) +FUNCTION Indx_y_ED_Blade_Start(p_ED, y_ED, y_FAST, BladeNum) RESULT(ED_Out_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER, INTENT(IN ) :: BladeNum !< blade number to find index for INTEGER :: k !< blade number loop - INTEGER :: ED_Out_Start !< starting index of this blade mesh in ElastoDyn outputs - - ED_Out_Start = y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field (blade motions in y_ED) + ED_Out_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (p_ED%Jac_y_idxStartList%Blade - 1) ! index starts at 1 if (allocated(y_ED%BladeLn2Mesh)) then do k = 1,min(BladeNum-1,SIZE(y_ED%BladeLn2Mesh,1)) ! Loop through all blades (p_ED%NumBl) ED_Out_Start = ED_Out_Start + y_ED%BladeLn2Mesh(k)%NNodes*18 ! 6 fields with 3 components on each blade end do end if - END FUNCTION Indx_y_ED_Blade_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the y_ED%PlatformPtMesh mesh in the FAST linearization outputs. -FUNCTION Indx_y_ED_Platform_Start(y_ED, y_FAST) RESULT(ED_Out_Start) +FUNCTION Indx_y_ED_Platform_Start(p_ED, y_ED, y_FAST) RESULT(ED_Out_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t - + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER :: ED_Out_Start !< starting index of this mesh in ElastoDyn outputs - - ED_Out_Start = Indx_y_ED_Blade_Start(y_ED, y_FAST, MaxNBlades+1) ! skip all of the blades to get to start of platform + ED_Out_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (p_ED%Jac_y_idxStartList%Platform - 1) ! index starts at 1 END FUNCTION Indx_y_ED_Platform_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the y_ED%TowerLn2Mesh mesh in the FAST linearization outputs. -FUNCTION Indx_y_ED_Tower_Start(y_ED, y_FAST) RESULT(ED_Out_Start) +FUNCTION Indx_y_ED_Tower_Start(p_ED, y_ED, y_FAST) RESULT(ED_Out_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t - + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER :: ED_Out_Start !< starting index of this mesh in ElastoDyn outputs - - ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) - ED_Out_Start = ED_Out_Start + y_ED%PlatformPtMesh%NNodes*18 ! 6 fields with 3 components + ED_Out_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (p_ED%Jac_y_idxStartList%Tower - 1) ! index starts at 1 END FUNCTION Indx_y_ED_Tower_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the y_ED%HubPtMesh mesh in the FAST linearization outputs. -FUNCTION Indx_y_ED_Hub_Start(y_ED, y_FAST) RESULT(ED_Out_Start) +FUNCTION Indx_y_ED_Hub_Start(p_ED, y_ED, y_FAST) RESULT(ED_Out_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t - + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER :: ED_Out_Start !< starting index of this mesh in ElastoDyn outputs - - ED_Out_Start = Indx_y_ED_Tower_Start(y_ED, y_FAST) - ED_Out_Start = ED_Out_Start + y_ED%TowerLn2Mesh%NNodes*18 ! 6 fields with 3 components + ED_Out_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (p_ED%Jac_y_idxStartList%Hub - 1) ! index starts at 1 END FUNCTION Indx_y_ED_Hub_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the y_ED%BladeRootMotion(BladeNum) mesh in the FAST linearization outputs. -FUNCTION Indx_y_ED_BladeRoot_Start(y_ED, y_FAST, BladeNum) RESULT(ED_Out_Start) +FUNCTION Indx_y_ED_BladeRoot_Start(p_ED, y_ED, y_FAST, BladeNum) RESULT(ED_Out_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER, INTENT(IN ) :: BladeNum !< blade number to find index for INTEGER :: k !< blade number loop - INTEGER :: ED_Out_Start !< starting index of this blade mesh in ElastoDyn outputs - - ED_Out_Start = Indx_y_ED_Hub_Start(y_ED, y_FAST) - ED_Out_Start = ED_Out_Start + y_ED%HubPtMotion%NNodes*9 ! 3 fields with 3 components - + ED_Out_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (p_ED%Jac_y_idxStartList%BladeRoot - 1) ! index starts at 1 do k = 1,min(BladeNum-1,size(y_ED%BladeRootMotion)) - ED_Out_Start = ED_Out_Start + y_ED%BladeRootMotion(k)%NNodes*18 + ED_Out_Start = ED_Out_Start + y_ED%BladeRootMotion(k)%NNodes*18 ! all fields end do END FUNCTION Indx_y_ED_BladeRoot_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the y_ED%NacelleMotion mesh in the FAST linearization outputs. -FUNCTION Indx_y_ED_Nacelle_Start(y_ED, y_FAST) RESULT(ED_Out_Start) +FUNCTION Indx_y_ED_Nacelle_Start(p_ED, y_ED, y_FAST) RESULT(ED_Out_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters INTEGER :: k !< blade number loop - INTEGER :: ED_Out_Start !< starting index of this blade mesh in ElastoDyn outputs - - ED_Out_Start = Indx_y_ED_BladeRoot_Start(y_ED, y_FAST, size(y_ED%BladeRootMotion)) ! start of last blade root - ED_Out_Start = ED_Out_Start + y_ED%BladeRootMotion(size(y_ED%BladeRootMotion))%NNodes*18 ! N blade roots, 6 fields with 3 components per blade. + ED_Out_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (p_ED%Jac_y_idxStartList%Nacelle - 1) ! index starts at 1 END FUNCTION Indx_y_ED_Nacelle_Start !---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the y_ED%TFinCMMotion mesh in the FAST linearization outputs. +FUNCTION Indx_y_ED_TFin_Start(p_ED, y_ED, y_FAST) RESULT(ED_Out_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ED outputs at t + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ED parameters + INTEGER :: k !< blade number loop + INTEGER :: ED_Out_Start !< starting index of tailfin mesh in ElastoDyn outputs + ED_Out_Start = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + (p_ED%Jac_y_idxStartList%TFin - 1) ! index starts at 1 +END FUNCTION Indx_y_ED_TFin_Start +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for y_ED%Yaw in the FAST linearization outputs. FUNCTION Indx_y_Yaw_Start(y_FAST, ThisModule) RESULT(ED_Out_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) INTEGER, INTENT(IN ) :: ThisModule !< which structural module this is for - INTEGER :: ED_Out_Start !< starting index of this blade mesh in ElastoDyn outputs - - ED_Out_Start = y_FAST%Lin%Modules(thisModule)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + y_FAST%Lin%Modules(thisModule)%Instance(1)%SizeLin(LIN_OUTPUT_COL) & !end of ED outputs (+1) - y_FAST%Lin%Modules(thisModule)%Instance(1)%NumOutputs - 3 ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) - END FUNCTION Indx_y_Yaw_Start !---------------------------------------------------------------------------------------------------------------------------------- + +! Indexing to AD15 Jac_u. Order is: +! Nacelle +! Hub +! Tower +! BladeRoot +! Blades +! TailFin +! UserProp +! Extended inputs +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_AD%rotors(1)%NacelleMotion mesh in the FAST linearization inputs. +FUNCTION Indx_u_AD_Nacelle_Start(p_AD, u_AD, y_FAST) RESULT(AD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AD parameters + INTEGER :: AD_Start !< starting index of this mesh in AeroDyn inputs + AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_AD%rotors(1)%Jac_u_idxStartList%Nacelle - 1) ! index starts at 1 +END FUNCTION Indx_u_AD_Nacelle_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_AD%rotors(1)%NacelleMotion mesh in the FAST linearization inputs. +FUNCTION Indx_u_AD_Hub_Start(p_AD, u_AD, y_FAST) RESULT(AD_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AD parameters + INTEGER :: AD_Start !< starting index of this mesh in AeroDyn inputs + AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_AD%rotors(1)%Jac_u_idxStartList%Hub - 1) ! index starts at 1 +END FUNCTION Indx_u_AD_Hub_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_AD%rotors(1)%TowerMotion mesh in the FAST linearization inputs. -FUNCTION Indx_u_AD_Tower_Start(u_AD, y_FAST) RESULT(AD_Start) +FUNCTION Indx_u_AD_Tower_Start(p_AD, u_AD, y_FAST) RESULT(AD_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t - + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AD parameters INTEGER :: AD_Start !< starting index of this mesh in AeroDyn inputs - - AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) - + AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_AD%rotors(1)%Jac_u_idxStartList%Tower - 1) ! index starts at 1 END FUNCTION Indx_u_AD_Tower_Start !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine returns the starting index for the u_AD%rotors(1)%HubMotion mesh in the FAST linearization inputs. -FUNCTION Indx_u_AD_Hub_Start(u_AD, y_FAST) RESULT(AD_Start) +!> This routine returns the starting index for the u_AD%rotors(1)%TFinMotion mesh in the FAST linearization inputs. +FUNCTION Indx_u_AD_TFin_Start(p_AD, u_AD, y_FAST) RESULT(AD_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t - + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AD parameters INTEGER :: AD_Start !< starting index of this mesh in AeroDyn inputs - - AD_Start = Indx_u_AD_Tower_Start(u_AD, y_FAST) + u_AD%rotors(1)%TowerMotion%NNodes * 9 ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel) with 3 components - -END FUNCTION Indx_u_AD_Hub_Start + AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_AD%rotors(1)%Jac_u_idxStartList%TFin - 1) ! index starts at 1 +END FUNCTION Indx_u_AD_TFin_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_AD%rotors(1)%BladeRootMotion(k) mesh in the FAST linearization inputs. -FUNCTION Indx_u_AD_BladeRoot_Start(u_AD, y_FAST, BladeNum) RESULT(AD_Start) +FUNCTION Indx_u_AD_BladeRoot_Start(p_AD, u_AD, y_FAST, BladeNum) RESULT(AD_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AD parameters INTEGER, INTENT(IN ) :: BladeNum !< blade number to find index for INTEGER :: k !< blade number loop - INTEGER :: AD_Start !< starting index of this mesh in AeroDyn inputs - AD_Start = Indx_u_AD_Hub_Start(u_AD, y_FAST) + u_AD%rotors(1)%HubMotion%NNodes * 9 ! 3 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_RotationVel) with 3 components + AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_AD%rotors(1)%Jac_u_idxStartList%BladeRoot - 1) ! index starts at 1 do k = 1,min(BladeNum-1,size(u_AD%rotors(1)%BladeRootMotion)) AD_Start = AD_Start + u_AD%rotors(1)%BladeRootMotion(k)%NNodes * 3 ! 1 field (MASKID_Orientation) with 3 components @@ -4846,32 +4972,21 @@ FUNCTION Indx_u_AD_BladeRoot_Start(u_AD, y_FAST, BladeNum) RESULT(AD_Start) END FUNCTION Indx_u_AD_BladeRoot_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_AD%rotors(1)%BladeMotion(k) mesh in the FAST linearization inputs. -FUNCTION Indx_u_AD_Blade_Start(u_AD, y_FAST, BladeNum) RESULT(AD_Start) +FUNCTION Indx_u_AD_Blade_Start(p_AD, u_AD, y_FAST, BladeNum) RESULT(AD_Start) TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t + TYPE(AD_ParameterType), INTENT(IN ) :: p_AD !< AD parameters INTEGER, INTENT(IN ) :: BladeNum !< blade number to find index for INTEGER :: k !< blade number loop - INTEGER :: AD_Start !< starting index of this mesh in AeroDyn inputs - AD_Start = Indx_u_AD_BladeRoot_Start(u_AD, y_FAST, MaxNBlades+1) + AD_Start = y_FAST%Lin%Modules(Module_AD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + (p_AD%rotors(1)%Jac_u_idxStartList%Blade - 1) ! index starts at 1 do k = 1,min(BladeNum-1,size(u_AD%rotors(1)%BladeMotion)) - AD_Start = AD_Start + u_AD%rotors(1)%BladeMotion(k)%NNodes * 15 ! 5 fields (TranslationDisp, MASKID_Orientation, TranslationVel, RotationVel, TranslationAcc) with 3 components + AD_Start = AD_Start + u_AD%rotors(1)%BladeMotion(k)%NNodes * 18 ! 6 fields (TranslationDisp, MASKID_Orientation, TranslationVel, RotationVel, TranslationAcc, RotationAcc) with 3 components end do END FUNCTION Indx_u_AD_Blade_Start -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine returns the starting index for the u_AD%rotors(1)%InflowOnBlade array in the FAST linearization inputs. -FUNCTION Indx_u_AD_BladeInflow_Start(u_AD, y_FAST) RESULT(AD_Start) - TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) - TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD Inputs at t - - INTEGER :: AD_Start !< starting index of this array in AeroDyn inputs - AD_Start = Indx_u_AD_Blade_Start(u_AD, y_FAST, MaxNBlades+1) - -END FUNCTION Indx_u_AD_BladeInflow_Start -!---------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_SD%TPMesh mesh in the FAST linearization inputs. @@ -4961,7 +5076,19 @@ FUNCTION Indx_u_HD_PRP_Start(u_HD, y_FAST) RESULT(HD_Start) HD_Start = Indx_u_HD_WAMIT_Start(u_HD, y_FAST) if (u_HD%WAMITMesh%committed) HD_Start = HD_Start + u_HD%WAMITMesh%NNodes * 18 ! 6 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel,MASKID_ROTATIONVel,MASKID_TRANSLATIONAcc,MASKID_ROTATIONAcc) with 3 components - END FUNCTION Indx_u_HD_PRP_Start +END FUNCTION Indx_u_HD_PRP_Start +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for the u_HD%PRPMesh mesh in the FAST linearization inputs. +function Indx_u_HD_Ext_Start(u_HD, y_FAST) RESULT(HD_Start) + type(FAST_OutputFileType), intent(in ) :: y_FAST !< FAST output file data (for linearization) + type(HydroDyn_InputType), intent(in ) :: u_HD !< HD Inputs at t + + integer :: HD_Start !< starting index of this mesh in HydroDyn inputs + + HD_Start = Indx_u_HD_PRP_Start(u_HD, y_FAST) + if (u_HD%WAMITMesh%committed) HD_Start = HD_Start + u_HD%PRPMesh%NNodes * 18 ! 6 fields (MASKID_TRANSLATIONDISP,MASKID_Orientation,MASKID_TRANSLATIONVel,MASKID_ROTATIONVel,MASKID_TRANSLATIONAcc,MASKID_ROTATIONAcc) with 3 components + +end function Indx_u_HD_Ext_Start !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the y_HD%Morison%DistribMesh mesh in the FAST linearization outputs. FUNCTION Indx_y_HD_Morison_Start(y_HD, y_FAST) RESULT(HD_Start) @@ -5002,6 +5129,7 @@ SUBROUTINE AllocateOP(p_FAST, y_FAST, ErrStat, ErrMsg ) ! local variables INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AllocateOP' @@ -5013,28 +5141,18 @@ SUBROUTINE AllocateOP(p_FAST, y_FAST, ErrStat, ErrMsg ) !---------------------------------------------------------------------------------------- - ALLOCATE( y_FAST%op%x_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_ED(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ElastoDyn operating point data")) return; + ALLOCATE( y_FAST%op%xd_ED(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ElastoDyn operating point data")) return; + ALLOCATE( y_FAST%op%z_ED(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ElastoDyn operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_ED(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ElastoDyn operating point data")) return; + ALLOCATE( y_FAST%op%u_ED(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ElastoDyn operating point data")) return; IF ( p_FAST%CompElast == Module_BD ) THEN - ALLOCATE( y_FAST%op%x_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("BeamDyn operating point data")) return; + ALLOCATE( y_FAST%op%xd_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("BeamDyn operating point data")) return; + ALLOCATE( y_FAST%op%z_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("BeamDyn operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("BeamDyn operating point data")) return; + ALLOCATE( y_FAST%op%u_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("BeamDyn operating point data")) return; END IF @@ -5042,155 +5160,117 @@ SUBROUTINE AllocateOP(p_FAST, y_FAST, ErrStat, ErrMsg ) !IF ( p_FAST%CompAero == Module_AD14 ) THEN !ELSE IF ( p_FAST%CompAero == Module_AD ) THEN - ALLOCATE( y_FAST%op%x_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_AD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("AeroDyn operating point data")) return; + ALLOCATE( y_FAST%op%xd_AD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("AeroDyn operating point data")) return; + ALLOCATE( y_FAST%op%z_AD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("AeroDyn operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_AD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("AeroDyn operating point data")) return; + ALLOCATE( y_FAST%op%u_AD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("AeroDyn operating point data")) return; END IF IF ( p_FAST%CompInflow == Module_IfW ) THEN - ALLOCATE( y_FAST%op%x_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("InflowWind operating point data")) return; + ALLOCATE( y_FAST%op%xd_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("InflowWind operating point data")) return; + ALLOCATE( y_FAST%op%z_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("InflowWind operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("InflowWind operating point data")) return; + ALLOCATE( y_FAST%op%u_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("InflowWind operating point data")) return; END IF - - + + if ( p_FAST%CompSeaSt == Module_SeaSt ) then + allocate( y_FAST%op%x_SeaSt(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SeaState operating point data")) return; + allocate( y_FAST%op%xd_SeaSt(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SeaState operating point data")) return; + allocate( y_FAST%op%z_SeaSt(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SeaState operating point data")) return; + allocate( y_FAST%op%OtherSt_SeaSt(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SeaState operating point data")) return; + allocate( y_FAST%op%u_SeaSt(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SeaState operating point data")) return; + endif + IF ( p_FAST%CompServo == Module_SrvD ) THEN - ALLOCATE( y_FAST%op%x_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ServoDyn operating point data")) return; + ALLOCATE( y_FAST%op%xd_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ServoDyn operating point data")) return; + ALLOCATE( y_FAST%op%z_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ServoDyn operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ServoDyn operating point data")) return; + ALLOCATE( y_FAST%op%u_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ServoDyn operating point data")) return; END IF IF ( p_FAST%CompHydro == Module_HD ) THEN - ALLOCATE( y_FAST%op%x_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_HD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("HydroDyn operating point data")) return; + ALLOCATE( y_FAST%op%xd_HD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("HydroDyn operating point data")) return; + ALLOCATE( y_FAST%op%z_HD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("HydroDyn operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_HD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("HydroDyn operating point data")) return; + ALLOCATE( y_FAST%op%u_HD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("HydroDyn operating point data")) return; END IF ! SubDyn: copy final predictions to actual states IF ( p_FAST%CompSub == Module_SD ) THEN - ALLOCATE( y_FAST%op%x_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_SD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SubDyn operating point data")) return; + ALLOCATE( y_FAST%op%xd_SD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SubDyn operating point data")) return; + ALLOCATE( y_FAST%op%z_SD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SubDyn operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_SD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SubDyn operating point data")) return; + ALLOCATE( y_FAST%op%u_SD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("SubDyn operating point data")) return; ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN - ALLOCATE( y_FAST%op%x_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ExtPtfm operating point data")) return; + ALLOCATE( y_FAST%op%xd_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ExtPtfm operating point data")) return; + ALLOCATE( y_FAST%op%z_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ExtPtfm operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ExtPtfm operating point data")) return; + ALLOCATE( y_FAST%op%u_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("ExtPtfm operating point data")) return; END IF ! MAP/MoorDyn/FEAM: copy states and inputs to OP array IF (p_FAST%CompMooring == Module_MAP) THEN - ALLOCATE( y_FAST%op%x_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - !ALLOCATE( y_FAST%op%OtherSt_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) - ! if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MAP operating point data")) return; + ALLOCATE( y_FAST%op%xd_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MAP operating point data")) return; + ALLOCATE( y_FAST%op%z_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MAP operating point data")) return; + !ALLOCATE( y_FAST%op%OtherSt_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MAP operating point data")) return; + ALLOCATE( y_FAST%op%u_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MAP operating point data")) return; ELSEIF (p_FAST%CompMooring == Module_MD) THEN - ALLOCATE( y_FAST%op%x_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_MD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MoorDyn operating point data")) return; + ALLOCATE( y_FAST%op%xd_MD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MoorDyn operating point data")) return; + ALLOCATE( y_FAST%op%z_MD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MoorDyn operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_MD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MoorDyn operating point data")) return; + ALLOCATE( y_FAST%op%u_MD(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("MoorDyn operating point data")) return; ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN - ALLOCATE( y_FAST%op%x_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("FEAM operating point data")) return; + ALLOCATE( y_FAST%op%xd_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("FEAM operating point data")) return; + ALLOCATE( y_FAST%op%z_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("FEAM operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("FEAM operating point data")) return; + ALLOCATE( y_FAST%op%u_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("FEAM operating point data")) return; !ELSEIF (p_FAST%CompMooring == Module_Orca) THEN END IF ! IceFloe/IceDyn: copy states and inputs to OP array IF ( p_FAST%CompIce == Module_IceF ) THEN - ALLOCATE( y_FAST%op%x_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceFloe operating point data")) return; + ALLOCATE( y_FAST%op%xd_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceFloe operating point data")) return; + ALLOCATE( y_FAST%op%z_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceFloe operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceFloe operating point data")) return; + ALLOCATE( y_FAST%op%u_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceFloe operating point data")) return; ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN - ALLOCATE( y_FAST%op%x_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%xd_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%z_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%OtherSt_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) - ALLOCATE( y_FAST%op%u_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) - if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%x_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceDyn operating point data")) return; + ALLOCATE( y_FAST%op%xd_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceDyn operating point data")) return; + ALLOCATE( y_FAST%op%z_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceDyn operating point data")) return; + ALLOCATE( y_FAST%op%OtherSt_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceDyn operating point data")) return; + ALLOCATE( y_FAST%op%u_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ); if (Failed0("IceDyn operating point data")) return; END IF - + +contains + ! check for failed where /= 0 is fatal + logical function Failed0(txt) + character(*), intent(in) :: txt + if (errStat /= 0) then + ErrStat2 = ErrID_Fatal + ErrMsg2 = "Could not allocate "//trim(txt) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + endif + Failed0 = ErrStat >= AbortErrLev + end function Failed0 END SUBROUTINE AllocateOP !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine is the inverse of SetOperatingPoint(). It saves the current operating points so they can be retrieved !> when visualizing mode shapes. -SUBROUTINE SaveOP(i, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +SUBROUTINE SaveOP(i, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg, CtrlCode ) - INTEGER(IntKi) , INTENT(IN ) :: i !< current index into LinTimes TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code @@ -5202,6 +5282,7 @@ SUBROUTINE SaveOP(i, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, Ext TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data @@ -5280,7 +5361,7 @@ SUBROUTINE SaveOP(i, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, Ext CALL AD_CopyInput (AD%Input(1), y_FAST%op%u_AD(i), CtrlCode, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF - + ! InflowWind: copy states and inputs to OP array IF ( p_FAST%CompInflow == Module_IfW ) THEN CALL InflowWind_CopyContState (IfW%x( STATE_CURR), y_FAST%op%x_IfW( i), CtrlCode, Errstat2, ErrMsg2) @@ -5294,10 +5375,23 @@ SUBROUTINE SaveOP(i, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, Ext CALL InflowWind_CopyInput (IfW%Input(1), y_FAST%op%u_IfW(i), CtrlCode, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - + + ! SeaState: copy states and inputs to OP array + if ( p_FAST%CompSeaSt == Module_SeaSt ) then + call SeaSt_CopyContState (SeaSt%x( STATE_CURR), y_FAST%op%x_SeaSt( i), CtrlCode, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SeaSt_CopyDiscState (SeaSt%xd(STATE_CURR), y_FAST%op%xd_SeaSt( i), CtrlCode, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SeaSt_CopyConstrState (SeaSt%z( STATE_CURR), y_FAST%op%z_SeaSt( i), CtrlCode, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SeaSt_CopyOtherState( SeaSt%OtherSt( STATE_CURR), y_FAST%op%OtherSt_SeaSt( i), CtrlCode, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + call SeaSt_CopyInput (SeaSt%Input(1), y_FAST%op%u_SeaSt(i), CtrlCode, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + endif + ! ServoDyn: copy states and inputs to OP array IF ( p_FAST%CompServo == Module_SrvD ) THEN CALL SrvD_CopyContState (SrvD%x( STATE_CURR), y_FAST%op%x_SrvD( i), CtrlCode, Errstat2, ErrMsg2) @@ -5435,7 +5529,7 @@ END SUBROUTINE SaveOP !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine takes arrays representing the eigenvector of the states and uses it to modify the operating points for !! continuous states. It is highly tied to the module organizaton. -SUBROUTINE PerturbOP(t, iLinTime, iMode, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +SUBROUTINE PerturbOP(t, iLinTime, iMode, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt,SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t @@ -5452,6 +5546,7 @@ SUBROUTINE PerturbOP(t, iLinTime, iMode, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data @@ -5600,8 +5695,13 @@ SUBROUTINE PerturbOP(t, iLinTime, iMode, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, !!!! InflowWind: copy op to actual states and inputs !!!IF ( p_FAST%CompInflow == Module_IfW ) THEN !!!END IF - !!! - !!! + !!! + !!! + !!!! SeaState: copy op to actual states and inputs + !!!IF ( p_FAST%CompSeaSt == Module_SeaSt ) THEN + !!!END IF + !!! + !!! !!!! ServoDyn: copy op to actual states and inputs !!!IF ( p_FAST%CompServo == Module_SrvD ) THEN !!!END IF @@ -5645,7 +5745,7 @@ SUBROUTINE PerturbOP(t, iLinTime, iMode, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, END SUBROUTINE PerturbOP !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE SetOperatingPoint(i, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & +SUBROUTINE SetOperatingPoint(i, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) INTEGER(IntKi), INTENT(IN ) :: i !< Index into LinTimes (to determine which operating point to copy) @@ -5660,6 +5760,7 @@ SUBROUTINE SetOperatingPoint(i, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, E TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data @@ -5735,7 +5836,7 @@ SUBROUTINE SetOperatingPoint(i, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, E CALL AD_CopyInput (y_FAST%op%u_AD(i), AD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF - + ! InflowWind: copy op to actual states and inputs IF ( p_FAST%CompInflow == Module_IfW ) THEN CALL InflowWind_CopyContState (y_FAST%op%x_IfW( i), IfW%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -5749,10 +5850,23 @@ SUBROUTINE SetOperatingPoint(i, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, E CALL InflowWind_CopyInput (y_FAST%op%u_IfW(i), IfW%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - + ! SeaSt: copy op to actual states and inputs + if ( p_FAST%CompSeaSt == Module_SeaSt ) then + call SeaSt_CopyContState (y_FAST%op%x_SeaSt( i), SeaSt%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SeaSt_CopyDiscState (y_FAST%op%xd_SeaSt( i), SeaSt%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SeaSt_CopyConstrState (y_FAST%op%z_SeaSt( i), SeaSt%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call SeaSt_CopyOtherState (y_FAST%op%OtherSt_SeaSt( i), SeaSt%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + call SeaSt_CopyInput (y_FAST%op%u_SeaSt(i), SeaSt%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + endif + ! ServoDyn: copy op to actual states and inputs IF ( p_FAST%CompServo == Module_SrvD ) THEN CALL SrvD_CopyContState (y_FAST%op%x_SrvD( i), SrvD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -5902,7 +6016,7 @@ end subroutine GetStateAry !---------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------- !> This routine performs the algorithm for computing a periodic steady-state solution. -SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg ) INTEGER(IntKi), INTENT(IN ) :: n_t_global !< integer time step @@ -5918,6 +6032,7 @@ SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(ExternalInflow_Data),INTENT(INOUT) :: ExtInfw !< ExternalInflow data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data @@ -5951,7 +6066,7 @@ SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD if (n_t_global == 0) then ! initialize a few things on the first call: - call FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + call FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) else @@ -5964,7 +6079,7 @@ SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD end if ! save the outputs and azimuth angle for possible interpolation later - call FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + call FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end if @@ -5991,7 +6106,7 @@ SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD if (NextAzimuth) then ! interpolate to find y at the target azimuth - call FAST_DiffInterpOutputs( m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx), p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + call FAST_DiffInterpOutputs( m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx), p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg ) ! If linearization is forced if (m_FAST%Lin%ForceLin) then @@ -6000,7 +6115,7 @@ SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD if (m_FAST%Lin%IsConverged .or. m_FAST%Lin%n_rot == 0) then ! save this operating point for linearization later m_FAST%Lin%LinTimes(m_FAST%Lin%AzimIndx) = t_global - call SaveOP(m_FAST%Lin%AzimIndx, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + call SaveOP(m_FAST%Lin%AzimIndx, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg, m_FAST%Lin%CopyOP_CtrlCode ) end if @@ -6051,19 +6166,20 @@ SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD END SUBROUTINE FAST_CalcSteady !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes variables for calculating periodic steady-state solution. -SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: psi !< psi (rotor azimuth) at which the outputs are defined TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data @@ -6080,75 +6196,75 @@ SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, H INTEGER(IntKi) :: j, k ! loop counters INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitSteadyOutputs' - - + + ErrStat = ErrID_None ErrMsg = "" - + do j=1,p_FAST%NLinTimes m_FAST%Lin%AzimTarget(j) = (j-1) * p_FAST%AzimDelta + psi call Zero2TwoPi( m_FAST%Lin%AzimTarget(j) ) end do - ! this is circular, so I am going to add points at the beginning and end to avoid + ! this is circular, so I am going to add points at the beginning and end to avoid ! more IF statements later m_FAST%Lin%AzimTarget(0) = m_FAST%Lin%AzimTarget(p_FAST%NLinTimes) m_FAST%Lin%AzimTarget(p_FAST%NLinTimes+1) = m_FAST%Lin%AzimTarget(1) - + ! Azimuth angles that correspond to Output arrays for interpolation: !m_FAST%Lin%Psi = psi ! initialize entire array (note that we won't be able to interpolate with a constant array DO j = 1, p_FAST%LinInterpOrder + 1 m_FAST%Lin%Psi(j) = psi - (j - 1) * D2R_D ! arbitrarily say azimuth is one degree different END DO - - - ! ElastoDyn - allocate( ED%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + + + ! ElastoDyn + allocate( ED%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating ED%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call ED_CopyOutput(ED%y, ED%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call ED_CopyOutput(ED%y, ED%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + ! BeamDyn + IF (p_FAST%CompElast == Module_BD) THEN + + allocate( BD%Output( p_FAST%LinInterpOrder+1, p_FAST%nBeams ), STAT = ErrStat2 ) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, "Error allocating ED%Output.", ErrStat, ErrMsg, RoutineName ) + call SetErrStat(ErrID_Fatal, "Error allocating BD%Output.", ErrStat, ErrMsg, RoutineName ) else - do j = 1, p_FAST%LinInterpOrder + 1 - call ED_CopyOutput(ED%y, ED%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + do k=1,p_FAST%nBeams + do j = 1, p_FAST%LinInterpOrder + 1 + call BD_CopyOutput(BD%y(k), BD%Output(j,k), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do end do - - call ED_CopyOutput(ED%y, ED%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - end if - - ! BeamDyn - IF (p_FAST%CompElast == Module_BD) THEN - - allocate( BD%Output( p_FAST%LinInterpOrder+1, p_FAST%nBeams ), STAT = ErrStat2 ) + + allocate( BD%y_interp( p_FAST%nBeams ), STAT = ErrStat2 ) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, "Error allocating BD%Output.", ErrStat, ErrMsg, RoutineName ) else do k=1,p_FAST%nBeams - do j = 1, p_FAST%LinInterpOrder + 1 - call BD_CopyOutput(BD%y(k), BD%Output(j,k), MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - end do + call BD_CopyOutput(BD%y(k), BD%y_interp(k), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end do - - allocate( BD%y_interp( p_FAST%nBeams ), STAT = ErrStat2 ) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, "Error allocating BD%Output.", ErrStat, ErrMsg, RoutineName ) - else - do k=1,p_FAST%nBeams - call BD_CopyOutput(BD%y(k), BD%y_interp(k), MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - end do - end if - end if - - END IF ! BeamDyn - + + end if + + END IF ! BeamDyn + ! AeroDyn IF ( p_FAST%CompAero == Module_AD ) THEN - + allocate( AD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, "Error allocating AD%Output.", ErrStat, ErrMsg, RoutineName ) @@ -6157,17 +6273,17 @@ SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, H call AD_CopyOutput(AD%y, AD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end do - + call AD_CopyOutput(AD%y, AD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end if - + END IF ! CompAero - - + + ! InflowWind IF ( p_FAST%CompInflow == Module_IfW ) THEN - + allocate( IfW%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, "Error allocating IfW%Output.", ErrStat, ErrMsg, RoutineName ) @@ -6176,17 +6292,34 @@ SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, H call InflowWind_CopyOutput(IfW%y, IfW%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end do - + call InflowWind_CopyOutput(IfW%y, IfW%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end if - + END IF ! CompInflow - - + + + ! SeaSt + if ( p_FAST%CompSeaSt == Module_SeaSt ) then + allocate( SeaSt%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating SeaSt%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call SeaSt_CopyOutput(SeaSt%y, SeaSt%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call SeaSt_CopyOutput(SeaSt%y, SeaSt%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + endif ! CompSeaSt + + ! ServoDyn IF ( p_FAST%CompServo == Module_SrvD ) THEN - + allocate( SrvD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, "Error allocating SrvD%Output.", ErrStat, ErrMsg, RoutineName ) @@ -6195,13 +6328,13 @@ SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, H call SrvD_CopyOutput(SrvD%y, SrvD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end do - + call SrvD_CopyOutput(SrvD%y, SrvD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end if - + END IF ! ServoDyn - + ! HydroDyn IF ( p_FAST%CompHydro == Module_HD ) THEN @@ -6213,13 +6346,13 @@ SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, H call HydroDyn_CopyOutput(HD%y, HD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end do - + call HydroDyn_CopyOutput(HD%y, HD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end if - + END IF ! HydroDyn - + !! SubDyn/ExtPtfm_MCKF IF ( p_FAST%CompSub == Module_SD ) THEN allocate( SD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) @@ -6230,18 +6363,18 @@ SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, H call SD_CopyOutput(SD%y, SD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end do - + call SD_CopyOutput(SD%y, SD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - end if + end if ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN END IF ! SubDyn/ExtPtfm_MCKF - - + + ! Mooring (MAP , FEAM , MoorDyn) ! MAP IF ( p_FAST%CompMooring == Module_MAP ) THEN - + allocate( MAPp%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) if (ErrStat2 /= 0) then call SetErrStat(ErrID_Fatal, "Error allocating MAPp%Output.", ErrStat, ErrMsg, RoutineName ) @@ -6250,14 +6383,14 @@ SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, H call MAP_CopyOutput(MAPp%y, MAPp%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end do - + call MAP_CopyOutput(MAPp%y, MAPp%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) end if - + ! 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 ) @@ -6266,37 +6399,32 @@ SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, H 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 !ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN - + END IF ! MAP/FEAM/MoorDyn/OrcaFlex - - - + !! Ice (IceFloe or IceDyn) !! IceFloe !IF ( p_FAST%CompIce == Module_IceF ) THEN - ! + ! !! IceDyn !ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN ! !END IF ! IceFloe/IceDyn +END SUBROUTINE FAST_InitSteadyOutputs -END SUBROUTINE FAST_InitSteadyOutputs !---------------------------------------------------------------------------------------------------------------------------------- !> This routine saves outputs for future interpolation at a desired azimuth. -SUBROUTINE FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +SUBROUTINE FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: psi !< psi (rotor azimuth) at which the outputs are defined @@ -6309,6 +6437,7 @@ SUBROUTINE FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data @@ -6342,31 +6471,31 @@ SUBROUTINE FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, end if m_FAST%Lin%Psi(1) = psi - ! ElastoDyn - DO j = p_FAST%LinInterpOrder, 1, -1 - CALL ED_CopyOutput(ED%Output(j), ED%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - END DO - - CALL ED_CopyOutput (ED%y, ED%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + ! ElastoDyn + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL ED_CopyOutput(ED%Output(j), ED%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - ! BeamDyn - IF (p_FAST%CompElast == Module_BD) THEN - - DO k = 1,p_FAST%nBeams - - DO j = p_FAST%LinInterpOrder, 1, -1 - CALL BD_CopyOutput (BD%Output(j,k), BD%Output(j+1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - END DO - - CALL BD_CopyOutput (BD%y(k), BD%Output(1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + END DO + + CALL ED_CopyOutput (ED%y, ED%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + ! BeamDyn + IF (p_FAST%CompElast == Module_BD) THEN + + DO k = 1,p_FAST%nBeams + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL BD_CopyOutput (BD%Output(j,k), BD%Output(j+1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - END DO ! k=p_FAST%nBeams - - END IF ! BeamDyn + END DO + + CALL BD_CopyOutput (BD%y(k), BD%Output(1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END DO ! k=p_FAST%nBeams + + END IF ! BeamDyn ! AeroDyn @@ -6397,6 +6526,18 @@ SUBROUTINE FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, END IF ! CompInflow + ! SeaState + if ( p_FAST%CompSeaSt == Module_SeaSt ) then + do j = p_FAST%LinInterpOrder, 1, -1 + call SeaSt_CopyOutput (SeaSt%Output(j), SeaSt%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + enddo + + call SeaSt_CopyOutput (SeaSt%y, SeaSt%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + endif ! CompSeaSt + + ! ServoDyn IF ( p_FAST%CompServo == Module_SrvD ) THEN @@ -6481,22 +6622,23 @@ SUBROUTINE FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, END SUBROUTINE FAST_SaveOutputs !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine interpolates the outputs at the target azimuths, computes the compared to the previous rotation, and stores +!> This routine interpolates the outputs at the target azimuths, computes the compared to the previous rotation, and stores !! them for future rotation . -SUBROUTINE FAST_DiffInterpOutputs( psi_target, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +SUBROUTINE FAST_DiffInterpOutputs( psi_target, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: psi_target !< psi (rotor azimuth) at which the outputs are requested TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables - + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SeaState_Data), INTENT(INOUT) :: SeaSt !< SeaState data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data @@ -6515,9 +6657,9 @@ SUBROUTINE FAST_DiffInterpOutputs( psi_target, p_FAST, y_FAST, m_FAST, ED, BD, S CHARACTER(ErrMsgLen) :: ErrMsg2 REAL(DbKi) :: t_global REAL(ReKi) :: eps_squared - + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DiffInterpOutputs' - + ErrStat = ErrID_None ErrMsg = "" t_global = 0.0_DbKi ! we don't really need this to get the output OPs @@ -6526,140 +6668,152 @@ SUBROUTINE FAST_DiffInterpOutputs( psi_target, p_FAST, y_FAST, m_FAST, ED, BD, S ! Extrapolate outputs to the target azimuth and pack into OP arrays !................................................................................................ - ! ElastoDyn - CALL ED_Output_ExtrapInterp (ED%Output, m_FAST%Lin%Psi, ED%y_interp, psi_target, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - call ED_GetOP( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%y_interp, ED%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, NeedTrimOP=.true.) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - ! BeamDyn - IF (p_FAST%CompElast == Module_BD) THEN - - DO k = 1,p_FAST%nBeams - - CALL BD_Output_ExtrapInterp (BD%Output(:,k), m_FAST%Lin%Psi, BD%y_interp(k), psi_target, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - call BD_GetOP( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & - BD%y_interp(k), BD%m(k), ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_y, NeedTrimOP=.true.) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - END DO ! k=p_FAST%nBeams - - END IF ! BeamDyn - - + ! ElastoDyn + CALL ED_Output_ExtrapInterp (ED%Output, m_FAST%Lin%Psi, ED%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call ED_GetOP( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y_interp, ED%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, NeedTrimOP=.true.) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! BeamDyn + IF (p_FAST%CompElast == Module_BD) THEN + + DO k = 1,p_FAST%nBeams + + CALL BD_Output_ExtrapInterp (BD%Output(:,k), m_FAST%Lin%Psi, BD%y_interp(k), psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call BD_GetOP( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & + BD%y_interp(k), BD%m(k), ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_y, NeedTrimOP=.true.) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END DO ! k=p_FAST%nBeams + + END IF ! BeamDyn + + ! AeroDyn IF ( p_FAST%CompAero == Module_AD ) THEN - + CALL AD_Output_ExtrapInterp (AD%Output, m_FAST%Lin%Psi, AD%y_interp, psi_target, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - + call AD_GetOP( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), AD%OtherSt(STATE_CURR), & AD%y_interp, AD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_y) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END IF ! CompAero - - + + ! InflowWind IF ( p_FAST%CompInflow == Module_IfW ) THEN - + CALL InflowWind_Output_ExtrapInterp (IfW%Output, m_FAST%Lin%Psi, IfW%y_interp, psi_target, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - + call InflowWind_GetOP( t_global, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), IfW%OtherSt(STATE_CURR), & IfW%y_interp, IfW%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_IfW)%Instance(1)%op_y) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END IF ! CompInflow - - + + + ! SeaState + if ( p_FAST%CompSeaSt == Module_SeaSt ) then + ! No normal outputs to extrapolate + !call SeaSt_Output_ExtrapInterp (SeaSt%Output, m_FAST%Lin%Psi, SeaSt%y_interp, psi_target, ErrStat2, ErrMsg2) + ! call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call SeaSt_GetOP( t_global, SeaSt%Input(1), SeaSt%p, SeaSt%x(STATE_CURR), SeaSt%xd(STATE_CURR), SeaSt%z(STATE_CURR), SeaSt%OtherSt(STATE_CURR), & + SeaSt%y_interp, SeaSt%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_SeaSt)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + endif ! CompSeaSt + + ! ServoDyn IF ( p_FAST%CompServo == Module_SrvD ) THEN - + CALL SrvD_Output_ExtrapInterp (SrvD%Output, m_FAST%Lin%Psi, SrvD%y_interp, psi_target, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - + call SrvD_GetOP( t_global, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), SrvD%OtherSt(STATE_CURR), & SrvD%y_interp, SrvD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%op_y) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END IF ! ServoDyn - + ! HydroDyn IF ( p_FAST%CompHydro == Module_HD ) THEN CALL HydroDyn_Output_ExtrapInterp (HD%Output, m_FAST%Lin%Psi, HD%y_interp, psi_target, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - + call HD_GetOP( t_global, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & HD%y_interp, HD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_y) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END IF ! HydroDyn - + !! SubDyn/ExtPtfm_MCKF IF ( p_FAST%CompSub == Module_SD ) THEN - + CALL SD_Output_ExtrapInterp (SD%Output, m_FAST%Lin%Psi, SD%y_interp, psi_target, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - + call SD_GetOP( t_global, SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), SD%z(STATE_CURR), SD%OtherSt(STATE_CURR), & SD%y_interp, SD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_SD)%Instance(1)%op_y, NeedTrimOP=.true.) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN END IF ! SubDyn/ExtPtfm_MCKF - - + + ! Mooring (MAP , FEAM , MoorDyn) ! MAP IF ( p_FAST%CompMooring == Module_MAP ) THEN - + CALL MAP_Output_ExtrapInterp (MAPp%Output, m_FAST%Lin%Psi, MAPp%y_interp, psi_target, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - + 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 - + 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 !ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN - + END IF ! MAP/FEAM/MoorDyn/OrcaFlex - - - + + + !! Ice (IceFloe or IceDyn) !! IceFloe !IF ( p_FAST%CompIce == Module_IceF ) THEN - ! + ! !! IceDyn !ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN ! !END IF ! IceFloe/IceDyn - + call pack_in_array(p_FAST, y_FAST, m_FAST) - + if (m_FAST%Lin%IsConverged) then ! if Forced Linearization, the error may be large due to a different azimuth, so printing it here isn't very helpful ! check that error equation is less than TrimTol call calc_error(p_FAST, y_FAST, m_FAST, SrvD%y, eps_squared) m_FAST%Lin%IsConverged = eps_squared < p_FAST%TrimTol end if - - + + m_FAST%Lin%Y_prevRot(:,m_FAST%Lin%AzimIndx) = m_FAST%Lin%y_interp - + END SUBROUTINE FAST_DiffInterpOutputs !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE pack_in_array(p_FAST, y_FAST, m_FAST) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 014a148710..ad916081b5 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -285,6 +285,12 @@ typedef ^ ^ HydroDyn_DiscreteStateType xd_HD typedef ^ ^ HydroDyn_ConstraintStateType z_HD {:} - - "Constraint states" typedef ^ ^ HydroDyn_OtherStateType OtherSt_HD {:} - - "Other states" typedef ^ ^ HydroDyn_InputType u_HD {:} - - "System inputs" +# ..... SeaSt OP data ....................................................................................................... +typedef FAST FAST_LinStateSave SeaSt_ContinuousStateType x_SeaSt {:} - - "Continuous states" +typedef ^ ^ SeaSt_DiscreteStateType xd_SeaSt {:} - - "Discrete states" +typedef ^ ^ SeaSt_ConstraintStateType z_SeaSt {:} - - "Constraint states" +typedef ^ ^ SeaSt_OtherStateType OtherSt_SeaSt {:} - - "Other states" +typedef ^ ^ SeaSt_InputType u_SeaSt {:} - - "System inputs" # ..... IceFloe OP data ....................................................................................................... typedef FAST FAST_LinStateSave IceFloe_ContinuousStateType x_IceF {:} - - "Continuous states" typedef ^ ^ IceFloe_DiscreteStateType xd_IceF {:} - - "Discrete states" diff --git a/modules/openfast-library/src/FAST_SS_Solver.f90 b/modules/openfast-library/src/FAST_SS_Solver.f90 index e31574b55e..f4ea398e61 100644 --- a/modules/openfast-library/src/FAST_SS_Solver.f90 +++ b/modules/openfast-library/src/FAST_SS_Solver.f90 @@ -1153,25 +1153,15 @@ SUBROUTINE SteadyStatePrescribedInputs( caseData, p_FAST, y_FAST, m_FAST, ED, BD !AD%Input(1)%rotors(1)%BladeMotion(k)%RotationAcc = 0.0_ReKi AD%Input(1)%rotors(1)%BladeMotion(k)%TranslationAcc = 0.0_ReKi END DO - - !> begin @todo - do k = 1,size(AD%m%Inflow(1)%RotInflow(1)%Bld) - AD%m%Inflow(1)%RotInflow(1)%Bld(k)%InflowOnBlade( 1, :) = caseData%WindSpeed - AD%m%Inflow(1)%RotInflow(1)%Bld(k)%InflowOnBlade( 2:3,:) = 0.0_ReKi - end do - AD%m%Inflow(1)%RotInflow(1)%InflowOnHub( 1 ,1) = caseData%WindSpeed - AD%m%Inflow(1)%RotInflow(1)%InflowOnHub( 2:3,1) = 0.0_ReKi - AD%m%Inflow(1)%RotInflow(1)%InflowOnNacelle(1 ,1) = caseData%WindSpeed - AD%m%Inflow(1)%RotInflow(1)%InflowOnNacelle(2:3,1) = 0.0_ReKi - AD%m%Inflow(1)%RotInflow(1)%InflowOnTailFin(1 ,1) = caseData%WindSpeed - AD%m%Inflow(1)%RotInflow(1)%InflowOnTailFin(2:3,1) = 0.0_ReKi - AD%m%Inflow(1)%RotInflow(1)%InflowOnTower = 0.0_ReKi - !> end @todo - + + ! Set FlowField information -- AD calculates everything from the data stored in the FlowField pointer + AD%p%FlowField%Uniform%VelH(:) = caseData%WindSpeed + AD%p%FlowField%Uniform%LinShrV(:) = 0.0_ReKi + AD%p%FlowField%Uniform%AngleH(:) = 0.0_ReKi + AD%p%FlowField%PropagationDir = 0.0_ReKi + AD%Input(1)%rotors(1)%UserProp = 0.0_ReKi - AD%m%Inflow(1)%RotInflow(1)%AvgDiskVel = AD%m%Inflow(1)%RotInflow(1)%Bld(1)%InflowOnBlade(:,1) - END SUBROUTINE SteadyStatePrescribedInputs !---------------------------------------------------------------------------------------------------------------------------------- @@ -1530,7 +1520,7 @@ SUBROUTINE GetGlueJacobians( dUdu, dUdy, p_FAST, y_FAST, m_FAST, ED, BD, AD, Mes if (p_FAST%CompElast == Module_ED) then - call LinearSS_ED_InputSolve_dy( p_FAST, y_FAST, ED%Input(1), ED%y, AD%y, AD%Input(1), MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call LinearSS_ED_InputSolve_dy( p_FAST, y_FAST, ED%p, ED%Input(1), ED%y, AD%y, AD%Input(1), MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) elseif (p_FAST%CompElast == MODULE_BD) then call LinearSS_BD_InputSolve_dy( p_FAST, y_FAST, AD%y, AD%Input(1), BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) @@ -1864,27 +1854,23 @@ END SUBROUTINE LinearSS_BD_InputSolve_du !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the dU^{AD}/du^{AD} block of dUdu. (i.e., how do changes in the AD inputs affect the AD inputs?) SUBROUTINE LinearSS_AD_InputSolve_du( p_FAST, y_FAST, u_AD, y_ED, BD, 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(AD_InputType), INTENT(INOUT) :: u_AD !< The inputs to AeroDyn14 - TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs from the structural dynamics module + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< The outputs from the structural dynamics module TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD 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) :: ErrStat !< Error status of the operation - CHARACTER(*) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi), INTENT(INOUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT(INOUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local variables: - INTEGER(IntKi) :: K ! Loops through blades INTEGER(IntKi) :: AD_Start_td ! starting index of dUdu (column) where AD translation displacements are located INTEGER(IntKi) :: AD_Start_tv ! starting index of dUdu (column) where AD translation velocities are located INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'LinearSS_ED_InputSolve_dy' + CHARACTER(*), PARAMETER :: RoutineName = 'LinearSS_AD_InputSolve_du' ErrStat = ErrID_None @@ -1938,10 +1924,10 @@ END SUBROUTINE LinearSS_AD_InputSolve_du !---------------------------------------------------------------------------------------------------------------------------------- !> 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 LinearSS_ED_InputSolve_dy( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, MeshMapData, dUdy, ErrStat, ErrMsg ) - +SUBROUTINE LinearSS_ED_InputSolve_dy( p_FAST, y_FAST, p_ED, u_ED, y_ED, y_AD, u_AD, 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) + TYPE(ED_ParameterType), INTENT(IN ) :: p_ED !< ElastoDyn parameters TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs @@ -1977,11 +1963,11 @@ SUBROUTINE LinearSS_ED_InputSolve_dy( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, Me !CALL Linearize_Line2_to_Point( y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ErrStat2, ErrMsg2, u_AD%BladeMotion(k), y_ED%BladeLn2Mesh(k) ) ! AD loads-to-ED loads transfer (dU^{ED}/dy^{AD}): - ED_Start = Indx_u_ED_Blade_Start(u_ED, y_FAST, k) ! start of u_ED%BladePtLoads(k)%Force field + ED_Start = Indx_u_ED_Blade_Start(p_ED, u_ED, y_FAST, k) ! start of u_ED%BladePtLoads(k)%Force field call Assemble_dUdy_Loads(y_AD%rotors(1)%BladeLoad(k), u_ED%BladePtLoads(k), MeshMapData%AD_L_2_BDED_B(k), ED_Start, AD_Out_Start, dUdy) ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): - ED_Start = Indx_u_ED_Blade_Start(u_ED, y_FAST, k) + u_ED%BladePtLoads(k)%NNodes*3 ! start of u_ED%BladePtLoads(k)%Moment field (skip the ED forces) + ED_Start = Indx_u_ED_Blade_Start(p_ED, u_ED, y_FAST, k) + u_ED%BladePtLoads(k)%NNodes*3 ! start of u_ED%BladePtLoads(k)%Moment field (skip the ED forces) ED_Out_Start = SS_Indx_y_ED_Blade_Start(y_ED, p_FAST, y_FAST, k) ! start of y_ED%BladeLn2Mesh(1)%TranslationDisp field call SetBlockMatrix( dUdy, MeshMapData%AD_L_2_BDED_B(k)%dM%m_uD, ED_Start, ED_Out_Start ) @@ -2086,6 +2072,7 @@ SUBROUTINE LinearSS_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, u_AD, y_ED, BD, Mesh INTEGER(IntKi) :: AD_Start ! starting index of dUdy (column) where particular AD fields are located INTEGER(IntKi) :: ED_Out_Start! starting index of dUdy (row) where particular ED fields are located INTEGER(IntKi) :: BD_Out_Start! starting index of dUdy (row) where particular BD fields are located + LOGICAL :: FieldMask(FIELDMASK_SIZE) ! INTEGER(IntKi) :: ErrStat2 ! CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'LinearSS_AD_InputSolve_NoIfW_dy' @@ -2093,7 +2080,15 @@ SUBROUTINE LinearSS_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, u_AD, y_ED, BD, Mesh ErrStat = ErrID_None ErrMsg = "" - + + ! Only assemble from the following source fields + FieldMask(MASKID_TRANSLATIONDISP) = .true. + FieldMask(MASKID_ORIENTATION) = .true. + FieldMask(MASKID_TRANSLATIONVEL) = .true. + FieldMask(MASKID_ROTATIONVEL) = .false. + FieldMask(MASKID_TRANSLATIONACC) = .false. + FieldMask(MASKID_ROTATIONACC) = .false. + !------------------------------------------------------------------------------------------------- ! Set the inputs from ElastoDyn and/or BeamDyn: !------------------------------------------------------------------------------------------------- @@ -2109,7 +2104,7 @@ SUBROUTINE LinearSS_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, u_AD, y_ED, BD, Mesh AD_Start = SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, k) ! start of u_AD%BladeMotion(k)%TranslationDisp field ED_Out_Start = SS_Indx_y_ED_Blade_Start(y_ED, p_FAST, y_FAST, k) ! start of y_ED%BladeLn2Mesh(k)%TranslationDisp field - CALL Assemble_dUdy_Motions(y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, ED_Out_Start, dUdy, skipRotVel=.true.) + CALL Assemble_dUdy_Motions(y_ED%BladeLn2Mesh(k), u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, ED_Out_Start, dUdy, FieldMask) END DO @@ -2122,7 +2117,7 @@ SUBROUTINE LinearSS_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, u_AD, y_ED, BD, Mesh AD_Start = SS_Indx_u_AD_Blade_Start(u_AD, p_FAST, y_FAST, k) ! start of u_AD%BladeMotion(k)%TranslationDisp field BD_Out_Start = y_FAST%Lin%Modules(Module_BD)%Instance(k)%LinStartIndx(LIN_OUTPUT_COL) - CALL Assemble_dUdy_Motions(BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, BD_Out_Start, dUdy, skipRotVel=.true.) + CALL Assemble_dUdy_Motions(BD%y(k)%BldMotion, u_AD%rotors(1)%BladeMotion(k), MeshMapData%BDED_L_2_AD_L_B(k), AD_Start, BD_Out_Start, dUdy, FieldMask) END DO END IF diff --git a/modules/openfast-library/src/FAST_SS_Subs.f90 b/modules/openfast-library/src/FAST_SS_Subs.f90 index f391591f60..be6ff78f95 100644 --- a/modules/openfast-library/src/FAST_SS_Subs.f90 +++ b/modules/openfast-library/src/FAST_SS_Subs.f90 @@ -103,7 +103,32 @@ SUBROUTINE FAST_InitializeSteadyState_T( Turbine, ErrStat, ErrMsg ) Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, CompAeroMaps, ErrStat, ErrMsg ) - + call InitFlowField() + +contains + !> AD15 now directly accesses FlowField data from IfW. Since we don't use IfW, we need to manually set the FlowField data + !! NOTE: we deallocate(AD%p%FlowField) at the end of the simulation if CompAeroMaps is true + subroutine InitFlowField() + use InflowWind_IO, only: IfW_SteadyWind_Init + use InflowWind_IO_Types, only: InflowWind_IO_DestroySteady_InitInputType, InflowWind_IO_DestroyWindFileDat + type(Steady_InitInputType) :: InitInp + integer(IntKi) :: SumFileUnit = -1 + type(WindFileDat) :: WFileDat ! throw away data returned form init + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + + allocate(Turbine%AD%p%FlowField) + Turbine%AD%p%FlowField%FieldType = 1 ! Steady wind, init below. + InitInp%RefHt = 100.0_ReKi ! Any value will do here. No exponent, so this doesn't matter + InitInp%HWindSpeed = 8.0_ReKi ! This gets overwritten later before used + InitInp%PLExp = 0.0_ReKi ! no shear used + call IfW_SteadyWind_Init(InitInp, SumFileUnit, Turbine%AD%p%FlowField%Uniform, WFileDat, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'FAST_InitializeSteadyState_T:InitFlowField') + if (ErrStat >= AbortErrLev) deallocate(Turbine%AD%p%FlowField) + + call InflowWind_IO_DestroySteady_InitInputType(InitInp, ErrStat2, ErrMsg2) ! ignore errors here because I'm lazy + call InflowWind_IO_DestroyWindFileDat(WFileDat, ErrStat2, ErrMsg2) ! ignore errors here because I'm lazy + end subroutine END SUBROUTINE FAST_InitializeSteadyState_T !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that calls FAST_Solution for one instance of a Turbine data structure. This is a separate subroutine so that the FAST diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index ebcd9b96d1..c0068324c9 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -531,15 +531,11 @@ SUBROUTINE IfW_InputSolve( p_FAST, m_FAST, u_IfW, p_IfW, u_AD14, u_AD, OtherSt_A Node = Node + 1 u_IfW%PositionXYZ(:,Node) = u_AD14%Twr_InputMarkers%TranslationDisp(:,J) + u_AD14%Twr_InputMarkers%Position(:,J) END DO - END IF - - + + !FIXME: This is used for the disk average returned from IfW_CalcOutput. May not be needed after removing AD14 u_IfW%HubPosition = y_ED%HubPtMotion%Position(:,1) + y_ED%HubPtMotion%TranslationDisp(:,1) u_IfW%HubOrientation = y_ED%HubPtMotion%Orientation(:,:,1) - - - IF ( p_FAST%MHK /= MHK_None ) THEN u_IfW%PositionXYZ(3,:) = u_IfW%PositionXYZ(3,:) + p_FAST%WtrDpth @@ -773,8 +769,7 @@ SUBROUTINE AD14_InputSolve_IfW( p_FAST, u_AD14, y_IfW, ErrStat, ErrMsg ) END IF u_AD14%AvgInfVel = y_IfW%DiskVel - - + END SUBROUTINE AD14_InputSolve_IfW !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets all the AeroDyn14 inputs, except for the wind inflow values. @@ -5569,9 +5564,9 @@ SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, IF (p_FAST%CompInflow == Module_IfW) THEN ! get Lidar position directly from hub mesh (may map meshes later) - IfW%Input%lidar%HubDisplacementX = ED%y%HubPtMotion%TranslationDisp(1,1) - IfW%Input%lidar%HubDisplacementY = ED%y%HubPtMotion%TranslationDisp(2,1) - IfW%Input%lidar%HubDisplacementZ = ED%y%HubPtMotion%TranslationDisp(3,1) + IfW%Input(1)%lidar%HubDisplacementX = ED%y%HubPtMotion%TranslationDisp(1,1) + IfW%Input(1)%lidar%HubDisplacementY = ED%y%HubPtMotion%TranslationDisp(2,1) + IfW%Input(1)%lidar%HubDisplacementZ = ED%y%HubPtMotion%TranslationDisp(3,1) CALL InflowWind_CalcOutput( this_time, IfW%Input(1), IfW%p, IfW%x(this_state), IfW%xd(this_state), IfW%z(this_state), & IfW%OtherSt(this_state), IfW%y, IfW%m, ErrStat2, ErrMsg2 ) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index cb4f7f1823..4aa56f6c98 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -438,7 +438,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ - ! initialize AeroDyn + ! initialize AeroDyn14 ! ........................ ALLOCATE( AD14%Input( p_FAST%InterpOrder+1 ), AD14%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -454,20 +454,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - ALLOCATE( AD%Input( p_FAST%InterpOrder+1 ), AD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating AD%Input and AD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - - ALLOCATE( AD%Input_Saved( p_FAST%InterpOrder+1 ), AD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating AD%Input and AD%InputTimes.",ErrStat,ErrMsg,RoutineName) - CALL Cleanup() - RETURN - END IF - IF ( p_FAST%CompAero == Module_AD14 ) THEN CALL AD_SetInitInput(Init%InData_AD14, Init%OutData_ED, ED%y, p_FAST, ErrStat2, ErrMsg2) ! set the values in Init%InData_AD14 @@ -487,137 +473,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL Cleanup() RETURN END IF + ENDIF - ELSEIF ( (p_FAST%CompAero == Module_AD) .OR. (p_FAST%CompAero == Module_ExtLd) ) THEN - - allocate(Init%InData_AD%rotors(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat( ErrID_Fatal, 'Allocating rotors', errStat, errMsg, RoutineName ) - call Cleanup() - return - end if - - Init%InData_AD%rotors(1)%NumBlades = NumBl - - if (p_FAST%CompAeroMaps) then - CALL AllocAry( MeshMapData%HubOrient, 3, 3, Init%InData_AD%rotors(1)%NumBlades, 'Hub orientation matrix', ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - theta = 0.0_R8Ki - do k=1,Init%InData_AD%rotors(1)%NumBlades - theta(1) = TwoPi_R8 * (k-1) / Init%InData_AD%rotors(1)%NumBlades - MeshMapData%HubOrient(:,:,k) = EulerConstruct( theta ) - end do - end if - - - ! set initialization data for AD - CALL AllocAry( Init%InData_AD%rotors(1)%BladeRootPosition, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%rotors(1)%BladeRootPosition', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry( Init%InData_AD%rotors(1)%BladeRootOrientation,3, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%rotors(1)%BladeRootOrientation', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - Init%InData_AD%Gravity = p_FAST%Gravity - Init%InData_AD%Linearize = p_FAST%Linearize - Init%InData_AD%CompAeroMaps = p_FAST%CompAeroMaps - Init%InData_AD%rotors(1)%RotSpeed = p_FAST%RotSpeedInit ! used only for aeromaps - Init%InData_AD%InputFile = p_FAST%AeroFile - Init%InData_AD%RootName = p_FAST%OutFileRoot - Init%InData_AD%MHK = p_FAST%MHK - if ( p_FAST%MHK == MHK_None ) then - Init%InData_AD%defFldDens = p_FAST%AirDens - else - Init%InData_AD%defFldDens = p_FAST%WtrDens - end if - Init%InData_AD%defKinVisc = p_FAST%KinVisc - Init%InData_AD%defSpdSound = p_FAST%SpdSound - Init%InData_AD%defPatm = p_FAST%Patm - Init%InData_AD%defPvap = p_FAST%Pvap - Init%InData_AD%WtrDpth = p_FAST%WtrDpth - Init%InData_AD%MSL2SWL = p_FAST%MSL2SWL - - - Init%InData_AD%rotors(1)%HubPosition = ED%y%HubPtMotion%Position(:,1) - Init%InData_AD%rotors(1)%HubOrientation = ED%y%HubPtMotion%RefOrientation(:,:,1) - Init%InData_AD%rotors(1)%NacellePosition = ED%y%NacelleMotion%Position(:,1) - Init%InData_AD%rotors(1)%NacelleOrientation = ED%y%NacelleMotion%RefOrientation(:,:,1) - ! Note: not passing tailfin position and orientation at init - Init%InData_AD%rotors(1)%AeroProjMod = APM_BEM_NoSweepPitchTwist - - do k=1,NumBl - Init%InData_AD%rotors(1)%BladeRootPosition(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) - Init%InData_AD%rotors(1)%BladeRootOrientation(:,:,k) = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) - end do - - CALL AD_Init( Init%InData_AD, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & - AD%OtherSt(STATE_CURR), AD%y, AD%m, p_FAST%dt_module( MODULE_AD ), Init%OutData_AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - p_FAST%ModuleInitialized(Module_AD) = .TRUE. - CALL SetModuleSubstepTime(Module_AD, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - allocate( y_FAST%Lin%Modules(MODULE_AD)%Instance(1), stat=ErrStat2) - if (ErrStat2 /= 0 ) then - call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(AD).", ErrStat, ErrMsg, RoutineName ) - else - if (allocated(Init%OutData_AD%rotors(1)%LinNames_u )) call move_alloc(Init%OutData_AD%rotors(1)%LinNames_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_u ) - if (allocated(Init%OutData_AD%rotors(1)%LinNames_y )) call move_alloc(Init%OutData_AD%rotors(1)%LinNames_y ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_y ) - if (allocated(Init%OutData_AD%rotors(1)%LinNames_x )) call move_alloc(Init%OutData_AD%rotors(1)%LinNames_x ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_x ) - if (allocated(Init%OutData_AD%rotors(1)%RotFrame_u )) call move_alloc(Init%OutData_AD%rotors(1)%RotFrame_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_u ) - if (allocated(Init%OutData_AD%rotors(1)%RotFrame_y )) call move_alloc(Init%OutData_AD%rotors(1)%RotFrame_y ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_y ) - if (allocated(Init%OutData_AD%rotors(1)%RotFrame_x )) call move_alloc(Init%OutData_AD%rotors(1)%RotFrame_x ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_x ) - if (allocated(Init%OutData_AD%rotors(1)%IsLoad_u )) call move_alloc(Init%OutData_AD%rotors(1)%IsLoad_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%IsLoad_u ) - if (allocated(Init%OutData_AD%rotors(1)%DerivOrder_x)) call move_alloc(Init%OutData_AD%rotors(1)%DerivOrder_x,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%DerivOrder_x ) - - if (allocated(Init%OutData_AD%rotors(1)%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%NumOutputs = size(Init%OutData_AD%rotors(1)%WriteOutputHdr) - end if - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - AirDens = Init%OutData_AD%rotors(1)%AirDens - - ELSE - AirDens = 0.0_ReKi - END IF ! CompAero - - IF ( p_FAST%CompAero == Module_ExtLd ) THEN - - IF ( PRESENT(ExternInitData) ) THEN - - ! set initialization data for ExtLoads - CALL ExtLd_SetInitInput(Init%InData_ExtLd, Init%OutData_ED, ED%y, Init%OutData_BD, BD%y(:), Init%OutData_AD, p_FAST, ExternInitData, ErrStat2, ErrMsg2) - CALL ExtLd_Init( Init%InData_ExtLd, ExtLd%u, ExtLd%xd(1), ExtLd%p, ExtLd%y, ExtLd%m, p_FAST%dt_module( MODULE_ExtLd ), Init%OutData_ExtLd, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - p_FAST%ModuleInitialized(Module_ExtLd) = .TRUE. - CALL SetModuleSubstepTime(Module_ExtLd, p_FAST, y_FAST, ErrStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - - AirDens = Init%OutData_ExtLd%AirDens - - ! Set pointer to flowfield - IF (p_FAST%CompAero == Module_AD) AD%p%FlowField => Init%OutData_ExtLd%FlowField - - END IF - - END IF ! ........................ ! initialize InflowWind @@ -690,9 +547,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL SetModuleSubstepTime(Module_IfW, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - ! Set pointers to flowfield - IF (p_FAST%CompAero == Module_AD) AD%p%FlowField => Init%OutData_IfW%FlowField - allocate( y_FAST%Lin%Modules(MODULE_IfW)%Instance(1), stat=ErrStat2) if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(IfW).", ErrStat, ErrMsg, RoutineName ) @@ -790,29 +644,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi END IF ! CompInflow - ! ........................ - ! initialize SuperController - ! ........................ - IF ( PRESENT(ExternInitData) ) THEN - ! set up the data structures for integration with supercontroller - IF ( p_FAST%UseSC ) THEN - CALL SC_DX_Init( ExternInitData%NumSC2CtrlGlob, ExternInitData%NumSC2Ctrl, ExternInitData%NumCtrl2SC, SC_DX, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ELSE - SC_DX%u%c_obj%toSC_Len = 0 - SC_DX%u%c_obj%toSC = C_NULL_PTR - SC_DX%y%c_obj%fromSC_Len = 0 - SC_DX%y%c_obj%fromSC = C_NULL_PTR - SC_DX%y%c_obj%fromSCglob_Len = 0 - SC_DX%y%c_obj%fromSCglob = C_NULL_PTR - END IF - END IF - - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - ! ........................ ! some checks for AeroDyn14's Dynamic Inflow with Mean Wind Speed from InflowWind: ! (DO NOT COPY THIS CODE!) @@ -884,6 +715,19 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, p_FAST%VTK_surface%NWaveElevPts(2) = 0 endif + allocate( y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(SeaSt).", ErrStat, ErrMsg, RoutineName ) + else + if (allocated(Init%OutData_SeaSt%LinNames_y)) call move_alloc(Init%OutData_SeaSt%LinNames_y,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%Names_y ) + if (allocated(Init%OutData_SeaSt%LinNames_u)) call move_alloc(Init%OutData_SeaSt%LinNames_u,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%Names_u ) + if (allocated(Init%OutData_SeaSt%RotFrame_y)) call move_alloc(Init%OutData_SeaSt%RotFrame_y,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%RotFrame_y ) + if (allocated(Init%OutData_SeaSt%RotFrame_u)) call move_alloc(Init%OutData_SeaSt%RotFrame_u,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%RotFrame_u ) + if (allocated(Init%OutData_SeaSt%IsLoad_u )) call move_alloc(Init%OutData_SeaSt%IsLoad_u ,y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%IsLoad_u ) + + if (allocated(Init%OutData_SeaSt%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SeaSt)%Instance(1)%NumOutputs = size(Init%OutData_SeaSt%WriteOutputHdr) + end if + IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN @@ -891,6 +735,187 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, end if + + ! ........................ + ! initialize AeroDyn15 + ! ........................ + ALLOCATE( AD%Input( p_FAST%InterpOrder+1 ), AD%InputTimes( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating AD%Input and AD%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + ALLOCATE( AD%Input_Saved( p_FAST%InterpOrder+1 ), AD%InputTimes_Saved( p_FAST%InterpOrder+1 ), STAT = ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal,"Error allocating AD%Input and AD%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL Cleanup() + RETURN + END IF + + IF ( (p_FAST%CompAero == Module_AD) .OR. (p_FAST%CompAero == Module_ExtLd) ) THEN + + allocate(Init%InData_AD%rotors(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat( ErrID_Fatal, 'Allocating rotors', errStat, errMsg, RoutineName ) + call Cleanup() + return + end if + + Init%InData_AD%rotors(1)%NumBlades = NumBl + + if (p_FAST%CompAeroMaps) then + CALL AllocAry( MeshMapData%HubOrient, 3, 3, Init%InData_AD%rotors(1)%NumBlades, 'Hub orientation matrix', ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + theta = 0.0_R8Ki + do k=1,Init%InData_AD%rotors(1)%NumBlades + theta(1) = TwoPi_R8 * (k-1) / Init%InData_AD%rotors(1)%NumBlades + MeshMapData%HubOrient(:,:,k) = EulerConstruct( theta ) + end do + end if + + + ! set initialization data for AD + CALL AllocAry( Init%InData_AD%rotors(1)%BladeRootPosition, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%rotors(1)%BladeRootPosition', errStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL AllocAry( Init%InData_AD%rotors(1)%BladeRootOrientation,3, 3, Init%InData_AD%rotors(1)%NumBlades, 'Init%InData_AD%rotors(1)%BladeRootOrientation', errStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + Init%InData_AD%Gravity = p_FAST%Gravity + Init%InData_AD%Linearize = p_FAST%Linearize + Init%InData_AD%CompAeroMaps = p_FAST%CompAeroMaps + Init%InData_AD%rotors(1)%RotSpeed = p_FAST%RotSpeedInit ! used only for aeromaps + Init%InData_AD%InputFile = p_FAST%AeroFile + Init%InData_AD%RootName = p_FAST%OutFileRoot + Init%InData_AD%MHK = p_FAST%MHK + if ( p_FAST%MHK == MHK_None ) then + Init%InData_AD%defFldDens = p_FAST%AirDens + else + Init%InData_AD%defFldDens = p_FAST%WtrDens + end if + Init%InData_AD%defKinVisc = p_FAST%KinVisc + Init%InData_AD%defSpdSound = p_FAST%SpdSound + Init%InData_AD%defPatm = p_FAST%Patm + Init%InData_AD%defPvap = p_FAST%Pvap + Init%InData_AD%WtrDpth = p_FAST%WtrDpth + Init%InData_AD%MSL2SWL = p_FAST%MSL2SWL + + + Init%InData_AD%rotors(1)%HubPosition = ED%y%HubPtMotion%Position(:,1) + Init%InData_AD%rotors(1)%HubOrientation = ED%y%HubPtMotion%RefOrientation(:,:,1) + Init%InData_AD%rotors(1)%NacellePosition = ED%y%NacelleMotion%Position(:,1) + Init%InData_AD%rotors(1)%NacelleOrientation = ED%y%NacelleMotion%RefOrientation(:,:,1) + ! Note: not passing tailfin position and orientation at init + Init%InData_AD%rotors(1)%AeroProjMod = APM_BEM_NoSweepPitchTwist + + do k=1,NumBl + Init%InData_AD%rotors(1)%BladeRootPosition(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) + Init%InData_AD%rotors(1)%BladeRootOrientation(:,:,k) = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) + end do + + ! Set pointers to flowfield + IF (p_FAST%CompInflow == Module_IfW) Init%InData_AD%FlowField => Init%OutData_IfW%FlowField + + CALL AD_Init( Init%InData_AD, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & + AD%OtherSt(STATE_CURR), AD%y, AD%m, p_FAST%dt_module( MODULE_AD ), Init%OutData_AD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(Module_AD) = .TRUE. + CALL SetModuleSubstepTime(Module_AD, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + allocate( y_FAST%Lin%Modules(MODULE_AD)%Instance(1), stat=ErrStat2) + if (ErrStat2 /= 0 ) then + call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(AD).", ErrStat, ErrMsg, RoutineName ) + else + if (allocated(Init%OutData_AD%rotors(1)%LinNames_u )) call move_alloc(Init%OutData_AD%rotors(1)%LinNames_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_u ) + if (allocated(Init%OutData_AD%rotors(1)%LinNames_y )) call move_alloc(Init%OutData_AD%rotors(1)%LinNames_y ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_y ) + if (allocated(Init%OutData_AD%rotors(1)%LinNames_x )) call move_alloc(Init%OutData_AD%rotors(1)%LinNames_x ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_x ) + if (allocated(Init%OutData_AD%rotors(1)%RotFrame_u )) call move_alloc(Init%OutData_AD%rotors(1)%RotFrame_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_u ) + if (allocated(Init%OutData_AD%rotors(1)%RotFrame_y )) call move_alloc(Init%OutData_AD%rotors(1)%RotFrame_y ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_y ) + if (allocated(Init%OutData_AD%rotors(1)%RotFrame_x )) call move_alloc(Init%OutData_AD%rotors(1)%RotFrame_x ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_x ) + if (allocated(Init%OutData_AD%rotors(1)%IsLoad_u )) call move_alloc(Init%OutData_AD%rotors(1)%IsLoad_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%IsLoad_u ) + if (allocated(Init%OutData_AD%rotors(1)%DerivOrder_x)) call move_alloc(Init%OutData_AD%rotors(1)%DerivOrder_x,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%DerivOrder_x ) + + if (allocated(Init%OutData_AD%rotors(1)%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%NumOutputs = size(Init%OutData_AD%rotors(1)%WriteOutputHdr) + end if + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + AirDens = Init%OutData_AD%rotors(1)%AirDens + + END IF ! CompAero + + IF ( p_FAST%CompAero == Module_ExtLd ) THEN + + IF ( PRESENT(ExternInitData) ) THEN + + ! set initialization data for ExtLoads + CALL ExtLd_SetInitInput(Init%InData_ExtLd, Init%OutData_ED, ED%y, Init%OutData_BD, BD%y(:), Init%OutData_AD, p_FAST, ExternInitData, ErrStat2, ErrMsg2) + CALL ExtLd_Init( Init%InData_ExtLd, ExtLd%u, ExtLd%xd(1), ExtLd%p, ExtLd%y, ExtLd%m, p_FAST%dt_module( MODULE_ExtLd ), Init%OutData_ExtLd, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + p_FAST%ModuleInitialized(Module_ExtLd) = .TRUE. + CALL SetModuleSubstepTime(Module_ExtLd, p_FAST, y_FAST, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + AirDens = Init%OutData_ExtLd%AirDens + + END IF + + END IF + + ! ........................ + ! No aero of any sort + ! ........................ + IF ( (p_FAST%CompAero /= Module_AD14) .and. (p_FAST%CompAero /= Module_AD) .and. (p_FAST%CompAero /= Module_ExtLd) ) THEN + ELSE + AirDens = 0.0_ReKi + ENDIF + + + + ! ........................ + ! initialize SuperController + ! ........................ + IF ( PRESENT(ExternInitData) ) THEN + ! set up the data structures for integration with supercontroller + IF ( p_FAST%UseSC ) THEN + CALL SC_DX_Init( ExternInitData%NumSC2CtrlGlob, ExternInitData%NumSC2Ctrl, ExternInitData%NumCtrl2SC, SC_DX, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSE + SC_DX%u%c_obj%toSC_Len = 0 + SC_DX%u%c_obj%toSC = C_NULL_PTR + SC_DX%y%c_obj%fromSC_Len = 0 + SC_DX%y%c_obj%fromSC = C_NULL_PTR + SC_DX%y%c_obj%fromSCglob_Len = 0 + SC_DX%y%c_obj%fromSCglob = C_NULL_PTR + END IF + END IF + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + + ! ........................ ! initialize HydroDyn ! ........................ @@ -9275,7 +9300,7 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%HD, Turbine%SeaSt, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN @@ -9293,7 +9318,7 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) t_global = t_initial + n_t_global*Turbine%p_FAST%dt call FAST_CalcSteady( n_t_global, t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, Turbine%ED, Turbine%BD, Turbine%SrvD, & - Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, & + Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%HD, Turbine%SeaSt, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, & Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -9306,8 +9331,8 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) t_global = Turbine%m_FAST%Lin%LinTimes(iLinTime) call SetOperatingPoint(iLinTime, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, Turbine%ED, Turbine%BD, Turbine%SrvD, & - Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, & - Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) + Turbine%AD, Turbine%IfW, Turbine%ExtInfw, Turbine%HD, Turbine%SeaSt, Turbine%SD, Turbine%ExtPtfm, & + Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (Turbine%p_FAST%DT_UJac < Turbine%p_FAST%TMax) then @@ -9323,7 +9348,7 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%ExtInfw, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%HD, Turbine%SeaSt, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN @@ -9459,6 +9484,11 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, end if + ! If we are doing AeroMaps, there is leftover data in AD15 parameters + if (p_FAST%CompAeroMaps) then + if (associated(AD%p%FlowField)) deallocate(AD%p%FlowField) + endif + ! End all modules CALL FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) @@ -10356,12 +10386,12 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, m_FAST%NextJacCalcTime = m_FAST%Lin%LinTimes(iLinTime) end if - call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & + call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! set perturbation of states based on x_eig magnitude and phase - call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN @@ -10388,12 +10418,12 @@ SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, do it = 1,nt tprime = (it-1)*dt - call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, & + call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! set perturbation of states based on x_eig magnitude and phase - call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, ExtInfw, HD, SeaSt, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index fa01557597..e6b4d86fa9 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -282,6 +282,11 @@ MODULE FAST_Types TYPE(HydroDyn_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_HD !< Constraint states [-] TYPE(HydroDyn_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_HD !< Other states [-] TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: u_HD !< System inputs [-] + TYPE(SeaSt_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_SeaSt !< Continuous states [-] + TYPE(SeaSt_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_SeaSt !< Discrete states [-] + TYPE(SeaSt_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_SeaSt !< Constraint states [-] + TYPE(SeaSt_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_SeaSt !< Other states [-] + TYPE(SeaSt_InputType) , DIMENSION(:), ALLOCATABLE :: u_SeaSt !< System inputs [-] TYPE(IceFloe_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_IceF !< Continuous states [-] TYPE(IceFloe_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_IceF !< Discrete states [-] TYPE(IceFloe_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_IceF !< Constraint states [-] @@ -2524,6 +2529,86 @@ subroutine FAST_CopyLinStateSave(SrcLinStateSaveData, DstLinStateSaveData, CtrlC if (ErrStat >= AbortErrLev) return end do end if + if (allocated(SrcLinStateSaveData%x_SeaSt)) then + LB(1:1) = lbound(SrcLinStateSaveData%x_SeaSt, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%x_SeaSt, kind=B8Ki) + if (.not. allocated(DstLinStateSaveData%x_SeaSt)) then + allocate(DstLinStateSaveData%x_SeaSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SeaSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyContState(SrcLinStateSaveData%x_SeaSt(i1), DstLinStateSaveData%x_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%xd_SeaSt)) then + LB(1:1) = lbound(SrcLinStateSaveData%xd_SeaSt, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%xd_SeaSt, kind=B8Ki) + if (.not. allocated(DstLinStateSaveData%xd_SeaSt)) then + allocate(DstLinStateSaveData%xd_SeaSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SeaSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyDiscState(SrcLinStateSaveData%xd_SeaSt(i1), DstLinStateSaveData%xd_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%z_SeaSt)) then + LB(1:1) = lbound(SrcLinStateSaveData%z_SeaSt, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%z_SeaSt, kind=B8Ki) + if (.not. allocated(DstLinStateSaveData%z_SeaSt)) then + allocate(DstLinStateSaveData%z_SeaSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SeaSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyConstrState(SrcLinStateSaveData%z_SeaSt(i1), DstLinStateSaveData%z_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%OtherSt_SeaSt)) then + LB(1:1) = lbound(SrcLinStateSaveData%OtherSt_SeaSt, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%OtherSt_SeaSt, kind=B8Ki) + if (.not. allocated(DstLinStateSaveData%OtherSt_SeaSt)) then + allocate(DstLinStateSaveData%OtherSt_SeaSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SeaSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyOtherState(SrcLinStateSaveData%OtherSt_SeaSt(i1), DstLinStateSaveData%OtherSt_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if + if (allocated(SrcLinStateSaveData%u_SeaSt)) then + LB(1:1) = lbound(SrcLinStateSaveData%u_SeaSt, kind=B8Ki) + UB(1:1) = ubound(SrcLinStateSaveData%u_SeaSt, kind=B8Ki) + if (.not. allocated(DstLinStateSaveData%u_SeaSt)) then + allocate(DstLinStateSaveData%u_SeaSt(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SeaSt.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + do i1 = LB(1), UB(1) + call SeaSt_CopyInput(SrcLinStateSaveData%u_SeaSt(i1), DstLinStateSaveData%u_SeaSt(i1), CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + end do + end if if (allocated(SrcLinStateSaveData%x_IceF)) then LB(1:1) = lbound(SrcLinStateSaveData%x_IceF, kind=B8Ki) UB(1:1) = ubound(SrcLinStateSaveData%x_IceF, kind=B8Ki) @@ -3266,6 +3351,51 @@ subroutine FAST_DestroyLinStateSave(LinStateSaveData, ErrStat, ErrMsg) end do deallocate(LinStateSaveData%u_HD) end if + if (allocated(LinStateSaveData%x_SeaSt)) then + LB(1:1) = lbound(LinStateSaveData%x_SeaSt, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%x_SeaSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call SeaSt_DestroyContState(LinStateSaveData%x_SeaSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%x_SeaSt) + end if + if (allocated(LinStateSaveData%xd_SeaSt)) then + LB(1:1) = lbound(LinStateSaveData%xd_SeaSt, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%xd_SeaSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call SeaSt_DestroyDiscState(LinStateSaveData%xd_SeaSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%xd_SeaSt) + end if + if (allocated(LinStateSaveData%z_SeaSt)) then + LB(1:1) = lbound(LinStateSaveData%z_SeaSt, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%z_SeaSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call SeaSt_DestroyConstrState(LinStateSaveData%z_SeaSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%z_SeaSt) + end if + if (allocated(LinStateSaveData%OtherSt_SeaSt)) then + LB(1:1) = lbound(LinStateSaveData%OtherSt_SeaSt, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%OtherSt_SeaSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call SeaSt_DestroyOtherState(LinStateSaveData%OtherSt_SeaSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%OtherSt_SeaSt) + end if + if (allocated(LinStateSaveData%u_SeaSt)) then + LB(1:1) = lbound(LinStateSaveData%u_SeaSt, kind=B8Ki) + UB(1:1) = ubound(LinStateSaveData%u_SeaSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call SeaSt_DestroyInput(LinStateSaveData%u_SeaSt(i1), ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + end do + deallocate(LinStateSaveData%u_SeaSt) + end if if (allocated(LinStateSaveData%x_IceF)) then LB(1:1) = lbound(LinStateSaveData%x_IceF, kind=B8Ki) UB(1:1) = ubound(LinStateSaveData%x_IceF, kind=B8Ki) @@ -3871,6 +4001,51 @@ subroutine FAST_PackLinStateSave(RF, Indata) call HydroDyn_PackInput(RF, InData%u_HD(i1)) end do end if + call RegPack(RF, allocated(InData%x_SeaSt)) + if (allocated(InData%x_SeaSt)) then + call RegPackBounds(RF, 1, lbound(InData%x_SeaSt, kind=B8Ki), ubound(InData%x_SeaSt, kind=B8Ki)) + LB(1:1) = lbound(InData%x_SeaSt, kind=B8Ki) + UB(1:1) = ubound(InData%x_SeaSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call SeaSt_PackContState(RF, InData%x_SeaSt(i1)) + end do + end if + call RegPack(RF, allocated(InData%xd_SeaSt)) + if (allocated(InData%xd_SeaSt)) then + call RegPackBounds(RF, 1, lbound(InData%xd_SeaSt, kind=B8Ki), ubound(InData%xd_SeaSt, kind=B8Ki)) + LB(1:1) = lbound(InData%xd_SeaSt, kind=B8Ki) + UB(1:1) = ubound(InData%xd_SeaSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call SeaSt_PackDiscState(RF, InData%xd_SeaSt(i1)) + end do + end if + call RegPack(RF, allocated(InData%z_SeaSt)) + if (allocated(InData%z_SeaSt)) then + call RegPackBounds(RF, 1, lbound(InData%z_SeaSt, kind=B8Ki), ubound(InData%z_SeaSt, kind=B8Ki)) + LB(1:1) = lbound(InData%z_SeaSt, kind=B8Ki) + UB(1:1) = ubound(InData%z_SeaSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call SeaSt_PackConstrState(RF, InData%z_SeaSt(i1)) + end do + end if + call RegPack(RF, allocated(InData%OtherSt_SeaSt)) + if (allocated(InData%OtherSt_SeaSt)) then + call RegPackBounds(RF, 1, lbound(InData%OtherSt_SeaSt, kind=B8Ki), ubound(InData%OtherSt_SeaSt, kind=B8Ki)) + LB(1:1) = lbound(InData%OtherSt_SeaSt, kind=B8Ki) + UB(1:1) = ubound(InData%OtherSt_SeaSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call SeaSt_PackOtherState(RF, InData%OtherSt_SeaSt(i1)) + end do + end if + call RegPack(RF, allocated(InData%u_SeaSt)) + if (allocated(InData%u_SeaSt)) then + call RegPackBounds(RF, 1, lbound(InData%u_SeaSt, kind=B8Ki), ubound(InData%u_SeaSt, kind=B8Ki)) + LB(1:1) = lbound(InData%u_SeaSt, kind=B8Ki) + UB(1:1) = ubound(InData%u_SeaSt, kind=B8Ki) + do i1 = LB(1), UB(1) + call SeaSt_PackInput(RF, InData%u_SeaSt(i1)) + end do + end if call RegPack(RF, allocated(InData%x_IceF)) if (allocated(InData%x_IceF)) then call RegPackBounds(RF, 1, lbound(InData%x_IceF, kind=B8Ki), ubound(InData%x_IceF, kind=B8Ki)) @@ -4659,6 +4834,71 @@ subroutine FAST_UnPackLinStateSave(RF, OutData) call HydroDyn_UnpackInput(RF, OutData%u_HD(i1)) ! u_HD end do end if + if (allocated(OutData%x_SeaSt)) deallocate(OutData%x_SeaSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%x_SeaSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackContState(RF, OutData%x_SeaSt(i1)) ! x_SeaSt + end do + end if + if (allocated(OutData%xd_SeaSt)) deallocate(OutData%xd_SeaSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%xd_SeaSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackDiscState(RF, OutData%xd_SeaSt(i1)) ! xd_SeaSt + end do + end if + if (allocated(OutData%z_SeaSt)) deallocate(OutData%z_SeaSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%z_SeaSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackConstrState(RF, OutData%z_SeaSt(i1)) ! z_SeaSt + end do + end if + if (allocated(OutData%OtherSt_SeaSt)) deallocate(OutData%OtherSt_SeaSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%OtherSt_SeaSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackOtherState(RF, OutData%OtherSt_SeaSt(i1)) ! OtherSt_SeaSt + end do + end if + if (allocated(OutData%u_SeaSt)) deallocate(OutData%u_SeaSt) + call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return + if (IsAllocAssoc) then + call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return + allocate(OutData%u_SeaSt(LB(1):UB(1)),stat=stat) + if (stat /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SeaSt.', RF%ErrStat, RF%ErrMsg, RoutineName) + return + end if + do i1 = LB(1), UB(1) + call SeaSt_UnpackInput(RF, OutData%u_SeaSt(i1)) ! u_SeaSt + end do + end if if (allocated(OutData%x_IceF)) deallocate(OutData%x_IceF) call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return if (IsAllocAssoc) then diff --git a/modules/seastate/src/SeaSt_WaveField.txt b/modules/seastate/src/SeaSt_WaveField.txt index f0b4aeaf14..f5730bc868 100644 --- a/modules/seastate/src/SeaSt_WaveField.txt +++ b/modules/seastate/src/SeaSt_WaveField.txt @@ -14,6 +14,10 @@ param SeaSt_WaveField - INTEGER WaveMod_ExtE param SeaSt_WaveField - INTEGER WaveMod_ExtFull - 6 - "WaveMod = 6 [Incident wave kinematics model: Externally generated full wave-kinematics time series (invalid for PotMod/=0)]" - param SeaSt_WaveField - INTEGER WaveMod_UserFreq - 7 - "WaveMod = 7 [Incident wave kinematics model: user-defined wave frequency components]" - +param SeaSt_WaveField - INTEGER ConstWaveMod_None - 0 - "ConstWaveMod = 0 [Constrained wave model: No constrained waves]" - +param SeaSt_WaveField - INTEGER ConstWaveMod_CrestElev - 1 - "ConstWaveMod = 1 [Constrained wave model: Constrained wave with specified crest elevation, alpha]" - +param SeaSt_WaveField - INTEGER ConstWaveMod_Peak2Trough - 2 - "ConstWaveMod = 2 [Constrained wave model: Constrained wave with guaranteed peak-to-trough crest height, HCrest]" - + #--------------------------------------------------------------------------------------------------------------------------------------------------------- # #--------------------------------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/seastate/src/SeaSt_WaveField_Types.f90 b/modules/seastate/src/SeaSt_WaveField_Types.f90 index 869882a3aa..a7d3397fc8 100644 --- a/modules/seastate/src/SeaSt_WaveField_Types.f90 +++ b/modules/seastate/src/SeaSt_WaveField_Types.f90 @@ -44,6 +44,9 @@ MODULE SeaSt_WaveField_Types INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtElev = 5 ! WaveMod = 5 [Incident wave kinematics model: Externally generated wave-elevation time series] [-] INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_ExtFull = 6 ! WaveMod = 6 [Incident wave kinematics model: Externally generated full wave-kinematics time series (invalid for PotMod/=0)] [-] INTEGER(IntKi), PUBLIC, PARAMETER :: WaveMod_UserFreq = 7 ! WaveMod = 7 [Incident wave kinematics model: user-defined wave frequency components] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ConstWaveMod_None = 0 ! ConstWaveMod = 0 [Constrained wave model: No constrained waves] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ConstWaveMod_CrestElev = 1 ! ConstWaveMod = 1 [Constrained wave model: Constrained wave with specified crest elevation, alpha] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: ConstWaveMod_Peak2Trough = 2 ! ConstWaveMod = 2 [Constrained wave model: Constrained wave with guaranteed peak-to-trough crest height, HCrest] [-] ! ========= SeaSt_WaveField_ParameterType ======= TYPE, PUBLIC :: SeaSt_WaveField_ParameterType INTEGER(IntKi) , DIMENSION(1:4) :: n = 0_IntKi !< number of evenly-spaced grid points in the t, x, y, and z directions [-] diff --git a/modules/seastate/src/SeaState.f90 b/modules/seastate/src/SeaState.f90 index a0d1424ac6..10dca7ab7d 100644 --- a/modules/seastate/src/SeaState.f90 +++ b/modules/seastate/src/SeaState.f90 @@ -33,27 +33,27 @@ MODULE SeaState USE Current USE Waves2 - - IMPLICIT NONE - PRIVATE - - - ! ..... Public Subroutines ................................................................................................... - - PUBLIC :: SeaSt_Init ! Initialization routine - PUBLIC :: SeaSt_End ! Ending routine (includes clean up) + ! ..... Public Subroutines ................................................................................................... + PUBLIC :: SeaSt_Init ! Initialization routine + PUBLIC :: SeaSt_End ! Ending routine (includes clean up) - PUBLIC :: SeaSt_UpdateStates ! Loose coupling routine for solving for constraint states, integrating - ! continuous states, and updating discrete states - PUBLIC :: SeaSt_CalcOutput ! Routine for computing outputs + PUBLIC :: SeaSt_UpdateStates ! Loose coupling routine for solving for constraint states, integrating + ! continuous states, and updating discrete states + PUBLIC :: SeaSt_CalcOutput ! Routine for computing outputs - PUBLIC :: SeaSt_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual - PUBLIC :: SeaSt_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states - !PUBLIC :: SeaSt_UpdateDiscState ! Tight coupling routine for updating discrete states - + PUBLIC :: SeaSt_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual + PUBLIC :: SeaSt_CalcContStateDeriv ! Tight coupling routine for computing derivatives of continuous states + !PUBLIC :: SeaSt_UpdateDiscState ! Tight coupling routine for updating discrete states + + ! Linearization routines + PUBLIC :: SeaSt_JacobianPInput ! Jacobians dY/du, dX/du, dXd/du, and dZ/du + PUBLIC :: SeaSt_JacobianPContState ! Jacobians dY/dx, dX/dx, dXd/dx, and dZ/dx + PUBLIC :: SeaSt_JacobianPDiscState ! Jacobians dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd + PUBLIC :: SeaSt_JacobianPConstrState ! Jacobians dY/dz, dX/dz, dXd/dz, and dZ/dz + PUBLIC :: SeaSt_GetOP ! operating points u_op, y_op, x_op, dx_op, xd_op, and z_op CONTAINS !---------------------------------------------------------------------------------------------------------------------------------- @@ -270,18 +270,18 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init p%WaveField%GridParams%pZero(4) = -InputFileData%Z_Depth ! zi p%WaveField%GridParams%Z_Depth = InputFileData%Z_Depth - IF ( p%OutSwtch == 1 ) THEN ! Only HD-level output writing - ! HACK WE can tell FAST not to write any HD outputs by simply deallocating the WriteOutputHdr array! + IF ( p%OutSwtch == 1 ) THEN ! Only SeaSt-level output writing + ! HACK WE can tell FAST not to write any SeaState outputs by simply deallocating the WriteOutputHdr array! DEALLOCATE ( InitOut%WriteOutputHdr ) END IF InitOut%WaveField => p%WaveField ! Tell HydroDyn if state-space wave excitation is not allowed: - InitOut%InvalidWithSSExctn = InputFileData%WaveMod == WaveMod_ExtFull .or. & ! 'Externally generated full wave-kinematics time series cannot be used with state-space wave excitations. Set WaveMod 0, 1, 1P#, 2, 3, 4, or 5.' - InputFileData%WaveDirMod /= WaveDirMod_None .or. & ! 'Directional spreading cannot be used with state-space wave excitations. Set WaveDirMod=0.' - InputFileData%Waves2%WvDiffQTFF .or. & ! 'Cannot use full difference-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvDiffQTF=FALSE.' - InputFileData%Waves2%WvSumQTFF ! 'Cannot use full summation-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvSumQTF=FALSE.' + InitOut%InvalidWithSSExctn = InputFileData%WaveMod == WaveMod_ExtFull .or. & ! 'Externally generated full wave-kinematics time series cannot be used with state-space wave excitations. Set WaveMod 0, 1, 1P#, 2, 3, 4, or 5.' + InputFileData%WaveDirMod /= WaveDirMod_None .or. & ! 'Directional spreading cannot be used with state-space wave excitations. Set WaveDirMod=0.' + InputFileData%Waves2%WvDiffQTFF .or. & ! 'Cannot use full difference-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvDiffQTF=FALSE.' + InputFileData%Waves2%WvSumQTFF ! 'Cannot use full summation-frequency 2nd-order wave kinematics with state-space wave excitations. Set WvSumQTF=FALSE.' ! Write Wave Kinematics? if ( InputFileData%WaveMod /= WaveMod_ExtFull ) then @@ -311,8 +311,9 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init END IF END IF + + ! Linearization if (InitInp%Linearize) then - if ( InputFileData%WaveMod /= WaveMod_None ) then call SetErrStat( ErrID_Fatal, 'Still water conditions must be used for linearization. Set WaveMod=0.', ErrStat, ErrMsg, RoutineName ) end if @@ -329,7 +330,15 @@ SUBROUTINE SeaSt_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init call SetErrStat( ErrID_Fatal, 'Cannot use full summation-frequency 2nd-order wave kinematics for linearization. Set WvSumQTF=FALSE.', ErrStat, ErrMsg, RoutineName ) end if - + if ( InputFileData%Waves%ConstWaveMod /= WaveMod_None ) then + call SetErrStat( ErrID_Fatal, 'Constrained wave conditions cannot be used for linearization. Set ConstWaveMod=0.', ErrStat, ErrMsg, RoutineName ) + end if + + ! set the Jacobian info if we don't have a fatal error + if (ErrStat < AbortErrLev) then + call SeaSt_Init_Jacobian(p, InitOut, ErrStat2, ErrMsg2) + if (Failed()) return + endif end if @@ -445,7 +454,7 @@ SUBROUTINE AddArrays_4D(Array1, Array2, ArrayName, ErrStat, ErrMsg) CHARACTER(*), INTENT(IN ) :: ArrayName INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - + ErrStat = ErrID_None ErrMsg = "" @@ -453,7 +462,7 @@ SUBROUTINE AddArrays_4D(Array1, Array2, ArrayName, ErrStat, ErrMsg) SIZE(Array1,DIM=2) /= SIZE(Array2,DIM=2) .OR. & SIZE(Array1,DIM=3) /= SIZE(Array2,DIM=3) .OR. & SIZE(Array1,DIM=4) /= SIZE(Array2,DIM=4)) THEN - + ErrStat = ErrID_Fatal ErrMsg = TRIM(ArrayName)//' arrays for first and second order wave elevations are of different sizes: '//NewLine// & 'Waves: '// TRIM(Num2LStr(SIZE(Array1,DIM=1)))//'x'// & @@ -467,7 +476,7 @@ SUBROUTINE AddArrays_4D(Array1, Array2, ArrayName, ErrStat, ErrMsg) ELSE Array1 = Array1 + Array2 ENDIF - + END SUBROUTINE AddArrays_4D !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE AddArrays_5D(Array1, Array2, ArrayName, ErrStat, ErrMsg) @@ -476,14 +485,14 @@ SUBROUTINE AddArrays_5D(Array1, Array2, ArrayName, ErrStat, ErrMsg) CHARACTER(*), INTENT(IN ) :: ArrayName INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - + IF ( SIZE(Array1,DIM=1) /= SIZE(Array2,DIM=1) .OR. & SIZE(Array1,DIM=2) /= SIZE(Array2,DIM=2) .OR. & SIZE(Array1,DIM=3) /= SIZE(Array2,DIM=3) .OR. & SIZE(Array1,DIM=4) /= SIZE(Array2,DIM=4) .OR. & SIZE(Array1,DIM=5) /= SIZE(Array2,DIM=5)) THEN - + ErrStat = ErrID_Fatal ErrMsg = TRIM(ArrayName)//' arrays for first and second order wave elevations are of different sizes: '//NewLine// & 'Waves: '// TRIM(Num2LStr(SIZE(Array1,DIM=1)))//'x'// & @@ -501,71 +510,56 @@ SUBROUTINE AddArrays_5D(Array1, Array2, ArrayName, ErrStat, ErrMsg) ErrMsg = "" Array1 = Array1 + Array2 ENDIF - + END SUBROUTINE AddArrays_5D !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. SUBROUTINE SeaSt_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) - TYPE(SeaSt_InputType), INTENT(INOUT) :: u !< System inputs - TYPE(SeaSt_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(SeaSt_ParameterType), INTENT(INOUT) :: p !< Parameters TYPE(SeaSt_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states TYPE(SeaSt_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states TYPE(SeaSt_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states - TYPE(SeaSt_OtherStateType), INTENT(INOUT) :: OtherState !< Other/optimization states + TYPE(SeaSt_OtherStateType), INTENT(INOUT) :: OtherState !< Other/optimization states TYPE(SeaSt_OutputType), INTENT(INOUT) :: y !< System outputs - TYPE(SeaSt_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + TYPE(SeaSt_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - + ErrStat = ErrID_None + ErrMsg = "" + ! Place any last minute operations or calculations here: ! CALL WaveField_End(p%WaveField) - ! Write the SeaState-level output file data FROM THE LAST COMPLETED TIME STEP if the user requested module-level output ! and the current time has advanced since the last stored time step. - - IF ( p%OutSwtch == 1 .OR. p%OutSwtch == 3) THEN !Note: this will always output a line, even if we're ending early (e.g. if HD doesn't initialize properly, this will write a line of zeros to the output file.) - CALL SeaStOut_WriteOutputs( m%LastOutTime, y, p, m%Decimate, ErrStat, ErrMsg ) - END IF - - ! Close files here: - CALL SeaStOut_CloseOutput( p, ErrStat, ErrMsg ) - + + IF ( p%OutSwtch == 1 .OR. p%OutSwtch == 3) THEN !Note: this will always output a line, even if we're ending early (e.g. if SeaState doesn't initialize properly, this will write a line of zeros to the output file.) + CALL SeaStOut_WriteOutputs( m%LastOutTime, y, p, m%Decimate, ErrStat, ErrMsg ) + END IF + + ! Close files here: + CALL SeaStOut_CloseOutput( p, ErrStat, ErrMsg ) ! Destroy the input data: - CALL SeaSt_DestroyInput( u, ErrStat, ErrMsg ) - ! Destroy the parameter data: - CALL SeaSt_DestroyParam( p, ErrStat, ErrMsg ) - ! Destroy the state data: - CALL SeaSt_DestroyContState( x, ErrStat, ErrMsg ) CALL SeaSt_DestroyDiscState( xd, ErrStat, ErrMsg ) CALL SeaSt_DestroyConstrState( z, ErrStat, ErrMsg ) CALL SeaSt_DestroyOtherState( OtherState, ErrStat, ErrMsg ) - + ! Destroy misc variables: - CALL SeaSt_DestroyMisc( m, ErrStat, ErrMsg ) ! Destroy the output data: - CALL SeaSt_DestroyOutput( y, ErrStat, ErrMsg ) - END SUBROUTINE SeaSt_End @@ -574,7 +568,6 @@ END SUBROUTINE SeaSt_End !> Loose coupling routine for solving constraint states, integrating continuous states, and updating discrete states. !! Continuous, constraint, and discrete states are updated to values at t + Interval. SUBROUTINE SeaSt_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds INTEGER(IntKi), INTENT(IN ) :: n !< Current step of the simulation: t = n*Interval TYPE(SeaSt_InputType), INTENT(INOUT ) :: Inputs(:) !< Inputs at InputTimes @@ -588,26 +581,20 @@ SUBROUTINE SeaSt_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState !! Output: Constraint states at t + Interval TYPE(SeaSt_OtherStateType), INTENT(INOUT) :: OtherState !< Other states: Other states at t; !! Output: Other states at t + Interval - TYPE(SeaSt_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + TYPE(SeaSt_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! Initialize variables - + ! Initialize variables ErrStat = ErrID_None ! no error has occurred ErrMsg = "" - - - END SUBROUTINE SeaSt_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. -SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) - +SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds TYPE(SeaSt_InputType), INTENT(INOUT) :: u !< Inputs at Time (note that this is intent out because we're copying the u%WAMITMesh into m%u_wamit%mesh) TYPE(SeaSt_ParameterType), INTENT(IN ) :: p !< Parameters @@ -617,17 +604,17 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er TYPE(SeaSt_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time TYPE(SeaSt_OutputType), INTENT(INOUT) :: y !< Outputs computed at Time (Input only so that mesh con- !! nectivity information does not have to be recalculated) - TYPE(SeaSt_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + TYPE(SeaSt_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !! Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !! Error message if ErrStat /= ErrID_None INTEGER :: I ! Generic counters - + INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (secondary error) CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None character(*), parameter :: RoutineName = 'SeaSt_CalcOutput' - + REAL(SiKi) :: WaveElev (p%NWaveElev) ! Instantaneous total elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) REAL(SiKi) :: WaveElev1(p%NWaveElev) ! Instantaneous first order elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) REAL(SiKi) :: WaveElev2(p%NWaveElev) ! Instantaneous first order elevation of incident waves at each of the NWaveElev points where the incident wave elevations can be output (meters) @@ -637,16 +624,16 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er REAL(SiKi) :: WaveDynP(p%NWaveKin) REAL(ReKi) :: AllOuts(MaxOutPts) real(ReKi) :: positionXYZ(3), positionXY(2) - + REAL(SiKi) :: zeta REAL(SiKi) :: zeta1 REAL(SiKi) :: zeta2 - + INTEGER(IntKi) :: nodeInWater - + ! Initialize ErrStat - - ErrStat = ErrID_None + + ErrStat = ErrID_None ErrMsg = "" WaveElev = 0.0_ReKi WaveElev1 = 0.0_ReKi @@ -654,18 +641,18 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er WaveAccMCF = 0.0_ReKi ! In case we don't use MCF approximation ErrStat2 = ErrID_None ErrMsg = "" - + ! Compute outputs here: - + ! These Outputs are only used for generated user-requested output channel results. ! If the user did not request any outputs, then we can simply return IF ( p%NumOuts > 0 ) THEN - + ! Write the SeaState-level output file data FROM THE LAST COMPLETED TIME STEP if the user requested module-level output ! and the current time has advanced since the last stored time step. Note that this must be done before filling y%WriteOutput ! so that we don't get recent results. Also note that this may give strange results in the .SeaSt.out files of linearization simulations ! because it assumes that the last call to SeaSt_CalcOutput was for a "normal" time step. - + IF ( (p%OutSwtch == 1 .OR. p%OutSwtch == 3) .AND. ( Time > m%LastOutTime ) ) THEN CALL SeaStOut_WriteOutputs( m%LastOutTime, y, p, m%Decimate, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -677,94 +664,443 @@ SUBROUTINE SeaSt_CalcOutput( Time, u, p, x, xd, z, OtherState, y, m, ErrStat, Er CALL WaveField_GetNodeWaveKin( p%WaveField, m%WaveField_m, Time, positionXYZ, .FALSE., nodeInWater, zeta1, zeta2, zeta, WaveDynP(i), WaveVel(:,i), WaveAcc(:,i), WaveAccMCF(:,i), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO - + ! Compute the wave elevations at the requested output locations for this time. Note that p%WaveElev has the second order added to it already. - DO i = 1, p%NWaveElev positionXY = (/p%WaveElevxi(i),p%WaveElevyi(i)/) WaveElev1(i) = WaveField_GetNodeWaveElev1( p%WaveField, m%WaveField_m, Time, positionXY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) WaveElev2(i) = WaveField_GetNodeWaveElev2( p%WaveField, m%WaveField_m, Time, positionXY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - WaveElev(i) = WaveElev1(i) + WaveElev2(i) + WaveElev(i) = WaveElev1(i) + WaveElev2(i) END DO - + ! Map calculated results into the AllOuts Array CALL SeaStOut_MapOutputs( p, WaveElev, WaveElev1, WaveElev2, WaveVel, WaveAcc, WaveAccMCF, WaveDynP, AllOuts, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + DO I = 1,p%NumOuts y%WriteOutput(I) = p%OutParam(I)%SignM * AllOuts( p%OutParam(I)%Indx ) - END DO - + END DO + END IF - + END SUBROUTINE SeaSt_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- -!> Tight coupling routine for computing derivatives of continuous states -SUBROUTINE SeaSt_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(SeaSt_InputType), INTENT(INOUT) :: u !< Inputs at Time (intent OUT only because we're copying the input mesh) - TYPE(SeaSt_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SeaSt_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(SeaSt_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time - TYPE(SeaSt_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time - TYPE(SeaSt_OtherStateType), INTENT(IN ) :: OtherState !< Other states - TYPE(SeaSt_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables - TYPE(SeaSt_ContinuousStateType), INTENT(INOUT) :: dxdt !< Continuous state derivatives at Time - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - CHARACTER(*), PARAMETER :: RoutineName = 'SeaSt_CalcContStateDeriv' - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - +!> Tight coupling routine for computing derivatives of continuous states. Not used in SeaState +SUBROUTINE SeaSt_CalcContStateDeriv( Time, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: Time !< Current simulation time in seconds + type(SeaSt_InputType), intent(inout) :: u !< Inputs at Time (intent OUT only because we're copying the input mesh) + type(SeaSt_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_ContinuousStateType), intent(in ) :: x !< Continuous states at Time + type(SeaSt_DiscreteStateType), intent(in ) :: xd !< Discrete states at Time + type(SeaSt_ConstraintStateType), intent(in ) :: z !< Constraint states at Time + type(SeaSt_OtherStateType), intent(in ) :: OtherState !< Other states + type(SeaSt_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + type(SeaSt_ContinuousStateType), intent(inout) :: dxdt !< Continuous state derivatives at Time + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + character(*), parameter :: RoutineName = 'SeaSt_CalcContStateDeriv' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" END SUBROUTINE SeaSt_CalcContStateDeriv +!---------------------------------------------------------------------------------------------------------------------------------- +!> Tight coupling routine for solving for the residual of the constraint state equations +SUBROUTINE SeaSt_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_residual, ErrStat, ErrMsg ) + real(DbKi), intent(in ) :: Time !< Current simulation time in seconds + type(SeaSt_InputType), intent(inout) :: u !< Inputs at Time (intent OUT only because we're copying the input mesh) + type(SeaSt_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_ContinuousStateType), intent(in ) :: x !< Continuous states at Time + type(SeaSt_DiscreteStateType), intent(in ) :: xd !< Discrete states at Time + type(SeaSt_ConstraintStateType), intent(in ) :: z !< Constraint states at Time (possibly a guess) + type(SeaSt_OtherStateType), intent(in ) :: OtherState !< Other/optimization states + type(SeaSt_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + type(SeaSt_ConstraintStateType), intent( out) :: z_residual !< Residual of the constraint state equations using + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" + + ! Nothing to do here since no contraint states + call SeaSt_CopyConstrState(z, z_residual, MESH_NEWCOPY, ErrStat, ErrMsg) +END SUBROUTINE SeaSt_CalcConstrStateResidual + !---------------------------------------------------------------------------------------------------------------------------------- -!> Tight coupling routine for solving for the residual of the constraint state equations -SUBROUTINE SeaSt_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_residual, ErrStat, ErrMsg ) - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(SeaSt_InputType), INTENT(INOUT) :: u !< Inputs at Time (intent OUT only because we're copying the input mesh) - TYPE(SeaSt_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(SeaSt_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(SeaSt_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time - TYPE(SeaSt_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time (possibly a guess) - TYPE(SeaSt_OtherStateType), INTENT(IN ) :: OtherState !< Other/optimization states - TYPE(SeaSt_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables - TYPE(SeaSt_ConstraintStateType), INTENT( OUT) :: z_residual !< Residual of the constraint state equations using - !! the input values described above - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - ! Nothing to do here since none of the sub-modules have contraint states - z_residual = z - - ! Solve for the constraint states here: +! Linearization routines +!---------------------------------------------------------------------------------------------------------------------------------- +!> Initialize Jacobian info for linearization (only u and y) +subroutine SeaSt_Init_Jacobian(p, InitOut, ErrStat, ErrMsg) + type(SeaSt_ParameterType), intent(inout) :: p !< Parameters + type(SeaSt_InitOutputType), intent(inout) :: InitOut !< Output for initialization routine + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + integer(IntKi) :: nu, ny ! counters for number of u and y linearization terms + integer(IntKi) :: i, idx ! generic indexing + integer(IntKi) :: ExtStart ! start of Extended input/output + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_Init_Jacobian' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + + !-------------------------- + ! Init Jacobians for u + !-------------------------- + + ! One extended input (WaveElev0), and no regular inputs. Starts at first index. + nu = 1 + p%LinParams%NumExtendedInputs = 1 + ! Total number of inputs (including regular and extended inputs) + p%LinParams%Jac_nu = nu + + ! Allocate storage for names, indexing, and perturbations + call AllocAry(InitOut%LinNames_u, nu, "LinNames_u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%RotFrame_u, nu, "RotFrame_u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(InitOut%IsLoad_u, nu, "IsLoad_u", ErrStat2, ErrMsg2); if (Failed()) return + call AllocAry(p%LinParams%du, nu, "LinParams%du", ErrStat2, ErrMsg2); if (Failed()) return + + ! Step through list of inputs and save names. No regular inputs, so we skip directly to the Extended input + ! WaveElev0 - extended input + ExtStart = 1 + InitOut%LinNames_u(ExtStart) = 'Extended input: wave elevation at platform ref point, m' + InitOut%RotFrame_u(ExtStart) = .false. + InitOut%IsLoad_u( ExtStart) = .false. + + p%LinParams%Jac_u_idxStartList%Extended = ExtStart + p%LinParams%du(ExtStart) = 0.02_ReKi * Pi / 180.0_ReKi * max(1.0_ReKi, p%WaveField%WtrDpth) ! TODO: check that this is the correct perturbation to use + + + !-------------------------- + ! Init Jacobians for y + !-------------------------- + + ! No regular outputs, only the extended outputs and the WrOuts + p%LinParams%NumExtendedOutputs = 1 + ExtStart = 1 ! Extended output is the first output + ny = 1 ! one extended output + p%LinParams%Jac_y_idxStartList%Extended = 1 + + ! Nunber of WrOuts (only if output to OpenFAST) + if ( p%OutSwtch /= 1 .and. allocated(InitOut%WriteOutputHdr) ) then + ny = ny + size(InitOut%WriteOutputHdr) + endif + + ! start position for WrOuts (may be beyond ny) + p%LinParams%Jac_y_idxStartList%WrOuts = p%LinParams%Jac_y_idxStartList%Extended + p%LinParams%NumExtendedOutputs + + ! Total number of outs (including regular outs and extended outs) + p%LinParams%Jac_ny = ny + + ! allocate some things + call AllocAry(InitOut%LinNames_y, ny, "LinNames_y", ErrStat2, ErrMsg2); if (Failed()) return; + call AllocAry(InitOut%RotFrame_y, ny, "RotFrame_y", ErrStat2, ErrMsg2); if (Failed()) return; + InitOut%RotFrame_y = .false. ! No outputs in rotating frame + + ! Set names: no regular output, so start at extended output + InitOut%LinNames_y(ExtStart) = 'Extended output: wave elevation at platform ref point, m' + + ! WrOuts names (only if output to OpenFAST) + if ( p%OutSwtch > 1 .and. allocated(InitOut%WriteOutputHdr) ) then + do i = 1,size(InitOut%WriteOutputHdr) + idx = p%LinParams%Jac_y_idxStartList%WrOuts - 1 + i ! current index + InitOut%LinNames_y(idx) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) + enddo + endif -END SUBROUTINE SeaSt_CalcConstrStateResidual +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine SeaSt_Init_Jacobian + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Linearization Jacobians dY/du, dX/du, dXd/du, and dZ/du +subroutine SeaSt_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) + real(DbKi), intent(in ) :: t !< Time in seconds at operating point + type(SeaSt_InputType), intent(inout) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + type(SeaSt_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_ContinuousStateType), intent(in ) :: x !< Continuous states at operating point + type(SeaSt_DiscreteStateType), intent(in ) :: xd !< Discrete states at operating point + type(SeaSt_ConstraintStateType), intent(in ) :: z !< Constraint states at operating point + type(SeaSt_OtherStateType), intent(in ) :: OtherState !< Other states at operating point + type(SeaSt_OutputType), intent(inout) :: y !< Output (change to inout if a mesh copy is required); + type(SeaSt_MiscVarType), intent(inout) :: m !< Misc/optimization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + real(R8Ki), allocatable, optional, intent(inout) :: dYdu(:,:) !< Partial derivatives of output functions + real(R8Ki), allocatable, optional, intent(inout) :: dXdu(:,:) !< Partial derivatives of continuous state + real(R8Ki), allocatable, optional, intent(inout) :: dXddu(:,:) !< Partial derivatives of discrete state + real(R8Ki), allocatable, optional, intent(inout) :: dZdu(:,:) !< Partial derivatives of constraint state + + integer(IntKi) :: idx_dY,idx_du,i + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_JacobianPInput' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + + if ( present( dYdu ) ) then + ! If dYdu is allocated, make sure it is the correct size + if (allocated(dYdu)) then + if (size(dYdu,1) /= p%LinParams%Jac_ny .or. size(dYdu,2) /= p%LinParams%Jac_nu) deallocate (dYdu) + endif + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + ! - inputs are extended inputs only + ! - outputs are the extended outputs and the WriteOutput values + if (.not. ALLOCATED(dYdu)) then + call AllocAry( dYdu, p%LinParams%Jac_ny, p%LinParams%Jac_nu, 'dYdu', ErrStat2, ErrMsg2 ) + if (Failed()) return + end if - + dYdu = 0.0_R8Ki + + ! Extended inputs to extended outputs (direct pass-through) + do i=1,min(p%LinParams%NumExtendedInputs,p%LinParams%NumExtendedOutputs) + idx_du = p%LinParams%Jac_u_idxStartList%Extended + i - 1 + idx_dY = p%LinParams%Jac_y_idxStartList%Extended + i - 1 + dYdu(idx_dY,idx_du) = 1.0_R8Ki + enddo + + ! It isn't possible to determine the relationship between the extended input and the WrOuts. So we leave them all zero. + + endif + + + ! No states or constraints, so deallocate any such matrices + if ( present( dXdu ) ) then + if (allocated(dXdu)) deallocate(dXdu) + endif + + if ( present( dXddu ) ) then + if (allocated(dXddu)) deallocate(dXddu) + endif + + if ( present( dZdu ) ) then + if (allocated(dZdu)) deallocate(dZdu) + endif + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine SeaSt_JacobianPInput + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Linearization Jacobians dY/dx, dX/dx, dXd/dx, and dZ/dx +!! No continuous states, so this doesn't do anything +subroutine SeaSt_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) + real(DbKi), intent(in ) :: t !< Time in seconds at operating point + type(SeaSt_InputType), intent(in ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + type(SeaSt_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_ContinuousStateType), intent(in ) :: x !< Continuous states at operating point + type(SeaSt_DiscreteStateType), intent(in ) :: xd !< Discrete states at operating point + type(SeaSt_ConstraintStateType), intent(in ) :: z !< Constraint states at operating point + type(SeaSt_OtherStateType), intent(in ) :: OtherState !< Other states at operating point + type(SeaSt_OutputType), intent(inout) :: y !< Output (change to inout if a mesh copy is required); + type(SeaSt_MiscVarType), intent(inout) :: m !< Misc/optimization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + real(R8Ki), allocatable, optional, intent(inout) :: dYdx(:,:) !< Partial derivatives of output functions + real(R8Ki), allocatable, optional, intent(inout) :: dXdx(:,:) !< Partial derivatives of continuous state + real(R8Ki), allocatable, optional, intent(inout) :: dXddx(:,:) !< Partial derivatives of discrete state + real(R8Ki), allocatable, optional, intent(inout) :: dZdx(:,:) !< Partial derivatives of constraint state + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + + ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x): + ! if (present(dYdx)) then + ! endif + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x): + ! if (present(dXdx)) then + ! endif + + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the continuous states (x): + ! if (present(dXddx)) then + ! endif + + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the continuous states (x): + ! if (present(dZdx)) then + ! endif +end subroutine SeaSt_JacobianPContState + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Linearization Jacobians dY/dxd, dX/dxd, dXd/dxd, and dZ/dxd +!! No discrete states, so this doesn't do anything +subroutine SeaSt_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) + real(DbKi), intent(in ) :: t !< Time in seconds at operating point + type(SeaSt_InputType), intent(in ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + type(SeaSt_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_ContinuousStateType), intent(in ) :: x !< Continuous states at operating point + type(SeaSt_DiscreteStateType), intent(in ) :: xd !< Discrete states at operating point + type(SeaSt_ConstraintStateType), intent(in ) :: z !< Constraint states at operating point + type(SeaSt_OtherStateType), intent(in ) :: OtherState !< Other states at operating point + type(SeaSt_OutputType), intent(in ) :: y !< Output (change to inout if a mesh copy is required); + type(SeaSt_MiscVarType), intent(inout) :: m !< Misc/optimization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + real(R8Ki), allocatable, optional, intent(inout) :: dYdxd(:,:) !< Partial derivatives of output functions + real(R8Ki), allocatable, optional, intent(inout) :: dXdxd(:,:) !< Partial derivatives of continuous state + real(R8Ki), allocatable, optional, intent(inout) :: dXddxd(:,:)!< Partial derivatives of discrete state + real(R8Ki), allocatable, optional, intent(inout) :: dZdxd(:,:) !< Partial derivatives of constraint state + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + + ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd): + ! if (present(dYdxd)) then + ! endif + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd): + ! if (present(dXdxd)) then + ! endif + + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd): + ! if (present(dXddxd)) then + ! endif + + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd): + ! if (present(dZdxd)) then + ! endif +end subroutine SeaSt_JacobianPDiscState + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Linearization Jacobians dY/dz, dX/dz, dXd/dz, and dZ/dz +!! No constraint states, so this doesn't do anything +subroutine SeaSt_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) + real(DbKi), intent(in ) :: t !< Time in seconds at operating point + type(SeaSt_InputType), intent(in ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + type(SeaSt_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_ContinuousStateType), intent(in ) :: x !< Continuous states at operating point + type(SeaSt_DiscreteStateType), intent(in ) :: xd !< Discrete states at operating point + type(SeaSt_ConstraintStateType), intent(in ) :: z !< Constraint states at operating point + type(SeaSt_OtherStateType), intent(in ) :: OtherState !< Other states at operating point + type(SeaSt_OutputType), intent(inout) :: y !< Output (change to inout if a mesh copy is required); + type(SeaSt_MiscVarType), intent(inout) :: m !< Misc/optimization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + real(R8Ki), allocatable, optional, intent(inout) :: dYdz(:,:) !< Partial derivatives of output + real(R8Ki), allocatable, optional, intent(inout) :: dXdz(:,:) !< Partial derivatives of continuous + real(R8Ki), allocatable, optional, intent(inout) :: dXddz(:,:) !< Partial derivatives of discrete state + real(R8Ki), allocatable, optional, intent(inout) :: dZdz(:,:) !< Partial derivatives of constraint + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + + ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z): + ! if (present(dYdz)) then + ! endif + + ! Calculate the partial derivative of the continuous state functions (X) with respect to the constraint states (z): + ! if (present(dXdz)) then + ! endif + + ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the constraint states (z): + ! if (present(dXddz)) then + ! endif + + ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z): + ! if (present(dZdz)) then + ! endif +end subroutine SeaSt_JacobianPConstrState + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Linearization operating points u_op, y_op, x_op, dx_op, xd_op, and z_op +subroutine SeaSt_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) + real(DbKi), intent(in ) :: t !< Time in seconds at operating point + type(SeaSt_InputType), intent(in ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + type(SeaSt_ParameterType), intent(in ) :: p !< Parameters + type(SeaSt_ContinuousStateType), intent(in ) :: x !< Continuous states at operating point + type(SeaSt_DiscreteStateType), intent(in ) :: xd !< Discrete states at operating point + type(SeaSt_ConstraintStateType), intent(in ) :: z !< Constraint states at operating point + type(SeaSt_OtherStateType), intent(in ) :: OtherState !< Other states at operating point + type(SeaSt_OutputType), intent(in ) :: y !< Output at operating point + type(SeaSt_MiscVarType), intent(inout) :: m !< Misc/optimization variables + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + real(ReKi), allocatable, optional, intent(inout) :: u_op(:) !< values of linearized inputs + real(ReKi), allocatable, optional, intent(inout) :: y_op(:) !< values of linearized outputs + real(ReKi), allocatable, optional, intent(inout) :: x_op(:) !< values of linearized continuous states + real(ReKi), allocatable, optional, intent(inout) :: dx_op(:) !< values of first time derivatives of linearized continuous states + real(ReKi), allocatable, optional, intent(inout) :: xd_op(:) !< values of linearized discrete states + real(ReKi), allocatable, optional, intent(inout) :: z_op(:) !< values of linearized constraint states + + integer(IntKi) :: idxStart, idxEnd + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_GetOP' + + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = '' + + + if ( present( u_op ) ) then + if (.not. allocated(u_op)) then + call AllocAry(u_op, p%LinParams%Jac_nu, 'u_op', ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! no regular inputs, only extended input + u_op(p%LinParams%Jac_u_idxStartList%Extended) = 0.0_ReKi ! WaveElev0 is zero to be consistent with linearization requirements + ! NOTE: if more extended inputs are added, place them here + end if + + if ( present( y_op ) ) then + if (.not. allocated(y_op)) then + call AllocAry(y_op, p%LinParams%Jac_ny, 'y_op', ErrStat2, ErrMsg2) + if (Failed()) return + end if + + ! no regular outputs, only extended output and WrOuts + y_op(p%LinParams%Jac_y_idxStartList%Extended) = 0.0_ReKi ! WaveElev0 is zero to be consistent with linearization requirements + ! NOTE: if more extended inputs are added, place them here + + ! WrOuts may not be sent to OpenFAST (y_op sized smaller if WrOuts not sent to OpenFAST) + if (p%LinParams%Jac_y_idxStartList%WrOuts <= p%LinParams%Jac_ny) then + idxStart = p%LinParams%Jac_y_idxStartList%WrOuts + idxEnd = p%LinParams%Jac_y_idxStartList%WrOuts + p%NumOuts - 1 + ! unnecessary array check to make me feel better about the potentially sloppy indexing + if (idxEnd > p%LinParams%Jac_ny) then + ErrStat2 = ErrID_Fatal; ErrMsg2 = "Error in the y_op sizing -- u_op not large enough for WrOuts" + if (Failed()) return + endif + ! copy over the returned outputs + y_op(idxStart:idxEnd) = y%WriteOutput(1:p%NumOuts) + endif + end if + + +contains + logical function Failed() + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + Failed = ErrStat >= AbortErrLev + end function Failed +end subroutine SeaSt_GetOP !---------------------------------------------------------------------------------------------------------------------------------- END MODULE SeaState diff --git a/modules/seastate/src/SeaState.txt b/modules/seastate/src/SeaState.txt index 455938b537..f38dfdf231 100644 --- a/modules/seastate/src/SeaState.txt +++ b/modules/seastate/src/SeaState.txt @@ -94,6 +94,13 @@ typedef ^ ^ SiKi Wav typedef ^ ^ SiKi WaveElevVisY {:} - - "Y locations of grid output" "m,-" typedef ^ ^ SiKi WaveElevVisGrid {:}{:}{:} - - "Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second/third dimensions are the grid of points." (m) typedef ^ ^ SeaSt_WaveFieldType *WaveField - - - "Pointer to wave field" +typedef ^ ^ CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - +typedef ^ ^ CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - +typedef ^ ^ LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - +typedef ^ ^ LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - +typedef ^ ^ LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - + + # # @@ -121,6 +128,22 @@ typedef ^ ^ DbKi typedef ^ ^ INTEGER LastIndWave - - - "The last index used in the wave kinematics arrays, used to optimize interpolation" - typedef ^ ^ SeaSt_WaveField_MiscVarType WaveField_m - - - "misc var information from the SeaState Interpolation module" - +# .... Linearization params ....................................................................................................... +# NOTE: This is overkill given how limited linearization is. For completeness and similarity to other modules, keeping all this here. Also note some +# values are set here, but will be overwritten in the code. +typedef ^ Jac_u_idxStarts IntKi Extended - 1 - "Index to first point in u jacobian for Extended" - +typedef ^ Jac_y_idxStarts IntKi Extended - 1 - "Index to first point in y jacobian for Extended" - +typedef ^ Jac_y_idxStarts IntKi WrOuts - 2 - "Index to first point in y jacobian for WrOuts" - +typedef ^ SeaSt_LinParams IntKi NumExtendedInputs - 1 - "number of extended inputs" - +typedef ^ ^ IntKi NumExtendedOutputs - 1 - "number of extended outputs" - +typedef ^ ^ Jac_u_idxStarts Jac_u_idxStartList - - - "Starting indices for all Jac_u components" - +typedef ^ ^ Jac_y_idxStarts Jac_y_idxStartList - - - "Starting indices for all Jac_y components" - +typedef ^ ^ ReKi du {:} - - "vector that determines size of perturbation for u (inputs)" +typedef ^ ^ IntKi Jac_nu - - - "number of inputs in jacobian matrix" - +typedef ^ ^ IntKi Jac_ny - - - "number of outputs in jacobian matrix" - + + + # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: @@ -144,7 +167,9 @@ typedef ^ ^ CHARACTER(20) Out typedef ^ ^ CHARACTER(1) Delim - - - "Delimiter string for outputs, defaults to space" - typedef ^ ^ INTEGER UnOutFile - - - "File unit for the SeaState outputs" - typedef ^ ^ INTEGER OutDec - - - "Write every OutDec time steps" - -typedef ^ ^ SeaSt_WaveFieldType &WaveField - - - "Wave field" +typedef ^ ^ SeaSt_WaveFieldType &WaveField - - - "Wave field" - +typedef ^ ^ SeaSt_LinParams LinParams - - - "Linearization parameters" - + # # # ..... Inputs .................................................................................................................... diff --git a/modules/seastate/src/SeaState_Input.f90 b/modules/seastate/src/SeaState_Input.f90 index a3c27756a4..71daf185e9 100644 --- a/modules/seastate/src/SeaState_Input.f90 +++ b/modules/seastate/src/SeaState_Input.f90 @@ -866,14 +866,17 @@ subroutine SeaStateInput_ProcessInitData( InitInp, p, InputFileData, ErrStat, Er !------------------------------------------------------------------------- ! ConstWaveMod - IF ( ( InputFileData%Waves%ConstWaveMod /= 0 ) .AND. ( InputFileData%Waves%ConstWaveMod /= 1 ) .AND. & - ( InputFileData%Waves%ConstWaveMod /= 2 ) ) THEN - call SetErrStat( ErrID_Fatal,'ConstWaveMod must be 0, 1, or 2.',ErrStat,ErrMsg,RoutineName) - RETURN - END IF + select case(InputFileData%Waves%ConstWaveMod) + case(ConstWaveMod_None) ! 0 + case(ConstWaveMod_CrestElev) ! 1 + case(ConstWaveMod_Peak2Trough) ! 2 + case default + call SetErrStat( ErrID_Fatal,'ConstWaveMod must be 0, 1, or 2.',ErrStat,ErrMsg,RoutineName) + return + end select ! CrestHmax - IF ( ( InputFileData%WaveMod == WaveMod_JONSWAP ) .AND. ( InputFileData%Waves%ConstWaveMod>0 ) .AND. & + IF ( ( InputFileData%WaveMod == WaveMod_JONSWAP ) .AND. ( InputFileData%Waves%ConstWaveMod /= ConstWaveMod_None ) .AND. & ( InputFileData%Waves%CrestHmax < InputFileData%Waves%WaveHs ) ) THEN call SetErrStat( ErrID_Fatal,'CrestHmax must be larger than WaveHs.',ErrStat,ErrMsg,RoutineName) RETURN diff --git a/modules/seastate/src/SeaState_Output.f90 b/modules/seastate/src/SeaState_Output.f90 index 7e0a6d0ebd..96ff2d0f06 100644 --- a/modules/seastate/src/SeaState_Output.f90 +++ b/modules/seastate/src/SeaState_Output.f90 @@ -24,7 +24,6 @@ MODULE SeaState_Output USE NWTC_Library USE SeaState_Types USE Waves ! for WaveNumber - USE VersionInfo IMPLICIT NONE @@ -1023,7 +1022,6 @@ SUBROUTINE SeaStOut_WrSummaryFile(InitInp, InputFileData, p, ErrStat, ErrMsg ) WRITE (UnSum,'(/,A/)', IOSTAT=ErrStat2) 'This summary file was generated by '//trim(SeaSt_ProgDesc%Name)//' on '//CurDate()//' at '//CurTime()//'.' - WRITE( UnSum, '(A/)') trim(GetVersion(SeaSt_ProgDesc)) IF (InputFileData%WaveMod /= WaveMod_None .and. InputFileData%WaveMod /= WaveMod_ExtFull) THEN WRITE( UnSum, '(1X,A61,F8.2,A4/)' ) 'The Mean Sea Level to Still Water Level (MSL2SWL) Offset is :',p%WaveField%MSL2SWL,' (m)' diff --git a/modules/seastate/src/SeaState_Types.f90 b/modules/seastate/src/SeaState_Types.f90 index f5d01aa62e..fa16c449bb 100644 --- a/modules/seastate/src/SeaState_Types.f90 +++ b/modules/seastate/src/SeaState_Types.f90 @@ -114,6 +114,11 @@ MODULE SeaState_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: WaveElevVisY !< Y locations of grid output [m,-] REAL(SiKi) , DIMENSION(:,:,:), ALLOCATABLE :: WaveElevVisGrid !< Wave elevation time-series at each of the points given by WaveElevXY. First dimension is the timestep. Second/third dimensions are the grid of points. [(m)] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Pointer to wave field [-] + CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_y !< Names of the outputs used in linearization [-] + CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: LinNames_u !< Names of the inputs used in linearization [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_u !< Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: RotFrame_y !< Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame [-] + LOGICAL , DIMENSION(:), ALLOCATABLE :: IsLoad_u !< Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix) [-] END TYPE SeaSt_InitOutputType ! ======================= ! ========= SeaSt_ContinuousStateType ======= @@ -144,6 +149,28 @@ MODULE SeaState_Types TYPE(SeaSt_WaveField_MiscVarType) :: WaveField_m !< misc var information from the SeaState Interpolation module [-] END TYPE SeaSt_MiscVarType ! ======================= +! ========= Jac_u_idxStarts ======= + TYPE, PUBLIC :: Jac_u_idxStarts + INTEGER(IntKi) :: Extended = 1 !< Index to first point in u jacobian for Extended [-] + END TYPE Jac_u_idxStarts +! ======================= +! ========= Jac_y_idxStarts ======= + TYPE, PUBLIC :: Jac_y_idxStarts + INTEGER(IntKi) :: Extended = 1 !< Index to first point in y jacobian for Extended [-] + INTEGER(IntKi) :: WrOuts = 2 !< Index to first point in y jacobian for WrOuts [-] + END TYPE Jac_y_idxStarts +! ======================= +! ========= SeaSt_LinParams ======= + TYPE, PUBLIC :: SeaSt_LinParams + INTEGER(IntKi) :: NumExtendedInputs = 1 !< number of extended inputs [-] + INTEGER(IntKi) :: NumExtendedOutputs = 1 !< number of extended outputs [-] + TYPE(Jac_u_idxStarts) :: Jac_u_idxStartList !< Starting indices for all Jac_u components [-] + TYPE(Jac_y_idxStarts) :: Jac_y_idxStartList !< Starting indices for all Jac_y components [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] + INTEGER(IntKi) :: Jac_nu = 0_IntKi !< number of inputs in jacobian matrix [-] + INTEGER(IntKi) :: Jac_ny = 0_IntKi !< number of outputs in jacobian matrix [-] + END TYPE SeaSt_LinParams +! ======================= ! ========= SeaSt_ParameterType ======= TYPE, PUBLIC :: SeaSt_ParameterType REAL(DbKi) :: WaveDT = 0.0_R8Ki !< Wave DT [sec] @@ -166,6 +193,7 @@ MODULE SeaState_Types INTEGER(IntKi) :: UnOutFile = 0_IntKi !< File unit for the SeaState outputs [-] INTEGER(IntKi) :: OutDec = 0_IntKi !< Write every OutDec time steps [-] TYPE(SeaSt_WaveFieldType) , POINTER :: WaveField => NULL() !< Wave field [-] + TYPE(SeaSt_LinParams) :: LinParams !< Linearization parameters [-] END TYPE SeaSt_ParameterType ! ======================= ! ========= SeaSt_InputType ======= @@ -616,6 +644,66 @@ subroutine SeaSt_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%WaveElevVisGrid = SrcInitOutputData%WaveElevVisGrid end if DstInitOutputData%WaveField => SrcInitOutputData%WaveField + if (allocated(SrcInitOutputData%LinNames_y)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_y, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_y, kind=B8Ki) + if (.not. allocated(DstInitOutputData%LinNames_y)) then + allocate(DstInitOutputData%LinNames_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_y = SrcInitOutputData%LinNames_y + end if + if (allocated(SrcInitOutputData%LinNames_u)) then + LB(1:1) = lbound(SrcInitOutputData%LinNames_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%LinNames_u, kind=B8Ki) + if (.not. allocated(DstInitOutputData%LinNames_u)) then + allocate(DstInitOutputData%LinNames_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%LinNames_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%LinNames_u = SrcInitOutputData%LinNames_u + end if + if (allocated(SrcInitOutputData%RotFrame_u)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_u, kind=B8Ki) + if (.not. allocated(DstInitOutputData%RotFrame_u)) then + allocate(DstInitOutputData%RotFrame_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_u = SrcInitOutputData%RotFrame_u + end if + if (allocated(SrcInitOutputData%RotFrame_y)) then + LB(1:1) = lbound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%RotFrame_y, kind=B8Ki) + if (.not. allocated(DstInitOutputData%RotFrame_y)) then + allocate(DstInitOutputData%RotFrame_y(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%RotFrame_y.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%RotFrame_y = SrcInitOutputData%RotFrame_y + end if + if (allocated(SrcInitOutputData%IsLoad_u)) then + LB(1:1) = lbound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + UB(1:1) = ubound(SrcInitOutputData%IsLoad_u, kind=B8Ki) + if (.not. allocated(DstInitOutputData%IsLoad_u)) then + allocate(DstInitOutputData%IsLoad_u(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%IsLoad_u.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstInitOutputData%IsLoad_u = SrcInitOutputData%IsLoad_u + end if end subroutine subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) @@ -645,6 +733,21 @@ subroutine SeaSt_DestroyInitOutput(InitOutputData, ErrStat, ErrMsg) deallocate(InitOutputData%WaveElevVisGrid) end if nullify(InitOutputData%WaveField) + if (allocated(InitOutputData%LinNames_y)) then + deallocate(InitOutputData%LinNames_y) + end if + if (allocated(InitOutputData%LinNames_u)) then + deallocate(InitOutputData%LinNames_u) + end if + if (allocated(InitOutputData%RotFrame_u)) then + deallocate(InitOutputData%RotFrame_u) + end if + if (allocated(InitOutputData%RotFrame_y)) then + deallocate(InitOutputData%RotFrame_y) + end if + if (allocated(InitOutputData%IsLoad_u)) then + deallocate(InitOutputData%IsLoad_u) + end if end subroutine subroutine SeaSt_PackInitOutput(RF, Indata) @@ -667,6 +770,11 @@ subroutine SeaSt_PackInitOutput(RF, Indata) call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if + call RegPackAlloc(RF, InData%LinNames_y) + call RegPackAlloc(RF, InData%LinNames_u) + call RegPackAlloc(RF, InData%RotFrame_u) + call RegPackAlloc(RF, InData%RotFrame_y) + call RegPackAlloc(RF, InData%IsLoad_u) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -705,6 +813,11 @@ subroutine SeaSt_UnPackInitOutput(RF, OutData) else OutData%WaveField => null() end if + call RegUnpackAlloc(RF, OutData%LinNames_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%LinNames_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_u); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotFrame_y); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%IsLoad_u); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SeaSt_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -914,6 +1027,171 @@ subroutine SeaSt_UnPackMisc(RF, OutData) call SeaSt_WaveField_UnpackMisc(RF, OutData%WaveField_m) ! WaveField_m end subroutine +subroutine SeaSt_CopyJac_u_idxStarts(SrcJac_u_idxStartsData, DstJac_u_idxStartsData, CtrlCode, ErrStat, ErrMsg) + type(Jac_u_idxStarts), intent(in) :: SrcJac_u_idxStartsData + type(Jac_u_idxStarts), intent(inout) :: DstJac_u_idxStartsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_CopyJac_u_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' + DstJac_u_idxStartsData%Extended = SrcJac_u_idxStartsData%Extended +end subroutine + +subroutine SeaSt_DestroyJac_u_idxStarts(Jac_u_idxStartsData, ErrStat, ErrMsg) + type(Jac_u_idxStarts), intent(inout) :: Jac_u_idxStartsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyJac_u_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_PackJac_u_idxStarts(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Jac_u_idxStarts), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackJac_u_idxStarts' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Extended) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackJac_u_idxStarts(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Jac_u_idxStarts), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackJac_u_idxStarts' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Extended); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyJac_y_idxStarts(SrcJac_y_idxStartsData, DstJac_y_idxStartsData, CtrlCode, ErrStat, ErrMsg) + type(Jac_y_idxStarts), intent(in) :: SrcJac_y_idxStartsData + type(Jac_y_idxStarts), intent(inout) :: DstJac_y_idxStartsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_CopyJac_y_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' + DstJac_y_idxStartsData%Extended = SrcJac_y_idxStartsData%Extended + DstJac_y_idxStartsData%WrOuts = SrcJac_y_idxStartsData%WrOuts +end subroutine + +subroutine SeaSt_DestroyJac_y_idxStarts(Jac_y_idxStartsData, ErrStat, ErrMsg) + type(Jac_y_idxStarts), intent(inout) :: Jac_y_idxStartsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + character(*), parameter :: RoutineName = 'SeaSt_DestroyJac_y_idxStarts' + ErrStat = ErrID_None + ErrMsg = '' +end subroutine + +subroutine SeaSt_PackJac_y_idxStarts(RF, Indata) + type(RegFile), intent(inout) :: RF + type(Jac_y_idxStarts), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackJac_y_idxStarts' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%Extended) + call RegPack(RF, InData%WrOuts) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackJac_y_idxStarts(RF, OutData) + type(RegFile), intent(inout) :: RF + type(Jac_y_idxStarts), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackJac_y_idxStarts' + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%Extended); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%WrOuts); if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_CopyLinParams(SrcLinParamsData, DstLinParamsData, CtrlCode, ErrStat, ErrMsg) + type(SeaSt_LinParams), intent(in) :: SrcLinParamsData + type(SeaSt_LinParams), intent(inout) :: DstLinParamsData + integer(IntKi), intent(in ) :: CtrlCode + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_CopyLinParams' + ErrStat = ErrID_None + ErrMsg = '' + DstLinParamsData%NumExtendedInputs = SrcLinParamsData%NumExtendedInputs + DstLinParamsData%NumExtendedOutputs = SrcLinParamsData%NumExtendedOutputs + call SeaSt_CopyJac_u_idxStarts(SrcLinParamsData%Jac_u_idxStartList, DstLinParamsData%Jac_u_idxStartList, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + call SeaSt_CopyJac_y_idxStarts(SrcLinParamsData%Jac_y_idxStartList, DstLinParamsData%Jac_y_idxStartList, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return + if (allocated(SrcLinParamsData%du)) then + LB(1:1) = lbound(SrcLinParamsData%du, kind=B8Ki) + UB(1:1) = ubound(SrcLinParamsData%du, kind=B8Ki) + if (.not. allocated(DstLinParamsData%du)) then + allocate(DstLinParamsData%du(LB(1):UB(1)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstLinParamsData%du.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstLinParamsData%du = SrcLinParamsData%du + end if + DstLinParamsData%Jac_nu = SrcLinParamsData%Jac_nu + DstLinParamsData%Jac_ny = SrcLinParamsData%Jac_ny +end subroutine + +subroutine SeaSt_DestroyLinParams(LinParamsData, ErrStat, ErrMsg) + type(SeaSt_LinParams), intent(inout) :: LinParamsData + integer(IntKi), intent( out) :: ErrStat + character(*), intent( out) :: ErrMsg + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SeaSt_DestroyLinParams' + ErrStat = ErrID_None + ErrMsg = '' + call SeaSt_DestroyJac_u_idxStarts(LinParamsData%Jac_u_idxStartList, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + call SeaSt_DestroyJac_y_idxStarts(LinParamsData%Jac_y_idxStartList, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (allocated(LinParamsData%du)) then + deallocate(LinParamsData%du) + end if +end subroutine + +subroutine SeaSt_PackLinParams(RF, Indata) + type(RegFile), intent(inout) :: RF + type(SeaSt_LinParams), intent(in) :: InData + character(*), parameter :: RoutineName = 'SeaSt_PackLinParams' + if (RF%ErrStat >= AbortErrLev) return + call RegPack(RF, InData%NumExtendedInputs) + call RegPack(RF, InData%NumExtendedOutputs) + call SeaSt_PackJac_u_idxStarts(RF, InData%Jac_u_idxStartList) + call SeaSt_PackJac_y_idxStarts(RF, InData%Jac_y_idxStartList) + call RegPackAlloc(RF, InData%du) + call RegPack(RF, InData%Jac_nu) + call RegPack(RF, InData%Jac_ny) + if (RegCheckErr(RF, RoutineName)) return +end subroutine + +subroutine SeaSt_UnPackLinParams(RF, OutData) + type(RegFile), intent(inout) :: RF + type(SeaSt_LinParams), intent(inout) :: OutData + character(*), parameter :: RoutineName = 'SeaSt_UnPackLinParams' + integer(B8Ki) :: LB(1), UB(1) + integer(IntKi) :: stat + logical :: IsAllocAssoc + if (RF%ErrStat /= ErrID_None) return + call RegUnpack(RF, OutData%NumExtendedInputs); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumExtendedOutputs); if (RegCheckErr(RF, RoutineName)) return + call SeaSt_UnpackJac_u_idxStarts(RF, OutData%Jac_u_idxStartList) ! Jac_u_idxStartList + call SeaSt_UnpackJac_y_idxStarts(RF, OutData%Jac_y_idxStartList) ! Jac_y_idxStartList + call RegUnpackAlloc(RF, OutData%du); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_nu); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Jac_ny); if (RegCheckErr(RF, RoutineName)) return +end subroutine + subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) type(SeaSt_ParameterType), intent(in) :: SrcParamData type(SeaSt_ParameterType), intent(inout) :: DstParamData @@ -1028,6 +1306,9 @@ subroutine SeaSt_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return end if + call SeaSt_CopyLinParams(SrcParamData%LinParams, DstParamData%LinParams, CtrlCode, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if (ErrStat >= AbortErrLev) return end subroutine subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -1071,6 +1352,8 @@ subroutine SeaSt_DestroyParam(ParamData, ErrStat, ErrMsg) deallocate(ParamData%WaveField) ParamData%WaveField => null() end if + call SeaSt_DestroyLinParams(ParamData%LinParams, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine SeaSt_PackParam(RF, Indata) @@ -1115,6 +1398,7 @@ subroutine SeaSt_PackParam(RF, Indata) call SeaSt_WaveField_PackSeaSt_WaveFieldType(RF, InData%WaveField) end if end if + call SeaSt_PackLinParams(RF, InData%LinParams) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1178,6 +1462,7 @@ subroutine SeaSt_UnPackParam(RF, OutData) else OutData%WaveField => null() end if + call SeaSt_UnpackLinParams(RF, OutData%LinParams) ! LinParams end subroutine subroutine SeaSt_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg) diff --git a/modules/seastate/src/Waves.f90 b/modules/seastate/src/Waves.f90 index 15998ac18f..405b35e2ab 100644 --- a/modules/seastate/src/Waves.f90 +++ b/modules/seastate/src/Waves.f90 @@ -909,8 +909,8 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, WaveField, ErrStat, ErrMsg ) !-------------------------------------------------------------------------------- !=== Constrained New Waves === ! Modify the wave components to implement the constrained wave - ! Only do this if WaveMod = 2 (JONSWAP/Pierson-Moskowitz Spectrum) and ConstWaveMod > 0 - IF ( WaveField%WaveMod == WaveMod_JONSWAP .AND. InitInp%ConstWaveMod > 0) THEN + ! Only do this if WaveMod = 2 (JONSWAP/Pierson-Moskowitz Spectrum) and ConstWaveMod /= ConstWaveMod_None + IF ( WaveField%WaveMod == WaveMod_JONSWAP .AND. InitInp%ConstWaveMod /= ConstWaveMod_None ) THEN ! adjust InitOut%WaveElevC0 for constrained wave: call ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddArr, CosWaveDir, SinWaveDir, FFT_Data, ErrStatTmp, ErrMsgTmp) call SetErrStat(ErrStatTmp,ErrMsgTmp, ErrStat,ErrMsg,RoutineName) @@ -2188,7 +2188,7 @@ SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddA REAL(SiKi) :: Trough !< The trough preceding or following the crest, whichever is lower (m) REAL(SiKi) :: m0 !< Zeroth spectral moment of the wave spectrum (m^2) REAL(SiKi) :: m2 !< First spectral moment of the wave spectrum (m^2(rad/s)^2) - REAL(SiKi) :: CrestHeightTol = 1.0E-3 !< Relative tolerance for the crest height when ConstWaveMod = 2 + REAL(SiKi) :: CrestHeightTol = 1.0E-3 !< Relative tolerance for the crest height when ConstWaveMod = ConstWaveMod_Peak2Trough (2) INTEGER(IntKi) :: NStepTp !< Number of time steps per peak period when waveMod = 2 (-) INTEGER(IntKi) :: Iter !< Number of iterations when trying to meet the prescribed crest height (-) INTEGER(IntKi) :: MaxCrestIter = 20 !< Maximum number of iterations when trying to meet the prescribed crest height (-) @@ -2221,12 +2221,12 @@ SUBROUTINE ConstrainedNewWaves(InitInp, InitOut, WaveField, OmegaArr, WaveS1SddA Crest = 0.5_SiKi * InitInp%CrestHmax ! Set crest elevation to half of crest height tmpArr = WaveField%NStepWave2/m0 * WaveField%WaveDOmega * WaveS1SddArr - IF (InitInp%ConstWaveMod == 1) THEN ! Crest elevation prescribed + IF (InitInp%ConstWaveMod == ConstWaveMod_CrestElev) THEN ! Crest elevation prescribed ! Apply the remaining part of the modification proportional to crest elevation WaveField%WaveElevC0(1,:) = WaveField%WaveElevC0(1,:) + Crest * tmpArr - ELSE IF (InitInp%ConstWaveMod == 2) THEN ! Crest height prescribed - Need to interate + ELSE IF (InitInp%ConstWaveMod == ConstWaveMod_Peak2Trough) THEN ! Crest height prescribed - Need to interate NStepTp = CEILING(InitInp%WaveTp/InitInp%WaveDT) diff --git a/reg_tests/CTestList.cmake b/reg_tests/CTestList.cmake index 924f6f80a3..07b182092d 100644 --- a/reg_tests/CTestList.cmake +++ b/reg_tests/CTestList.cmake @@ -348,9 +348,9 @@ of_regression_aeroacoustic("IEA_LB_RWT-AeroAcoustics" "openfast;aerodyn15;aeroa of_regression_linear("WP_Stationary_Linear" "" "openfast;linear;elastodyn") of_regression_linear("Ideal_Beam_Fixed_Free_Linear" "-highpass=0.10" "openfast;linear;beamdyn") of_regression_linear("Ideal_Beam_Free_Free_Linear" "-highpass=0.10" "openfast;linear;beamdyn") -#of_regression_linear("5MW_Land_Linear_Aero" "-highpass=0.05" "openfast;linear;elastodyn;servodyn;aerodyn") +of_regression_linear("5MW_Land_Linear_Aero" "-highpass=0.25" "openfast;linear;elastodyn;servodyn;aerodyn") of_regression_linear("5MW_Land_BD_Linear" "" "openfast;linear;beamdyn;servodyn") -#of_regression_linear("5MW_Land_BD_Linear_Aero" "-highpass=0.05" "openfast;linear;beamdyn;servodyn;aerodyn") +of_regression_linear("5MW_Land_BD_Linear_Aero" "-highpass=0.25" "openfast;linear;beamdyn;servodyn;aerodyn") of_regression_linear("5MW_OC4Semi_Linear" "" "openfast;linear;hydrodyn;servodyn;map") of_regression_linear("5MW_OC4Semi_MD_Linear" "" "openfast;linear;hydrodyn;servodyn;moordyn") of_regression_linear("StC_test_OC4Semi_Linear_Nac" "" "openfast;linear;servodyn;stc") diff --git a/reg_tests/executeOpenfastLinearRegressionCase.py b/reg_tests/executeOpenfastLinearRegressionCase.py index 9223304bef..91f43062b3 100644 --- a/reg_tests/executeOpenfastLinearRegressionCase.py +++ b/reg_tests/executeOpenfastLinearRegressionCase.py @@ -88,7 +88,7 @@ def isclose(a, b, rtol=1e-09, atol=0.0): # is between 1e-3 and 1e-4. We allow a bit of margin and use rtol=2e-3 # Lin matrices have a lot of small values, so atol is quite important rtol = 2e-3 -atol = 1e-5 +atol = 5e-4 # --- Tolerances for frequencies # Low frequencies are hard to match, so we use a high atol diff --git a/reg_tests/r-test b/reg_tests/r-test index e31443e859..e739a1885d 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit e31443e859b345603524f972b0e463fb2bfac95a +Subproject commit e739a1885d66a6f3b5ee0af535c0685ee6c43ba6