@@ -248,11 +248,15 @@ SUBROUTINE AdaptiveEnvelopeProtectionSystem(LocalVar, CntrPar, objInst, PerfData
248248
249249 ENDIF
250250
251- ! NOTE: Calculation of the Thrust (Estimate) of the controlled turbine is realized under the subroutine of WindSpeedEstimator
251+ ! NOTE: Calculation of the Thrust (Estimate) of the controlled turbine is realized under the subroutine of WindSpeedEstimator
252252
253- ! Adaptive EPS Algorithm Starts from Here
253+ ! Adaptive EPS Algorithm Starts from Here
254254
255- P = 0.5 / CntrPar% Kc ! Solution of Lyapunov Equation (-K)'*P+P*(-K)=-I
255+ LocalVar% ASO_PitchOffset = 0.0_DbKi ! Initialize the extra pitch angle output
256+
257+ if (CntrPar% ASO_UseNN > 0 ) THEN
258+
259+ P = 0.5 / CntrPar% Kc ! Solution of Lyapunov Equation (-K)'*P+P*(-K)=-I
256260
257261 ! Kronecker product calculation (del = D1 ⊗ D2)
258262 bias = 1.0
@@ -272,7 +276,7 @@ SUBROUTINE AdaptiveEnvelopeProtectionSystem(LocalVar, CntrPar, objInst, PerfData
272276 del((i-1 )* 2 + j) = 1.0_DbKi / (1.0_DbKi + exp (- del((i-1 )* 2 + j)))
273277 end do
274278 end do
275-
279+
276280 ! Compute the Derivative of Weight
277281 do i = 1 , n
278282 dWeght_dt(i) = CntrPar% gamma * (del(i) * LocalVar% T_err * P - CntrPar% ke * Weght(i) * abs (LocalVar% T_err))
@@ -288,7 +292,7 @@ SUBROUTINE AdaptiveEnvelopeProtectionSystem(LocalVar, CntrPar, objInst, PerfData
288292
289293 ! Compute the Derivative of Thrust estimate (ASO_ThrustNN)
290294 Thrst_es_dt = a_s * LocalVar% ASO_ThrustNN + b_s * LocalVar% We_Vw + LocalVar% Delta + CntrPar% Kc * LocalVar% T_err
291-
295+
292296 ! Update ASO_ThrustNN using Euler's method
293297 LocalVar% ASO_ThrustNN = LocalVar% ASO_ThrustNN + Thrst_es_dt * LocalVar% DT ! ASO_ThrustNN in Mega Newton
294298 LocalVar% Thrst_esN= LocalVar% ASO_ThrustNN * (10 ** 6 ) ! ASO_ThrustNN in Newton
@@ -298,40 +302,11 @@ SUBROUTINE AdaptiveEnvelopeProtectionSystem(LocalVar, CntrPar, objInst, PerfData
298302
299303 ! Calculate the Adaptation
300304 LocalVar% Adp = LocalVar% Delta + CntrPar% Kc * LocalVar% T_err
301-
305+
302306 ! Calculate the Derivative of Thrust Estimate
303307 Pre_Thrst_es = LocalVar% ASO_ThrustNN - Thrst_es_dt * LocalVar% DT
304308 LocalVar% Tdot = (LocalVar% ASO_ThrustNN - Pre_Thrst_es) / LocalVar% DT
305309
306- if (CntrPar% ASO_Mode == 0 ) then
307- LocalVar% ASO_PitchOffset = 0
308-
309- else if (CntrPar% ASO_Mode == 1 .and. LocalVar% time >= CntrPar% ASO_StartTime) then
310-
311- ! Detecting the Excessive Thrust Force and Generating Extra Blade Pitch Output
312- ! if (LocalVar%We_Vw - LocalVar%Uenv >= 0) then
313- if (LocalVar% We_Vw - LocalVar% Uenv >= - CntrPar% Um) then
314- ! LocalVar%ASO_PitchOffset = CntrPar%ASO_ThrustGain * (LocalVar%We_Vw - LocalVar%Uenv)
315- LocalVar% ASO_PitchOffset = CntrPar% ASO_ThrustGain * abs (LocalVar% We_Vw - (LocalVar% Uenv- CntrPar% Um))
316-
317- else
318- LocalVar% ASO_PitchOffset = 0
319- end if
320-
321- else if (CntrPar% ASO_Mode == 2 ) then
322-
323- if (LocalVar% ASO_ThrustEst - CntrPar% ASO_ThrustLim >= - CntrPar% Tm* CntrPar% ASO_ThrustLim) then
324- LocalVar% ASO_PitchOffset = CntrPar% ASO_ThrustGain * abs (LocalVar% ASO_ThrustEst - (CntrPar% ASO_ThrustLim- CntrPar% Tm* CntrPar% ASO_ThrustLim))
325- else
326- LocalVar% ASO_PitchOffset = 0
327- end if
328-
329- else if (CntrPar% ASO_Mode == 3 ) then
330-
331- print * , " Design ASCOS system"
332-
333- end if
334-
335310 ! Envelope wind speed calculation
336311 Es = 0.01 ! Uenv tolerance
337312 LocalVar% Uold = LocalVar% Uenv
@@ -345,7 +320,30 @@ SUBROUTINE AdaptiveEnvelopeProtectionSystem(LocalVar, CntrPar, objInst, PerfData
345320 LocalVar% Uold = LocalVar% Uenv
346321 m = m + 1
347322
348- end do
323+ end do
324+
325+ if (LocalVar% time >= CntrPar% ASO_StartTime) then
326+
327+ ! Detecting the Excessive Thrust Force and Generating Extra Blade Pitch Output
328+ ! if (LocalVar%We_Vw - LocalVar%Uenv >= 0) then
329+ if (LocalVar% We_Vw - LocalVar% Uenv >= - CntrPar% Um) then
330+ ! LocalVar%ASO_PitchOffset = CntrPar%ASO_ThrustGain * (LocalVar%We_Vw - LocalVar%Uenv)
331+ LocalVar% ASO_PitchOffset = CntrPar% ASO_ThrustGain * abs (LocalVar% We_Vw - (LocalVar% Uenv- CntrPar% Um))
332+
333+ endif
334+ endif
335+
336+ else ! Use plain thrust esimate from WSE
337+
338+ if ((LocalVar% time >= CntrPar% ASO_StartTime) .AND. (LocalVar% ASO_ThrustEst > CntrPar% ASO_ThrustLim * (1 - CntrPar% Tm))) then
339+ LocalVar% ASO_PitchOffset = CntrPar% ASO_ThrustGain * abs (LocalVar% ASO_ThrustEst - (CntrPar% ASO_ThrustLim- CntrPar% Tm* CntrPar% ASO_ThrustLim))
340+ else
341+ LocalVar% ASO_PitchOffset = 0
342+ end if
343+
344+ endif
345+
346+
349347
350348 ! Adaptive EPS Algorithm Ends Here
351349
0 commit comments