From 0ada500cf6ef8ac77d35d5cf19606359f5741d6c Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Thu, 30 Nov 2023 18:14:26 -0700 Subject: [PATCH] AD: SkewMod=0,1,2, <> Skew_Mod=-1,0,1 --- modules/aerodyn/src/AeroDyn.f90 | 10 ++--- modules/aerodyn/src/AeroDyn_IO.f90 | 47 ++++++++++++++++++------ modules/aerodyn/src/AeroDyn_Registry.txt | 4 +- modules/aerodyn/src/AeroDyn_Types.f90 | 18 ++++----- modules/aerodyn/src/BEMT.f90 | 2 +- modules/aerodyn/src/BEMT_Registry.txt | 13 +++---- modules/aerodyn/src/BEMT_Types.f90 | 13 +++---- 7 files changed, 62 insertions(+), 45 deletions(-) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index b77cc29bf8..185c7f769b 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -365,7 +365,7 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! set the rest of the parameters - p%SkewMod = InputFileData%SkewMod + p%Skew_Mod = InputFileData%Skew_Mod do iR = 1, nRotors p%rotors(iR)%AeroProjMod = InitInp%rotors(iR)%AeroProjMod !p%rotors(iR)%AeroProjMod = AeroProjMod(iR) @@ -2679,7 +2679,7 @@ subroutine SetDisturbedInflow(p, p_AD, u, m, errStat, errMsg) end do end if - if (p_AD%SkewMod == SkewMod_Orthogonal) then + if (p_AD%Skew_Mod == Skew_Mod_Orthogonal) then x_hat_disk = u%HubMotion%Orientation(1,:,1) do k=1,p%NumBlades @@ -3847,8 +3847,8 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) if ( InputFileData%IndToler < 0.0 .or. EqualRealNos(InputFileData%IndToler, 0.0_ReKi) ) & call SetErrStat( ErrID_Fatal, 'IndToler must be greater than 0.', ErrStat, ErrMsg, RoutineName ) - if ( InputFileData%SkewMod /= SkewMod_Orthogonal .and. InputFileData%SkewMod /= SkewMod_Uncoupled .and. InputFileData%SkewMod /= SkewMod_PittPeters) & ! .and. InputFileData%SkewMod /= SkewMod_Coupled ) - call SetErrStat( ErrID_Fatal, 'SkewMod must be 1, or 2. Option 3 will be implemented in a future version.', ErrStat, ErrMsg, RoutineName ) + if ( InputFileData%Skew_Mod /= Skew_Mod_Orthogonal .and. InputFileData%Skew_Mod /= Skew_Mod_None .and. InputFileData%Skew_Mod /= Skew_Mod_Glauert) & + call SetErrStat( ErrID_Fatal, 'Skew_Mod must be -1, 0, or 1.', ErrStat, ErrMsg, RoutineName ) if ( InputFileData%SectAvg) then if (InputFileData%SA_nPerSec <= 1) call SetErrStat(ErrID_Fatal, 'SA_nPerSec must be >=1', ErrStat, ErrMsg, RoutineName) @@ -4294,7 +4294,7 @@ SUBROUTINE Init_BEMTmodule( InputFileData, RotInputFileData, u_AD, u, p, p_AD, x InitInp%airDens = InputFileData%AirDens InitInp%kinVisc = InputFileData%KinVisc - InitInp%skewWakeMod = InputFileData%SkewMod + InitInp%skewWakeMod = InputFileData%Skew_Mod InitInp%yawCorrFactor = InputFileData%SkewModFactor InitInp%aTol = InputFileData%IndToler InitInp%useTipLoss = InputFileData%TipLoss diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index 4247219387..4c9eb931eb 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -659,7 +659,7 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade integer(IntKi) :: CurLine !< current entry in FileInfo_In%Lines array real(ReKi) :: TmpRe5(5) !< temporary 8 number array for reading values in character(1024) :: sDummy !< temporary string - logical :: frozenWakeProvided, AFAeroModProvided, isLegalComment, firstWarn !< Temporary for legacy purposes + logical :: frozenWakeProvided, skewModProvided, AFAeroModProvided, isLegalComment, firstWarn !< Temporary for legacy purposes character(*), parameter :: RoutineName = 'ParsePrimaryFileInfo' @@ -765,9 +765,20 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade InputFileData%BEM_Mod = BEMMod_2D endif - ! SkewMod - Select skew model {0: No skew model at all, -1:Throw away non-normal component for linearization, 1: Glauert skew model, } + ! SkewMod Legacy call ParseVar( FileInfo_In, CurLine, "SkewMod", InputFileData%SkewMod, ErrStat2, ErrMsg2, UnEc ) - if (Failed()) return + skewModProvided = legacyInputPresent('SkewMod', CurLine, ErrStat2, ErrMsg2, 'Skew_Mod=-1 (SkewMod=0), Skew_Mod=0 (SkewMod=1), Skew_Mod=1 (SkewMod>=2)') + ! Skew_Mod- Select skew model {0: No skew model at all, -1:Throw away non-normal component for linearization, 1: Glauert skew model, } + call ParseVar( FileInfo_In, CurLine, "Skew_Mod", InputFileData%Skew_Mod, ErrStat2, ErrMsg2, UnEc ) + if (newInputAbsent('Skew_Mod', CurLine, errStat2, errMsg2)) then + call WrScr(' Setting Skew_Mod to 1 (skew active, Gluaert) as the input is absent (typical behavior).') + InputFileData%Skew_Mod = Skew_Mod_Glauert + else + if (skewModProvided) then + call LegacyAbort('Cannot have both Skew_Mod and SkewMod in the input file'); return + endif + endif + ! SkewMomCorr - Turn the skew momentum correction on or off [used only when SkewMod=1] call ParseVar( FileInfo_In, CurLine, "SkewMomCorr", InputFileData%SkewMomCorr, ErrStat2, ErrMsg2, UnEc ) @@ -1048,6 +1059,17 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade call LegacyAbort('AFAeroMod should be 1 or 2'); return endif endif + if (skewModProvided) then + if (InputFileData%SkewMod==0) then + InputFileData%Skew_Mod = Skew_Mod_Orthogonal + else if (InputFileData%SkewMod==1) then + InputFileData%Skew_Mod = Skew_Mod_None + else if (InputFileData%SkewMod==2) then + InputFileData%Skew_Mod = Skew_Mod_Glauert + else + call LegacyAbort('Legacy option SkewMod is not 0, 1,2 which is not supported.') + endif + endif !====== Nodal Outputs ============================================================================== ! In case there is something ill-formed in the additional nodal outputs section, we will simply ignore it. @@ -1090,12 +1112,13 @@ SUBROUTINE ParsePrimaryFileInfo( PriPath, InitInp, InputFile, RootName, NumBlade write (*,'(A20,I0)') 'SectAvgWeighting: ', InputFileData%SA_Weighting write (*,'(A20,I0)') 'SectAvgNPoints: ', InputFileData%SA_nPerSec write (*,'(A20,I0)') 'DBEMT_Mod:' , InputFileData%DBEMT_Mod - write (*,'(A20,I0)') 'SkewMod: ' , InputFileData%SkewMod + write (*,'(A20,I0)') 'Skew_Mod: ' , InputFileData%Skew_Mod write (*,'(A20,L0)') 'SkewMomCorr:' , InputFileData%SkewMomCorr write (*,'(A20,I0)') 'SkewRedistrMod:' , InputFileData%SkewRedistrMod write (*,'(A20,L0)') 'AoA34: ' , InputFileData%AoA34 write (*,'(A20,I0)') 'UAMod: ' , InputFileData%UAMod call WrScr('-------------- Old AeroDyn inputs:') + write (*,'(A20,I0)') 'SkewMod: ', InputFileData%SkewMod write (*,'(A20,I0)') 'AFAeroMod:', InputFileData%AFAeroMod write (*,'(A20,L0)') 'FrozenWake:', InputFileData%FrozenWake call WrScr('------------------------------------------------------') @@ -1174,7 +1197,7 @@ logical function legacyInputPresent(varName, iLine, errStat, errMsg, varNameSubs legacyInputPresent = errStat == ErrID_None if (legacyInputPresent) then if (present(varNameSubs)) then - call LegacyWarning(trim(varName)//' has now been removed.'//NewLine//' Using: '//trim(varNameSubs)//'.') + call LegacyWarning(trim(varName)//' has now been removed.'//NewLine//' Use: '//trim(varNameSubs)//'.') else call LegacyWarning(trim(varName)//' has now been removed.') endif @@ -1561,17 +1584,17 @@ SUBROUTINE AD_PrintSum( InputFileData, p, p_AD, u, y, ErrStat, ErrMsg ) WRITE (UnSu,'(A)') '====== Blade-Element/Momentum Theory Options ======================================================' ! SkewMod - select case (InputFileData%SkewMod) - case (SkewMod_Orthogonal) + select case (InputFileData%Skew_Mod) + case (Skew_Mod_Orthogonal) Msg = 'orthogonal' - case (SkewMod_Uncoupled) - Msg = 'uncoupled' - case (SkewMod_PittPeters) - Msg = 'Pitt/Peters' + case (Skew_Mod_None) + Msg = 'no correction' + case (Skew_Mod_Glauert) + Msg = 'Glauert/Pitt/Peters' case default Msg = 'unknown' end select - WRITE (UnSu,Ec_IntFrmt) InputFileData%SkewMod, 'SkewMod', 'Type of skewed-wake correction model: '//TRIM(Msg) + WRITE (UnSu,Ec_IntFrmt) InputFileData%Skew_Mod, 'Skew_Mod', 'Type of skewed-wake correction model: '//TRIM(Msg) ! TipLoss diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 0c6e436179..88ab542493 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -179,8 +179,8 @@ typedef ^ AD_InputFile ReKi KinVisc - - - "Kinematic air viscosity" m^2/s typedef ^ AD_InputFile ReKi Patm - - - "Atmospheric pressure" Pa typedef ^ AD_InputFile ReKi Pvap - - - "Vapour pressure" Pa typedef ^ AD_InputFile ReKi SpdSound - - - "Speed of sound" m/s +typedef ^ AD_InputFile IntKi SkewMod - - - "LEGACY - Skew Mod" - typedef ^ AD_InputFile IntKi Skew_Mod - - - "Select skew model {0=No skew model at all, -1=Throw away non-normal component for linearization, 1=Glauert skew model}" - -typedef ^ AD_InputFile IntKi SkewMod - - - "Legacy Skew Mod" - typedef ^ AD_InputFile Logical SkewMomCorr - - - "Turn the skew momentum correction on or off [used only when SkewMod=1]" - typedef ^ AD_InputFile IntKi SkewRedistrMod - - - "Type of skewed-wake correction model (switch) {0=no redistribution, 1=Glauert/Pitt/Peters, 2=Vortex Cylinder} [unsed only when SkewMod=1]" - typedef ^ AD_InputFile ReKi SkewModFactor - - - "Constant used in Pitt/Peters skewed wake model (default is 15*pi/32)" - @@ -415,7 +415,7 @@ typedef ^ ParameterType RotParameterType rotors {:} - - "Parameter types for typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds typedef ^ ParameterType CHARACTER(1024) RootName - - - "RootName for writing output files" - typedef ^ ParameterType AFI_ParameterType AFI {:} - - "AirfoilInfo parameters" -typedef ^ ParameterType IntKi SkewMod - - - "Type of skewed-wake correction model {0=orthogonal, 1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0]" - +typedef ^ ParameterType IntKi Skew_Mod - - - "Type of skewed-wake correction model {-1=orthogonal, 0=None, 1=Glauert} [unused when WakeMod=0]" - typedef ^ ParameterType IntKi WakeMod - - - "Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW}" - typedef ^ ParameterType FVW_ParameterType FVW - - - "Parameters for FVW module" typedef ^ ParameterType LOGICAL CompAeroMaps - .FALSE. - "flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false)" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index a5bc6caa3e..276b0f7dbf 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -208,8 +208,8 @@ MODULE AeroDyn_Types REAL(ReKi) :: Patm = 0.0_ReKi !< Atmospheric pressure [Pa] REAL(ReKi) :: Pvap = 0.0_ReKi !< Vapour pressure [Pa] REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound [m/s] + INTEGER(IntKi) :: SkewMod = 0_IntKi !< LEGACY - Skew Mod [-] INTEGER(IntKi) :: Skew_Mod = 0_IntKi !< Select skew model {0=No skew model at all, -1=Throw away non-normal component for linearization, 1=Glauert skew model} [-] - INTEGER(IntKi) :: SkewMod = 0_IntKi !< Legacy Skew Mod [-] LOGICAL :: SkewMomCorr = .false. !< Turn the skew momentum correction on or off [used only when SkewMod=1] [-] INTEGER(IntKi) :: SkewRedistrMod = 0_IntKi !< Type of skewed-wake correction model (switch) {0=no redistribution, 1=Glauert/Pitt/Peters, 2=Vortex Cylinder} [unsed only when SkewMod=1] [-] REAL(ReKi) :: SkewModFactor = 0.0_ReKi !< Constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] @@ -453,7 +453,7 @@ MODULE AeroDyn_Types REAL(DbKi) :: DT = 0.0_R8Ki !< Time step for continuous state integration & discrete state update [seconds] CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(AFI_ParameterType) , DIMENSION(:), ALLOCATABLE :: AFI !< AirfoilInfo parameters [-] - INTEGER(IntKi) :: SkewMod = 0_IntKi !< Type of skewed-wake correction model {0=orthogonal, 1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0] [-] + INTEGER(IntKi) :: Skew_Mod = 0_IntKi !< Type of skewed-wake correction model {-1=orthogonal, 0=None, 1=Glauert} [unused when WakeMod=0] [-] INTEGER(IntKi) :: WakeMod = 0_IntKi !< Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW} [-] TYPE(FVW_ParameterType) :: FVW !< Parameters for FVW module [-] LOGICAL :: CompAeroMaps = .FALSE. !< flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false) [-] @@ -2609,8 +2609,8 @@ subroutine AD_CopyInputFile(SrcInputFileData, DstInputFileData, CtrlCode, ErrSta DstInputFileData%Patm = SrcInputFileData%Patm DstInputFileData%Pvap = SrcInputFileData%Pvap DstInputFileData%SpdSound = SrcInputFileData%SpdSound - DstInputFileData%Skew_Mod = SrcInputFileData%Skew_Mod DstInputFileData%SkewMod = SrcInputFileData%SkewMod + DstInputFileData%Skew_Mod = SrcInputFileData%Skew_Mod DstInputFileData%SkewMomCorr = SrcInputFileData%SkewMomCorr DstInputFileData%SkewRedistrMod = SrcInputFileData%SkewRedistrMod DstInputFileData%SkewModFactor = SrcInputFileData%SkewModFactor @@ -2769,8 +2769,8 @@ subroutine AD_PackInputFile(Buf, Indata) call RegPack(Buf, InData%Patm) call RegPack(Buf, InData%Pvap) call RegPack(Buf, InData%SpdSound) - call RegPack(Buf, InData%Skew_Mod) call RegPack(Buf, InData%SkewMod) + call RegPack(Buf, InData%Skew_Mod) call RegPack(Buf, InData%SkewMomCorr) call RegPack(Buf, InData%SkewRedistrMod) call RegPack(Buf, InData%SkewModFactor) @@ -2897,10 +2897,10 @@ subroutine AD_UnPackInputFile(Buf, OutData) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%SpdSound) if (RegCheckErr(Buf, RoutineName)) return - call RegUnpack(Buf, OutData%Skew_Mod) - if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%SkewMod) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%Skew_Mod) + if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%SkewMomCorr) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%SkewRedistrMod) @@ -6431,7 +6431,7 @@ subroutine AD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return end do end if - DstParamData%SkewMod = SrcParamData%SkewMod + DstParamData%Skew_Mod = SrcParamData%Skew_Mod DstParamData%WakeMod = SrcParamData%WakeMod call FVW_CopyParam(SrcParamData%FVW, DstParamData%FVW, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6507,7 +6507,7 @@ subroutine AD_PackParam(Buf, Indata) call AFI_PackParam(Buf, InData%AFI(i1)) end do end if - call RegPack(Buf, InData%SkewMod) + call RegPack(Buf, InData%Skew_Mod) call RegPack(Buf, InData%WakeMod) call FVW_PackParam(Buf, InData%FVW) call RegPack(Buf, InData%CompAeroMaps) @@ -6571,7 +6571,7 @@ subroutine AD_UnPackParam(Buf, OutData) call AFI_UnpackParam(Buf, OutData%AFI(i1)) ! AFI end do end if - call RegUnpack(Buf, OutData%SkewMod) + call RegUnpack(Buf, OutData%Skew_Mod) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%WakeMod) if (RegCheckErr(Buf, RoutineName)) return diff --git a/modules/aerodyn/src/BEMT.f90 b/modules/aerodyn/src/BEMT.f90 index e04f5dc5af..7cf1c80e97 100644 --- a/modules/aerodyn/src/BEMT.f90 +++ b/modules/aerodyn/src/BEMT.f90 @@ -1590,7 +1590,7 @@ subroutine ApplySkewedWakeCorrection_AllNodes(p, u, m, x, phi, OtherState, axInd !............................................ ! Apply skewed wake correction to the axial induction (y%axInduction) !............................................ - if ( p%skewWakeMod == SkewMod_PittPeters ) then + if ( p%skewWakeMod == Skew_Mod_Glauert ) then if (p%BEM_Mod==BEMMod_2D) then ! do nothing else diff --git a/modules/aerodyn/src/BEMT_Registry.txt b/modules/aerodyn/src/BEMT_Registry.txt index 0595a1d21b..ca226ffd01 100644 --- a/modules/aerodyn/src/BEMT_Registry.txt +++ b/modules/aerodyn/src/BEMT_Registry.txt @@ -16,13 +16,10 @@ usefrom AirfoilInfo_Registry.txt usefrom UnsteadyAero_Registry.txt usefrom DBEMT_Registry.txt -param BEMT/BEMT - INTEGER SkewMod_Orthogonal - -1 - "Inflow orthogonal to rotor [-]" - -param BEMT/BEMT - INTEGER SkewMod_None - 0 - "No skew model (previously called uncoupled)" - -param BEMT/BEMT - INTEGER SkewMod_Glauert - 10 - "Pitt/Peters/Glauert skew model (should be 1)" - -param BEMT/BEMT - INTEGER SkewMod_Uncoupled - 1 - "Uncoupled (no correction)" - -param BEMT/BEMT - INTEGER SkewMod_PittPeters - 2 - "Pitt/Peters" - -param BEMT/BEMT - INTEGER SkewMod_Coupled - 3 - "Coupled" - -param BEMT/BEMT - INTEGER SkewMod_PittPeters_Cont - 4 - "Pitt/Peters continuous formulation" - +param BEMT/BEMT - INTEGER Skew_Mod_Orthogonal - -1 - "Inflow orthogonal to rotor [-]" - +param BEMT/BEMT - INTEGER Skew_Mod_None - 0 - "No skew model (previously called uncoupled)" - +param BEMT/BEMT - INTEGER Skew_Mod_Glauert - 1 - "Pitt/Peters/Glauert skew model (should be 1)" - +param BEMT/BEMT - INTEGER Skew_Mod_PittPeters_Cont - 4 - "Pitt/Peters continuous formulation" - param BEMT/BEMT - INTEGER SkewRedistrMod_None - 0 - "No redistribution" - param BEMT/BEMT - INTEGER SkewRedistrMod_PittPeters - 1 - "Pitt/Petesr/Glauert redistribution" - @@ -146,7 +143,7 @@ typedef ^ ^ ReKi typedef ^ ^ INTEGER numBlades - - - "Number of blades" - typedef ^ ^ ReKi airDens - - - "Air density" kg/m^3 typedef ^ ^ ReKi kinVisc - - - "Kinematic air viscosity" m^2/s -typedef ^ ^ INTEGER skewWakeMod - - - "Type of skewed-wake correction model [switch] {1=uncoupled, 2=Pitt/Peters, 3=coupled}" - +typedef ^ ^ INTEGER skewWakeMod - - - "Type of skewed-wake correction model [switch] {0=None, 1=Glauert/Pitt/Peters}" - typedef ^ ^ ReKi aTol - - - "Tolerance for the induction solution" - typedef ^ ^ LOGICAL useTipLoss - - - "Use the Prandtl tip-loss model? [flag]" - typedef ^ ^ LOGICAL useHubLoss - - - "Use the Prandtl hub-loss model? [flag]" - diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index a3a2f94f53..9202214daf 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -36,13 +36,10 @@ MODULE BEMT_Types USE DBEMT_Types USE NWTC_Library IMPLICIT NONE - INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_Orthogonal = -1 ! Inflow orthogonal to rotor [-] [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_None = 0 ! No skew model (previously called uncoupled) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_Glauert = 10 ! Pitt/Peters/Glauert skew model (should be 1) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_Uncoupled = 1 ! Uncoupled (no correction) [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_PittPeters = 2 ! Pitt/Peters [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_Coupled = 3 ! Coupled [-] - INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_PittPeters_Cont = 4 ! Pitt/Peters continuous formulation [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Skew_Mod_Orthogonal = -1 ! Inflow orthogonal to rotor [-] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Skew_Mod_None = 0 ! No skew model (previously called uncoupled) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Skew_Mod_Glauert = 1 ! Pitt/Peters/Glauert skew model (should be 1) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: Skew_Mod_PittPeters_Cont = 4 ! Pitt/Peters continuous formulation [-] INTEGER(IntKi), PUBLIC, PARAMETER :: SkewRedistrMod_None = 0 ! No redistribution [-] INTEGER(IntKi), PUBLIC, PARAMETER :: SkewRedistrMod_PittPeters = 1 ! Pitt/Petesr/Glauert redistribution [-] INTEGER(IntKi), PUBLIC, PARAMETER :: BEMMod_2D = 0 ! 2D BEM assuming Cx, Cy, phi, L, D are in the same plane [-] @@ -156,7 +153,7 @@ MODULE BEMT_Types INTEGER(IntKi) :: numBlades = 0_IntKi !< Number of blades [-] REAL(ReKi) :: airDens = 0.0_ReKi !< Air density [kg/m^3] REAL(ReKi) :: kinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] - INTEGER(IntKi) :: skewWakeMod = 0_IntKi !< Type of skewed-wake correction model [switch] {1=uncoupled, 2=Pitt/Peters, 3=coupled} [-] + INTEGER(IntKi) :: skewWakeMod = 0_IntKi !< Type of skewed-wake correction model [switch] {0=None, 1=Glauert/Pitt/Peters} [-] REAL(ReKi) :: aTol = 0.0_ReKi !< Tolerance for the induction solution [-] LOGICAL :: useTipLoss = .false. !< Use the Prandtl tip-loss model? [flag] [-] LOGICAL :: useHubLoss = .false. !< Use the Prandtl hub-loss model? [flag] [-]