From 67a06dcd92be34e00afe897b70b7f250e6d42ed1 Mon Sep 17 00:00:00 2001 From: pibo Date: Mon, 16 Nov 2020 15:36:51 -0700 Subject: [PATCH 01/12] recode how rel thick is computed in TI Guidati --- modules/aerodyn/src/AeroAcoustics.f90 | 107 +++++++++++++------------- 1 file changed, 55 insertions(+), 52 deletions(-) diff --git a/modules/aerodyn/src/AeroAcoustics.f90 b/modules/aerodyn/src/AeroAcoustics.f90 index 429b8edd9..e2e4b225f 100644 --- a/modules/aerodyn/src/AeroAcoustics.f90 +++ b/modules/aerodyn/src/AeroAcoustics.f90 @@ -123,10 +123,10 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat / = ErrID_None INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation INTEGER(IntKi) :: simcou,coun ! simple loop counter - INTEGER(IntKi) :: I,J,whichairfoil,K + INTEGER(IntKi) :: I,J,whichairfoil,K,i1_1,i10_1,i1_2,i10_2,iLE character(*), parameter :: RoutineName = 'SetParameters' - LOGICAL :: tr,tri,exist - REAL(ReKi) :: val1,val2,f2,f4,lefttip,rightip,jumpreg + LOGICAL :: tr,tri,exist,LE_flag + REAL(ReKi) :: val1,val10,f2,f4,lefttip,rightip,jumpreg, dist1, dist10 ! Initialize variables for this routine ErrStat = ErrID_None ErrMsg = "" @@ -340,60 +340,63 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) if(Failed()) return endif - ! If simplified guidati is on, calculate the airfoil thickness from input airfoil coordinates + ! If simplified guidati is on, calculate the airfoil thickness at 1% and at 10% chord from input airfoil coordinates IF (p%IInflow .EQ. 2) THEN - ! Calculate the Thickness @ 1% chord and @ 10% chord (normalized thickness) call AllocAry(p%AFThickGuida,2,size(p%AFInfo), 'p%AFThickGuida', errStat2, errMsg2); if(Failed()) return p%AFThickGuida=0.0_Reki DO k=1,size(p%AFInfo) ! for each airfoil interpolation - tri=.true.;tr=.true.; - do i=2,size(p%AFInfo(k)%X_Coord) - if ( (p%AFInfo(k)%X_Coord(i)+p%AFInfo(k)%Y_Coord(i)) .eq. 0) then - !print*,i - goto 174 - endif - if ( p%AFInfo(k)%X_Coord(i) .eq. 0.1) then - val1=p%AFInfo(k)%Y_Coord(i) - elseif ( (p%AFInfo(k)%X_Coord(i) .lt. 0.1) .and. (tri) ) then - val1=( abs(p%AFInfo(k)%X_Coord(i-1)-0.1)*p%AFInfo(k)%Y_Coord(i) + & - abs(p%AFInfo(k)%X_Coord(i)-0.1)*p%AFInfo(k)%Y_Coord(i-1))/ & - (abs(p%AFInfo(k)%X_Coord(i-1)-0.1)+abs(p%AFInfo(k)%X_Coord(i)-0.1)) - - tri=.false. - elseif (p%AFInfo(k)%X_Coord(i) .eq. 0.01) then - val2=p%AFInfo(k)%Y_Coord(i) - elseif ( (p%AFInfo(k)%X_Coord(i) .lt. 0.01) .and. (tr) ) then - val2=( abs(p%AFInfo(k)%X_Coord(i-1)-0.01)*p%AFInfo(k)%Y_Coord(i) + & - abs(p%AFInfo(k)%X_Coord(i)-0.01)*p%AFInfo(k)%Y_Coord(i-1))/ & - (abs(p%AFInfo(k)%X_Coord(i-1)-0.01)+abs(p%AFInfo(k)%X_Coord(i)-0.01)) - tr=.false. - endif - enddo - - 174 tri=.true.;tr=.true.; - do j=i,size(p%AFInfo(k)%X_Coord) - if ( p%AFInfo(k)%X_Coord(j) .eq. 0.1) then - val1=abs(p%AFInfo(k)%Y_Coord(j)) + abs(val1) - elseif ( (p%AFInfo(k)%X_Coord(j) .gt. 0.1) .and. (tri) ) then - val1=abs(val1)+abs((abs(p%AFInfo(k)%X_Coord(j-1)-0.1)*p%AFInfo(k)%Y_Coord(j)+ & - abs(p%AFInfo(k)%X_Coord(j)-0.1)*p%AFInfo(k)%Y_Coord(j-1))/& - (abs(p%AFInfo(k)%X_Coord(j-1)-0.1)+abs(p%AFInfo(k)%X_Coord(j)-0.1))); - tri=.false. - elseif (p%AFInfo(k)%X_Coord(j) .eq. 0.01) then - val2=abs(p%AFInfo(k)%Y_Coord(j)) + abs(val2) - elseif ( (p%AFInfo(k)%X_Coord(j) .gt. 0.01) .and. (tr) ) then - val2=abs(val2)+abs((abs(p%AFInfo(k)%X_Coord(j-1)-0.01)*p%AFInfo(k)%Y_Coord(j)+ & - abs(p%AFInfo(k)%X_Coord(j)-0.01)*p%AFInfo(k)%Y_Coord(j-1))/& - (abs(p%AFInfo(k)%X_Coord(j-1)-0.01)+abs(p%AFInfo(k)%X_Coord(j)-0.01))); - tr=.false. - endif - enddo - - p%AFThickGuida(1,k)=val2 ! 1 % chord thickness - p%AFThickGuida(2,k)=val1 ! 10 % chord thickness + + ! IF ((MIN(p%AFInfo(k)%X_Coord) < 0.) .or. (MAX(p%AFInfo(k)%X_Coord) > 0.)) THEN + ! call SetErrStat ( ErrID_Fatal,'The coordinates of airfoil '//trim(num2lstr(k))//' are mot defined between x=0 and x=1. Code stops.' ,ErrStat, ErrMsg, RoutineName ) + ! ENDIF + + ! Flip the flag when LE is found and find index + LE_flag = .False. + DO i=3,size(p%AFInfo(k)%X_Coord) + IF (LE_flag .eqv. .False.) THEN + IF (p%AFInfo(k)%X_Coord(i) - p%AFInfo(k)%X_Coord(i-1) > 0.) THEN + LE_flag = .TRUE. + iLE = i + ENDIF + ENDIF + ENDDO + + ! From LE toward TE + dist1 = ABS( p%AFInfo(k)%X_Coord(iLE) - 0.01) + dist10 = ABS( p%AFInfo(k)%X_Coord(iLE) - 0.10) + DO i=iLE+1,size(p%AFInfo(k)%X_Coord) + IF (ABS(p%AFInfo(k)%X_Coord(i) - 0.01) < dist1) THEN + i1_1 = i + dist1 = ABS(p%AFInfo(k)%X_Coord(i) - 0.01) + ENDIF + IF (ABS(p%AFInfo(k)%X_Coord(i) - 0.1) < dist10) THEN + i10_1 = i + dist10 = ABS(p%AFInfo(k)%X_Coord(i) - 0.1) + ENDIF + ENDDO + + ! From TE to LE + dist1 = 0.99 + dist10 = 0.90 + DO i=1,iLE-1 + IF (ABS(p%AFInfo(k)%X_Coord(i) - 0.01) < dist1) THEN + i1_2 = i + dist1 = ABS(p%AFInfo(k)%X_Coord(i) - 0.01) + ENDIF + IF (ABS(p%AFInfo(k)%X_Coord(i) - 0.1) < dist10) THEN + i10_2 = i + dist10 = ABS(p%AFInfo(k)%X_Coord(i) - 0.1) + ENDIF + ENDDO + + val1 = p%AFInfo(k)%Y_Coord(i1_1) - p%AFInfo(k)%Y_Coord(i1_2) + val10 = p%AFInfo(k)%Y_Coord(i10_1) - p%AFInfo(k)%Y_Coord(i10_2) + + p%AFThickGuida(1,k)=val1 ! 1 % chord thickness + p%AFThickGuida(2,k)=val10 ! 10 % chord thickness ENDDO - ENDIF ! If simplified guidati is on, calculate the airfoil thickness + ENDIF !! for turbulence intensity calculations on the fly every 5 meter the whole rotor area is divided vertically to store flow fields in each region jumpreg=7 @@ -1445,7 +1448,7 @@ SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,jj,ii,kk,d99Var2,dstarVar1,dstarVar LOGICAL :: SWITCH !!LOGICAL FOR COMPUTATION OF ANGLE OF ATTACK CONTRIBUTION - + ErrStat = ErrID_None ErrMsg = "" From 7ecc3a219ba35cc6a0033730ce5729b1ac392ddd Mon Sep 17 00:00:00 2001 From: pibo Date: Wed, 18 Nov 2020 16:29:19 -0700 Subject: [PATCH 02/12] remove AAblade input file --- modules/aerodyn/src/AeroAcoustics.f90 | 31 +-- modules/aerodyn/src/AeroAcoustics_IO.f90 | 98 ++------ .../aerodyn/src/AeroAcoustics_Registry.txt | 9 +- modules/aerodyn/src/AeroAcoustics_Types.f90 | 235 +----------------- 4 files changed, 53 insertions(+), 320 deletions(-) diff --git a/modules/aerodyn/src/AeroAcoustics.f90 b/modules/aerodyn/src/AeroAcoustics.f90 index e2e4b225f..83eb9210c 100644 --- a/modules/aerodyn/src/AeroAcoustics.f90 +++ b/modules/aerodyn/src/AeroAcoustics.f90 @@ -241,18 +241,19 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) call AllocAry(p%StallStart,p%NumBlNds,p%NumBlades,'p%StallStart',ErrStat2,ErrMsg2); if(Failed()) return p%StallStart(:,:) = 0.0_ReKi - do i=1,p%NumBlades - p%TEThick(:,i) = InputFileData%BladeProps(i)%TEThick(:) ! - p%TEAngle(:,i) = InputFileData%BladeProps(i)%TEAngle(:) ! + do i=1,p%NumBlades do j=1,p%NumBlNds - whichairfoil = p%BlAFID(j,i) - if(p%AFInfo(whichairfoil)%NumTabs /=1 ) then - call SetErrStat(ErrID_Fatal, 'Number of airfoil tables within airfoil file different than 1, which is not supported.', ErrStat2, ErrMsg2, RoutineName ) - if(Failed()) return - endif - p%StallStart(j,i) = p%AFInfo(whichairfoil)%Table(1)%UA_BL%alpha1*180/PI ! approximate stall angle of attack [deg] (alpha1 in [rad]) + whichairfoil = p%BlAFID(j,i) + p%TEThick(j,i) = InputFileData%BladeProps(whichairfoil)%TEThick + p%TEAngle(j,i) = InputFileData%BladeProps(whichairfoil)%TEAngle + + if(p%AFInfo(whichairfoil)%NumTabs /=1 ) then + call SetErrStat(ErrID_Fatal, 'Number of airfoil tables within airfoil file different than 1, which is not supported.', ErrStat2, ErrMsg2, RoutineName ) + if(Failed()) return + endif + p%StallStart(j,i) = p%AFInfo(whichairfoil)%Table(1)%UA_BL%alpha1*180/PI ! approximate stall angle of attack [deg] (alpha1 in [rad]) enddo - end do + enddo call AllocAry(p%BlSpn, p%NumBlNds, p%NumBlades, 'p%BlSpn' , ErrStat2, ErrMsg2); if(Failed()) return call AllocAry(p%BlChord, p%NumBlNds, p%NumBlades, 'p%BlChord', ErrStat2, ErrMsg2); if(Failed()) return @@ -1066,8 +1067,8 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) !--------Turbulent Boundary Layer Trailing Edge Noise----------------------------! IF ( (p%ITURB .EQ. 1) .or. (p%ITURB .EQ. 2) ) THEN CALL TBLTE(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & - elementspan,m%rTEtoObserve(K,J,I), p, j,i,k,m%d99Var(2),m%dstarVar(1),m%dstarVar(2),p%StallStart(J,I), & - m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,errStat2,errMsg2 ) + elementspan,m%rTEtoObserve(K,J,I), p, j,i,k,m%d99Var(2),m%dstarVar(1),m%dstarVar(2),p%StallStart(J,I), & + m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,errStat2,errMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (p%ITURB .EQ. 2) THEN m%SPLP=0.0_ReKi;m%SPLS=0.0_ReKi;m%SPLTBL=0.0_ReKi; @@ -1081,9 +1082,9 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) !--------Blunt Trailing Edge Noise----------------------------------------------! IF ( p%IBLUNT .EQ. 1 ) THEN CALL BLUNT(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & - elementspan,m%rTEtoObserve(K,J,I),p%TEThick(J,I),p%TEAngle(J,I), & - p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLBLUNT,p%StallStart(J,I),errStat2,errMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + elementspan,m%rTEtoObserve(K,J,I),p%TEThick(J,I),p%TEAngle(J,I), & + p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLBLUNT,p%StallStart(J,I),errStat2,errMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ENDIF !--------Tip Noise--------------------------------------------------------------! IF ( (p%ITIP .EQ. 1) .AND. (J .EQ. p%NumBlNds) ) THEN diff --git a/modules/aerodyn/src/AeroAcoustics_IO.f90 b/modules/aerodyn/src/AeroAcoustics_IO.f90 index 76e4e02c6..eb26ced86 100644 --- a/modules/aerodyn/src/AeroAcoustics_IO.f90 +++ b/modules/aerodyn/src/AeroAcoustics_IO.f90 @@ -76,7 +76,6 @@ SUBROUTINE ReadInputFiles( InputFileName, BL_Files, InputFileData, Default_DT, O INTEGER(IntKi) :: I INTEGER(IntKi) :: ErrStat2 ! The error status code CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred - CHARACTER(1024) :: AABlFile(MaxBl) ! File that contains the blade information (specified in the primary input file) CHARACTER(*), PARAMETER :: RoutineName = 'ReadInputFiles' ! initialize values: ErrStat = ErrID_None @@ -85,29 +84,23 @@ SUBROUTINE ReadInputFiles( InputFileName, BL_Files, InputFileData, Default_DT, O ! Reads the module input-file data - CALL ReadPrimaryFile( InputFileName, InputFileData, AABlFile, Default_DT, OutFileRoot, UnEcho, ErrStat2, ErrMsg2 ) + CALL ReadPrimaryFile( InputFileName, InputFileData, Default_DT, OutFileRoot, UnEcho, ErrStat2, ErrMsg2 ) if(Failed()) return ! get the blade input-file data - ALLOCATE( InputFileData%BladeProps( NumBlades ), STAT = ErrStat2 ) + ALLOCATE( InputFileData%BladeProps( size(BL_Files) ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating memory for BladeProps.", ErrStat, ErrMsg, RoutineName) return END IF - do i = 1,NumBlades - CALL ReadBladeInputs ( AABlFile(i), InputFileData%BladeProps(i), UnEcho, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName//TRIM(':Blade')//TRIM(Num2LStr(I))) - if(Failed()) return - end do - - if ((InputFileData%ITURB.eq.2) .or. (InputFileData%X_BLMethod.eq.2)) then + if ((InputFileData%ITURB==2) .or. (InputFileData%X_BLMethod==2) .or. (InputFileData%IBLUNT==1)) then ! We need to read the BL tables - CALL ReadBLTables( InputFileName, BL_Files, InputFileData, InputFileData%BladeProps(1)%NumBlNds, ErrStat2, ErrMsg2 ) + CALL ReadBLTables( InputFileName, BL_Files, InputFileData, ErrStat2, ErrMsg2 ) if (Failed())return endif - IF( (InputFileData%TICalcMeth.eq.1) ) THEN + IF( (InputFileData%TICalcMeth==1) ) THEN CALL REadTICalcTables(InputFileName,InputFileData, ErrStat2, ErrMsg2); if(Failed()) return ENDIF @@ -121,11 +114,10 @@ END SUBROUTINE ReadInputFiles !---------------------------------------------------------------------------------------------------------------------------------- !> This routine reads in the primary Noise input file and places the values it reads in the InputFileData structure. ! It opens and prints to an echo file if requested. -SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, AABlFile, Default_DT, OutFileRoot, UnEc, ErrStat, ErrMsg ) +SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, Default_DT, OutFileRoot, UnEc, ErrStat, ErrMsg ) integer(IntKi), intent(out) :: UnEc ! I/O unit for echo file. If > 0, file is open for writing. integer(IntKi), intent(out) :: ErrStat ! Error status REAL(DbKi), INTENT(IN) :: Default_DT ! The default DT (from glue code) - character(*), intent(out) :: AABlFile(MaxBl) ! name of the files containing blade inputs character(*), intent(in) :: InputFile ! Name of the file containing the primary input data character(*), intent(out) :: ErrMsg ! Error message character(*), intent(in) :: OutFileRoot ! The rootname of the echo file, possibly opened in this routine @@ -230,12 +222,6 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, AABlFile, Default_DT, Out CALL ReadVar(UnIn,InputFile,InputFileData%ROUND ,"RoundTip" ,"" ,ErrStat2,ErrMsg2,UnEc); call check CALL ReadVar(UnIn,InputFile,InputFileData%ALPRAT ,"ALPRAT" ,"" ,ErrStat2,ErrMsg2,UnEc); call check CALL ReadVar(UnIn,InputFile,InputFileData%IBLUNT ,"BluntMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check - - ! AABlFile - Names of files containing distributed aerodynamic properties for each blade (see AA_BladeInputFile type): - DO I = 1,MaxBl - CALL ReadVar ( UnIn, InputFile, AABlFile(I), 'AABlFile('//TRIM(Num2Lstr(I))//')', 'Name of file containing distributed aerodynamic properties for blade '//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ); call check - IF ( PathIsRelative( AABlFile(I) ) ) AABlFile(I) = TRIM(PriPath)//TRIM(AABlFile(I)) - END DO ! Return on error at end of section IF ( ErrStat >= AbortErrLev ) THEN @@ -307,58 +293,6 @@ END SUBROUTINE Cleanup !............................................................................................................................... END SUBROUTINE ReadPrimaryFile !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine reads a blade input file. -SUBROUTINE ReadBladeInputs ( AABlFile, BladeKInputFileData, UnEc, ErrStat, ErrMsg ) - TYPE(AA_BladePropsType), INTENT(INOUT) :: BladeKInputFileData ! Data for Blade K stored in the module's input file - CHARACTER(*), INTENT(IN) :: AABlFile ! Name of the blade input file data - INTEGER(IntKi), INTENT(IN) :: UnEc ! I/O unit for echo file. If present and > 0, write to UnEc - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Error status - CHARACTER(*), INTENT(OUT) :: ErrMsg ! Error message - ! Local variables: - INTEGER(IntKi) :: I ! A generic DO index. - INTEGER( IntKi ) :: UnIn ! Unit number for reading file - INTEGER(IntKi) :: ErrStat2 , IOS ! Temporary Error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Err msg - CHARACTER(*), PARAMETER :: RoutineName = 'ReadBladeInputs' - ErrStat = ErrID_None - ErrMsg = "" - UnIn = -1 - ! Allocate space for these variables - CALL GetNewUnit (UnIn, ErrStat2, ErrMsg2 ); if(Failed()) return - CALL OpenFInpFile (UnIn, AABlFile, ErrStat2, ErrMsg2 ); if(Failed()) return - ! -------------- HEADER ------------------------------------------------------- - ! Skip the header. - CALL ReadCom ( UnIn, AABlFile, 'unused blade file header line 1', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - CALL ReadCom ( UnIn, AABlFile, 'unused blade file header line 2', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - ! -------------- Blade properties table ------------------------------------------ - CALL ReadCom ( UnIn, AABlFile, 'Section header: Blade Properties', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - ! NumBlNds - Number of blade nodes used in the analysis (-): - CALL ReadVar( UnIn, AABlFile, BladeKInputFileData%NumBlNds, "NumBlNds", "Number of blade nodes used in the analysis (-)", ErrStat2, ErrMsg2, UnEc); if(Failed()) return - CALL ReadCom ( UnIn, AABlFile, 'Table header: names', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - CALL ReadCom ( UnIn, AABlFile, 'Table header: units', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - ! allocate space for blade inputs: - CALL AllocAry(BladeKInputFileData%TEAngle ,BladeKInputFileData%NumBlNds,'TEAngle' ,ErrStat2,ErrMsg2); if(Failed()) return - CALL AllocAry(BladeKInputFileData%TEThick ,BladeKInputFileData%NumBlNds,'TEThick' ,ErrStat2,ErrMsg2); if(Failed()) return - CALL AllocAry(BladeKInputFileData%StallStart,BladeKInputFileData%NumBlNds,'StallStart',ErrStat2,ErrMsg2); if(Failed()) return - DO I=1,BladeKInputFileData%NumBlNds - READ( UnIn, *, IOStat=IOS ) BladeKInputFileData%TEAngle(I), BladeKInputFileData%TEThick(I) - CALL CheckIOS( IOS, AABlFile, 'Blade properties row '//TRIM(Num2LStr(I)), NumType, ErrStat2, ErrMsg2); if(Failed()) return - IF (UnEc > 0) THEN - WRITE( UnEc, "(6(F9.4,1x),I9)", IOStat=IOS) BladeKInputFileData%TEAngle(I), BladeKInputFileData%TEThick(I) - END IF - END DO - ! -------------- END OF FILE -------------------------------------------- - 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 (UnIn > 0) CLOSE(UnIn) - END SUBROUTINE Cleanup -END SUBROUTINE ReadBladeInputs ! ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- @@ -388,12 +322,11 @@ subroutine ReadRealMatrix(fid, FileName, Mat, VarName, nLines,nRows, iStat, Msg, -SUBROUTINE ReadBLTables( InputFile,BL_Files,InputFileData, nAirfoils, ErrStat, ErrMsg ) +SUBROUTINE ReadBLTables( InputFile, BL_Files, InputFileData, ErrStat, ErrMsg ) ! Passed variables character(*), intent(in) :: InputFile ! Name of the file containing the primary input data character(*), dimension(:), intent(in) :: BL_Files ! Name of the file containing the primary input data -type(AA_InputFile), intent(inout) :: InputFileData ! All the data in the Noise input file - integer(IntKi), intent(in) :: nAirfoils ! Number of Airfoil tables +type(AA_InputFile), intent(inout) :: InputFileData ! All the data in the Noise input file integer(IntKi), intent(out) :: ErrStat ! Error status character(*), intent(out) :: ErrMsg ! Error message ! Local variables: @@ -406,7 +339,7 @@ SUBROUTINE ReadBLTables( InputFile,BL_Files,InputFileData, nAirfoils, ErrStat, E character(1024) :: FTitle ! "File Title": the 2nd line of the input file, which contains a description of its contents character(200) :: Line ! Temporary storage of a line from the input file (to compare with "default") character(*), parameter :: RoutineName = 'readbltable' - integer(IntKi) :: nRe, nAoA ! Number of Reynolds number and angle of attack listed + integer(IntKi) :: nRe, nAoA, nAirfoils ! Number of Reynolds number, angle of attack, and number of airfoils listed integer(IntKi) :: iAF , iRe, iAoA, iDummy, iBuffer ! loop counters real(DbKi),dimension(:,:),ALLOCATABLE :: Buffer integer :: iLine @@ -415,7 +348,7 @@ SUBROUTINE ReadBLTables( InputFile,BL_Files,InputFileData, nAirfoils, ErrStat, E ErrMsg = "" CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - + nAirfoils = size(BL_Files) do iAF=1,nAirfoils FileName = trim(BL_Files(iAF)) @@ -474,6 +407,17 @@ SUBROUTINE ReadBLTables( InputFile,BL_Files,InputFileData, nAirfoils, ErrStat, E InputFileData%AoAListBL(iAoA)= Buffer(iAoA, 1) ! AoA enddo endif + + if (InputFileData%IBLUNT==1) then + call ReadCom(UnIn, FileName, 'Comment' , ErrStat2, ErrMsg2) + call ReadCom(UnIn, FileName, 'Comment' , ErrStat2, ErrMsg2) + call ReadVar(UnIn, FileName, InputFileData%BladeProps(iAF)%TEAngle, 'TEAngle', 'TE Angle',ErrStat2, ErrMsg2); if(Failed()) return + call ReadVar(UnIn, FileName, InputFileData%BladeProps(iAF)%TEThick, 'TEThick', 'TE Thick',ErrStat2, ErrMsg2); if(Failed()) return + else + InputFileData%BladeProps(iAF)%TEAngle = 0._ReKi + InputFileData%BladeProps(iAF)%TEThick = 0._ReKi + endif + if (UnIn > 0) CLOSE(UnIn) enddo diff --git a/modules/aerodyn/src/AeroAcoustics_Registry.txt b/modules/aerodyn/src/AeroAcoustics_Registry.txt index b5d1a865e..13a9933d8 100644 --- a/modules/aerodyn/src/AeroAcoustics_Registry.txt +++ b/modules/aerodyn/src/AeroAcoustics_Registry.txt @@ -20,17 +20,14 @@ usefrom AirfoilInfo_Registry.txt # ..... Input file data ........................................................................................................... # This is data defined in the Input File for this module (or could otherwise be passed in) # ..... Blade Input file data ..................................................................................................... -typedef AeroAcoustics/AA AA_BladePropsType IntKi NumBlNds - - - "Number of blade nodes used in the analysis" - -typedef ^ AA_BladePropsType ReKi TEThick {:} - - "" - -typedef ^ AA_BladePropsType ReKi StallStart {:} - - "" - -typedef ^ AA_BladePropsType ReKi TEAngle {:} - - "" - -typedef ^ AA_BladePropsType ReKi AerCent {:} - - "" - +typedef AeroAcoustics/AA AA_BladePropsType ReKi TEThick - - - "" - +typedef ^ AA_BladePropsType ReKi TEAngle - - - "" - # # ..... Initialization data ....................................................................................................... # Define inputs that the initialization routine may need here: typedef AeroAcoustics/AA InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - typedef ^ InitInputType IntKi NumBlades - - - "Number of blades on the turbine" -typedef ^ InitInputType IntKi NumBlNds - - - "Number of blades on the turbine" +typedef ^ InitInputType IntKi NumBlNds - - - "Number of blade nodes" typedef ^ InitInputType CHARACTER(1024) RootName - - - "RootName for writing output files" - typedef ^ InitInputType ReKi BlSpn {:}{:} - - "Span at blade node" m typedef ^ InitInputType ReKi BlChord {:}{:} - - "Chord at blade node" m diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 9ed3b64f5..f17474138 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -36,18 +36,15 @@ MODULE AeroAcoustics_Types IMPLICIT NONE ! ========= AA_BladePropsType ======= TYPE, PUBLIC :: AA_BladePropsType - INTEGER(IntKi) :: NumBlNds !< Number of blade nodes used in the analysis [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TEThick !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: StallStart !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TEAngle !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AerCent !< [-] + REAL(ReKi) :: TEThick !< [-] + REAL(ReKi) :: TEAngle !< [-] END TYPE AA_BladePropsType ! ======================= ! ========= AA_InitInputType ======= TYPE, PUBLIC :: AA_InitInputType CHARACTER(1024) :: InputFile !< Name of the input file [-] INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumBlNds !< Number of blades on the turbine [-] + INTEGER(IntKi) :: NumBlNds !< Number of blade nodes [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlSpn !< Span at blade node [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlChord !< Chord at blade node [m] @@ -297,55 +294,8 @@ SUBROUTINE AA_CopyBladePropsType( SrcBladePropsTypeData, DstBladePropsTypeData, ! ErrStat = ErrID_None ErrMsg = "" - DstBladePropsTypeData%NumBlNds = SrcBladePropsTypeData%NumBlNds -IF (ALLOCATED(SrcBladePropsTypeData%TEThick)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%TEThick,1) - i1_u = UBOUND(SrcBladePropsTypeData%TEThick,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%TEThick)) THEN - ALLOCATE(DstBladePropsTypeData%TEThick(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%TEThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF DstBladePropsTypeData%TEThick = SrcBladePropsTypeData%TEThick -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%StallStart)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%StallStart,1) - i1_u = UBOUND(SrcBladePropsTypeData%StallStart,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%StallStart)) THEN - ALLOCATE(DstBladePropsTypeData%StallStart(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%StallStart.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%StallStart = SrcBladePropsTypeData%StallStart -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%TEAngle)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%TEAngle,1) - i1_u = UBOUND(SrcBladePropsTypeData%TEAngle,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%TEAngle)) THEN - ALLOCATE(DstBladePropsTypeData%TEAngle(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%TEAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF DstBladePropsTypeData%TEAngle = SrcBladePropsTypeData%TEAngle -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%AerCent)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%AerCent,1) - i1_u = UBOUND(SrcBladePropsTypeData%AerCent,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%AerCent)) THEN - ALLOCATE(DstBladePropsTypeData%AerCent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%AerCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%AerCent = SrcBladePropsTypeData%AerCent -ENDIF END SUBROUTINE AA_CopyBladePropsType SUBROUTINE AA_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg ) @@ -357,18 +307,6 @@ SUBROUTINE AA_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg ) ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(BladePropsTypeData%TEThick)) THEN - DEALLOCATE(BladePropsTypeData%TEThick) -ENDIF -IF (ALLOCATED(BladePropsTypeData%StallStart)) THEN - DEALLOCATE(BladePropsTypeData%StallStart) -ENDIF -IF (ALLOCATED(BladePropsTypeData%TEAngle)) THEN - DEALLOCATE(BladePropsTypeData%TEAngle) -ENDIF -IF (ALLOCATED(BladePropsTypeData%AerCent)) THEN - DEALLOCATE(BladePropsTypeData%AerCent) -ENDIF END SUBROUTINE AA_DestroyBladePropsType SUBROUTINE AA_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -406,27 +344,8 @@ SUBROUTINE AA_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! NumBlNds - Int_BufSz = Int_BufSz + 1 ! TEThick allocated yes/no - IF ( ALLOCATED(InData%TEThick) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TEThick upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TEThick) ! TEThick - END IF - Int_BufSz = Int_BufSz + 1 ! StallStart allocated yes/no - IF ( ALLOCATED(InData%StallStart) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! StallStart upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%StallStart) ! StallStart - END IF - Int_BufSz = Int_BufSz + 1 ! TEAngle allocated yes/no - IF ( ALLOCATED(InData%TEAngle) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TEAngle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TEAngle) ! TEAngle - END IF - Int_BufSz = Int_BufSz + 1 ! AerCent allocated yes/no - IF ( ALLOCATED(InData%AerCent) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AerCent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AerCent) ! AerCent - END IF + Re_BufSz = Re_BufSz + 1 ! TEThick + Re_BufSz = Re_BufSz + 1 ! TEAngle IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -454,68 +373,10 @@ SUBROUTINE AA_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf(Int_Xferred) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TEThick) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TEThick,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEThick,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TEThick,1), UBOUND(InData%TEThick,1) - ReKiBuf(Re_Xferred) = InData%TEThick(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%StallStart) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StallStart,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StallStart,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%StallStart,1), UBOUND(InData%StallStart,1) - ReKiBuf(Re_Xferred) = InData%StallStart(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%TEAngle) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TEAngle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEAngle,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%TEAngle,1), UBOUND(InData%TEAngle,1) - ReKiBuf(Re_Xferred) = InData%TEAngle(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%AerCent) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AerCent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AerCent,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AerCent,1), UBOUND(InData%AerCent,1) - ReKiBuf(Re_Xferred) = InData%AerCent(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF + ReKiBuf(Re_Xferred) = InData%TEThick + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEAngle + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AA_PackBladePropsType SUBROUTINE AA_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -548,80 +409,10 @@ SUBROUTINE AA_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumBlNds = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TEThick not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TEThick)) DEALLOCATE(OutData%TEThick) - ALLOCATE(OutData%TEThick(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TEThick,1), UBOUND(OutData%TEThick,1) - OutData%TEThick(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StallStart not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StallStart)) DEALLOCATE(OutData%StallStart) - ALLOCATE(OutData%StallStart(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StallStart.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%StallStart,1), UBOUND(OutData%StallStart,1) - OutData%StallStart(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TEAngle not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TEAngle)) DEALLOCATE(OutData%TEAngle) - ALLOCATE(OutData%TEAngle(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%TEAngle,1), UBOUND(OutData%TEAngle,1) - OutData%TEAngle(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AerCent not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AerCent)) DEALLOCATE(OutData%AerCent) - ALLOCATE(OutData%AerCent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AerCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AerCent,1), UBOUND(OutData%AerCent,1) - OutData%AerCent(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF + OutData%TEThick = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEAngle = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AA_UnPackBladePropsType SUBROUTINE AA_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) From ddbdd15769f762ddaca5642e354eab1cfb02aa69 Mon Sep 17 00:00:00 2001 From: pibo Date: Thu, 19 Nov 2020 15:14:24 -0700 Subject: [PATCH 03/12] update docs aeroacoustics --- .../user/aerodyn-aeroacoustics/App-usage.rst | 62 +++++++------------ 1 file changed, 22 insertions(+), 40 deletions(-) diff --git a/docs/source/user/aerodyn-aeroacoustics/App-usage.rst b/docs/source/user/aerodyn-aeroacoustics/App-usage.rst index fb36ee7c2..2f04a91b4 100644 --- a/docs/source/user/aerodyn-aeroacoustics/App-usage.rst +++ b/docs/source/user/aerodyn-aeroacoustics/App-usage.rst @@ -97,12 +97,7 @@ models: - **BluntMod** – Integer 0/1: flag to activate (**BluntMod=1**) the trailing-edge bluntness – vortex shedding model, see :numref:`aa-TE-vortex`. If the flag is set to 1, the trailing-edge geometry must be specified in - the file(s) listed in the field Blade Properties. - -Next, the field Blade Properties lists three file names, often but not -necessarily identical, which contain the distributed properties -describing the detailed geometry of the trailing edge. These are -described in :numref:`aa-sec-TEgeom`. + the files as described in :numref:`aa-sec-BLinputs`. The field Observer Locations contains the path to the file where the number of observers (NrObsLoc) and the respective locations are @@ -141,7 +136,7 @@ The file must be closed by an END command. .. _aa-sec-BLinputs: -Boundary Layer Inputs +Boundary Layer Inputs and Trailing Edge Geometry --------------------- When the flag **BLMod** is set equal to 2, pretabulated properties of the @@ -188,6 +183,26 @@ outputs of XFoil. Because it is usually impossible to obtain these values for the whole ranges of Reynolds numbers and angles of attack, the code is set to adopt the last available values and print to screen a warning. +When the flag **BluntMod** is set to 1, the detailed geometry of the +trailing edge must also be defined along the span. Two inputs must be +provided, namely the angle, :math:`\Psi` between the suction and +pressure sides of the profile, right before the trailing-edge point, and +the height, :math:`h`, of the trailing edge. :math:`\Psi` must be +defined in degrees, while :math:`h` is in meters. Note that the BPM +trailing-edge bluntness model is very sensitive to these two parameters, +which, however, are often not easy to determine for real blades. +:numref:`aa-fig:GeomParamTE` shows the two inputs. + +.. figure:: media/NoiseN011.png + :alt: Geometric parameters of the trailing-edge bluntness + :name: aa-fig:GeomParamTE + :width: 100.0% + + Geometric parameters :math:`\mathbf{\Psi}` and + :math:`\mathbf{h}` of the trailing-edge bluntness + +One value of :math:`\Psi` and one value of :math:`h` per file must be defined. +These values are not used if the flag **BluntMod** is set to 0. .. container:: :name: aa-tab:AF20_BL @@ -264,38 +279,5 @@ grid looks like the following: :language: none -.. _aa-sec-TEgeom: - -Trailing-Edge Geometry ----------------------- - -When the flag **BluntMod** is set to 1, the detailed geometry of the -trailing edge must be defined along the span. Two inputs must be -provided, namely the angle, :math:`\Psi,` between the suction and -pressure sides of the profile, right before the trailing-edge point, and -the height, :math:`h`, of the trailing edge. :math:`\Psi` must be -defined in degrees, while :math:`h` is in meters. Note that the BPM -trailing-edge bluntness model is very sensitive to these two parameters, -which, however, are often not easy to determine for real blades. -:numref:`aa-fig:GeomParamTE` shows the two inputs. - -.. figure:: media/NoiseN011.png - :alt: Geometric parameters of the trailing-edge bluntness - :name: aa-fig:GeomParamTE - :width: 100.0% - - Geometric parameters :math:`\mathbf{\Psi}` and - :math:`\mathbf{h}` of the trailing-edge bluntness - -The two distributions must be defined with the same spanwise resolution -of the AeroDyn15 blade file, such as: - -.. container:: - :name: aa-tab:BladeProp - - .. literalinclude:: example/BladeProp.dat - :linenos: - :language: none - .. [4] https://github.com/OpenFAST/python-toolbox From 64a22081a0f3b1798d132058e0fc0c834fc990a9 Mon Sep 17 00:00:00 2001 From: Rafael M Mudafort Date: Fri, 20 Nov 2020 13:29:42 -0600 Subject: [PATCH 04/12] Get new TE definitions from r-test --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 7ab61a078..daf08a6a9 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 7ab61a078f6dc48b26234988fbef84fbf7676ad2 +Subproject commit daf08a6a9f55ada9b947a18f1d28af992a601e8d From 1e5f066ab9b170b327a4e600618a6aa74ab06cb7 Mon Sep 17 00:00:00 2001 From: pibo Date: Wed, 6 Jan 2021 19:02:04 -0700 Subject: [PATCH 05/12] Lturb and AvgV among inputs --- modules/aerodyn/src/AeroAcoustics.f90 | 38 +++++++++++-------- modules/aerodyn/src/AeroAcoustics_IO.f90 | 5 ++- .../aerodyn/src/AeroAcoustics_Registry.txt | 6 ++- modules/aerodyn/src/AeroAcoustics_Types.f90 | 34 ++++++++++++----- 4 files changed, 54 insertions(+), 29 deletions(-) diff --git a/modules/aerodyn/src/AeroAcoustics.f90 b/modules/aerodyn/src/AeroAcoustics.f90 index 83eb9210c..e8004cfe2 100644 --- a/modules/aerodyn/src/AeroAcoustics.f90 +++ b/modules/aerodyn/src/AeroAcoustics.f90 @@ -156,7 +156,7 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) p%KinVisc = InitInp%KinVisc p%SpdSound = InitInp%SpdSound p%HubHeight = InitInp%HubHeight - p%z0_AA = InputFileData%z0_AA + p%Lturb = InputFileData%Lturb p%dy_turb_in = InputFileData%dy_turb_in p%dz_turb_in = InputFileData%dz_turb_in p%NrObsLoc = InputFileData%NrObsLoc @@ -164,6 +164,7 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) call AllocAry(p%TI_Grid_In,size(InputFileData%TI_Grid_In,1), size(InputFileData%TI_Grid_In,2), 'p%TI_Grid_In', errStat2, errMsg2); if(Failed()) return p%TI_Grid_In=InputFileData%TI_Grid_In + p%AvgV=InputFileData%AvgV ! Copy AFInfo into AA module ! TODO Allocate AFInfo and AFindx variables (DONE AND DONE) @@ -652,7 +653,7 @@ subroutine AA_UpdateStates( t, n, m, u, p, xd, errStat, errMsg ) character(ErrMsgLen) :: ErrMsg2 ! temporary Error message character(*), parameter :: RoutineName = 'AA_UpdateStates' REAL(ReKi),DIMENSION(p%NumBlNds,p%numBlades) :: TEMPSTD ! temporary standard deviation variable - REAL(ReKi) :: tempsingle,tempmean,angletemp,abs_le_x ! temporary standard deviation variable + REAL(ReKi) :: tempsingle,tempmean,angletemp,abs_le_x,ti_vx,U1,U2 ! temporary standard deviation variable integer(intKi) :: i,j,k,rco, y0_a,y1_a,z0_a,z1_a logical :: exist REAL(ReKi) :: yi_a,zi_a,yd_a,zd_a,c00_a,c10_a @@ -724,8 +725,16 @@ subroutine AA_UpdateStates( t, n, m, u, p, xd, errStat, errMsg ) yd_a=yi_a-y0_a c00_a=(1.0_ReKi-yd_a)*p%TI_Grid_In(z0_a+1,y0_a+1)+yd_a*p%TI_Grid_In(z0_a+1,y1_a+1) c10_a=(1.0_ReKi-yd_a)*p%TI_Grid_In(z1_a+1,y0_a+1)+yd_a*p%TI_Grid_In(z1_a+1,y1_a+1) - ! 2 points - xd%TIVx(j,i)=(1.0_ReKi-zd_a)*c00_a+zd_a*c10_a + + ! This is the turbulence intensity of the wind at the location of the blade i at node j + ti_vx = (1.0_ReKi-zd_a)*c00_a+zd_a*c10_a + ! With some velocity triangles, we convert it into the incident turbulence intensity, i.e. the TI used by the Amiet model + U1 = u%Vrel(J,I) + U2 = SQRT((p%AvgV*(1.+ti_vx))**2. + U1**2. - p%AvgV**2.) + ! xd%TIVx(j,i)=(U2-U1)/U1 + xd%TIVx(j,i)=p%AvgV*ti_vx/U1 + + if (i.eq.p%NumBlades) then if (j.eq.p%NumBlNds) then endif @@ -1686,7 +1695,6 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,MeanVNoise,TINoise,LE REAL(ReKi) :: Directivity ! Directivity correction factor REAL(ReKi) :: Frequency_cutoff ! Cutoff frequency between REAL(ReKi) :: LFC ! low-frequency correction factor - REAL(ReKi) :: LTurb ! turbulence length scale (isotropic integral scale parameter from IEC standard (Von Karman)) REAL(ReKi) :: Mach ! local mach number REAL(ReKi) :: Sears ! Sears function REAL(ReKi) :: SPLhigh ! predicted high frequency sound pressure level @@ -1709,7 +1717,7 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,MeanVNoise,TINoise,LE ! This part is recently added for height and surface roughness dependent estimation of turbulence intensity and turbulence scales !%Lturb=300*(Z/300)^(0.46+0.074*log(p%z0_aa)); !% Gives larger length scale - Lturb=25.d0*LE_Location**(0.35)*p%z0_aa**(-0.063) !% Gives smaller length scale ! Wei Jun Zhu, Modeling of Aerodynamically generated Noise From Wind Turbines + ! Lturb=25.d0*LE_Location**(0.35)*p%z0_aa**(-0.063) !% Gives smaller length scale ! Wei Jun Zhu, Modeling of Aerodynamically generated Noise From Wind Turbines ! L_Gammas=0.24+0.096*log10(p%z0_aa)+0.016*(log10(p%z0_aa))**2; !% Can be computed or just give it a value. ! Wei Jun Zhu, Modeling of Aerodynamically generated Noise From Wind Turbines !tinooisess=L_Gammas*log(30.d0/p%z0_aa)/log(LE_Location/p%z0_aa) !% F.E. 16% is 0.16 which is the correct input for SPLhIgh, no need to divide 100 ! ! Wei Jun Zhu, Modeling of Aerodynamically generated Noise From Wind Turbines tinooisess=TINoise @@ -1733,7 +1741,7 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,MeanVNoise,TINoise,LE !*********************************************** Model 1: !!! Nafnoise source code version see below Frequency_cutoff = 10*U/PI/Chord - Ke = 3.0/(4.0*LTurb) + Ke = 3.0/(4.0*p%Lturb) Beta2 = 1-Mach*Mach ALPSTAR = AlphaNoise*PI/180. @@ -1749,10 +1757,10 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,MeanVNoise,TINoise,LE Khat = WaveNumber/Ke ! mu = Mach*WaveNumber*Chord/2.0/Beta2 - SPLhigh = 10.*LOG10(p%AirDens*p%AirDens*p%SpdSound**4*LTurb*(d/2.)/ & + SPLhigh = 10.*LOG10(p%AirDens*p%AirDens*p%SpdSound**4*p%Lturb*(d/2.)/ & (RObs*RObs)*(Mach**5)*tinooisess*tinooisess*(Khat**3)* & (1+Khat**2)**(-7./3.)*Directivity) + 78.4 ! ref a) - !!! SPLhigh = 10.*LOG10(LTurb*(d/2.)/ & + !!! SPLhigh = 10.*LOG10(p%Lturb*(d/2.)/ & !!! (RObs*RObs)*(Mach**5)*tinooisess*tinooisess*(WaveNumber**3) & !!! *(1+WaveNumber**2)**(-7./3.)*Directivity) + 181.3 @@ -1784,7 +1792,7 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,MeanVNoise,TINoise,LE ! ! corresponding line: Ssq = (2.d0*pi*K/Bsq + (1.d0+2.4d0*K/Bsq)**(-1))**(-1); ! LFC = 10.d0 * Sears*Mach*WaveNumber**2*Beta2**(-1); ! ! corresponding line: LFC = 10.d0 * Ssq*Ma*K**2*Bsq**(-1); -! SPLti(I)=(p%AirDens*p%AirDens*p%SpdSound*p%SpdSound*Lturb*d)/(2*RObs*RObs) +! SPLti(I)=(p%AirDens*p%AirDens*p%SpdSound*p%SpdSound*p%Lturb*d)/(2*RObs*RObs) ! ! SPLti(I)=SPLti(I)*(Mach**3)*(MeanVnoise**2)*(tinooisess**2) ! SPLti(I)=SPLti(I)*(Mach**3)*(tinooisess**2) ! ! SPLti(I)=SPLti(I)*(Mach**3)*ufluct**2 @@ -1792,14 +1800,14 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,MeanVNoise,TINoise,LE ! SPLti(I)=SPLti(I)*DBARH ! SPLti(I)=10*log10(SPLti(I))+58.4 ! SPLti(I) = SPLti(I) + 10.*LOG10(LFC/(1+LFC)) -! ! SPLti(I)=10.d0*log10(DBARH*p%AirDens**2*p%SpdSound**2*Lturb*d/2.0*Mach**3*tinooisess**2* & +! ! SPLti(I)=10.d0*log10(DBARH*p%AirDens**2*p%SpdSound**2*p%Lturb*d/2.0*Mach**3*tinooisess**2* & ! !WaveNumber**3*(1.d0+WaveNumber**2)**(-7.d0/3.d0)/RObs**2)+58.4d0 + 10.d0*log10(LFC/(1+LFC)) ! ! corresponding line: SPLti(i)=10.d0*log10(Di_hi_fr*Density**2*co**2*Tbscale*L/2.0*Ma ! ! & **3*Tbinten**2*K**3*(1.d0+K**2)**(-7.d0/3.d0)/Distance**2)+58.4d0 ! ! & + 10.d0*log10(LFC/(1+LFC)); ! ! !% ver2.! -! ! Kh = 8.d0*pi*p%FreqList(i)*Lturb/(3.d0*U); -! ! SPLti(i) = 10*log10(DBARH*Lturb*0.5*d*Mach**5*tinooisess**2*Kh**3*(1+Kh**2)**(-7/3)/RObs**2) +& +! ! Kh = 8.d0*pi*p%FreqList(i)*p%Lturb/(3.d0*U); +! ! SPLti(i) = 10*log10(DBARH*p%Lturb*0.5*d*Mach**5*tinooisess**2*Kh**3*(1+Kh**2)**(-7/3)/RObs**2) +& ! ! 10*log10(10**18.13) + 10*log10(DBARH*LFC/(1+LFC)); ! ! ENDDO @@ -1816,7 +1824,7 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,MeanVNoise,TINoise,LE !!!! ! corresponding line: Ssq = (2.d0*pi*K/Bsq + (1.d0+2.4d0*K/Bsq)**(-1))**(-1); !!!! LFC = 10.d0 * Sears*Mach*WaveNumber**2*Beta2**(-1); !!!! ! corresponding line: LFC = 10.d0 * Ssq*Ma*K**2*Bsq**(-1); -!!!! SPLti(I)=(p%AirDens*p%AirDens*p%SpdSound*p%SpdSound*Lturb*d)/(2*RObs*RObs) +!!!! SPLti(I)=(p%AirDens*p%AirDens*p%SpdSound*p%SpdSound*p%Lturb*d)/(2*RObs*RObs) !!!! SPLti(I)=SPLti(I)*(Mach**3)*(MeanVnoise**2)*(tinooisess**2) !!!! SPLti(I)=(SPLti(I)*(WaveNumber**3)) / ((1+WaveNumber**2)**(7./3.)) !!!! SPLti(I)=SPLti(I)*DBARH @@ -1892,7 +1900,7 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,MeanVNoise,TINoise,LE !! ENDIF !! WaveNumber = PI*p%FreqList(I)*Chord/U !! Beta2 = 1-Mach*Mach -!! SPLhigh = 10.*LOG10(p%AirDens*p%AirDens*p%SpdSound*p%SpdSound*LTurb*(d/2.)/(RObs*RObs)*(Mach**3)*Ums* & +!! SPLhigh = 10.*LOG10(p%AirDens*p%AirDens*p%SpdSound*p%SpdSound*p%Lturb*(d/2.)/(RObs*RObs)*(Mach**3)*Ums* & !! (WaveNumber**3)*(1+WaveNumber**2)**(-7./3.)*Directivity) + 58.4 !! Sears = 1/(2*PI*WaveNumber/Beta2+1/(1+2.4*WaveNumber/Beta2)) !! LFC = 10*Sears*Mach*WaveNumber*WaveNumber/Beta2 diff --git a/modules/aerodyn/src/AeroAcoustics_IO.f90 b/modules/aerodyn/src/AeroAcoustics_IO.f90 index eb26ced86..1fde6bc86 100644 --- a/modules/aerodyn/src/AeroAcoustics_IO.f90 +++ b/modules/aerodyn/src/AeroAcoustics_IO.f90 @@ -213,7 +213,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, Default_DT, OutFileRoot, U CALL ReadVar(UnIn,InputFile,InputFileData%IInflow ,"InflowMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check CALL ReadVar(UnIn,InputFile,InputFileData%TICalcMeth ,"TICalcMeth" ,"" ,ErrStat2,ErrMsg2,UnEc); call check CALL ReadVAr(UnIn,InputFile,InputFileData%TICalcTabFile,"TICalcTabFile","" ,ErrStat2,ErrMsg2,UnEc); call check - CALL ReadVar(UnIn,InputFile,InputFileData%z0_AA ,"SurfRoughness","" ,ErrStat2,ErrMsg2,UnEc); call check + CALL ReadVar(UnIn,InputFile,InputFileData%Lturb ,"Lturb" ,"" ,ErrStat2,ErrMsg2,UnEc); call check CALL ReadVar(UnIn,InputFile,InputFileData%ITURB ,"TurbMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check ! ITURB - TBLTE NOISE CALL ReadVar(UnIn,InputFile,InputFileData%X_BLMethod ,"BLMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check CALL ReadVar(UnIn,InputFile,InputFileData%ITRIP ,"TripMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check @@ -464,7 +464,8 @@ SUBROUTINE ReadTICalcTables(InputFile, InputFileData, ErrStat, ErrMsg) CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2); call check() CALL OpenFInpFile ( UnIn, FileName, ErrStat2, ErrMsg2 ); if(Failed()) return - + CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check + CALL ReadVar(UnIn, FileName, InputFileData%AvgV, 'AvgV', 'Echo flag', ErrStat2, ErrMsg2); call check CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check CALL ReadVar(UnIn, FileName, GridY, 'GridY', 'Echo flag', ErrStat2, ErrMsg2); call check CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2);call check diff --git a/modules/aerodyn/src/AeroAcoustics_Registry.txt b/modules/aerodyn/src/AeroAcoustics_Registry.txt index 13a9933d8..ec84c4c06 100644 --- a/modules/aerodyn/src/AeroAcoustics_Registry.txt +++ b/modules/aerodyn/src/AeroAcoustics_Registry.txt @@ -77,7 +77,8 @@ typedef ^ AA_InputFile CHARACTER(1024) AAoutfi typedef ^ AA_InputFile CHARACTER(1024) TICalcTabFile - - - "Name of the file containing the table for incident turbulence intensity" - typedef ^ AA_InputFile CHARACTER(1024) FTitle - - - "File Title: the 2nd line of the input file, which contains a description of its contents" - typedef ^ AA_InputFile DBKi AAStart - - - "Time after which to calculate AA" s -typedef ^ AA_InputFile ReKi z0_AA - - - "Surface roughness" - +typedef ^ AA_InputFile ReKi Lturb - - - "Turbulent lengthscale in Amiet model" - +typedef ^ AA_InputFile ReKi AvgV - - - "Average wind speed to compute incident turbulence intensity" m typedef ^ AA_InputFile ReKi ReListBL {:} - - "" typedef ^ AA_InputFile ReKi AoAListBL {:} - - "" deg typedef ^ AA_InputFile ReKi Pres_DispThick {:}{:}{:} - - "" @@ -182,7 +183,8 @@ typedef ^ ParameterType IntKi total_s typedef ^ ParameterType IntKi total_sampleTI - - - "Total FFT Sample amount for dissipation calculation" - typedef ^ ParameterType IntKi AA_Bl_Prcntge - - - "The Percentage of the Blade which the noise is calculated" % typedef ^ ParameterType IntKi startnode - - - "Corersponding node to the noise calculation percentage of the blade" - -typedef ^ ParameterType ReKi z0_aa - - - "Surface roughness" m +typedef ^ ParameterType ReKi Lturb - - - "Turbulent lengthscale in Amiet model" m +typedef ^ ParameterType ReKi AvgV - - - "Average wind speed to compute incident turbulence intensity" m typedef ^ ParameterType ReKi dz_turb_in - - - "" m typedef ^ ParameterType ReKi dy_turb_in - - - "" m typedef ^ ParameterType ReKi TI_Grid_In {:}{:} - - "" diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index f17474138..21b3557bc 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -97,7 +97,8 @@ MODULE AeroAcoustics_Types CHARACTER(1024) :: TICalcTabFile !< Name of the file containing the table for incident turbulence intensity [-] CHARACTER(1024) :: FTitle !< File Title: the 2nd line of the input file, which contains a description of its contents [-] REAL(DbKi) :: AAStart !< Time after which to calculate AA [s] - REAL(ReKi) :: z0_AA !< Surface roughness [-] + REAL(ReKi) :: Lturb !< Turbulent lengthscale in Amiet model [-] + REAL(ReKi) :: AvgV !< Average wind speed to compute incident turbulence intensity [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ReListBL !< [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AoAListBL !< [deg] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Pres_DispThick !< [-] @@ -210,7 +211,8 @@ MODULE AeroAcoustics_Types INTEGER(IntKi) :: total_sampleTI !< Total FFT Sample amount for dissipation calculation [-] INTEGER(IntKi) :: AA_Bl_Prcntge !< The Percentage of the Blade which the noise is calculated [%] INTEGER(IntKi) :: startnode !< Corersponding node to the noise calculation percentage of the blade [-] - REAL(ReKi) :: z0_aa !< Surface roughness [m] + REAL(ReKi) :: Lturb !< Turbulent lengthscale in Amiet model [m] + REAL(ReKi) :: AvgV !< Average wind speed to compute incident turbulence intensity [m] REAL(ReKi) :: dz_turb_in !< [m] REAL(ReKi) :: dy_turb_in !< [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TI_Grid_In !< [-] @@ -1715,7 +1717,8 @@ SUBROUTINE AA_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%TICalcTabFile = SrcInputFileData%TICalcTabFile DstInputFileData%FTitle = SrcInputFileData%FTitle DstInputFileData%AAStart = SrcInputFileData%AAStart - DstInputFileData%z0_AA = SrcInputFileData%z0_AA + DstInputFileData%Lturb = SrcInputFileData%Lturb + DstInputFileData%AvgV = SrcInputFileData%AvgV IF (ALLOCATED(SrcInputFileData%ReListBL)) THEN i1_l = LBOUND(SrcInputFileData%ReListBL,1) i1_u = UBOUND(SrcInputFileData%ReListBL,1) @@ -2046,7 +2049,8 @@ SUBROUTINE AA_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Int_BufSz = Int_BufSz + 1*LEN(InData%TICalcTabFile) ! TICalcTabFile Int_BufSz = Int_BufSz + 1*LEN(InData%FTitle) ! FTitle Db_BufSz = Db_BufSz + 1 ! AAStart - Re_BufSz = Re_BufSz + 1 ! z0_AA + Re_BufSz = Re_BufSz + 1 ! Lturb + Re_BufSz = Re_BufSz + 1 ! AvgV Int_BufSz = Int_BufSz + 1 ! ReListBL allocated yes/no IF ( ALLOCATED(InData%ReListBL) ) THEN Int_BufSz = Int_BufSz + 2*1 ! ReListBL upper/lower bounds for each dimension @@ -2276,7 +2280,9 @@ SUBROUTINE AA_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg END DO ! I DbKiBuf(Db_Xferred) = InData%AAStart Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%z0_AA + ReKiBuf(Re_Xferred) = InData%Lturb + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AvgV Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%ReListBL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2735,7 +2741,9 @@ SUBROUTINE AA_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err END DO ! I OutData%AAStart = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 - OutData%z0_AA = ReKiBuf(Re_Xferred) + OutData%Lturb = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AvgV = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ReListBL not allocated Int_Xferred = Int_Xferred + 1 @@ -5842,7 +5850,8 @@ SUBROUTINE AA_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%total_sampleTI = SrcParamData%total_sampleTI DstParamData%AA_Bl_Prcntge = SrcParamData%AA_Bl_Prcntge DstParamData%startnode = SrcParamData%startnode - DstParamData%z0_aa = SrcParamData%z0_aa + DstParamData%Lturb = SrcParamData%Lturb + DstParamData%AvgV = SrcParamData%AvgV DstParamData%dz_turb_in = SrcParamData%dz_turb_in DstParamData%dy_turb_in = SrcParamData%dy_turb_in IF (ALLOCATED(SrcParamData%TI_Grid_In)) THEN @@ -6425,7 +6434,8 @@ SUBROUTINE AA_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 1 ! total_sampleTI Int_BufSz = Int_BufSz + 1 ! AA_Bl_Prcntge Int_BufSz = Int_BufSz + 1 ! startnode - Re_BufSz = Re_BufSz + 1 ! z0_aa + Re_BufSz = Re_BufSz + 1 ! Lturb + Re_BufSz = Re_BufSz + 1 ! AvgV Re_BufSz = Re_BufSz + 1 ! dz_turb_in Re_BufSz = Re_BufSz + 1 ! dy_turb_in Int_BufSz = Int_BufSz + 1 ! TI_Grid_In allocated yes/no @@ -6811,7 +6821,9 @@ SUBROUTINE AA_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%startnode Int_Xferred = Int_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%z0_aa + ReKiBuf(Re_Xferred) = InData%Lturb + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AvgV Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%dz_turb_in Re_Xferred = Re_Xferred + 1 @@ -7647,7 +7659,9 @@ SUBROUTINE AA_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Xferred = Int_Xferred + 1 OutData%startnode = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - OutData%z0_aa = ReKiBuf(Re_Xferred) + OutData%Lturb = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AvgV = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 OutData%dz_turb_in = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 From 0ff0690689b075f66c48b6640981b725e98df98f Mon Sep 17 00:00:00 2001 From: pibo Date: Wed, 6 Jan 2021 19:11:00 -0700 Subject: [PATCH 06/12] update docs --- docs/source/user/aerodyn-aeroacoustics/App-usage.rst | 12 +++++++----- .../user/aerodyn-aeroacoustics/example/TIGrid.txt | 2 ++ 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/docs/source/user/aerodyn-aeroacoustics/App-usage.rst b/docs/source/user/aerodyn-aeroacoustics/App-usage.rst index 2f04a91b4..003fb825a 100644 --- a/docs/source/user/aerodyn-aeroacoustics/App-usage.rst +++ b/docs/source/user/aerodyn-aeroacoustics/App-usage.rst @@ -62,8 +62,8 @@ models: - **TICalcTabFile** – String: name of the text file with the user-defined turbulence intensity grid; see :numref:`aa-sec-TIgrid`. -- **SurfRoughness** – Float: value of :math:`z_{0}` used to estimate - :math:`L_{t}` in the Amiet model. +- **Lturb** – Float: value of :math:`L_{turb}` used to estimate the turbulent + lengthscale used in the Amiet model. - **TBLTEMod** – Integer 0/1/2: flag to set the TBL-TE noise model; 0 turns off the model, 1 uses the Brooks-Pope-Marcolini (BPM) airfoil noise @@ -259,15 +259,17 @@ is shown here: Turbulence Grid --------------- -When the flag **TICalcMeth** is set equal to 1, the grid of incident -turbulent intensity :math:`I_{1}` must be defined by the user. This is +When the flag **TICalcMeth** is set equal to 1, the grid of turbulence +intensity of the wind :math:`TI` must be defined by the user. This is done by creating a file called **TIGrid_In.txt**, which mimics a TurbSim output file and contains a grid of turbulence intensity, which is defined as a fraction value. The file defines a grid centered at hub height and oriented with the OpenFAST global inertial frame coordinate system; see :numref:`aa-fig:ObsRefSys`. A user-defined number of lateral and vertical points equally spaced by a user-defined number of meters must be -specified. An example file for a 160 (lateral) by 180 (vertical) meters +specified. Note that an average wind speed must be defined to convert +the turbulence intensity of the wind to the incident turbulent intensity :math:`I_{1}`. +An example file for a 160 (lateral) by 180 (vertical) meters grid looks like the following: diff --git a/docs/source/user/aerodyn-aeroacoustics/example/TIGrid.txt b/docs/source/user/aerodyn-aeroacoustics/example/TIGrid.txt index 240382606..4f01c5483 100644 --- a/docs/source/user/aerodyn-aeroacoustics/example/TIGrid.txt +++ b/docs/source/user/aerodyn-aeroacoustics/example/TIGrid.txt @@ -1,3 +1,5 @@ +Average Inflow Wind Speed +8.0 Total Grid points In Y (lateral), Starts from - radius goes to + radius+ 4 Total Grid points In Z (vertical), Starts from bottom tip (hub-radius) From 7b583630d9ad7783006373f46f3fe4422c84bc2c Mon Sep 17 00:00:00 2001 From: Rafael M Mudafort Date: Thu, 7 Jan 2021 14:10:16 -0500 Subject: [PATCH 07/12] Update r-test --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index daf08a6a9..1ba607cf5 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit daf08a6a9f55ada9b947a18f1d28af992a601e8d +Subproject commit 1ba607cf5e531fb7d23e4254fb1b7fd1d6b25fa5 From 61abddf403abff7f69ff405cb34e66f4e1110739 Mon Sep 17 00:00:00 2001 From: pibo Date: Thu, 7 Jan 2021 12:25:35 -0700 Subject: [PATCH 08/12] update r-test --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 1ba607cf5..4fe12e338 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 1ba607cf5e531fb7d23e4254fb1b7fd1d6b25fa5 +Subproject commit 4fe12e338eef611abb458857b162164fc75ed1b8 From db4ad4343d63f1b6748687bb8f6102769a60066a Mon Sep 17 00:00:00 2001 From: pibo Date: Thu, 7 Jan 2021 15:48:44 -0700 Subject: [PATCH 09/12] correct wind speed to compute incident TI --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 4fe12e338..a29f7def7 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 4fe12e338eef611abb458857b162164fc75ed1b8 +Subproject commit a29f7def7e3ae97b88211fb4244355a42cdda9ab From c37fd3fa5443c852ce6f8b1d506b608aae9db970 Mon Sep 17 00:00:00 2001 From: pibo Date: Tue, 12 Jan 2021 18:44:39 -0700 Subject: [PATCH 10/12] add Dbar for leading edge at high frequency --- .../aerodyn-aeroacoustics/02-noise-models.rst | 26 +++++++--- modules/aerodyn/src/AeroAcoustics.f90 | 49 ++++++++++++++----- 2 files changed, 55 insertions(+), 20 deletions(-) diff --git a/docs/source/user/aerodyn-aeroacoustics/02-noise-models.rst b/docs/source/user/aerodyn-aeroacoustics/02-noise-models.rst index b1b13c469..d718034b4 100644 --- a/docs/source/user/aerodyn-aeroacoustics/02-noise-models.rst +++ b/docs/source/user/aerodyn-aeroacoustics/02-noise-models.rst @@ -519,10 +519,10 @@ OpenFAST the local airfoil-oriented reference system is used, and a rotation is applied. Given the angles :math:`\Theta_{e}` and :math:`\Phi_{e}`, at high frequency, -:math:`\overline{D}` takes the expression: +:math:`\overline{D}` for the trailing edge takes the expression: .. math:: - {\overline{D}}_{h}\left( \Theta_{e},\Phi_{e} \right) = \frac{ + {\overline{D}}_{h-TE}\left( \Theta_{e},\Phi_{e} \right) = \frac{ 2\sin^{2}\left( \frac{\Theta_{e}}{2} \right)\sin^{2}\Phi_{e}} {\left( 1 + M\cos\Theta_{e} \right) \left( 1 + \left( M - M_{c} \right) @@ -530,14 +530,26 @@ Given the angles :math:`\Theta_{e}` and :math:`\Phi_{e}`, at high frequency, :label: aa-eq:32 where :math:`M_{c}` represents the Mach number past the trailing edge -and that is here for simplicity assumed equal to 80% of free-stream M. At low -frequency, the equation becomes: +and that is here for simplicity assumed equal to 80% of free-stream M. + +For the leading edge, and therefore for the turbulent inflow noise model, +at high frequency, :math:`\overline{D}` is: + +.. math:: + {\overline{D}}_{h-LE}\left( \Theta_{e},\Phi_{e} \right) = \frac{ + 2\cos^{2}\left( \frac{\Theta_{e}}{2} \right)\sin^{2}\Phi_{e}} + {\left( 1 + M\cos\Theta_{e} \right)^{3}} + :label: aa-eq:33 + +Note that this equation was not reported in the NREL Tech Report NREL/TP-5000-75731! + +At low frequency, the equation is identical for both leading and trailing edges: .. math:: {\overline{D}}_{l}\left( \Theta_{e},\Phi_{e} \right) = \frac{\sin^{2}\left. \ \Theta_{e} \right.\ \sin^{2}\Phi_{e}} {\left( 1 + M\cos\Theta_{e} \right)^{4}}. - :label: aa-eq:33 + :label: aa-eq:34 Each model distinguishes a different value between low and high frequency. For the TI noise model, the shift between low and high @@ -565,12 +577,12 @@ The A-weight, :math:`A_{w}`, is computed as: {\left( f^{2} + {20.598997}^{2} \right)^{2} \left( f^{2} + {12194.22}^{2} \right)^{2}} \right)} {\log 10} - :label: aa-eq:34 + :label: aa-eq:35 The A-weighting is a function of frequency and is added to the values of sound pressure levels: .. math:: SPL_{A_{w}} = SPL + A_{w} - :label: aa-eq:35 + :label: aa-eq:36 diff --git a/modules/aerodyn/src/AeroAcoustics.f90 b/modules/aerodyn/src/AeroAcoustics.f90 index e8004cfe2..f295dd7db 100644 --- a/modules/aerodyn/src/AeroAcoustics.f90 +++ b/modules/aerodyn/src/AeroAcoustics.f90 @@ -1330,7 +1330,7 @@ SUBROUTINE LBLVS(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,SPLLAM, CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ENDIF ! compute directivity function - CALL DIRECTH(M,THETA,PHI,DBARH,errStat2,errMsg2) + CALL DIRECTH_TE(M,THETA,PHI,DBARH,errStat2,errMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (DBARH <= 0) THEN @@ -1477,7 +1477,7 @@ SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,jj,ii,kk,d99Var2,dstarVar1,dstarVar ! Compute directivity function CALL DIRECTL(M,THETA,PHI,DBARL,errStat2,errMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL DIRECTH(M,THETA,PHI,DBARH,errStat2,errMsg2) + CALL DIRECTH_TE(M,THETA,PHI,DBARH,errStat2,errMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! IF (DBARH <= 0) THEN ! SPLP = 0. @@ -1631,7 +1631,7 @@ SUBROUTINE TIPNOIS(ALPHTIP,ALPRAT2,C,U ,THETA,PHI, R,p,SPLTIP, errStat, errMsg) ALPTIPP = ABS(ALPHTIP) * ALPRAT2 M = U / p%SpdSound ! MACH NUMBER ! Compute directivity function - CALL DIRECTH(M,THETA,PHI,DBARH,errStat2,errMsg2) + CALL DIRECTH_TE(M,THETA,PHI,DBARH,errStat2,errMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (p%ROUND) THEN L = .008 * ALPTIPP * C ! Eq 63 from BPM Airfoil Self-noise and Prediction paper @@ -1725,9 +1725,9 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,MeanVNoise,TINoise,LE !tinooisess=0.1 !Ums = (tinooisess*U)**2 !Ums = (tinooisess*8)**2 - CALL DIRECTL(Mach,THETA,PHI,DBARL,errStat2,errMsg2) !yes, assume that noise is low-freq in nature because turbulence length scale is large + CALL DIRECTL(Mach,THETA,PHI,DBARL,errStat2,errMsg2) ! assume that noise is low-freq in nature because turbulence length scale is large CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL DIRECTH(Mach,THETA,PHI,DBARH,errStat2,errMsg2) + CALL DIRECTH_LE(Mach,THETA,PHI,DBARH,errStat2,errMsg2) ! Directivity for the leading edge at high frequencies CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (DBARH <= 0) THEN SPLti = 0. @@ -1878,7 +1878,7 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,MeanVNoise,TINoise,LE !!!!! ---------------------------- !! CALL DIRECTL(Mach,THETA,PHI,DBARL,errStat2,errMsg2) !yes, assume that noise is low-freq in nature because turbulence length scale is large !! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) -!! CALL DIRECTH(Mach,THETA,PHI,DBARH,errStat2,errMsg2) +!! CALL DIRECTH_LE(Mach,THETA,PHI,DBARH,errStat2,errMsg2) !! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !! IF (DBARH <= 0) THEN !! SPLti = 0. @@ -1977,7 +1977,7 @@ SUBROUTINE BLUNT(ALPSTAR,C,U ,THETA,PHI,L,R,H,PSI,p,d99Var2,dstarVar1,dstarVar2, HDSTAR = H / DSTRAVG DSTARH = 1. /HDSTAR ! Compute directivity function - CALL DIRECTH(M,THETA,PHI,DBARH,errStat2,errMsg2) + CALL DIRECTH_TE(M,THETA,PHI,DBARH,errStat2,errMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (DBARH <= 0) THEN SPLBLUNT = 0. @@ -2176,8 +2176,8 @@ SUBROUTINE THICK(C,M,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal,errStat,errMsg) ENDIF END SUBROUTINE Thick !==================================================================================================== -!> This subroutine computes the high frequency directivity function for the input observer location -SUBROUTINE DIRECTH(M,THETA,PHI,DBAR, errStat, errMsg) +!> This subroutine computes the high frequency directivity function for the trailing edge +SUBROUTINE DIRECTH_TE(M,THETA,PHI,DBAR, errStat, errMsg) REAL(ReKi), INTENT(IN ) :: THETA ! REAL(ReKi), INTENT(IN ) :: PHI ! REAL(ReKi), INTENT(IN ) :: M ! @@ -2185,7 +2185,7 @@ SUBROUTINE DIRECTH(M,THETA,PHI,DBAR, errStat, errMsg) INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None ! Local variables - character(*), parameter :: RoutineName = 'Directh' + character(*), parameter :: RoutineName = 'Directh_te' real(ReKi) :: MC real(ReKi) :: DEGRAD real(ReKi) :: PHIR @@ -2197,7 +2197,30 @@ SUBROUTINE DIRECTH(M,THETA,PHI,DBAR, errStat, errMsg) THETAR = THETA * DEGRAD PHIR = PHI * DEGRAD DBAR = 2.*SIN(THETAR/2.)**2.*SIN(PHIR)**2./((1.+M*COS(THETAR))* (1.+(M-MC)*COS(THETAR))**2.) ! eq B1 in BPM Airfoil Self-noise and Prediction paper -END SUBROUTINE DirectH +END SUBROUTINE DIRECTH_TE + +!==================================================================================================== +!> This subroutine computes the high frequency directivity function for the leading edge +SUBROUTINE DIRECTH_LE(M,THETA,PHI,DBAR, errStat, errMsg) + REAL(ReKi), INTENT(IN ) :: THETA ! + REAL(ReKi), INTENT(IN ) :: PHI ! + REAL(ReKi), INTENT(IN ) :: M ! + REAL(ReKi), INTENT( OUT) :: DBAR ! + INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation + character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None + ! Local variables + character(*), parameter :: RoutineName = 'Directh_le' + real(ReKi) :: DEGRAD + real(ReKi) :: PHIR + real(ReKi) :: THETAR + ErrStat = ErrID_None + ErrMsg = "" + DEGRAD = .017453 + THETAR = THETA * DEGRAD + PHIR = PHI * DEGRAD + DBAR = 2.*COS(THETAR/2.)**2.*SIN(PHIR)**2./(1.+M*COS(THETAR))**3. +END SUBROUTINE DIRECTH_LE + !==================================================================================================== !> This subroutine computes the high frequency directivity function for the input observer location ! Paper: @@ -2222,7 +2245,7 @@ SUBROUTINE DIRECTL(M,THETA,PHI,DBAR, errStat, errMsg) THETAR = THETA * DEGRAD PHIR = PHI * DEGRAD DBAR = (SIN(THETAR)*SIN(PHIR))**2/(1.+M*COS(THETAR))**4 ! eq B2 in BPM Airfoil Self-noise and Prediction paper -END SUBROUTINE DirectL +END SUBROUTINE DIRECTL !==================================================================================================================================! !=============================== Simplified Guidati Inflow Turbulence Noise Addition =============================================! !==================================================================================================================================! @@ -2306,7 +2329,7 @@ SUBROUTINE TBLTE_TNO(ALPSTAR,C,U,THETA,PHI,D,R,Cfall,d99all,EdgeVelAll,p,SPLP,SP Mach = U / p%SpdSound ! Directivity function - CALL DIRECTH(REAL(Mach),THETA,PHI,DBARH,errStat2,errMsg2) + CALL DIRECTH_TE(REAL(Mach),THETA,PHI,DBARH,errStat2,errMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsgn, RoutineName ) do i_omega = 1,n_freq From 892c2553d5a9026c1d294e02ef3ec70e4acfa688 Mon Sep 17 00:00:00 2001 From: pibo Date: Wed, 27 Jan 2021 10:35:44 -0700 Subject: [PATCH 11/12] support TICalcMeth==2 --- modules/aerodyn/src/AeroAcoustics.f90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/modules/aerodyn/src/AeroAcoustics.f90 b/modules/aerodyn/src/AeroAcoustics.f90 index f295dd7db..e463a8e34 100644 --- a/modules/aerodyn/src/AeroAcoustics.f90 +++ b/modules/aerodyn/src/AeroAcoustics.f90 @@ -162,8 +162,11 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) p%NrObsLoc = InputFileData%NrObsLoc p%FTitle = InputFileData%FTitle - call AllocAry(p%TI_Grid_In,size(InputFileData%TI_Grid_In,1), size(InputFileData%TI_Grid_In,2), 'p%TI_Grid_In', errStat2, errMsg2); if(Failed()) return - p%TI_Grid_In=InputFileData%TI_Grid_In + IF ((InputFileData%TICalcMeth==1)) THEN + call AllocAry(p%TI_Grid_In,size(InputFileData%TI_Grid_In,1), size(InputFileData%TI_Grid_In,2), 'p%TI_Grid_In', errStat2, errMsg2); if(Failed()) return + p%TI_Grid_In=InputFileData%TI_Grid_In + ENDIF + p%AvgV=InputFileData%AvgV ! Copy AFInfo into AA module From 7ca24ac8df624f5ad3cb50e6503d571805967f3a Mon Sep 17 00:00:00 2001 From: Rafael M Mudafort Date: Wed, 3 Feb 2021 16:25:13 -0600 Subject: [PATCH 12/12] Update AA regression test baselines --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index 2bea52af7..c4c2e6815 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 2bea52af7b41545b78fba686d2a77b3a75bf50f2 +Subproject commit c4c2e68157dcb07c411fcef4c7db593c39d662b3