Skip to content

Commit

Permalink
Rename to pitch saturation
Browse files Browse the repository at this point in the history
  • Loading branch information
nikhar-abbas committed Nov 19, 2019
1 parent 6c3ad82 commit ca63d61
Show file tree
Hide file tree
Showing 3 changed files with 7 additions and 7 deletions.
10 changes: 5 additions & 5 deletions src/ControllerBlocks.f90
Original file line number Diff line number Diff line change
Expand Up @@ -269,10 +269,10 @@ SUBROUTINE SetpointSmoother(LocalVar, CntrPar, objInst)

END SUBROUTINE SetpointSmoother
!-------------------------------------------------------------------------------------------------------------------------------
REAL FUNCTION PeakShaving(LocalVar, CntrPar, objInst)
! PeakShaving defines a minimum blade pitch angle based on a lookup table provided by DISON.IN
REAL FUNCTION PitchSaturation(LocalVar, CntrPar, objInst)
! PitchSaturation defines a minimum blade pitch angle based on a lookup table provided by DISCON.IN
! SS_Mode = 0, No setpoint smoothing
! SS_Mode = 1, Implement setpoint smoothing
! SS_Mode = 1, Implement pitch saturation
USE ROSCO_Types, ONLY : LocalVariables, ControlParameters, ObjectInstances
IMPLICIT NONE
! Inputs
Expand All @@ -293,9 +293,9 @@ REAL FUNCTION PeakShaving(LocalVar, CntrPar, objInst)
Vhatf = LPFilter(Vhat,LocalVar%DT,0.2,LocalVar%iStatus,.FALSE.,objInst%instLPF)
LocalVar%TestType = Vhatf
! Define minimum blade pitch angle as a function of estimated wind speed
PeakShaving = interp1d(CntrPar%PS_WindSpeeds, CntrPar%PS_BldPitchMin, Vhatf)
PitchSaturation = interp1d(CntrPar%PS_WindSpeeds, CntrPar%PS_BldPitchMin, Vhatf)

END FUNCTION PeakShaving
END FUNCTION PitchSaturation
!-------------------------------------------------------------------------------------------------------------------------------
REAL FUNCTION Shutdown(LocalVar, CntrPar, objInst)
! PeakShaving defines a minimum blade pitch angle based on a lookup table provided by DISON.IN
Expand Down
2 changes: 1 addition & 1 deletion src/Controllers.f90
Original file line number Diff line number Diff line change
Expand Up @@ -93,7 +93,7 @@ SUBROUTINE PitchControl(avrSWAP, CntrPar, LocalVar, objInst)

! Peak Shaving
IF (CntrPar%PS_Mode == 1) THEN
LocalVar%PC_MinPit = PeakShaving(LocalVar,CntrPar,objInst)
LocalVar%PC_MinPit = PitchSaturation(LocalVar,CntrPar,objInst)
ELSE
LocalVar%PC_MinPit = CntrPar%PC_MinPit
ENDIF
Expand Down
2 changes: 1 addition & 1 deletion src/ROSCO_Types.f90
Original file line number Diff line number Diff line change
Expand Up @@ -108,7 +108,7 @@ MODULE ROSCO_Types
REAL(4) :: Z_PitchAmplitude ! Amplitude of sine pitch excitation
REAL(4) :: Z_PitchFrequency ! Frequency of sine pitch excitation

INTEGER(4) :: PS_Mode ! Peak shaving mode {0: no peak shaving, 1: implement peak shaving}
INTEGER(4) :: PS_Mode ! Pitch saturation mode {0: no peak shaving, 1: implement pitch saturation}
INTEGER(4) :: PS_BldPitchMin_N ! Number of values in minimum blade pitch lookup table (should equal number of values in PS_WindSpeeds and PS_BldPitchMin)
REAL(4), DIMENSION(:), ALLOCATABLE :: PS_WindSpeeds ! Wind speeds corresponding to minimum blade pitch angles [m/s]
REAL(4), DIMENSION(:), ALLOCATABLE :: PS_BldPitchMin ! Minimum blade pitch angles [rad]
Expand Down

0 comments on commit ca63d61

Please sign in to comment.