diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index e2fc92f4cd..15b51936d0 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -1349,6 +1349,7 @@ subroutine SetParameters( InitInp, InputFileData, RotData, p, p_AD, ErrStat, Err p_AD%CompAeroMaps = InitInp%CompAeroMaps p_AD%SectAvg = InputFileData%SectAvg + p_AD%SA_Weighting = InputFileData%SA_Weighting p_AD%SA_PsiBwd = InputFileData%SA_PsiBwd*D2R p_AD%SA_PsiFwd = InputFileData%SA_PsiFwd*D2R p_AD%SA_nPerSec = InputFileData%SA_nPerSec @@ -2771,7 +2772,12 @@ subroutine SetSectAvgInflow(t, p, p_AD, u, m, errStat, errMsg) if (allocated(SectAcc)) deallocate(SectAcc) ! IfW_FlowField_GetVelAcc some logic for Acc, so we ensure it's deallocated SectVel = 0.0_ReKi SectPos = 0.0_ReKi - SectWgt = 1.0_ReKi/p_AD%SA_nPerSec ! TODO, potentially do a smart weighting function based on psi + if (p_AD%SA_Weighting == SA_Wgt_Uniform) then + SectWgt = 1.0_ReKi/p_AD%SA_nPerSec + else + errStat2 = errID_Fatal; errMsg2 = 'Sector averaging weighting (`SA_Weighting`) should be Uniform' + if (Failed()) return + endif dpsi = (p_AD%SA_PsiFwd-p_AD%SA_PsiBwd)/(p_AD%SA_nPerSec-1) ! Hub @@ -3864,6 +3870,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) if ( maxval(InputFileData%rotors(iR)%TwrTI) > 0.4 .and. maxval(InputFileData%rotors(iR)%TwrTI) < 1.0) call SetErrStat ( ErrID_Warn, 'The turbulence intensity for the Eames tower shadow model above 0.4 may return unphysical results. Interpret with caution.', ErrStat, ErrMsg, RoutineName ) enddo endif + if (Failed()) return if (InitInp%MHK == MHK_None .and. InputFileData%CavitCheck) call SetErrStat ( ErrID_Fatal, 'A cavitation check can only be performed for an MHK turbine.', ErrStat, ErrMsg, RoutineName ) if (InitInp%MHK == MHK_None .and. InputFileData%Buoyancy) call SetErrStat ( ErrID_Fatal, 'Buoyancy can only be calculated for an MHK turbine.', ErrStat, ErrMsg, RoutineName ) @@ -3880,24 +3887,30 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) - ! BEMT/DBEMT inputs - ! bjj: these checks should probably go into BEMT where they are used... - if (InputFileData%Wake_Mod /= WakeMod_none .and. InputFileData%Wake_Mod /= WakeMod_FVW) then + ! NOTE: this check is done here because it is used for all kind of Wake Mod + if (.not.any(InputFileData%BEM_Mod == (/BEMMod_2D, BEMMod_3D/))) call Fatal('BEM_Mod must be 1 or 2.') + + ! --- BEMT/DBEMT inputs + ! bjj: these checks should probably go into BEMT where they are used... + if (InputFileData%Wake_Mod == WakeMod_BEMT) then if ( InputFileData%MaxIter < 1 ) call SetErrStat( ErrID_Fatal, 'MaxIter must be greater than 0.', ErrStat, ErrMsg, RoutineName ) 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%Skew_Mod /= Skew_Mod_Orthogonal .and. InputFileData%Skew_Mod /= Skew_Mod_None .and. InputFileData%Skew_Mod /= Skew_Mod_Active) & - call SetErrStat( ErrID_Fatal, 'Skew_Mod must be -1, 0, or 1.', ErrStat, ErrMsg, RoutineName ) + if (.not.any(InputFileData%Skew_Mod == (/Skew_Mod_Orthogonal, Skew_Mod_None, Skew_Mod_Active/))) call Fatal('Skew_Mod must be -1, 0, or 1.') + if (.not.any(InputFileData%SkewRedistr_Mod == (/SkewRedistrMod_None, SkewRedistrMod_PittPeters/))) call Fatal('SkewRedistr_Mod should be 0 or 1') if ( InputFileData%SectAvg) then - if (InputFileData%SA_nPerSec <= 1) call SetErrStat(ErrID_Fatal, 'SA_nPerSec must be >=1', ErrStat, ErrMsg, RoutineName) - if (InputFileData%SA_PsiBwd > 0) call SetErrStat(ErrID_Fatal, 'SA_PsiBwd must be negative', ErrStat, ErrMsg, RoutineName) - if (InputFileData%SA_PsiFwd < 0) call SetErrStat(ErrID_Fatal, 'SA_PsiFwd must be positive', ErrStat, ErrMsg, RoutineName) - if (InputFileData%SA_PsiFwd <= InputFileData%SA_PsiBwd ) call SetErrStat(ErrID_Fatal, 'SA_PsiFwd must be strictly higher than SA_PsiBwd', ErrStat, ErrMsg, RoutineName) + if (InputFileData%SA_Weighting /= SA_Wgt_Uniform) call Fatal('SectAvgWeighting should be Uniform (=1) for now.') + if (InputFileData%SA_nPerSec <= 1) call Fatal('SectAvgNPoints must be >=1') + if (InputFileData%SA_PsiBwd > 0) call Fatal('SectAvgPsiBwd must be negative') + if (InputFileData%SA_PsiFwd < 0) call Fatal('SectAvgPsiFwd must be positive') + if (InputFileData%SA_PsiFwd <= InputFileData%SA_PsiBwd ) call Fatal('SectAvgPsiFwd must be strictly higher than SA_PsiBwd') endif + ! Good to return once in a while.. + if (Failed()) return end if !BEMT/DBEMT checks @@ -3966,6 +3979,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) end do ! k=blades end if end do ! iR rotor + if (Failed()) return ! ............................. ! check tower mesh data: @@ -4008,6 +4022,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) end if end do ! iR rotor + if (Failed()) return @@ -4059,6 +4074,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) enddo ! iR end if + if (Failed()) return if ( ( InputFileData%NBlOuts < 0_IntKi ) .OR. ( InputFileData%NBlOuts > 9_IntKi ) ) then @@ -4078,6 +4094,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) end do ! iR, rotor end if + if (Failed()) return !.................. ! Tail fin checks @@ -4092,6 +4109,7 @@ SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) endif endif enddo ! iR, rotor + if (Failed()) return !.................. ! check for linearization @@ -4117,6 +4135,10 @@ SUBROUTINE Fatal(ErrMsg_in) character(*), intent(in) :: ErrMsg_in call SetErrStat(ErrID_Fatal, ErrMsg_in, ErrStat, ErrMsg, RoutineName) END SUBROUTINE Fatal + + logical function Failed() + Failed = ErrStat >= AbortErrLev + end function Failed END SUBROUTINE ValidateInputData !---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index be6849dcee..e99760e729 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -32,6 +32,9 @@ param ^ - IntKi TwrShadow_none - 0 - "no tower s param ^ - IntKi TwrShadow_Powles - 1 - "Powles tower shadow model" - param ^ - IntKi TwrShadow_Eames - 2 - "Eames tower shadow model" - +param ^ - IntKi SA_Wgt_Uniform - 1 - "Sector average weighting - Uniform" - +#param ^ - IntKi SA_Wgt_Impulse - 1 - "Sector average weighting - Impulse" - + param ^ - IntKi TFinAero_none - 0 - "no tail fin aero" - param ^ - IntKi TFinAero_polar - 1 - "polar-based tail fin aerodynamics" - param ^ - IntKi TFinAero_USB - 2 - "unsteady slender body tail fin aerodynamics model" - @@ -422,6 +425,7 @@ typedef ^ ParameterType LOGICAL CompAeroMaps - .FALSE. - "fla typedef ^ ParameterType LOGICAL UA_Flag - - - "logical flag indicating whether to use UnsteadyAero" - typedef ^ ParameterType FlowFieldType *FlowField - - - "Pointer of InflowWinds flow field data type" - typedef ^ ^ Logical SectAvg - - - "Use Sector average for BEM inflow velocity calculation" - +typedef ^ ^ IntKi SA_Weighting - - 1 "Sector Average - Weighting function for sector average {1=Uniform, 2=Impulse} within a 360/nB sector centered on the blade (switch) [used only when SectAvg=True]" - typedef ^ ^ ReKi SA_PsiBwd - - - "Sector Average - Backard Azimuth (<0)" deg typedef ^ ^ ReKi SA_PsiFwd - - - "Sector Average - Forward Azimuth (>0)" deg typedef ^ ^ IntKi SA_nPerSec - - - "Sector Average - Number of points per sector (>1)" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 671199dcc5..4b4e131dbb 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -48,6 +48,7 @@ MODULE AeroDyn_Types INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_none = 0 ! no tower shadow [-] INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_Powles = 1 ! Powles tower shadow model [-] INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_Eames = 2 ! Eames tower shadow model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SA_Wgt_Uniform = 1 ! Sector average weighting - Uniform [-] INTEGER(IntKi), PUBLIC, PARAMETER :: TFinAero_none = 0 ! no tail fin aero [-] INTEGER(IntKi), PUBLIC, PARAMETER :: TFinAero_polar = 1 ! polar-based tail fin aerodynamics [-] INTEGER(IntKi), PUBLIC, PARAMETER :: TFinAero_USB = 2 ! unsteady slender body tail fin aerodynamics model [-] @@ -459,6 +460,7 @@ MODULE AeroDyn_Types LOGICAL :: UA_Flag = .false. !< logical flag indicating whether to use UnsteadyAero [-] TYPE(FlowFieldType) , POINTER :: FlowField => NULL() !< Pointer of InflowWinds flow field data type [-] LOGICAL :: SectAvg = .false. !< Use Sector average for BEM inflow velocity calculation [-] + INTEGER(IntKi) :: SA_Weighting = 0_IntKi !< Sector Average - Weighting function for sector average {1=Uniform, 2=Impulse} within a 360/nB sector centered on the blade (switch) [used only when SectAvg=True] [-] REAL(ReKi) :: SA_PsiBwd = 0.0_ReKi !< Sector Average - Backard Azimuth (<0) [deg] REAL(ReKi) :: SA_PsiFwd = 0.0_ReKi !< Sector Average - Forward Azimuth (>0) [deg] INTEGER(IntKi) :: SA_nPerSec = 0_IntKi !< Sector Average - Number of points per sector (>1) [-] @@ -6439,6 +6441,7 @@ subroutine AD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%UA_Flag = SrcParamData%UA_Flag DstParamData%FlowField => SrcParamData%FlowField DstParamData%SectAvg = SrcParamData%SectAvg + DstParamData%SA_Weighting = SrcParamData%SA_Weighting DstParamData%SA_PsiBwd = SrcParamData%SA_PsiBwd DstParamData%SA_PsiFwd = SrcParamData%SA_PsiFwd DstParamData%SA_nPerSec = SrcParamData%SA_nPerSec @@ -6519,6 +6522,7 @@ subroutine AD_PackParam(Buf, Indata) end if end if call RegPack(Buf, InData%SectAvg) + call RegPack(Buf, InData%SA_Weighting) call RegPack(Buf, InData%SA_PsiBwd) call RegPack(Buf, InData%SA_PsiFwd) call RegPack(Buf, InData%SA_nPerSec) @@ -6601,6 +6605,8 @@ subroutine AD_UnPackParam(Buf, OutData) end if call RegUnpack(Buf, OutData%SectAvg) if (RegCheckErr(Buf, RoutineName)) return + call RegUnpack(Buf, OutData%SA_Weighting) + if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%SA_PsiBwd) if (RegCheckErr(Buf, RoutineName)) return call RegUnpack(Buf, OutData%SA_PsiFwd) diff --git a/modules/aerodyn/src/BEMT_Registry.txt b/modules/aerodyn/src/BEMT_Registry.txt index 80f743eeeb..f4eff961b5 100644 --- a/modules/aerodyn/src/BEMT_Registry.txt +++ b/modules/aerodyn/src/BEMT_Registry.txt @@ -22,7 +22,8 @@ param BEMT/BEMT - INTEGER 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" - +param BEMT/BEMT - INTEGER SkewRedistrMod_PittPeters - 1 - "Pitt/Peters/Glauert redistribution" - +#param BEMT/BEMT - INTEGER SkewRedistrMod_VCyl - 2 - "Vortex cylinder redistribution" - param BEMT/BEMT - INTEGER BEMMod_2D - 0 - "2D BEM assuming Cx, Cy, phi, L, D are in the same plane" - param BEMT/BEMT - INTEGER BEMMod_3D - 2 - "3D BEM assuming a momentum balance system, and an airfoil system" - diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index ccf3f8c6b0..96d80b9d5c 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -41,7 +41,7 @@ MODULE BEMT_Types INTEGER(IntKi), PUBLIC, PARAMETER :: Skew_Mod_Active = 1 ! Skew model active [-] 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 :: SkewRedistrMod_PittPeters = 1 ! Pitt/Peters/Glauert redistribution [-] INTEGER(IntKi), PUBLIC, PARAMETER :: BEMMod_2D = 0 ! 2D BEM assuming Cx, Cy, phi, L, D are in the same plane [-] INTEGER(IntKi), PUBLIC, PARAMETER :: BEMMod_3D = 2 ! 3D BEM assuming a momentum balance system, and an airfoil system [-] ! ========= BEMT_InitInputType =======