diff --git a/modules/aerodyn/src/AeroAcoustics.f90 b/modules/aerodyn/src/AeroAcoustics.f90 index 308d3476d..9142a8eea 100644 --- a/modules/aerodyn/src/AeroAcoustics.f90 +++ b/modules/aerodyn/src/AeroAcoustics.f90 @@ -49,19 +49,23 @@ module AeroAcoustics REAL(ReKi), parameter :: AA_u_min = 0.1_ReKi REAL(ReKi), parameter :: AA_EPSILON = 1.E-16 ! EPSILON(AA_EPSILON) + + REAL(ReKi), parameter :: RotorRegionAlph_delta = 60.0_ReKi ! degrees : size of bin, must be a number that evenly divides 360 degrees + REAL(ReKi), parameter :: RotorRegionRad_delta = 5.0_ReKi ! meters : size of bin along blade span (rotor radius) + REAL(ReKi), parameter :: RotorRegionTimeSampling = 5.0_ReKi ! seconds (for Num_total_sampleTI) contains !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the start of the simulation to perform initialization steps. !! The parameters are set here and not changed during the simulation. !! The initial states and initial guess for the input are defined. -subroutine AA_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) - type(AA_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine +subroutine AA_Init( InitInp, u, p, xd, OtherState, y, m, Interval, AFInfo, InitOut, ErrStat, ErrMsg ) + type(AA_InitInputType), intent(inout) :: InitInp !< Input data for initialization routine; out because we move allocated array type(AA_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined type(AA_ParameterType), intent( out) :: p !< Parameters - type(AA_ContinuousStateType), intent( out) :: x !< Initial continuous states + !type(AA_ContinuousStateType), intent( out) :: x !< Initial continuous states type(AA_DiscreteStateType), intent( out) :: xd !< Initial discrete states - type(AA_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states + !type(AA_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states type(AA_OtherStateType), intent( out) :: OtherState !< Initial other states type(AA_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; !! only the output mesh is initialized) @@ -75,6 +79,9 @@ subroutine AA_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut type(AA_InitOutputType), intent( out) :: InitOut !< Output for initialization routine integer(IntKi), intent( out) :: errStat !< Error status of the operation character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + type(AFI_ParameterType), intent(in ) :: AFInfo(:) !< The airfoil parameter data +! integer(IntKi), intent(in ) :: AFIndx(:,:) + ! Local variables integer(IntKi) :: errStat2 ! temporary error status of the operation character(ErrMsgLen) :: errMsg2 ! temporary error message @@ -90,15 +97,15 @@ subroutine AA_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut call DispNVD( AA_Ver ) ! To get rid of a compiler warning. - x%DummyContState = 0.0_SiKi - z%DummyConstrState = 0.0_SiKi + !x%DummyContState = 0.0_SiKi + !z%DummyConstrState = 0.0_SiKi !bjj: note that we haven't validated p%NumBlades before using it below! p%NumBlades = InitInp%NumBlades ! need this before reading the AD input file so that we know how many blade files to read p%RootName = TRIM(InitInp%RootName)//'.'//trim(AA_Nickname) ! Read the primary AeroAcoustics input file in AeroAcoustics_IO - call ReadInputFiles( InitInp%InputFile, InitInp%AFInfo, InputFileData, interval, p%RootName, ErrStat2, ErrMsg2 ) + call ReadInputFiles( InitInp%InputFile, AFInfo, InputFileData, interval, p%RootName, ErrStat2, ErrMsg2 ) if (Failed()) return ! Validate the inputs @@ -108,19 +115,20 @@ subroutine AA_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut if (InitInp%AirDens <= 0.0) call SetErrStat ( ErrID_Fatal, 'The air density (AirDens) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) if (InitInp%KinVisc <= 0.0) call SetErrStat ( ErrID_Fatal, 'The kinesmatic viscosity (KinVisc) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) if (InitInp%SpdSound <= 0.0) call SetErrStat ( ErrID_Fatal, 'The speed of sound (SpdSound) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) + if (InitInp%NumBlNds < 1) call SetErrStat ( ErrID_Fatal, 'AeroAcoustics requires at least 1 node.', ErrStat, ErrMsg, RoutineName ) if (Failed()) return ! Define parameters - call SetParameters( InitInp, InputFileData, p, ErrStat2, ErrMsg2 ); if(Failed()) return + call SetParameters( InitInp, InputFileData, p, AFInfo, ErrStat2, ErrMsg2 ); if(Failed()) return ! Define and initialize inputs call Init_u( u, p, errStat2, errMsg2 ); if(Failed()) return ! Initialize states and misc vars - call Init_MiscVars(m, p, u, errStat2, errMsg2); if(Failed()) return + call Init_MiscVars(m, p, errStat2, errMsg2); if(Failed()) return call Init_States(xd, OtherState, p, errStat2, errMsg2); if(Failed()) return ! Define write outputs here (must initialize AFTER Init_MiscVars) - call Init_y(y, m, u, p, errStat2, errMsg2); if(Failed()) return + call Init_y(y, m, p, errStat2, errMsg2); if(Failed()) return ! Define initialization output here call AA_SetInitOut(p, InitOut, errStat2, errMsg2); if(Failed()) return @@ -142,10 +150,11 @@ end subroutine Cleanup end subroutine AA_Init !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets AeroAcoustics parameters for use during the simulation; these variables are not changed after AA_Init. -subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) - TYPE(AA_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine, out is needed because of copy below +subroutine SetParameters( InitInp, InputFileData, p, AFInfo, ErrStat, ErrMsg ) + TYPE(AA_InitInputType), INTENT(INOUT) :: InitInp !< Input data for initialization routine, out is needed because of copy below TYPE(AA_InputFile), INTENT(INOUT) :: InputFileData !< Data stored in the module's input file -- intent(out) only for move_alloc statements TYPE(AA_ParameterType), INTENT(INOUT) :: p !< Parameters + type(AFI_ParameterType), intent(in ) :: AFInfo(:) !< The airfoil parameter data INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! Local variables @@ -154,14 +163,15 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) ! INTEGER(IntKi) :: simcou,coun ! simple loop counter INTEGER(IntKi) :: I,J,whichairfoil,K,i1_1,i10_1,i1_2,i10_2,iLE character(*), parameter :: RoutineName = 'SetParameters' - REAL(ReKi) :: val1,val10,f2,f4,lefttip,rightip,jumpreg, dist1, dist10 + REAL(ReKi) :: val1,val10,f2,f4, dist1, dist10 + REAL(ReKi) :: BladeSpanUsedForNoise + ! Initialize variables for this routine ErrStat = ErrID_None ErrMsg = "" - !!Assign input fiel data to parameters + !!Assign input file data to parameters p%DT = InputFileData%DT_AA ! seconds - p%AA_Bl_Prcntge = InputFileData%AA_Bl_Prcntge ! % - p%total_sampleTI = 5/p%DT ! 10 seconds for TI sampling + p%Num_total_sampleTI = max( NINT(RotorRegionTimeSampling / InputFileData%DT_AA), 1 ) p%AAStart = InputFileData%AAStart p%IBLUNT = InputFileData%IBLUNT p%ILAM = InputFileData%ILAM @@ -177,7 +187,7 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) p%NrOutFile = InputFileData%NrOutFile p%outFmt = "ES15.6E3" p%NumBlNds = InitInp%NumBlNds - p%AirDens = InitInp%AirDens + p%AirDens = InitInp%AirDens p%KinVisc = InitInp%KinVisc p%SpdSound = InitInp%SpdSound p%HubHeight = InitInp%HubHeight @@ -187,23 +197,12 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) p%TI = InputFileData%TI p%avgV = InputFileData%avgV - ! Copy AFInfo into AA module - ! TODO Allocate AFInfo and AFindx variables (DONE AND DONE) - ALLOCATE(p%AFInfo( size(InitInp%AFInfo) ), STAT=ErrStat2) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating memory for the InitInp%AFInfo array.', ErrStat2, ErrMsg2, RoutineName) - RETURN - ENDIF - - do i=1,size(InitInp%AFInfo) - call AFI_CopyParam(InitInp%AFInfo(i), p%AFInfo(i), MESH_NEWCOPY, errStat2, errMsg2); if(Failed()) return - end do ! Check 1 IF( (p%ITURB.eq.ITURB_TNO) .or. p%IInflow == IInflow_FullGuidati .OR. p%IInflow == IInflow_SimpleGuidati )then ! if tno is on or one of the guidati models is on, check if we have airfoil coordinates - DO k=1,size(p%AFInfo) ! if any of the airfoil coordinates are missing change calculation method - IF( p%AFInfo(k)%NumCoords .lt. 5 )then + DO k=1,size(AFInfo) ! if any of the airfoil coordinates are missing change calculation method + IF( AFInfo(k)%NumCoords .lt. 5 )then CALL WrScr( 'Airfoil coordinates are missing: If Full or Simplified Guidati or Bl Calculation is on coordinates are needed ' ) CALL WrScr( 'Calculation methods enforced as BPM for TBLTE and only Amiet for inflow ' ) p%ITURB = ITURB_BPM @@ -243,8 +242,7 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) call MOVE_ALLOC(InputFileData%ObsXYZ,p%ObsXYZ) ! - call AllocAry(p%BlAFID, p%NumBlNds, p%numBlades, 'p%BlAFID' , ErrStat2, ErrMsg2); if(Failed()) return - p%BlAFID=InitInp%BlAFID + call MOVE_ALLOC(InitInp%BlAFID,p%BlAFID) ! Blade Characteristics chord,span,trailing edge angle and thickness,airfoil ID for each segment call AllocAry(p%TEThick ,p%NumBlNds,p%NumBlades,'p%TEThick' ,ErrStat2,ErrMsg2); if(Failed()) return @@ -252,36 +250,49 @@ 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 + do i=1,p%NumBlades do j=1,p%NumBlNds 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 + if(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]) + p%StallStart(j,i) = AFInfo(whichairfoil)%Table(1)%UA_BL%alpha1*180/PI ! approximate stall angle of attack [deg] (alpha1 in [rad]) enddo 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 - call AllocAry(p%AerCent, 2, p%NumBlNds, p%NumBlades, 'p%AerCent', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(p%BlSpn, p%NumBlNds, p%NumBlades, 'p%BlSpn' , ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(p%BlElemSpn, p%NumBlNds, p%NumBlades, 'p%BlElemSpn', ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(p%BlChord, p%NumBlNds, p%NumBlades, 'p%BlChord' , ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(p%AerCent, 2, p%NumBlNds, p%NumBlades, 'p%AerCent' , ErrStat2, ErrMsg2); if(Failed()) return p%BlSpn = InitInp%BlSpn p%BlChord = InitInp%BlChord - do j=p%NumBlNds,2,-1 - IF ( p%BlSpn(j,1) .lt. p%BlSpn(p%NumBlNds,1)*(100-p%AA_Bl_Prcntge)/100 )THEN ! assuming + p%startnode = max(1, p%NumBlNds - 1) + BladeSpanUsedForNoise = p%BlSpn(p%NumBlNds,1)*(1.0 - InputFileData%AA_Bl_Prcntge/100.0) + do j=p%NumBlNds-1,2,-1 + IF ( p%BlSpn(j,1) .lt. BladeSpanUsedForNoise )THEN p%startnode=j exit ! exit the loop endif enddo - - IF (p%startnode.lt.2) THEN - p%startnode=2 - ENDIF + p%startnode = max(min(p%NumBlNds,2),p%startnode) + + p%BlElemSpn = 0; + DO I = 1,p%numBlades + DO J = p%startnode,p%NumBlNds ! starts loop from startnode. + IF (J < 2) THEN + p%BlElemSpn(J,I) = p%BlSpn(J,I) !assume this is the innermost node + ELSEIF (J .EQ. p%NumBlNds) THEN + p%BlElemSpn(J,I) = p%BlSpn(J,I)-p%BlSpn(J-1,I) + ELSE + p%BlElemSpn(J,I) = (p%BlSpn(J,I)-p%BlSpn(J-1,I))/2 + (p%BlSpn(J+1,I)-p%BlSpn(J,I))/2 ! this is the average element size around this node, equivalent to (p%BlSpn(J+1,I) - p%BlSpn(J-1,I))/2 + ENDIF + end do + end do !print*, 'AeroAcoustics Module is using the blade nodes starting from ' ,p%startnode,' Radius in meter ',p%BlSpn(p%startnode,1) !AerodYnamic center extraction for each segment @@ -289,9 +300,9 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) do j=1,p%NumBlNds whichairfoil = p%BlAFID(j,i) ! just a temporary variable for clear coding ! airfoil coordinates read by AeroDyn. First value is the aerodynamic center - if (p%AFInfo(whichairfoil)%NumCoords > 0) then - p%AerCent(1,J,I) = p%AFInfo(whichairfoil)%X_Coord(1) ! assigned here corresponding airfoil. - p%AerCent(2,J,I) = p%AFInfo(whichairfoil)%Y_Coord(1) ! assigned here corresponding airfoil. + if (AFInfo(whichairfoil)%NumCoords > 0) then + p%AerCent(1,J,I) = AFInfo(whichairfoil)%X_Coord(1) ! assigned here corresponding airfoil. + p%AerCent(2,J,I) = AFInfo(whichairfoil)%Y_Coord(1) ! assigned here corresponding airfoil. else p%AerCent(1,J,I) = 0.0_ReKi p%AerCent(2,J,I) = 0.0_ReKi @@ -336,34 +347,30 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) ! If guidati is on, calculate the airfoil thickness at 1% and at 10% chord from input airfoil coordinates IF (p%IInflow .EQ. IInflow_FullGuidati) THEN - call AllocAry(p%AFThickGuida,2,size(p%AFInfo), 'p%AFThickGuida', errStat2, errMsg2); if(Failed()) return + call AllocAry(p%AFThickGuida,2,size(AFInfo), 'p%AFThickGuida', errStat2, errMsg2); if(Failed()) return p%AFThickGuida=0.0_Reki - DO k=1,size(p%AFInfo) ! for each airfoil interpolation + DO k=1,size(AFInfo) ! for each airfoil interpolation - ! 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 - ! find index where LE is found - DO i=3,size(p%AFInfo(k)%X_Coord) - IF (p%AFInfo(k)%X_Coord(i) - p%AFInfo(k)%X_Coord(i-1) > 0.) THEN + DO i=3,size(AFInfo(k)%X_Coord) + IF (AFInfo(k)%X_Coord(i) - AFInfo(k)%X_Coord(i-1) > 0.) THEN iLE = i exit ! end the innermost do loop (i) 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 + dist1 = ABS( AFInfo(k)%X_Coord(iLE) - 0.01) + dist10 = ABS( AFInfo(k)%X_Coord(iLE) - 0.10) + DO i=iLE+1,size(AFInfo(k)%X_Coord) + IF (ABS(AFInfo(k)%X_Coord(i) - 0.01) < dist1) THEN i1_1 = i - dist1 = ABS(p%AFInfo(k)%X_Coord(i) - 0.01) + dist1 = ABS(AFInfo(k)%X_Coord(i) - 0.01) ENDIF - IF (ABS(p%AFInfo(k)%X_Coord(i) - 0.1) < dist10) THEN + IF (ABS(AFInfo(k)%X_Coord(i) - 0.1) < dist10) THEN i10_1 = i - dist10 = ABS(p%AFInfo(k)%X_Coord(i) - 0.1) + dist10 = ABS(AFInfo(k)%X_Coord(i) - 0.1) ENDIF ENDDO @@ -371,52 +378,35 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) dist1 = 0.99 dist10 = 0.90 DO i=1,iLE-1 - IF (ABS(p%AFInfo(k)%X_Coord(i) - 0.01) < dist1) THEN + IF (ABS(AFInfo(k)%X_Coord(i) - 0.01) < dist1) THEN i1_2 = i - dist1 = ABS(p%AFInfo(k)%X_Coord(i) - 0.01) + dist1 = ABS(AFInfo(k)%X_Coord(i) - 0.01) ENDIF - IF (ABS(p%AFInfo(k)%X_Coord(i) - 0.1) < dist10) THEN + IF (ABS(AFInfo(k)%X_Coord(i) - 0.1) < dist10) THEN i10_2 = i - dist10 = ABS(p%AFInfo(k)%X_Coord(i) - 0.1) + dist10 = ABS(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) + val1 = AFInfo(k)%Y_Coord(i1_1 ) - AFInfo(k)%Y_Coord(i1_2) + val10 = AFInfo(k)%Y_Coord(i10_1) - AFInfo(k)%Y_Coord(i10_2) p%AFThickGuida(1,k)=val1 ! 1 % chord thickness p%AFThickGuida(2,k)=val10 ! 10 % chord thickness ENDDO 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 - p%toptip = CEILING(p%HubHeight+maxval(p%BlSpn(:,1)))+2 !Top Tip Height = Hub height plus radius - p%bottip = FLOOR(p%HubHeight-maxval(p%BlSpn(:,1)))-2 !Bottom Tip Height = Hub height minus radius - call AllocAry(p%rotorregionlimitsVert,ceiling(((p%toptip)-(p%bottip))/jumpreg), 'p%rotorregionlimitsVert', errStat2, errMsg2); if(Failed()) return - do i=0,size(p%rotorregionlimitsVert)-1 - p%rotorregionlimitsVert(i+1)=(p%bottip)+jumpreg*i - enddo - !! for turbulence intensity calculations on the fly every 5 meter the whole rotor area is divided horizontally to store flow fields in each region - jumpreg=7 - lefttip = 2*maxval(p%BlSpn(:,1))+5 ! - rightip = 0 ! - call AllocAry( p%rotorregionlimitsHorz,ceiling(((lefttip)-(rightip))/jumpreg), 'p%rotorregionlimitsHorz', errStat2, errMsg2); if(Failed()) return - do i=0,size(p%rotorregionlimitsHorz)-1 - p%rotorregionlimitsHorz(i+1)=rightip+jumpreg*i - enddo - jumpreg=60 ! 10 ! must be divisable to 360 - call AllocAry(p%rotorregionlimitsalph,INT((360/jumpreg)+1), 'p%rotorregionlimitsalph', errStat2, errMsg2); if(Failed()) return - do i=0,size(p%rotorregionlimitsalph)-1 - p%rotorregionlimitsalph(i+1)=jumpreg*i - enddo - jumpreg=5 - call AllocAry( p%rotorregionlimitsrad, (CEILING( maxval(p%BlSpn(:,1))/jumpreg )+2), 'p%rotorregionlimitsrad', errStat2, errMsg2); if(Failed()) return - do i=1,size(p%rotorregionlimitsrad)-1 - p%rotorregionlimitsrad(i+1)=jumpreg*i - enddo - p%rotorregionlimitsrad(1)=0.0_reki - p%rotorregionlimitsrad(size(p%rotorregionlimitsrad)-1)=p%rotorregionlimitsrad(size(p%rotorregionlimitsrad)-1)+3 + p%NumRotorRegionLimitsAlph = NINT(360./RotorRegionAlph_delta) + 1 + p%NumRotorRegionLimitsRad = CEILING( maxval(p%BlSpn)/RotorRegionRad_delta )+2 + + call AllocAry( p%RotorRegion_k_minus1, p%NumBlNds, p%NumBlades, 'p%RotorRegion_k_minus1', errStat2, errMsg2); if(Failed()) return + p%RotorRegion_k_minus1 = 0 + do i=1,p%NumBlades + do j=1,p%NumBlNds + p%RotorRegion_k_minus1(j,i) = CEILING( p%BlSpn(j,i) / RotorRegionRad_delta ) + p%RotorRegion_k_minus1(j,i) = MIN( p%NumRotorRegionLimitsRad - 1, MAX( 1, p%RotorRegion_k_minus1(j,i) ) ) !safety + end do + enddo contains logical function Failed() @@ -454,10 +444,9 @@ end function Failed end subroutine Init_u !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes AeroAcoustics output array variables for use during the simulation. -subroutine Init_y(y, m, u, p, errStat, errMsg) +subroutine Init_y(y, m, p, errStat, errMsg) type(AA_OutputType), intent( out) :: y !< Module outputs type(AA_MiscVarType), intent(in ) :: m !< misc/optimization data - type(AA_InputType), intent(inout) :: u !< Module inputs -- intent(out) because of mesh sibling copy type(AA_ParameterType), intent(inout) :: p !< Parameters integer(IntKi), intent( out) :: errStat !< Error status of the operation character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None @@ -502,10 +491,9 @@ end function Failed end subroutine Init_y !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes (allocates) the misc variables for use during the simulation. -subroutine Init_MiscVars(m, p, u, errStat, errMsg) +subroutine Init_MiscVars(m, p, errStat, errMsg) type(AA_MiscVarType), intent(inout) :: m !< misc/optimization data (not defined in submodules) type(AA_ParameterType), intent(in ) :: p !< Parameters - type(AA_InputType), intent(inout) :: u !< input for HubMotion mesh (create sibling mesh here) integer(IntKi), intent( out) :: errStat !< Error status of the operation character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None ! Local variables @@ -529,10 +517,7 @@ subroutine Init_MiscVars(m, p, u, errStat, errMsg) call AllocAry(m%SPLTIP , size(p%FreqList), 'SPLTIP' , errStat2, errMsg2); if(Failed()) return call AllocAry(m%SPLTI , size(p%FreqList), 'SPLTI' , errStat2, errMsg2); if(Failed()) return call AllocAry(m%SPLTIGui , size(p%FreqList), 'SPLTIGui' , errStat2, errMsg2); if(Failed()) return - call AllocAry(m%CfVar , 2 , 'CfVar' , errStat2, errMsg2); if(Failed()) return - call AllocAry(m%d99Var , 2 , 'd99Var' , errStat2, errMsg2); if(Failed()) return - call AllocAry(m%dstarVar , 2 , 'dstarVar' , errStat2, errMsg2); if(Failed()) return - call AllocAry(m%EdgeVelVar , 2 , 'EdgeVelVar', errStat2, errMsg2); if(Failed()) return + call AllocAry(m%LE_Location, 3, p%NumBlNds, p%numBlades, 'LE_Location', ErrStat2, ErrMsg2); if(Failed()) return ! arrays for computing WriteOutput values @@ -561,33 +546,30 @@ end subroutine Init_MiscVars !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes (allocates) the misc variables for use during the simulation. subroutine Init_states(xd, OtherState, p, errStat, errMsg) - type(AA_DiscreteStateType), intent(inout) :: xd ! - type(AA_OtherStateType), intent(inout) :: OtherState !< Initial other states - type(AA_ParameterType), intent(in ) :: p !< Parameters - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - ! Local variables - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'Init_DiscrStates' + type(AA_DiscreteStateType), intent(inout) :: xd ! + type(AA_OtherStateType), intent(inout) :: OtherState !< Initial other states + type(AA_ParameterType), intent(in ) :: p !< Parameters + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'Init_states' - ! Initialize variables for this routine - errStat = ErrID_None - errMsg = "" + ! Initialize variables for this routine + errStat = ErrID_None + errMsg = "" - call AllocAry(xd%MeanVxVyVz, p%NumBlNds, p%numBlades, 'xd%MeanVxVyVz', ErrStat2, ErrMsg2); if(Failed()) return - call AllocAry(xd%TIVx, p%NumBlNds, p%numBlades, 'xd%TIVx' , ErrStat2, ErrMsg2); if(Failed()) return + call AllocAry(xd%TIVx, p%NumBlNds, p%numBlades, 'xd%TIVx' , ErrStat2, ErrMsg2); if(Failed()) return + xd%TIVx = 0.0_ReKi - call AllocAry(xd%RegVxStor, p%total_sampleTI, size(p%rotorregionlimitsrad)-1,size(p%rotorregionlimitsalph)-1,'xd%Vxst', ErrStat2,ErrMsg2); if(Failed()) return - call AllocAry(xd%RegionTIDelete, size(p%rotorregionlimitsrad)-1,size(p%rotorregionlimitsalph)-1,'xd%RegionTIDelete', ErrStat2,ErrMsg2); if(Failed()) return - call AllocAry(OtherState%allregcounter , size(p%rotorregionlimitsrad)-1,size(p%rotorregionlimitsalph)-1,'OtherState%allregcounter', ErrStat2,ErrMsg2); if(Failed()) return + if (p%TICalcMeth == TICalc_Every) then + call AllocAry(xd%RegVxStor, p%Num_total_sampleTI, p%NumRotorRegionLimitsRad-1,p%NumRotorRegionLimitsAlph-1,'xd%Vxst', ErrStat2,ErrMsg2); if(Failed()) return + call AllocAry(OtherState%allregcounter , p%NumRotorRegionLimitsRad-1,p%NumRotorRegionLimitsAlph-1,'OtherState%allregcounter', ErrStat2,ErrMsg2); if(Failed()) return - xd%MeanVxVyVz = 0.0_ReKi - xd%TIVx = 0.0_ReKi - xd%RegionTIDelete = 0.0_ReKi - xd%RegVxStor = 0.0_reki - - OtherState%allregcounter = 2 + xd%RegVxStor = 0.0_reki + OtherState%allregcounter = 0 + endif contains logical function Failed() @@ -610,22 +592,23 @@ subroutine AA_UpdateStates( t, n, m, u, p, xd, OtherState, errStat, errMsg ) ! integer(intKi) :: ErrStat2 ! temporary Error status ! 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 - integer(intKi) :: i,j,k,rco +! REAL(ReKi),DIMENSION(p%NumBlNds,p%numBlades) :: TEMPSTD ! temporary standard deviation variable + REAL(ReKi) :: InflowNorm,meanInflow,angletemp,abs_le_x ! temporary standard deviation variable + integer(intKi) :: i,j integer(intKi) :: k_minus1,rco_minus1 ErrStat = ErrID_None ErrMsg = "" - ! Cumulative mean and standard deviation, states are updated as Vx Vy Vz changes at each time step - TEMPSTD = sqrt( u%Inflow(1,:,:)**2+u%Inflow(2,:,:)**2+u%Inflow(3,:,:)**2 ) - xd%MeanVxVyVz = (TEMPSTD + xd%MeanVxVyVz*n) / (n+1) - ! xd%VxSq = TEMPSTD**2 + xd%VxSq - ! TEMPSTD = sqrt( (xd%VxSq/(n+1)) - (xd%MeanVxVyVz**2) ) - ! xd%TIVx = (TEMPSTD / xd%MeanVxVyVz ) ! check inflow noise input for multiplication with 100 or not + !! Cumulative mean and standard deviation, states are updated as Vx Vy Vz changes at each time step + !TEMPSTD = sqrt( u%Inflow(1,:,:)**2+u%Inflow(2,:,:)**2+u%Inflow(3,:,:)**2 ) + !xd%MeanVxVyVz = (TEMPSTD + xd%MeanVxVyVz*n) / (n+1) + !! xd%VxSq = TEMPSTD**2 + xd%VxSq + !! TEMPSTD = sqrt( (xd%VxSq/(n+1)) - (xd%MeanVxVyVz**2) ) + !! xd%TIVx = (TEMPSTD / xd%MeanVxVyVz ) ! check inflow noise input for multiplication with 100 or not - IF( (p%TICalcMeth.eq.2) ) THEN + + IF( p%TICalcMeth == TICalc_Every ) THEN call Calc_LE_Location_Array(p,m,u) ! sets m%LE_Location(:,:,:) do i=1,p%NumBlades @@ -633,45 +616,34 @@ subroutine AA_UpdateStates( t, n, m, u, p, xd, OtherState, errStat, errMsg ) abs_le_x=m%LE_Location(3,j,i)-p%hubheight if (EqualRealNos(abs_le_x, 0.0_ReKi)) then - angletemp = 0.0_ReKi + rco_minus1 = 1 else angletemp = ATAN2(m%LE_Location(2,j,i), abs_le_x) * R2D ! returns angles in the range [-180, 180] degrees if (angletemp<0.) angletemp = angletemp + 360. ! in calculation for rco_minus1 below, we compare angles in the range [0, 360] degrees + rco_minus1 = ceiling(angletemp / RotorRegionAlph_delta) + rco_minus1 = MIN( p%NumRotorRegionLimitsAlph-1, MAX(1, rco_minus1) ) ! safety end if - k_minus1 = 0 - do k=1,size(p%rotorregionlimitsrad) - IF (p%BlSpn(j,i)-p%rotorregionlimitsrad(k).lt.0) THEN ! it means location is in the k-1 region - !print*, abs_le_x,p%rotorregionlimitsrad(k),k-1 - k_minus1 = k - 1 - exit ! exit "k" do loop - ENDIF - enddo - k_minus1 = MAX(1,k_minus1) + k_minus1 = p%RotorRegion_k_minus1(j,i) - rco_minus1 = 0 - do rco=1,size(p%rotorregionlimitsalph) - IF (angletemp-p%rotorregionlimitsalph(rco).lt.0) THEN ! it means location is in the k-1 region - rco_minus1 = rco - 1 - exit ! exit "rco" do loop - ENDIF - enddo - rco_minus1 = MAX(1,rco_minus1) ! make sure it didn't + OtherState%allregcounter(k_minus1,rco_minus1) = OtherState%allregcounter(k_minus1,rco_minus1) + 1 ! increase the sample amount in that specific bin - OtherState%allregcounter(k_minus1,rco_minus1) = OtherState%allregcounter(k_minus1,rco_minus1) + 1 ! increase the sample amount in that specific 5 meter height vertical region - - tempsingle = sqrt( u%Inflow(1,j,i)**2+u%Inflow(2,j,i)**2+u%Inflow(3,j,i)**2 ) ! + InflowNorm = TwoNorm( u%Inflow(:,j,i) ) + !note: p%Num_total_sampleTI = size(xd%RegVxStor,1) ! with storage region dependent moving average and TI - IF ( OtherState%allregcounter(k_minus1,rco_minus1) .lt. size(xd%RegVxStor,1)+1 ) THEN - xd%RegVxStor(OtherState%allregcounter(k_minus1,rco_minus1),k_minus1,rco_minus1)=tempsingle - xd%TIVx(j,i) = 0 - xd%RegionTIDelete(k_minus1,rco_minus1)=0 + IF ( OtherState%allregcounter(k_minus1,rco_minus1) <= p%Num_total_sampleTI ) THEN + xd%RegVxStor(OtherState%allregcounter(k_minus1,rco_minus1),k_minus1,rco_minus1) = InflowNorm + xd%TIVx(j,i) = 0 ELSE - xd%RegVxStor((mod( OtherState%allregcounter(k_minus1,rco_minus1) - size(xd%RegVxStor,1), size(xd%RegVxStor,1)))+1,k_minus1,rco_minus1)=tempsingle - tempmean=SUM(xd%RegVxStor(:,k_minus1,rco_minus1)) - tempmean=tempmean/size(xd%RegVxStor,1) - xd%RegionTIDelete(k_minus1,rco_minus1)=SQRT((SUM((xd%RegVxStor(:,k_minus1,rco_minus1)-tempmean)**2)) / size(xd%RegVxStor,1) ) - xd%TIVx(j,i) = xd%RegionTIDelete(k_minus1,rco_minus1) ! only the fluctuation + xd%RegVxStor( mod( OtherState%allregcounter(k_minus1,rco_minus1), p%Num_total_sampleTI )+1, k_minus1, rco_minus1)=InflowNorm + meanInflow = SUM( xd%RegVxStor(:,k_minus1,rco_minus1) ) /p%Num_total_sampleTI + + if ( EqualRealNos(meanInflow,0.0_ReKi)) then + xd%TIVx(j,i) = 0.0_ReKi + else + xd%TIVx(j,i) = SQRT( SUM((xd%RegVxStor(:,k_minus1,rco_minus1)-meanInflow)**2) / p%Num_total_sampleTI ) ! only the fluctuation (this is the population standard deviation, not TI) + xd%TIVx(j,i) = xd%TIVx(j,i) / meanInflow ! this is TI as a fraction (std(U)/mean(U)) + end if ENDIF enddo enddo @@ -681,7 +653,7 @@ subroutine AA_UpdateStates( t, n, m, u, p, xd, OtherState, errStat, errMsg ) do j=1,p%NumBlNds ! We scale the incident turbulence intensity by the ratio of average to incident wind speed ! The scaled TI is used by the Amiet model - xd%TIVx(j,i)=p%TI*p%avgV/u%Vrel(J,I) + xd%TIVx(j,i)=p%TI * p%avgV/u%Vrel(J,I) enddo enddo endif @@ -689,12 +661,12 @@ subroutine AA_UpdateStates( t, n, m, u, p, xd, OtherState, errStat, errMsg ) end subroutine AA_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- !> This routine is called at the end of the simulation. -subroutine AA_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +subroutine AA_End( u, p, xd, OtherState, y, m, ErrStat, ErrMsg ) TYPE(AA_InputType), INTENT(INOUT) :: u !< System inputs TYPE(AA_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(AA_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states + !TYPE(AA_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states TYPE(AA_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states - TYPE(AA_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states + !TYPE(AA_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states TYPE(AA_OtherStateType), INTENT(INOUT) :: OtherState !< Other states TYPE(AA_OutputType), INTENT(INOUT) :: y !< System outputs TYPE(AA_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables @@ -737,7 +709,7 @@ END SUBROUTINE AA_End !! This subroutine is used to compute the output channels (motions and loads) and place them in the WriteOutput() array. !! The descriptions of the output channels are not given here. Please see the included OutListParameters.xlsx sheet for !! for a complete description of each output parameter. -subroutine AA_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg) +subroutine AA_CalcOutput( t, u, p, xd, OtherState, y, m, ErrStat, ErrMsg) ! NOTE: no matter how many channels are selected for output, all of the outputs are calcalated ! All of the calculated output channels are placed into the m%AllOuts(:), while the channels selected for outputs are ! placed in the y%WriteOutput(:) array. @@ -745,9 +717,9 @@ subroutine AA_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg) REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds TYPE(AA_InputType), INTENT(IN ) :: u !< Inputs at Time t TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AA_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t + !TYPE(AA_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t TYPE(AA_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(AA_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t + !TYPE(AA_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t TYPE(AA_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t TYPE(AA_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- type(AA_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables @@ -766,13 +738,13 @@ subroutine AA_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg) IF (t >= p%AAStart) THEN IF (.NOT. AA_OutputToSeparateFile .or. mod(t + 1E-10,p%DT) .lt. 1E-6) THEN !bjj: should check NINT(t/p%DT)? - call CalcObserve(p,m,u,xd,errStat2, errMsg2) + call CalcObserve(p,m,u,errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName); if (ErrStat >= AbortErrLev) return - call CalcAeroAcousticsOutput(u,p,m,xd,y,errStat2,errMsg2) + call CalcAeroAcousticsOutput(u,p,m,xd,errStat2,errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName); if (ErrStat >= AbortErrLev) return - call Calc_WriteOutput( p, u, m, y, ErrStat2, ErrMsg2 ) + call Calc_WriteOutput( p, m, y, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName); if (ErrStat >= AbortErrLev) return if (AA_OutputToSeparateFile) then @@ -819,8 +791,7 @@ SUBROUTINE Calc_LE_Location_Array(p,m,u) END SUBROUTINE Calc_LE_Location_Array !----------------------------------------------------------------------------------------------------------------------------------! -SUBROUTINE CalcObserve(p,m,u,xd,errStat,errMsg) - TYPE(AA_DiscreteStateType), INTENT(IN ) :: xd !< discrete state type +SUBROUTINE CalcObserve(p,m,u,errStat,errMsg) TYPE(AA_ParameterType), intent(in ) :: p !< Parameters TYPE(AA_InputType), intent(in ) :: u !< NN Inputs at Time TYPE(AA_MiscVarType), intent(inout) :: m !< misc/optimization data (not defined in submodules) @@ -852,7 +823,7 @@ SUBROUTINE CalcObserve(p,m,u,xd,errStat,errMsg) DO J = 1,p%NumBlNds ! Rotate the coordinates of leading and trailing edge from the local reference system to the global. Then add the coordinates of the aerodynamic center in the global coordinate system ! The global coordinate system is located on the ground, has x pointing downwind, y pointing laterally, and z pointing vertically upwards - RTEObservereal = MATMUL(p%AFTeCo(:,J,I), u%RotGtoL(:,:,J,I)) + u%AeroCent_G(:,J,I) ! Note that with the vector math, this is equivalent to MATMUL(TRANSPOSE(p%AFTeCo(:,J,I)), p%AFTeCo(:,J,I)) + u%AeroCent_G(:,J,I) + RTEObservereal = MATMUL(p%AFTeCo(:,J,I), u%RotGtoL(:,:,J,I)) + u%AeroCent_G(:,J,I) ! Note that with the vector math, this is equivalent to MATMUL(TRANSPOSE(p%RotGtoL(:,:,J,I)), p%AFTeCo(:,J,I)) + u%AeroCent_G(:,J,I) ! Loop through the observers DO K = 1,p%NrObsLoc @@ -898,9 +869,8 @@ SUBROUTINE CalcObserve(p,m,u,xd,errStat,errMsg) END SUBROUTINE CalcObserve !----------------------------------------------------------------------------------------------------------------------------------! -SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) +SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,errStat,errMsg) TYPE(AA_InputType), INTENT(IN ) :: u !< Inputs at Time t - TYPE(AA_OutputType), INTENT(INOUT) :: y !< TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(AA_MiscVarType), INTENT(INOUT) :: m !< misc/optimization data (not defined in submodules) TYPE(AA_DiscreteStateType), INTENT(IN ) :: xd !< discrete state type @@ -915,7 +885,6 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) REAL(ReKi) :: AlphaNoise REAL(ReKi) :: AlphaNoise_Deg ! REAL(ReKi) :: UNoise ! - REAL(ReKi) :: elementspan ! real(ReKi) :: Ptotal character(*), parameter :: RoutineName = 'CalcAeroAcousticsOutput' @@ -947,11 +916,6 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) Unoise = SIGN(AA_u_min, Unoise) ENDIF - IF (J .EQ. p%NumBlNds) THEN - elementspan = p%BlSpn(J,I)-p%BlSpn(J-1,I) - ELSE - elementspan = (p%BlSpn(J,I)-p%BlSpn(J-1,I))/2 + (p%BlSpn(J+1,I)-p%BlSpn(J,I))/2 - ENDIF AlphaNoise= u%AoANoise(J,I) call MPi2Pi(AlphaNoise) ! make sure this is in an appropriate range [-pi,pi] AlphaNoise_Deg = AlphaNoise * R2D_D ! convert to degrees since that is how this code is set up. @@ -973,7 +937,7 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) !--------Laminar Boundary Layer Vortex Shedding Noise----------------------------! IF ( (p%ILAM .EQ. ILAM_BPM) .AND. (p%ITRIP .EQ. ITRIP_None) ) THEN CALL LBLVS(AlphaNoise_Deg,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & - elementspan,m%rTEtoObserve(K,J,I), p,m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLLBL,p%StallStart(J,I)) + p%BlElemSpn(J,I),m%rTEtoObserve(K,J,I), p,m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLLBL,p%StallStart(J,I)) call TotalContributionFromType(m%SPLLBL,Ptotal,NoiseMech=1) ENDIF @@ -982,14 +946,14 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) IF ( p%ITURB /= ITURB_None ) THEN !returns m%SPLP, m%SPLS, m%SPLALPH CALL TBLTE(AlphaNoise_Deg,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & - elementspan,m%rTEtoObserve(K,J,I), p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),p%StallStart(J,I), & + p%BlElemSpn(J,I),m%rTEtoObserve(K,J,I), p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),p%StallStart(J,I), & m%SPLP,m%SPLS,m%SPLALPH ) IF (p%ITURB .EQ. ITURB_TNO) THEN m%EdgeVelVar=1.0_ReKi !returns m%SPLP, m%SPLS from TBLTE CALL TBLTE_TNO(UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & - elementspan,m%rTEtoObserve(K,J,I),m%CfVar,m%d99var,m%EdgeVelVar ,p, & + p%BlElemSpn(J,I),m%rTEtoObserve(K,J,I),m%CfVar,m%d99var,m%EdgeVelVar ,p, & m%SPLP,m%SPLS) ENDIF @@ -1003,7 +967,7 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) !--------Blunt Trailing Edge Noise----------------------------------------------! IF ( p%IBLUNT == IBLUNT_BPM ) THEN ! calculate m%SPLBLUNT(1:nFreq) CALL BLUNT(AlphaNoise_Deg,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%BlElemSpn(J,I),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) ) call TotalContributionFromType(m%SPLBLUNT,Ptotal,NoiseMech=5) @@ -1026,7 +990,7 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) ! Amiet's Inflow Noise Model is Calculated as long as InflowNoise is On CALL InflowNoise(AlphaNoise,p%BlChord(J,I),Unoise,m%ChordAngleLE(K,J,I),m%SpanAngleLE(K,J,I),& - elementspan,m%rLEtoObserve(K,J,I),xd%TIVx(J,I),p,m%SPLti ) + p%BlElemSpn(J,I),m%rLEtoObserve(K,J,I),xd%TIVx(J,I),p,m%SPLti ) ! If Guidati model (simplified or full version) is also on then the 'SPL correction' to Amiet's model will be added IF ( p%IInflow .EQ. IInflow_FullGuidati ) THEN @@ -1530,7 +1494,7 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,TINoise,p,SPLti) REAL(ReKi), INTENT(IN ) :: d ! element span REAL(ReKi), INTENT(IN ) :: RObs ! distance to observer ! REAL(ReKi), INTENT(IN ) :: MeanVNoise ! - REAL(ReKi), INTENT(IN ) :: TINoise ! + REAL(ReKi), INTENT(IN ) :: TINoise ! turbulence intensity (NOT in percent) ! REAL(ReKi), INTENT(IN ) :: LE_Location ! ! REAL(ReKi), INTENT(IN ) :: dissip ! @@ -1599,9 +1563,15 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,TINoise,p,SPLti) ! mu = Mach*WaveNumber*Chord/2.0/Beta2 !Note: when we set RObs in CalcObserve(), we make sure it is >= AA_EPSILON ! avoid divide-by-zero - ! tinooisess could be 0, especially on the first step, so we need to check that we don't get a + ! tinooisess could be 0, especially on the first step, so we need to check (use LOG10AA instead of LOG10) SPLhigh = 10.*LOG10AA(p%AirDens**2 * p%SpdSound**4 * p%Lturb * (d/2.) / (RObs**2) *(Mach**5) * & tinooisess**2 *(Khat**3)* (1+Khat**2)**(-7./3.) * Directivity) + 78.4 ! ref a; [2] ) + !bjj 01-13-2026: comparing with Eq 8 in ref [2], + ! (1) The paper uses "Kbar" instead of Khat (which the code uses). + ! (2) In the paper, "I" is in percent and it adds the constant 58.4. In the code, we have "I" as a fraction and I is squared, so + ! 10*log10(x*100^2)+58.4 = 10*(log10(x)+log10(100^2)) + 58.4 = 10*log10(x) + 10*log10(100^2) + 58.4 = 10*log10(x) + 40 + 58.4 + ! Seems like we should be adding 98.4 instead of 78.4 in this code. However, I also haven't found documentation for the "component due to angles of attack" below, + ! so maybe this isn't wrong. !!! SPLhigh = 10.*LOG10(p%Lturb*(d/2.)/ & !!! (RObs*RObs)*(Mach**5)*tinooisess*tinooisess*(WaveNumber**3) & @@ -1609,7 +1579,7 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,TINoise,p,SPLti) SPLhigh = SPLhigh + 10.*LOG10(1+ 9.0*AlphaNoise**2) ! Component due to angles of attack, ref a [2]) - Sears = 1/(2.*PI*Kbar/Beta2+1/(1+2.4*Kbar/Beta2)) ! ref a [2]) + Sears = 1./(TwoPi*Kbar/Beta2 + 1./(1.+2.4*Kbar/Beta2)) ! ref a [2]) !!! Sears = 1/(2.*PI*WaveNumber/Beta2+1/(1+2.4*WaveNumber/Beta2)) ! ref b [3]) @@ -2004,9 +1974,9 @@ SUBROUTINE THICK(C,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal) REAL(ReKi), INTENT(IN ) :: C !< Chord Length REAL(ReKi), INTENT(IN ) :: RC !< RC= U*C/KinViscosity TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters - REAL(ReKi), INTENT( OUT) :: DELTAP !< - REAL(ReKi), INTENT( OUT) :: DSTRS !< - REAL(ReKi), INTENT( OUT) :: DSTRP !< + REAL(ReKi), INTENT( OUT) :: DELTAP !< Pressure side boundary layer thickness + REAL(ReKi), INTENT( OUT) :: DSTRS !< Suction side displacement thickness + REAL(ReKi), INTENT( OUT) :: DSTRP !< Pressure side displacement thickness REAL(ReKi), INTENT(IN ) :: StallVal !< Stall angle at station i ! Local variables @@ -2033,7 +2003,7 @@ SUBROUTINE THICK(C,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal) IF (RC .LE. .3E+06) THEN DSTR0 = .0601 * RC **(-.114)*C ELSE - DSTR0=10.**(3.411-1.5397*LogRC+.1059*LogRC**2)*C + DSTR0=10.**(3.411-1.5397*LogRC+.1059*LogRC**2)*C END IF ! Lightly tripped IF (p%ITRIP .EQ. ITRIP_Light) DSTR0 = DSTR0 * .6 @@ -2043,22 +2013,30 @@ SUBROUTINE THICK(C,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,StallVal) ENDIF ! Pressure side displacement thickness, Eq. (9) of [1] - DSTRP = 10.**(-.0432*ALPSTAR+.00113*ALPSTAR**2)*DSTR0 + DSTRP = 10.**(-.0432*ALPSTAR+.00113*ALPSTAR**2)*DSTR0 ! IF (p%ITRIP .EQ. 3) DSTRP = DSTRP * 1.48 ! commented since itrip is never 3 check if meant 2.(EB_DTU) + ! Suction side displacement thickness - IF (p%ITRIP .EQ. ITRIP_Heavy) THEN - ! Heavily tripped, Eq. (12) of [1] - IF (ALPSTAR .LE. 5.) DSTRS=10.**(.0679*ALPSTAR)*DSTR0 - IF((ALPSTAR .GT. 5.).AND.(ALPSTAR .LE. StallVal)) & - DSTRS = .381*10.**(.1516*ALPSTAR)*DSTR0 - IF (ALPSTAR .GT. StallVal)DSTRS=14.296*10.**(.0258*ALPSTAR)*DSTR0 - ELSE + IF (p%ITRIP .EQ. ITRIP_Heavy) THEN + ! Heavily tripped, Eq. (12) of [1] + IF (ALPSTAR .LE. 5.) THEN + DSTRS=10.**(.0679*ALPSTAR)*DSTR0 + ELSEIF (ALPSTAR .LE. StallVal) THEN + DSTRS = 0.381 * 10.**(.1516*ALPSTAR)*DSTR0 + ELSE + DSTRS = 14.296 * 10.**(.0258*ALPSTAR)*DSTR0 + ENDIF + ELSE ! Untripped or lightly tripped, Eq. (15) of [1] - IF (ALPSTAR .LE. 7.5)DSTRS =10.**(.0679*ALPSTAR)*DSTR0 - IF((ALPSTAR .GT. 7.5).AND.(ALPSTAR .LE. StallVal)) & - DSTRS = .0162*10.**(.3066*ALPSTAR)*DSTR0 - IF (ALPSTAR .GT. StallVal) DSTRS = 52.42*10.**(.0258*ALPSTAR)*DSTR0 - ENDIF + IF (ALPSTAR .LE. 7.5) THEN + DSTRS =10.**(.0679*ALPSTAR)*DSTR0 + ELSEIF(ALPSTAR .LE. StallVal) THEN + DSTRS = .0162*10.**(.3066*ALPSTAR)*DSTR0 + ELSE + DSTRS = 52.42*10.**(.0258*ALPSTAR)*DSTR0 + ENDIF + ENDIF + END SUBROUTINE Thick !==================================================================================================== !> This subroutine computes the high frequency directivity function for the trailing edge diff --git a/modules/aerodyn/src/AeroAcoustics_Driver.f90 b/modules/aerodyn/src/AeroAcoustics_Driver.f90 new file mode 100644 index 000000000..ea5bdbf6b --- /dev/null +++ b/modules/aerodyn/src/AeroAcoustics_Driver.f90 @@ -0,0 +1,176 @@ +!********************************************************************************************************************************** +! LICENSING +! Copyright (C) 2015-2016 National Renewable Energy Laboratory +! +! This file is part of AeroDyn. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. +! + +!there will also be various control flags... this may be updated as needed: +!TBLflag = {'BPM','TNO'} +!bluntnessFlag = {'DTU','BPM'} +!BPMBLflag = {'true','false'} +!useOrigModelAtSepOnset = {'true','false'} + + + + + +!********************************************************************************************************************************** +program AeroAcoustics_Driver + use AeroAcoustics_Driver_Subs + use VersionInfo + implicit none + + ! Program variables + REAL(ReKi) :: PrevClockTime ! Clock time at start of simulation in seconds [(s)] + REAL(ReKi) :: UsrTime1 ! User CPU time for simulation initialization [(s)] + REAL(ReKi) :: UsrTime2 ! User CPU time for simulation (without initialization) [(s)] + INTEGER(IntKi) , DIMENSION(1:8) :: StrtTime ! Start time of simulation (including initialization) [-] + INTEGER(IntKi) , DIMENSION(1:8) :: SimStrtTime ! Start time of simulation (after initialization) [-] + REAL(DbKi) :: t_global ! global-loop time marker + REAL(DbKi) :: TiLstPrn ! The simulation time of the last print (to file) [(s)] + + TYPE(Dvr_Data) :: DriverData + + character(1024) :: InputFile + integer :: nt !< loop counter (for time step) + character(20) :: FlagArg ! flag argument from command line + integer(IntKi) :: ErrStat ! status of error message + character(ErrMsgLen) :: ErrMsg !local error message if ErrStat /= ErrID_None + + + CALL DATE_AND_TIME ( Values=StrtTime ) ! Let's time the whole simulation + CALL CPU_TIME ( UsrTime1 ) ! Initial time (this zeros the start time when used as a MATLAB function) + UsrTime1 = MAX( 0.0_ReKi, UsrTime1 ) ! CPU_TIME: If a meaningful time cannot be returned, a processor-dependent negative value is returned + UsrTime2 = UsrTime1 ! CPU_TIME: Initialize in case of error before getting real data + SimStrtTime = StrtTime ! CPU_TIME: Initialize in case of error before getting real data + nt = 0 + + ! --- Driver initialization + CALL NWTC_Init( ProgNameIN=version%Name ) + + InputFile = "" ! initialize to empty string to make sure it's input from the command line + CALL CheckArgs( InputFile, Flag=FlagArg ) + IF ( LEN( TRIM(FlagArg) ) > 0 ) CALL NormStop() + + ! Display the copyright notice and compile info: + CALL DispCopyrightLicense( version%Name ) + CALL DispCompileRuntimeInfo( version%Name ) + + + ! Initialize modules + call ReadDriverInputFile( InputFile, DriverData, ErrStat, ErrMsg ); call CheckError() + call Init_AFI(DriverData%Airfoil_FileName, DriverData%AFInfo, ErrStat, ErrMsg); call CheckError() + call Init_AAmodule(DriverData, ErrStat, ErrMsg); call CheckError() + + ! Init of time estimator + t_global=0.0_DbKi + call SimStatus_FirstTime( TiLstPrn, PrevClockTime, SimStrtTime, UsrTime2, t_global, DriverData%TMax ) + + ! Time loop + do nt = 1, DriverData%numSteps + ! Time update to screen + t_global=nt * DriverData%dt + + if (mod( nt + 1, 10 )==0) call SimStatus(TiLstPrn, PrevClockTime, t_global, DriverData%TMax) + + ! update states and calculate output + call SetInputsForAA(DriverData) + + call AA_CalcOutput(t_global, DriverData%u, DriverData%p, DriverData%xd, DriverData%OtherState, DriverData%y, DriverData%m, errStat, errMsg); call CheckError() + call Dvr_WriteOutputs(t_global, nt, DriverData) ! write to file at this step + + ! Get state variables at next step: INPUT at step nt - 1, OUTPUT at step nt + call AA_UpdateStates(t_global, nt, DriverData%m, DriverData%u, DriverData%p, DriverData%xd, DriverData%OtherState, errStat, errMsg); call CheckError() + + end do !nt=1,numSteps + + + call Dvr_End() +contains +!................................ + subroutine CheckError() + if (ErrStat /= ErrID_None) then + call WrScr(TRIM(errMsg)) + if (errStat >= AbortErrLev) then + call Dvr_End() + end if + ErrStat = ErrID_None + end if + end subroutine CheckError +!................................ + subroutine Dvr_End() + integer(IntKi) :: errStat2 ! local status of error message + character(ErrMsgLen) :: errMsg2 ! local error message if ErrStat /= ErrID_None + + call Dvr_EndOutput(DriverData, nt, errStat2, errMsg2) + if (ErrStat2 /= ErrID_None) call WrScr(TRIM(errMsg2)) + + call RunTimes(StrtTime, UsrTime1, SimStrtTime, UsrTime2, t_global) + + if (ErrStat >= AbortErrLev) then + call WrScr('') + CALL ProgAbort( 'AeroAcoustics Driver encountered simulation error level: '& + //TRIM(GetErrStr(ErrStat)), TrapErrors=.FALSE., TimeWait=3._ReKi ) ! wait 3 seconds (in case they double-clicked and got an error) + else + call NormStop() + end if + end subroutine Dvr_End +!................................ +end program AeroAcoustics_Driver + + + +!Inputs that will be supplied externally: +!driver%DT +! +!Need to set in InitInput: +! rho [InitInputType%airDens] +! c0 or co [InitInputType%SpdSound] +! L [InitInputType%BlSpn] +! chord [InitInputType%BlChord] +! [driver%DT = Interval] +! visc [InitInputType%KinVisc] +! [InitInputType%HubHeight] +! Airfoil info: +! BlAFID +! AFInfo +! +!Set in AA Input File: +! Lturb (already in AA input file) [InputFileData%Lturb] +! dStarS [m%dstarVar(1), dstarVar1, DSTRS -> interpolated from p%dstarall1 = InputFileData%Suct_DispThick using AoA and Re] meters +! dStarP [m%dstarVar(2), dstarVar2, DSTRP -> interpolated from p%dstarall2 = InputFileData%Pres_DispThick using AoA and Re] meters +! TI [InputFileData%TI] +! cfS [m%CfVar(1), Cfall(1) -> interpolated p%Cfall1=InputFileData%Suct_Cf with Re and AoA] +! cfP [m%CfVar(2), Cfall(2) -> interpolated p%Cfall2=InputFileData%Pres_Cf with Re and AoA] +! deltaS [m%d99Var(1) -> interpolated p%d99all1=InputFileData%Suct_BLThick with Re and AoA] +! deltaP [m%d99Var(2), d99Var2 -> interpolated p%d99all2=InputFileData%Pres_BLThick with Re and AoA ] PRESSURE SIDE BOUNDARY LAYER THICKNESS METERS +! uEdgeS [m%EdgeVelVar(1), EdgeVelAll(2) -> interpolated p%EdgeVelRat1=InputFileData%Suct_EdgeVelRat with Re and AoA] +! uEdgeP [m%EdgeVelVar(2), EdgeVelAll(2) -> interpolated p%EdgeVelRat2=InputFileData%Pres_EdgeVelRat with Re and AoA] +! +!Inputs caluculated in AeroDyn (now set in driver input file?): +! meanWindspeed [u%Inflow] +! AoA [u%AoANoise] +! [u%vRel] +! [AeroCent_G] = u%BladeMotion(j)%Position(:,i) + u%BladeMotion(j)%TranslationDisp(:,i) (global position of the blade node) -> fixed value??? +! [RotGtoL] -> set to identity +! +!Inputs calculated +! Ma [M or Mach] : calculated M = U / p%SpdSound ! MACH NUMBER +! Re [RC] : calculated RC = U * C/p%KinVisc ! Reynolds number; C = chord; U=UNoise=sign( max(abs(u%Vrel(J,I)),0.1), u%Vrel(J,I) ) +! +!fSep1p0_alpha (new to BPM) +!fSpe0p7_alpha (new to BPM) + \ No newline at end of file diff --git a/modules/aerodyn/src/AeroAcoustics_Driver_Subs.f90 b/modules/aerodyn/src/AeroAcoustics_Driver_Subs.f90 new file mode 100644 index 000000000..553b65aa3 --- /dev/null +++ b/modules/aerodyn/src/AeroAcoustics_Driver_Subs.f90 @@ -0,0 +1,523 @@ +module AeroAcoustics_Driver_Subs + + use NWTC_Library + use AirfoilInfo + use AirfoilInfo_Types + use AeroAcoustics + use AeroAcoustics_Types + + implicit none + + integer, parameter :: NumAFfiles = 1 + integer, parameter :: NumBlades = 1 + integer, parameter :: NumBlNds = 1 + logical, parameter :: UseCm = .false. + + integer(IntKi), parameter :: idFmt_Ascii = 1 + integer(IntKi), parameter :: idFmt_Binary = 2 + integer(IntKi), parameter :: idFmt_Both = 3 + integer(IntKi), parameter :: idFmt_Valid(3) = (/idFmt_Ascii, idFmt_Binary, idFmt_Both/) + real(ReKi), parameter :: myNaN = -9999.9 + character(1), parameter :: delim = TAB + + real(DbKi), parameter :: RotGtoL(3,3) = reshape( [1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0], SHAPE=[3,3] ) + TYPE(ProgDesc), PARAMETER :: version = ProgDesc( 'AeroAcoustics_driver', '', '' ) ! The version number of this program. + + + type Dvr_Data + ! Environmental Conditions + real(ReKi) :: KinVisc !< Kinematic viscosity of working fluid (m^2/s) + real(ReKi) :: AirDens !< AirDens | Air density (kg/m^3) + real(ReKi) :: SpdSound !< Speed of sound in working fluid (m/s) + + ! Output data + character(1024) :: OutRootName = '' !< output file rootname [-] + integer(IntKi) :: unOutFile = -1 !< unit number for writing text output file + character(256) :: OutFmt !< Format used for text tabular output, excluding the time channel. Resulting field should be 10 characters. (quoted string) + integer(IntKi) :: OutFileFmt = idFmt_Binary !< Format for tabular (time-marching) output file (switch) {1: text file [.out], 2: binary file [.outb], 3: both} + logical :: WrBinaryOutput=.false. + logical :: WrTextOutput=.false. + integer(IntKi) :: NumOuts= 0 !< number of output channels, including time + integer(IntKi) :: NumSteps= 0 !< number of steps in output + character(ChanLen) , dimension(:), allocatable :: WriteOutputHdr !< channel headers [-] + character(ChanLen) , dimension(:), allocatable :: WriteOutputUnt !< channel units [-] + real(SiKi) , dimension(:,:), allocatable :: storage !< nchannel x ntime [-] + real(ReKi) , dimension(:), allocatable :: outline !< output line to be written to disk [-] + integer(IntKi) :: FmtWidth + + ! AeroAcoustics Input data + REAL(DbKi) :: AeroCent_G(3) !< Global position of the blade node + REAL(ReKi) :: vRel !< Relative velocity (m/s) + REAL(ReKi) :: AoA !< Angle of attack (rad) + REAL(ReKi) :: WindSpeed !< Atmospheric undisturbed flow on blade [Inflow] (m/s) + REAL(ReKi) :: HubHeight !< hub height (m) + REAL(ReKi) :: BladeLength !< effectively the element span (m) since we are running this with only one element + + ! Time control + real(DbKi) :: DT !< Simulation time step [used only when AnalysisType/=3] (s) + real(DbKi) :: TMax !< Total run time [used only when AnalysisType/=3] (s) + + ! AFI data + character(1024) :: AirFoil_FileName + real(ReKi) :: Chord = 1.0 + type(AFI_ParameterType) :: AFInfo(NumAFfiles) +! integer, allocatable :: AFIndx(:,:) + + ! AeroAcoustics data + character(1024) :: AA_InputFileName !< name of the AA input file + type(AA_InitInputType) :: InitInp !< Input data for initialization routine + type(AA_InputType) :: u !< An initial guess for the input; input mesh must be defined + type(AA_ParameterType) :: p !< Parameters + !type(AA_ContinuousStateType) :: x !< Initial continuous states + type(AA_DiscreteStateType) :: xd !< Initial discrete states + !type(AA_ConstraintStateType) :: z !< Initial guess of the constraint states + type(AA_OtherStateType) :: OtherState !< Initial other states + type(AA_OutputType) :: y !< Initial system outputs (outputs are not calculated) + type(AA_MiscVarType) :: m !< Initial misc/optimization variables + end type Dvr_Data + +contains + +!-------------------------------------------------------------------------------------------------------------- +subroutine ReadDriverInputFile( FileName, DriverData, ErrStat, ErrMsg ) + character(1024), intent(in ) :: FileName + type(Dvr_Data), intent(inout) :: DriverData ! driver data + integer, intent( out) :: ErrStat ! returns a non-zero value when an error occurs + character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None + + ! Local variables + integer :: UnEcho ! The local unit number for this module's echo file + integer :: iLine, i + character(1024) :: EchoFile ! Name of driver's echo file + character(1024) :: PriPath ! the path to the primary input file + character(1024) :: Line ! the path to the primary input file + type(FileInfoType) :: FI !< The derived type for holding the file information. + integer(IntKi) :: errStat2 ! Status of error message + character(1024) :: errMsg2 ! Error message if ErrStat /= ErrID_None + character(*), parameter :: RoutineName = 'ReadDriverInputFile' + integer, parameter :: NumHeaderLines = 3 + logical :: Echo + + ! Initialize the echo file unit to -1 which is the default to prevent echoing, we will alter this based on user input + UnEcho = -1 + Echo = .false. + ErrStat = ErrID_None + ErrMsg = '' + + ! Read all input file lines into fileinfo + call WrScr(' Opening AeroAcoustics Driver input file: '//trim(FileName) ) + call ProcessComFile(FileName, FI, errStat2, errMsg2); if (Failed()) return + CALL GetPath( FileName, PriPath ) ! Input files will be relative to the path where the primary input file is located. + !call GetRoot(FileName, dvr%root) + + ! --- Header and echo + iLine = NumHeaderLines ! Skip the first NumHeaderLines lines as they are known to be header lines and separators + call ParseVar(FI, iLine, 'Echo', Echo, errStat2, errMsg2); if (Failed()) return; + if ( Echo ) then + EchoFile = trim(FileName)//'.ech' + call OpenEcho (UnEcho, EchoFile, errStat2, errMsg2 ); if(Failed()) return + do i = 1,iLine-1 + write(UnEcho, '(A)') trim(FI%Lines(i)) + enddo + end if + + call ParseVar(FI, iLine, 'TMax', DriverData%TMax , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'DT', DriverData%DT, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'AA_InputFile', DriverData%AA_InputFileName , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'AirFoil_FileName' , DriverData%AirFoil_FileName, errStat2, errMsg2, UnEcho); if(Failed()) return + + ! --- Environmental conditions section + call ParseCom(FI, iLine, Line , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'AirDens', DriverData%AirDens , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'KinVisc', DriverData%KinVisc , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'SpdSound', DriverData%SpdSound, errStat2, errMsg2, UnEcho); if(Failed()) return + + ! --- SIMULATION INPUTS section + call ParseCom(FI, iLine, Line , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'WindSpeed' , DriverData%WindSpeed , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'AoA' , DriverData%AoA , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'vRel' , DriverData%vRel , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseAry(FI, iLine, 'AeroCent_G' , DriverData%AeroCent_G , 3, errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'HubHeight' , DriverData%HubHeight , errStat2, errMsg2, UnEcho); if(Failed()) return +! call ParseVar(FI, iLine, 'Chord' , DriverData%Chord , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'Span' , DriverData%BladeLength, errStat2, errMsg2, UnEcho); if(Failed()) return + + ! --- OUTPUT section + call ParseCom(FI, iLine, Line , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'OutFmt' , DriverData%OutFmt , errStat2, errMsg2, UnEcho); if(Failed()) return + call ParseVar(FI, iLine, 'OutFileFmt', DriverData%OutFileFmt, errStat2, errMsg2, UnEcho); if(Failed()) return + + ! convert units: + DriverData%AoA = DriverData%AoA * D2R + + + ! --- Get relative path names + call GetRoot(FileName, DriverData%OutRootName) ! OutRootName is inferred from current filename. + !if (PathIsRelative(DriverData%OutRootName)) DriverData%OutRootName = TRIM(PriPath)//TRIM(DriverData%OutRootName) + if (PathIsRelative(DriverData%AA_InputFileName)) DriverData%AA_InputFileName = TRIM(PriPath)//TRIM(DriverData%AA_InputFileName) + if (PathIsRelative(DriverData%AirFoil_FileName)) DriverData%AirFoil_FileName = TRIM(PriPath)//TRIM(DriverData%AirFoil_FileName ) + + ! --- Checks + if (DriverData%OutFileFmt == idFmt_Both) then + DriverData%WrBinaryOutput = .true. + DriverData%WrTextOutput = .true. + elseif (DriverData%OutFileFmt == idFmt_Ascii) then + DriverData%WrBinaryOutput = .false. + DriverData%WrTextOutput = .true. + elseif (DriverData%OutFileFmt == idFmt_Binary) then + DriverData%WrBinaryOutput = .true. + DriverData%WrTextOutput = .false. + else + DriverData%WrBinaryOutput = .false. + DriverData%WrTextOutput = .false. + end if + + if (DriverData%WrTextOutput) then + CALL ChkRealFmtStr( DriverData%OutFmt, 'OutFmt', DriverData%FmtWidth, ErrStat2, ErrMsg2 ) + IF ( DriverData%FmtWidth < 10 ) CALL SetErrStat( ErrID_Warn, 'OutFmt produces a column width of '// & + TRIM(Num2LStr(DriverData%FmtWidth))//'), which may be too small.', ErrStat, ErrMsg, RoutineName ) + end if + + 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() + ! Close this module's echo file + if ( Echo ) then + close(UnEcho) + end if + Call NWTC_Library_Destroyfileinfotype(FI, errStat2, errMsg2) + end subroutine Cleanup + + +end subroutine ReadDriverInputFile +!-------------------------------------------------------------------------------------------------------------- + +subroutine Dvr_EndOutput(DriverData, nt, errStat, errMsg) + type(Dvr_Data), intent(inout) :: DriverData ! driver data + integer(IntKi), intent(in ) :: nt ! number of time steps written + integer(IntKi) , intent(out) :: errStat ! Status of error message + character(*) , intent(out) :: errMsg ! Error message if errStat /= ErrID_None + + character(ErrMsgLen) :: errMsg2 ! temporary Error message if errStat /= ErrID_None + integer(IntKi) :: errStat2 ! temporary Error status of the operation + character(*), parameter :: RoutineName = 'Dvr_EndOutput' + + errStat = ErrID_None + errMsg = '' + + ! Close the output file + if (DriverData%WrTextOutput) then + if (DriverData%unOutFile > 0) close(DriverData%unOutFile) + DriverData%unOutFile = -1 + endif + if (DriverData%WrBinaryOutput .and. allocated(DriverData%storage)) then + call WrScr(' Writing output file: '//trim(DriverData%OutRootName)//'.outb') + call WrBinFAST(trim(DriverData%OutRootName)//'.outb', FileFmtID_ChanLen_In, version%Name, DriverData%WriteOutputHdr, DriverData%WriteOutputUnt, (/0.0_DbKi, DriverData%dt/), DriverData%storage(:,1:nt), errStat2, errMsg2) + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + endif +end subroutine Dvr_EndOutput + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> Initialize outputs to file for driver +subroutine Dvr_InitializeOutputs(DriverData, AA_InitOut, errStat, errMsg) + TYPE(Dvr_Data) , intent(inout) :: DriverData + TYPE(AA_InitOutputTYpe), intent(in ) :: AA_InitOut + integer(IntKi) , intent( out) :: errStat ! Status of error message + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None + ! locals + integer(IntKi) :: errStat2 ! Status of error message + character(ErrMsgLen) :: errMsg2 ! Error message + integer :: i, j + integer :: ActualChanLen + + errStat = ErrID_None + errMsg = '' + + DriverData%numSteps = ceiling(DriverData%TMax / DriverData%dt) + DriverData%numOuts = sum(DriverData%p%numOutsAll) + 1 ! includes time channel + if (DriverData%numOuts < 2) then + ErrStat2=ErrID_Fatal + ErrMsg2='AeroAcoustics module is not printing any outputs. Simulation will end.' + if (Failed()) return + end if + + ! --- Allocate driver-level outputs + call AllocAry(DriverData%WriteOutputHdr, DriverData%numOuts, 'WriteOutputHdr', errStat2, errMsg2); if(Failed()) return + call AllocAry(DriverData%WriteOutputUnt, DriverData%numOuts, 'WriteOutputUnt', errStat2, errMsg2); if(Failed()) return + + i=1 + DriverData%WriteOutputHdr(i) = 'Time' + DriverData%WriteOutputUnt(i) = '(s)' + + if (DriverData%numOuts > 0) then + do j=1,DriverData%p%numOutsAll(1) + i = i + 1 + DriverData%WriteOutputHdr(i) = AA_InitOut%WriteOutputHdr(j) + DriverData%WriteOutputUnt(i) = AA_InitOut%WriteOutputUnt(j) + end do + + do j=1,DriverData%p%numOutsAll(2) + i = i + 1 + DriverData%WriteOutputHdr(i) = AA_InitOut%WriteOutputHdrforPE(j) + DriverData%WriteOutputUnt(i) = AA_InitOut%WriteOutputUntforPE(j) + end do + + do j=1,DriverData%p%numOutsAll(3) + i = i + 1 + DriverData%WriteOutputHdr(i) = AA_InitOut%WriteOutputHdrSep(j) + DriverData%WriteOutputUnt(i) = AA_InitOut%WriteOutputUntSep(j) + end do + + do j=1,DriverData%p%numOutsAll(4) + i = i + 1 + DriverData%WriteOutputHdr(i) = AA_InitOut%WriteOutputHdrNodes(j) + DriverData%WriteOutputUnt(i) = AA_InitOut%WriteOutputUntNodes(j) + end do + end if + + if (DriverData%WrTextOutput .or. DriverData%WrBinaryOutput) then + call AllocAry(DriverData%outLine, DriverData%numOuts-1, 'outLine', errStat2, errMsg2); if(Failed()) return + DriverData%outLine=0.0_ReKi + end if + + if (DriverData%WrTextOutput) then + ActualChanLen = min(ChanLen, max(10, DriverData%FmtWidth)) + do i=1,DriverData%NumOuts + ActualChanLen = max( ActualChanLen, LEN_TRIM(DriverData%WriteOutputHdr(I)) ) + ActualChanLen = max( ActualChanLen, LEN_TRIM(DriverData%WriteOutputUnt(I)) ) + enddo ! I + + call GetNewUnit( DriverData%unOutFile, ErrStat2, ErrMsg2 ) + if (Failed()) return + + call OpenFOutFile ( DriverData%unOutFile, trim(DriverData%OutRootName)//'.out', ErrStat2, ErrMsg2 ) + if (Failed()) return + + write (DriverData%unOutFile,'(A)') '' + write (DriverData%unOutFile,'(A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using '//trim(GetNVD(version)) + write (DriverData%unOutFile,'(A)') '' + write (DriverData%unOutFile,'(A)') '' + write (DriverData%unOutFile,'(A)') 'Output from AeroAcoustics driver' + write (DriverData%unOutFile,'(A)') '' + + !...................................................... + ! Write the names of the output parameters on one line: line 7 + !...................................................... + call WrFileNR ( DriverData%unOutFile, DriverData%WriteOutputHdr(1)(1:min(15,ChanLen)) ) + do i=2,DriverData%NumOuts + call WrFileNR ( DriverData%unOutFile, delim//DriverData%WriteOutputHdr(i)(1:ActualChanLen) ) + end do ! i + write (DriverData%unOutFile,'()') + + !...................................................... + ! Write the units of the output parameters on one line: line 8 + !...................................................... + call WrFileNR ( DriverData%unOutFile, DriverData%WriteOutputUnt(1)(1:min(15,ChanLen)) ) + do i=2,DriverData%NumOuts + call WrFileNR ( DriverData%unOutFile, delim//DriverData%WriteOutputUnt(i)(1:ActualChanLen) ) + end do ! i + write (DriverData%unOutFile,'()') + + end if + + ! --- Binary + if (DriverData%WrBinaryOutput) then + ! we aren't storing time here + call AllocAry(DriverData%storage, DriverData%numOuts-1, DriverData%numSteps, 'storage', errStat2, errMsg2); if(Failed()) return + DriverData%storage= myNaN !0.0_ReKi ! Alternative: myNaN + endif + +contains + logical function Failed() + CALL SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Dvr_InitializeOutputs' ) + Failed = errStat >= AbortErrLev + end function Failed +end subroutine Dvr_InitializeOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine Dvr_WriteOutputs(t, nt, DriverData) + Integer(IntKi) , intent(in ) :: nt ! time step number + real(DbKi) , intent(in ) :: t ! simulation time (s) + type(Dvr_Data), intent(inout) :: DriverData ! driver data + + ! ! Local variables. + integer :: i, j + + if (DriverData%WrTextOutput .or. DriverData%WrBinaryOutput) then + i = 0 + + ! Driver outputs + if (DriverData%numOuts > 0) then + do j=1,DriverData%p%numOutsAll(1) + i = i + 1 + DriverData%outLine(i) = DriverData%y%WriteOutput(j) + end do + + do j=1,DriverData%p%numOutsAll(2) + i = i + 1 + DriverData%outLine(i) = DriverData%y%WriteOutputforPE(j) + end do + + do j=1,DriverData%p%numOutsAll(3) + i = i + 1 + DriverData%outLine(i) = DriverData%y%WriteOutputSep(j) + end do + + do j=1,DriverData%p%numOutsAll(4) + i = i + 1 + DriverData%outLine(i) = DriverData%y%WriteOutputNodes(j) + end do + end if + + if (DriverData%WrBinaryOutput) DriverData%storage(:,nt) = DriverData%outLine + if (DriverData%WrTextOutput) then + write(DriverData%unOutFile,'(F15.4,'//trim(num2lstr(DriverData%numOuts-1))//'("'//delim//'"'//trim(DriverData%outFmt)//'))') t, DriverData%outLine(:) + end if + + + end if + + +end subroutine Dvr_WriteOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine Init_AFI(afName, AFInfo, ErrStat, ErrMsg) + + CHARACTER(1024), intent(in ) :: afName + type(AFI_ParameterType), intent( out) :: AFInfo(NumAFfiles) + integer(IntKi), intent( out) :: ErrStat ! Error status. + character(*), intent( out) :: ErrMsg ! Error message. + + type(AFI_InitInputType) :: AFI_InitInputs + integer :: UnEc + + ErrStat = ErrID_None + ErrMsg = "" + + AFI_InitInputs%InCol_Alfa = 1 + AFI_InitInputs%InCol_Cl = 2 + AFI_InitInputs%InCol_Cd = 3 + AFI_InitInputs%InCol_Cm = 0 + AFI_InitInputs%InCol_Cpmin = 0 + AFI_InitInputs%AFTabMod = AFITable_1 ! 1D-interpolation (on AoA only) + AFI_InitInputs%UAMod = 3 ! We calculate some of the UA coefficients based on UA Model, but AA doesn't care which + AFI_InitInputs%FileName = afName !InitInp%AF_File(i) + + UnEc = 0 + + ! Read in and process the airfoil file. + ! This includes creating the spline coefficients to be used for interpolation. + + call AFI_Init ( AFI_InitInputs, AFInfo(1), errStat, errMsg, UnEc ) + if (ErrStat >= AbortErrLev) return + +end subroutine Init_AFI +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes the Airfoil Noise module from within AeroDyn. +SUBROUTINE Init_AAmodule( DriverData, ErrStat, ErrMsg ) +!.................................................................................................................................. + type(Dvr_Data), intent(inout) :: DriverData !< AeroDyn-level initialization inputs + + integer(IntKi), intent( out) :: errStat !< Error status of the operation + character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None + + ! Local variables + real(DbKi) :: Interval ! DT + type(AA_InitInputType) :: InitInp ! Input data for initialization routine + type(AA_InitOutputType) :: InitOut ! Output for initialization routine + integer(intKi) :: j ! node index + integer(intKi) :: k ! blade index + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'Init_AAmodule' + + ErrStat = ErrID_None + ErrMsg = "" + + ! Transfer from parameters and input file to init input + InitInp%InputFile = DriverData%AA_InputFileName + InitInp%NumBlades = NumBlades + InitInp%NumBlNds = NumBlNds + InitInp%RootName = DriverData%OutRootName + +! read from input file or set default value + Interval = DriverData%DT + InitInp%airDens = DriverData%airDens !(rho) + InitInp%kinVisc = DriverData%kinVisc !(nu) + InitInp%SpdSound = DriverData%SpdSound !(co) + InitInp%HubHeight = DriverData%HubHeight + + ! --- Allocate and set AirfoilID, chord and Span for each blades + ! note here that each blade is required to have the same number of nodes + call AllocAry( InitInp%BlAFID, NumBlNds, NumBlades,'InitInp%BlAFID', errStat2, ErrMsg2 ); call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry( InitInp%BlChord, NumBlNds, NumBlades, 'BlChord', errStat2, ErrMsg2 ); call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry( InitInp%BlSpn, NumBlNds, NumBlades, 'BlSpn', errStat2, ErrMsg2 ); call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + if (ErrStat >= AbortErrLev) then + call cleanup() + return + end if + + do k = 1, NumBlades + do j=1, NumBlNds + InitInp%BlChord(j,k) = DriverData%Chord !RotInputFileData%BladeProps(k)%BlChord(j) + InitInp%BlSpn (j,k) = real(j,ReKi)/real(NumBlNds,ReKi) * DriverData%BladeLength + InitInp%BlAFID(j,k) = NumAFfiles !RotInputFileData%BladeProps(k)%BlAFID(j) + end do + end do + + ! --- AeroAcoustics initialization call + call AA_Init(InitInp, DriverData%u, DriverData%p, DriverData%xd, DriverData%OtherState,DriverData%y, DriverData%m, Interval, DriverData%AFInfo, InitOut, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + + if (ErrStat < AbortErrLev) then + call Dvr_InitializeOutputs(DriverData, InitOut, errStat2, errMsg2) + call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + end if + + call Cleanup() + +contains + + subroutine Cleanup() + call AA_DestroyInitInput ( InitInp, ErrStat2, ErrMsg2 ) + call AA_DestroyInitOutput ( InitOut, ErrStat2, ErrMsg2 ) + end subroutine Cleanup + +END SUBROUTINE Init_AAmodule +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine sets m%AA_u. +subroutine SetInputsForAA(DriverData) + type(Dvr_Data), intent(inout) :: DriverData !< AeroDyn-level initialization inputs + + ! local variables + integer(intKi) :: i ! loop counter for nodes + integer(intKi) :: j ! loop counter for blades + + do j=1,NumBlades + do i = 1,NumBlNds + ! Get local orientation matrix to transform from blade element coordinates to global coordinates + DriverData%u%RotGtoL(:,:,i,j) = RotGtoL ! default to identitiy orientation + + ! Get blade element aerodynamic center in global coordinates + DriverData%u%AeroCent_G(:,i,j) = DriverData%AeroCent_G !BJJ: does this need to change with time? probably + + ! Set the blade element relative velocity (including induction) + DriverData%u%Vrel(i,j) = DriverData%VRel + + ! Set the blade element angle of attack + DriverData%u%AoANoise(i,j) = DriverData%AoA + + ! Set the blade element undisturbed flow + DriverData%u%Inflow(:,i,j) = [DriverData%WindSpeed, 0.0_ReKi, 0.0_ReKi] + end do + end do +end subroutine SetInputsForAA +!---------------------------------------------------------------------------------------------------------------------------------- + +end module AeroAcoustics_Driver_Subs + diff --git a/modules/aerodyn/src/AeroAcoustics_IO.f90 b/modules/aerodyn/src/AeroAcoustics_IO.f90 index 655717568..24049bb02 100644 --- a/modules/aerodyn/src/AeroAcoustics_IO.f90 +++ b/modules/aerodyn/src/AeroAcoustics_IO.f90 @@ -41,28 +41,28 @@ MODULE AeroAcoustics_IO integer(intKi), parameter :: X_BLMethod_BPM = 1 ! integer(intKi), parameter :: X_BLMethod_Tables = 2 ! - integer(intKi), parameter :: TICalc_Interp = 1 ! interpolate from pretabulated - integer(intKi), parameter :: TICalc_Every = 2 ! calculate ti automatically + integer(intKi), parameter :: TICalc_Interp = 1 ! interpolate from pretabulated (TICalcMethod) + integer(intKi), parameter :: TICalc_Every = 2 ! calculate ti automatically (TICalcMethod) integer(intKi), parameter :: ITURB_None = 0 ! TBLTE noise is not calculated integer(intKi), parameter :: ITURB_BPM = 1 ! TBLTE noise is calculated with BPM integer(intKi), parameter :: ITURB_TNO = 2 ! TBLTE noise is calculated with TNO - integer(intKi), parameter :: IInflow_None = 0 ! IInflow noise is not calculated - integer(intKi), parameter :: IInflow_BPM = 1 ! IInflow noise is calculated with BPM - integer(intKi), parameter :: IInflow_FullGuidati = 2 ! IInflow noise is calculated with FullGuidati + integer(intKi), parameter :: IInflow_None = 0 ! IInflow noise is not calculated + integer(intKi), parameter :: IInflow_BPM = 1 ! IInflow noise is calculated with BPM + integer(intKi), parameter :: IInflow_FullGuidati = 2 ! IInflow noise is calculated with FullGuidati integer(intKi), parameter :: IInflow_SimpleGuidati = 3 ! IInflow noise is calculated with SimpleGuidati contains !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadInputFiles( InputFileName, AFI, InputFileData, Default_DT, OutFileRoot, ErrStat, ErrMsg ) +SUBROUTINE ReadInputFiles( InputFileName, AFInfo, InputFileData, Default_DT, OutFileRoot, ErrStat, ErrMsg ) ! This subroutine reads the input file and stores all the data in the AA_InputFile structure. ! It does not perform data validation. !.................................................................................................................................. ! Passed variables REAL(DbKi), INTENT(IN) :: Default_DT ! The default DT (from glue code) CHARACTER(*), INTENT(IN) :: InputFileName ! Name of the aeroacoustics input file - TYPE(AFI_ParameterType), INTENT(IN) :: AFI(:) ! airfoil array: contains names of the BL input file + TYPE(AFI_ParameterType), INTENT(IN) :: AFInfo(:) ! airfoil array: contains names of the BL input file CHARACTER(*), INTENT(IN) :: OutFileRoot ! The rootname of all the output files written by this routine. TYPE(AA_InputFile), INTENT(OUT) :: InputFileData ! Data stored in the module's input file INTEGER(IntKi), INTENT(OUT) :: ErrStat ! The error status code @@ -83,7 +83,7 @@ SUBROUTINE ReadInputFiles( InputFileName, AFI, InputFileData, Default_DT, OutFil if(Failed()) return ! get the blade input-file data - ALLOCATE( InputFileData%BladeProps( size(AFI) ), STAT = ErrStat2 ) + ALLOCATE( InputFileData%BladeProps( size(AFInfo) ), STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating memory for BladeProps.", ErrStat, ErrMsg, RoutineName) call cleanup() @@ -92,7 +92,7 @@ SUBROUTINE ReadInputFiles( InputFileName, AFI, InputFileData, Default_DT, OutFil if (InputFileData%ITURB==ITURB_TNO .or. InputFileData%X_BLMethod==X_BLMethod_Tables .or. InputFileData%IBLUNT==IBLUNT_BPM) then ! We need to read the BL tables - CALL ReadBLTables( InputFileName, AFI, InputFileData, UnEcho, ErrStat2, ErrMsg2 ) + CALL ReadBLTables( InputFileName, AFInfo, InputFileData, UnEcho, ErrStat2, ErrMsg2 ) if (Failed()) return endif @@ -122,7 +122,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, Default_DT, OutFileRoot, U integer(IntKi) :: I ! loop counter integer(IntKi) :: UnIn,UnIn2 ! Unit number for reading file character(1024) :: ObserverFile ! name of the files containing obesever location - integer(IntKi) :: ErrStat2, IOS,cou ! Temporary Error status + integer(IntKi) :: ErrStat2, cou ! Temporary Error status logical :: Echo ! Determines if an echo file should be written character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message character(1024) :: PriPath ! Path name of the primary file @@ -279,10 +279,10 @@ END SUBROUTINE ReadPrimaryFile !---------------------------------------------------------------------------------------------------------------------------------- ! ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadBLTables( InputFile, AFI, InputFileData, UnEc, ErrStat, ErrMsg ) +SUBROUTINE ReadBLTables( InputFile, AFInfo, InputFileData, UnEc, ErrStat, ErrMsg ) ! Passed variables character(*), intent(in) :: InputFile ! Name of the file containing the primary input data - TYPE(AFI_ParameterType), INTENT(IN) :: AFI(:) ! airfoil array: contains names of the BL input file + TYPE(AFI_ParameterType), INTENT(IN) :: AFInfo(:) ! airfoil array: contains names of the BL input file type(AA_InputFile), intent(inout) :: InputFileData ! All the data in the Noise input file integer(IntKi), intent(in) :: UnEc ! I/O unit for echo file. If > 0, file is open for writing. integer(IntKi), intent(out) :: ErrStat ! Error status @@ -306,10 +306,10 @@ SUBROUTINE ReadBLTables( InputFile, AFI, InputFileData, UnEc, ErrStat, ErrMsg ) UnIn = -1 CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - nAirfoils = size(AFI) + nAirfoils = size(AFInfo) do iAF=1,nAirfoils - FileName = trim(AFI(iAF)%BL_file) + FileName = trim(AFInfo(iAF)%BL_file) call WrScr('AeroAcoustics_IO: reading BL table:'//trim(Filename)) @@ -442,48 +442,58 @@ SUBROUTINE ValidateInputData( InputFileData, NumBl, ErrStat, ErrMsg ) character(*), intent(out) :: ErrMsg !< Error message ! local variables character(*), parameter :: RoutineName = 'ValidateInputData' + ErrStat = ErrID_None ErrMsg = "" + if (NumBl > MaxBl .or. NumBl < 1) call SetErrStat( ErrID_Fatal, 'Number of blades must be between 1 and '//trim(num2lstr(MaxBl))//'.', ErrSTat, ErrMsg, RoutineName ) + if (InputFileData%DT_AA <= 0.0) call SetErrStat ( ErrID_Fatal, 'DT_AA must be greater than zero.', ErrStat, ErrMsg, RoutineName ) + if (InputFileData%IBLUNT /= IBLUNT_None .and. InputFileData%IBLUNT /= IBLUNT_BPM) then call SetErrStat ( ErrID_Fatal, & 'IBLUNT must '//trim(num2lstr(IBLUNT_None))//' (none) or '//trim(num2lstr(IBLUNT_BPM))//' (Bluntness noise calculated).', ErrStat, ErrMsg, RoutineName ) endif if (InputFileData%ILAM /= ILAM_None .and. InputFileData%ilam /= ILAM_BPM) then - call SetErrStat ( ErrID_Fatal, 'ILAM must be '//trim(num2lstr(ILAM_None))//' No calculation '//& + call SetErrStat ( ErrID_Fatal, 'ILAM must be '//trim(num2lstr(ILAM_None))//' No calculation '//& trim(num2lstr(ILAM_BPM))//' (ILAM Calculated).', ErrStat, ErrMsg, RoutineName ) end if if (InputFileData%ITIP /= ITIP_None .and. InputFileData%ITIP /= ITIP_ON) then - call SetErrStat ( ErrID_Fatal, 'ITIP must be '//trim(num2lstr(ITIP_None))//' (Off) or '//& + call SetErrStat ( ErrID_Fatal, 'ITIP must be '//trim(num2lstr(ITIP_None))//' (Off) or '//& trim(num2lstr(ITIP_On))//' (ITIP On).', ErrStat, ErrMsg, RoutineName ) end if if (InputFileData%ITRIP /= ITRIP_None .and. InputFileData%ITRIP /= ITRIP_Heavy .and. InputFileData%ITRIP /= ITRIP_Light) then - call SetErrStat ( ErrID_Fatal,'ITRIP must be '//trim(num2lstr(ITRIP_None))//' (none) or '//trim(num2lstr(ITRIP_Heavy))//& + call SetErrStat ( ErrID_Fatal,'ITRIP must be '//trim(num2lstr(ITRIP_None))//' (none) or '//trim(num2lstr(ITRIP_Heavy))//& ' (heavily tripped BL Calculation) or '//trim(num2lstr(ITRIP_Light))//' (lightly tripped BL)' ,ErrStat, ErrMsg, RoutineName ) end if if (InputFileData%ITURB /= ITURB_None .and. InputFileData%ITURB /= ITURB_BPM .and. InputFileData%ITURB /= ITURB_TNO) then - call SetErrStat ( ErrID_Fatal, 'ITURB must be 0 (off) or 1 (BPM) or 2 (TNO) .', ErrStat, ErrMsg, RoutineName ) + call SetErrStat ( ErrID_Fatal, 'ITURB must be 0 (off) or 1 (BPM) or 2 (TNO) .', ErrStat, ErrMsg, RoutineName ) end if if (InputFileData%IInflow /= IInflow_None .and. InputFileData%IInflow /= IInflow_BPM & .and. InputFileData%IInflow /= IInflow_FullGuidati .and. InputFileData%IInflow /= IInflow_SimpleGuidati ) then - call SetErrStat ( ErrID_Fatal, 'IInflow must be 0 (off) or 1 (only Amiet) or 2 (Full Guidati)'//& + call SetErrStat ( ErrID_Fatal, 'IInflow must be 0 (off) or 1 (only Amiet) or 2 (Full Guidati)'//& 'or 3 (Simple Guidati).', ErrStat, ErrMsg, RoutineName ) end if if (InputFileData%TICalcMeth /= TICalc_Every .and. InputFileData%TICalcMeth /= TICalc_Interp ) then - call SetErrStat ( ErrID_Fatal, 'TICalcMeth must be '//trim(num2lstr(TICalc_Every))//' TICalc automatic or '//& + call SetErrStat ( ErrID_Fatal, 'TICalcMeth must be '//trim(num2lstr(TICalc_Every))//' (TICalc automatic) or '//& trim(num2lstr(TICalc_Interp))//' (TICalcMeth interp).', ErrStat, ErrMsg, RoutineName ) end if if (InputFileData%X_BLMethod /= X_BLMethod_BPM .and. InputFileData%X_BLMethod /= X_BLMethod_Tables) then - call SetErrStat ( ErrID_Fatal, 'X_BLMethod must be '//trim(num2lstr(X_BLMethod_BPM))//' X_BLMethod_ with BPM or '//& + call SetErrStat ( ErrID_Fatal, 'X_BLMethod must be '//trim(num2lstr(X_BLMethod_BPM))//' X_BLMethod_ with BPM or '//& trim(num2lstr(X_BLMethod_Tables))//' (X_BLMethod with BL tables).', ErrStat, ErrMsg, RoutineName ) end if + if (InputFileData%NrObsLoc <= 0.0) call SetErrStat ( ErrID_Fatal, 'Number of Observer Locations should be greater than zero', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%NrOutFile /= 1 .and. InputFileData%NrOutFile /= 2 .and. InputFileData%NrOutFile /= 3 & - .and. InputFileData%NrOutFile /= 4) then - call SetErrStat ( ErrID_Fatal, ' NrOutFile must be 1 or 2 or 3 or 4', ErrStat, ErrMsg, RoutineName ) + + if (InputFileData%NrOutFile /= 1 .and. InputFileData%NrOutFile /= 2 .and. InputFileData%NrOutFile /= 3 .and. InputFileData%NrOutFile /= 4) then + call SetErrStat ( ErrID_Fatal, ' NrOutFile must be 1 or 2 or 3 or 4', ErrStat, ErrMsg, RoutineName ) + end if + + if (InputFileData%AA_Bl_Prcntge > 100.0 .or. InputFileData%AA_Bl_Prcntge < 0.0) then + call SetErrStat ( ErrID_Fatal, ' AA_Bl_Prcntge must be between 0 and 100%', ErrStat, ErrMsg, RoutineName ) end if + END SUBROUTINE ValidateInputData !---------------------------------------------------------------------------------------------------------------------------------- @@ -747,9 +757,8 @@ subroutine AA_WriteOutputLine(y, t, p, errStat, errMsg) ENDIF end subroutine AA_WriteOutputLine !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Calc_WriteOutput( p, u, m, y, ErrStat, ErrMsg ) +SUBROUTINE Calc_WriteOutput( p, m, y, ErrStat, ErrMsg ) TYPE(AA_ParameterType), INTENT(IN ) :: p ! The module parameters - TYPE(AA_InputType), INTENT(IN ) :: u ! inputs TYPE(AA_MiscVarType), INTENT(INOUT) :: m ! misc variables TYPE(AA_OutputType), INTENT(INOUT) :: y ! outputs INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code diff --git a/modules/aerodyn/src/AeroAcoustics_Registry.txt b/modules/aerodyn/src/AeroAcoustics_Registry.txt index b2d9e98b5..e858c0e1d 100644 --- a/modules/aerodyn/src/AeroAcoustics_Registry.txt +++ b/modules/aerodyn/src/AeroAcoustics_Registry.txt @@ -29,14 +29,13 @@ typedef AeroAcoustics/AA InitInputType CHARACTER(1024) InputFi typedef ^ InitInputType IntKi NumBlades - - - "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 +typedef ^ InitInputType ReKi BlSpn {:}{:} - - "Span at blade node" m +typedef ^ InitInputType ReKi BlChord {:}{:} - - "Chord at blade node" m typedef ^ InitInputType ReKi AirDens - - - "Air density" kg/m^3 typedef ^ InitInputType ReKi KinVisc - - - "Kinematic air viscosity" m^2/s typedef ^ InitInputType ReKi SpdSound - - - "Speed of sound" m/s -typedef ^ InitInputType ReKi HubHeight - - - "Hub Height" m +typedef ^ InitInputType ReKi HubHeight - - - "Hub Height" m typedef ^ InitInputType IntKi BlAFID {:}{:} - - "Index of airfoil data file for blade node location [array of numBladeNodes by numBlades]" - -typedef ^ InitInputType AFI_ParameterType AFInfo {:} - - "Airfoil information structure containing the aerodynamic center and airfoil shape coordinates" # # Define outputs from the initialization routine here: typedef ^ InitOutputType CHARACTER(20) WriteOutputHdr {:} - - "Names of the output-to-file channels" - @@ -50,54 +49,52 @@ typedef ^ InitOutputType CHARACTER(25) WriteOutputU # # ..... Primary Input file data ................................................................................................... -typedef ^ AA_InputFile DbKi DT_AA - - - "Time interval for aerodynamic calculations {or \"default\"}" s -typedef ^ AA_InputFile IntKi IBLUNT - - - "FLAG TO COMPUTE BLUNTNESS NOISE" - -typedef ^ AA_InputFile IntKi ILAM - - - "FLAG TO COMPUTE LBL NOISE {0=off, 1=BPM calculation}" - -typedef ^ AA_InputFile IntKi ITIP - - - "FLAG TO COMPUTE TIP NOISE {0=off, 1=on}" - -typedef ^ AA_InputFile IntKi ITRIP - - - "FLAG TO TRIP BOUNDARY LAYER {0=none, 1 (heavily tripped BL Calculation), 2 (lightly tripped BL)}" - -typedef ^ AA_InputFile IntKi ITURB - - - "FLAG TO COMPUTE TBLTE NOISE {0=none, 1 (BPM), 2 (TNO)}" - -typedef ^ AA_InputFile IntKi IInflow - - - "FLAG TO COMPUTE Turbulent Inflow NOISE {0=none, 1 (only Amiet), 2 (Full Guidati), 3 (Simplified Guidati)}" - -typedef ^ AA_InputFile IntKi X_BLMethod - - - "Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated" - -typedef ^ AA_InputFile IntKi TICalcMeth - - - "TICalcMeth" - -typedef ^ AA_InputFile IntKi NReListBL - - - "Number of values of ReListBL" - -typedef ^ AA_InputFile Logical aweightflag - - - "Integer a weighting call" - -typedef ^ AA_InputFile Logical ROUND - - - "LOGICAL INDICATING ROUNDED TIP" - -typedef ^ AA_InputFile ReKi ALPRAT - - - "TIP LIFT CURVE SLOPE" - -typedef ^ AA_InputFile IntKi AA_Bl_Prcntge - - - "see the AeroAcoustics input file for description " - -typedef ^ AA_InputFile IntKi NrObsLoc - - - "Number of observer locations " - -typedef ^ AA_InputFile ReKi ObsXYZ {:}{:} - - "Observer location in tower-base coordinate (X-Y-Z)" m -typedef ^ AA_InputFile AA_BladePropsType BladeProps {:} - - "blade property information from blade input files" - -typedef ^ AA_InputFile IntKi NrOutFile - - - "Nr of output files" - -typedef ^ AA_InputFile CHARACTER(1024) AAoutfile {4} - - "AAoutfile for writing output files" - -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 TI - - - "Average rotor incident turbulence intensity" - -typedef ^ AA_InputFile ReKi avgV - - - "Average wind speed" - -typedef ^ AA_InputFile ReKi Lturb - - - "Turbulent lengthscale in Amiet model" - -typedef ^ AA_InputFile ReKi ReListBL {:} - - "" - -typedef ^ AA_InputFile ReKi AoAListBL {:} - - "" deg -typedef ^ AA_InputFile ReKi Pres_DispThick {:}{:}{:} - - "" -typedef ^ AA_InputFile ReKi Suct_DispThick {:}{:}{:} - - "" -typedef ^ AA_InputFile ReKi Pres_BLThick {:}{:}{:} - - "" -typedef ^ AA_InputFile ReKi Suct_BLThick {:}{:}{:} - - "" -typedef ^ AA_InputFile ReKi Pres_Cf {:}{:}{:} - - "" -typedef ^ AA_InputFile ReKi Suct_Cf {:}{:}{:} - - "" -typedef ^ AA_InputFile ReKi Pres_EdgeVelRat {:}{:}{:} - - "" -typedef ^ AA_InputFile ReKi Suct_EdgeVelRat {:}{:}{:} - - "" +typedef ^ AA_InputFile DbKi DT_AA - - - "Time interval for aerodynamic calculations {or \"default\"}" s +typedef ^ AA_InputFile IntKi IBLUNT - - - "FLAG TO COMPUTE BLUNTNESS NOISE" - +typedef ^ AA_InputFile IntKi ILAM - - - "FLAG TO COMPUTE LBL NOISE {0=off, 1=BPM calculation}" - +typedef ^ AA_InputFile IntKi ITIP - - - "FLAG TO COMPUTE TIP NOISE {0=off, 1=on}" - +typedef ^ AA_InputFile IntKi ITRIP - - - "FLAG TO TRIP BOUNDARY LAYER {0=none, 1 (heavily tripped BL Calculation), 2 (lightly tripped BL)}" - +typedef ^ AA_InputFile IntKi ITURB - - - "FLAG TO COMPUTE TBLTE NOISE {0=none, 1 (BPM), 2 (TNO)}" - +typedef ^ AA_InputFile IntKi IInflow - - - "FLAG TO COMPUTE Turbulent Inflow NOISE {0=none, 1 (only Amiet), 2 (Full Guidati), 3 (Simplified Guidati)}" - +typedef ^ AA_InputFile IntKi X_BLMethod - - - "Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Pretabulated" - +typedef ^ AA_InputFile IntKi TICalcMeth - - - "TICalcMeth" - +typedef ^ AA_InputFile IntKi NReListBL - - - "Number of values of ReListBL" - +typedef ^ AA_InputFile Logical aweightflag - - - "Integer a weighting call" - +typedef ^ AA_InputFile Logical ROUND - - - "LOGICAL INDICATING ROUNDED TIP" - +typedef ^ AA_InputFile ReKi ALPRAT - - - "TIP LIFT CURVE SLOPE" - +typedef ^ AA_InputFile IntKi AA_Bl_Prcntge - - - "see the AeroAcoustics input file for description " - +typedef ^ AA_InputFile IntKi NrObsLoc - - - "Number of observer locations " - +typedef ^ AA_InputFile ReKi ObsXYZ {:}{:} - - "Observer location in tower-base coordinate (X-Y-Z)" m +typedef ^ AA_InputFile AA_BladePropsType BladeProps {:} - - "blade property information from blade input files" - +typedef ^ AA_InputFile IntKi NrOutFile - - - "Nr of output files" - +typedef ^ AA_InputFile CHARACTER(1024) AAoutfile {4} - - "AAoutfile for writing output files" - +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 TI - - - "Average rotor incident turbulence intensity" - +typedef ^ AA_InputFile ReKi avgV - - - "Average wind speed" - +typedef ^ AA_InputFile ReKi Lturb - - - "Turbulent lengthscale in Amiet model" - +typedef ^ AA_InputFile ReKi ReListBL {:} - - "" - +typedef ^ AA_InputFile ReKi AoAListBL {:} - - "" deg +typedef ^ AA_InputFile ReKi Pres_DispThick {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Suct_DispThick {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Pres_BLThick {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Suct_BLThick {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Pres_Cf {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Suct_Cf {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Pres_EdgeVelRat {:}{:}{:} - - "" +typedef ^ AA_InputFile ReKi Suct_EdgeVelRat {:}{:}{:} - - "" # ..... States .................................................................................................................... # Define continuous (differentiable) states here: # -typedef ^ ContinuousStateType SiKi DummyContState - - - "Remove this variable if you have continuous states" - +#typedef ^ ContinuousStateType SiKi DummyContState - - - "Remove this variable if you have continuous states" - # # Define discrete (nondifferentiable) states here: -typedef ^ DiscreteStateType ReKi TIVx {:}{:} - - "Vx St. deviat" - -typedef ^ DiscreteStateType ReKi MeanVxVyVz {:}{:} - - "Vrel Cumu. Mean" - -typedef ^ DiscreteStateType ReKi RegVxStor {:}{:}{:} - - "VxVyVz Store for fft or TI - dissipation" - -typedef ^ DiscreteStateType ReKi RegionTIDelete {:}{:} - - "" - +typedef ^ DiscreteStateType ReKi TIVx {:}{:} - - "Vx St. deviat" - +typedef ^ DiscreteStateType ReKi RegVxStor {:}{:}{:} - - "VxVyVz Store for fft or TI - dissipation" - # # Define constraint states here: -typedef ^ ConstraintStateType SiKi DummyConstrState - - - "Remove this variable if you have states" - +#typedef ^ ConstraintStateType SiKi DummyConstrState - - - "Remove this variable if you have states" - # # Define "other" states here: typedef ^ OtherStateType IntKi allregcounter {:}{:} - - "" - @@ -111,7 +108,7 @@ typedef ^ MiscVarType ReKi ChordAn typedef ^ MiscVarType ReKi SpanAngleLE {:}{:}{:} - - "C" - typedef ^ MiscVarType ReKi rTEtoObserve {:}{:}{:} - - "C" - typedef ^ MiscVarType ReKi rLEtoObserve {:}{:}{:} - - "C" - -typedef ^ MiscVarType ReKi LE_Location {:}{:}{:} - - "Height of Leading Edge for calculation of TI and Scales if needed" - +typedef ^ MiscVarType ReKi LE_Location {:}{:}{:} - - "Height of Leading Edge for calculation of TI and Scales if needed" - typedef ^ MiscVarType ReKi RotSpeedAoA - - - "C" - typedef ^ MiscVarType ReKi SPLLBL {:} - - "C" - typedef ^ MiscVarType ReKi SPLP {:} - - "C" - @@ -121,16 +118,16 @@ typedef ^ MiscVarType ReKi SPLTIP typedef ^ MiscVarType ReKi SPLTI {:} - - "C" - typedef ^ MiscVarType ReKi SPLTIGui {:} - - "C" - typedef ^ MiscVarType ReKi SPLBLUNT {:} - - "C" - -typedef ^ MiscVarType ReKi CfVar {:} - - "Output Skin friction coef Pressure Side" - -typedef ^ MiscVarType ReKi d99Var {:} - - "BL Output " - -typedef ^ MiscVarType ReKi dStarVar {:} - - "BL Output " - -typedef ^ MiscVarType ReKi EdgeVelVar {:} - - "BL Output " - -typedef ^ MiscVarType IntKi LastIndex {2} - - "index for BL param interpolation" - +typedef ^ MiscVarType ReKi CfVar {2} - - "Output Skin friction coef Pressure Side" - +typedef ^ MiscVarType ReKi d99Var {2} - - "BL Output " - +typedef ^ MiscVarType ReKi dStarVar {2} - - "BL Output " - +typedef ^ MiscVarType ReKi EdgeVelVar {2} - - "BL Output " - +typedef ^ MiscVarType IntKi LastIndex {2} - - "index for BL param interpolation" - # arrays for calculating WriteOutput values -typedef ^ MiscVarType ReKi SumSpecNoiseSep {:}{:}{:} - - "Spectra of summed noise level of all blades and blade nodes for each receiver and frequency" SPL -typedef ^ MiscVarType ReKi OASPL {:}{:}{:} - - "summed noise level for each blade and blade nodes and receiver " SPL -typedef ^ MiscVarType ReKi DirectiviOutput {:} - - " " SPL -typedef ^ MiscVarType ReKi PtotalFreq {:}{:} - - "SPL for each observer and frequency" +typedef ^ MiscVarType ReKi SumSpecNoiseSep {:}{:}{:} - - "Spectra of summed noise level of all blades and blade nodes for each receiver and frequency" SPL +typedef ^ MiscVarType ReKi OASPL {:}{:}{:} - - "summed noise level for each blade and blade nodes and receiver " SPL +typedef ^ MiscVarType ReKi DirectiviOutput {:} - - " " SPL +typedef ^ MiscVarType ReKi PtotalFreq {:}{:} - - "SPL for each observer and frequency" # ..... Parameters ................................................................................................................ @@ -152,69 +149,65 @@ typedef ^ ParameterType IntKi NumBlNd typedef ^ ParameterType ReKi AirDens - - - "Air density" kg/m^3 typedef ^ ParameterType ReKi KinVisc - - - "Kinematic air viscosity" m^2/s typedef ^ ParameterType ReKi SpdSound - - - "Speed of sound" m/s -typedef ^ ParameterType ReKi HubHeight - - - "Hub height" m -typedef ^ ParameterType ReKi toptip - - - "Top Tip Height = Hub height plus radius" m -typedef ^ ParameterType ReKi bottip - - - "Bottom Tip Height = Hub height minus radius" m -typedef ^ ParameterType ReKi rotorregionlimitsVert {:} - - "" -typedef ^ ParameterType ReKi rotorregionlimitsHorz {:} - - "" -typedef ^ ParameterType ReKi rotorregionlimitsalph {:} - - "" -typedef ^ ParameterType ReKi rotorregionlimitsrad {:} - - "" +typedef ^ ParameterType ReKi HubHeight - - - "Hub height" m +typedef ^ ParameterType IntKi RotorRegion_k_minus1 {:}{:} - - "index array for RotorRegion blade span location" - +typedef ^ ParameterType IntKi NumRotorRegionLimitsAlph - - - "size of RotorRegionLimitsAlph array" - +typedef ^ ParameterType IntKi NumRotorRegionLimitsRad - - - "size of RotorRegionLimitsRad array" - typedef ^ ParameterType IntKi NrObsLoc - - - "Number of observer locations " - typedef ^ ParameterType Logical aweightflag - - - " " - typedef ^ ParameterType Logical TxtFileOutput - - - " " - -typedef ^ ParameterType DBKi AAStart - - - "Time after which to calculate AA" s +typedef ^ ParameterType DBKi AAStart - - - "Time after which to calculate AA" s typedef ^ ParameterType ReKi ObsXYZ {:}{:} - - "Observer location in tower-base coordinate (X-Y-Z)" m typedef ^ ParameterType ReKi FreqList {:} - - "List of Acoustic Frequencies to Calculate" Hz -typedef ^ ParameterType ReKi Aweight {:} - - "List of Acoustic Frequencies a weighting" dB -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 ReKi Aweight {:} - - "List of Acoustic Frequencies a weighting" dB +typedef ^ ParameterType IntKi Num_total_sampleTI - - - "Total FFT Sample amount for dissipation calculation" - typedef ^ ParameterType IntKi startnode - - - "Corersponding node to the noise calculation percentage of the blade" - -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 TI - - - "Rotor incident turbulent intensity" -typedef ^ ParameterType CHARACTER(1024) FTitle - - - "File Title: the 2nd line of the input file, which contains a description of its contents" - +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 TI - - - "Rotor incident turbulent intensity" +typedef ^ ParameterType CHARACTER(1024) FTitle - - - "File Title: the 2nd line of the input file, which contains a description of its contents" - # parameters for output -typedef ^ ParameterType character(20) outFmt - - - "Format specifier" "-" -typedef ^ ParameterType IntKi NrOutFile - - - "Nr of output files" - -typedef ^ ParameterType IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ ParameterType IntKi NumOutsAll {4} - - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ ParameterType IntKi unOutFile {4} - - "unit number for writing output file" "-" -typedef ^ ParameterType CHARACTER(1024) RootName - - - "RootName for writing output files" - -typedef ^ ParameterType ReKi StallStart {:}{:} - - "ation" - -typedef ^ ParameterType ReKi TEThick {:}{:} - - "ation" - -typedef ^ ParameterType ReKi TEAngle {:}{:} - - "ation" - -typedef ^ ParameterType ReKi AerCent {:}{:}{:} - - "ation" - -typedef ^ ParameterType IntKi BlAFID {:}{:} - - "Index of airfoil data file for blade node location [array of numBladeNodes by numBlades]" - -typedef ^ ParameterType AFI_ParameterType AFInfo {:} - - "Airfoil information structure containing the aerodynamic center and airfoil shape coordinates" -typedef ^ ParameterType ReKi AFLECo {:}{:}{:} - - "Dimensionalized " -typedef ^ ParameterType ReKi AFTECo {:}{:}{:} - - -typedef ^ ParameterType ReKi BlSpn {:}{:} - - "Span at blade node" m -typedef ^ ParameterType ReKi BlChord {:}{:} - - "Chord at blade node" m -typedef ^ ParameterType ReKi ReListBL {:} - - "BL list of Reynolds" - -typedef ^ ParameterType ReKi AOAListBL {:} - - "BL list of Angle Of Attack " deg -typedef ^ ParameterType ReKi dStarAll1 {:}{:}{:} - - "Output Disp Thickness Suction Side" m -typedef ^ ParameterType ReKi dStarAll2 {:}{:}{:} - - "Output Disp Thickness Pressure Side" m -typedef ^ ParameterType ReKi d99All1 {:}{:}{:} - - "Output B.L. Thickness Suction Side" m -typedef ^ ParameterType ReKi d99All2 {:}{:}{:} - - "Output B.L. Thickness Pressure Side" m -typedef ^ ParameterType ReKi CfAll1 {:}{:}{:} - - "Output Skin friction coef Suction Side" - -typedef ^ ParameterType ReKi CfAll2 {:}{:}{:} - - "Output Skin friction coef Pressure Side" - -typedef ^ ParameterType ReKi EdgeVelRat1 {:}{:}{:} - - "Output Edge Velocity Ratio Suction" - -typedef ^ ParameterType ReKi EdgeVelRat2 {:}{:}{:} - - "Output Edge Velocity Ratio Pressure Side" - -typedef ^ ParameterType ReKi AFThickGuida {:}{:} - - "1 and 10 percent thickness t/c used for Simplified Guidati" +typedef ^ ParameterType character(20) outFmt - - - "Format specifier" "-" +typedef ^ ParameterType IntKi NrOutFile - - - "Nr of output files" - +typedef ^ ParameterType IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - +typedef ^ ParameterType IntKi NumOutsAll {4} - - "Number of parameters in the output list (number of outputs requested)" - +typedef ^ ParameterType IntKi unOutFile {4} - - "unit number for writing output file" "-" +typedef ^ ParameterType CHARACTER(1024) RootName - - - "RootName for writing output files" - +typedef ^ ParameterType ReKi StallStart {:}{:} - - "ation" - +typedef ^ ParameterType ReKi TEThick {:}{:} - - "ation" - +typedef ^ ParameterType ReKi TEAngle {:}{:} - - "ation" - +typedef ^ ParameterType ReKi AerCent {:}{:}{:} - - "ation" - +typedef ^ ParameterType IntKi BlAFID {:}{:} - - "Index of airfoil data file for blade node location [array of numBladeNodes by numBlades]" - +typedef ^ ParameterType ReKi AFLECo {:}{:}{:} - - "Dimensionalized " +typedef ^ ParameterType ReKi AFTECo {:}{:}{:} - - +typedef ^ ParameterType ReKi BlSpn {:}{:} - - "Span at blade node" m +typedef ^ ParameterType ReKi BlElemSpn {:}{:} - - "Element span at blade node" m +typedef ^ ParameterType ReKi BlChord {:}{:} - - "Chord at blade node" m +typedef ^ ParameterType ReKi ReListBL {:} - - "BL list of Reynolds" - +typedef ^ ParameterType ReKi AOAListBL {:} - - "BL list of Angle Of Attack " deg +typedef ^ ParameterType ReKi dStarAll1 {:}{:}{:} - - "Output Disp Thickness Suction Side" m +typedef ^ ParameterType ReKi dStarAll2 {:}{:}{:} - - "Output Disp Thickness Pressure Side" m +typedef ^ ParameterType ReKi d99All1 {:}{:}{:} - - "Output B.L. Thickness Suction Side" m +typedef ^ ParameterType ReKi d99All2 {:}{:}{:} - - "Output B.L. Thickness Pressure Side" m +typedef ^ ParameterType ReKi CfAll1 {:}{:}{:} - - "Output Skin friction coef Suction Side" - +typedef ^ ParameterType ReKi CfAll2 {:}{:}{:} - - "Output Skin friction coef Pressure Side" - +typedef ^ ParameterType ReKi EdgeVelRat1 {:}{:}{:} - - "Output Edge Velocity Ratio Suction" - +typedef ^ ParameterType ReKi EdgeVelRat2 {:}{:}{:} - - "Output Edge Velocity Ratio Pressure Side" - +typedef ^ ParameterType ReKi AFThickGuida {:}{:} - - "1 and 10 percent thickness t/c used for Simplified Guidati" # ..... Inputs .................................................................................................................... # Define inputs that are contained on the mesh here: -typedef ^ InputType ReKi RotGtoL {:}{:}{:}{:} - - "3x3 rotation matrix transform a vector from the local airfoil coordinate system to the global inertial coordinate system" - -typedef ^ InputType ReKi AeroCent_G {:}{:}{:} - - "location in global coordinates of the blade element aerodynamic center. 1st index = vector components, 2nd index = blade node, 3rd index = blade" - -typedef ^ InputType ReKi Vrel {:}{:} - - "Vrel" - -typedef ^ InputType ReKi AoANoise {:}{:} - - "Angle of attack" rad -typedef ^ InputType ReKi Inflow {:}{:}{:} - - "atmospheric undisturbed flow on blade" +typedef ^ InputType ReKi RotGtoL {:}{:}{:}{:} - - "3x3 rotation matrix transform a vector from the local airfoil coordinate system to the global inertial coordinate system" - +typedef ^ InputType ReKi AeroCent_G {:}{:}{:} - - "location in global coordinates of the blade element aerodynamic center. 1st index = vector components, 2nd index = blade node, 3rd index = blade" - +typedef ^ InputType ReKi Vrel {:}{:} - - "Vrel" - +typedef ^ InputType ReKi AoANoise {:}{:} - - "Angle of attack" rad +typedef ^ InputType ReKi Inflow {:}{:}{:} - - "atmospheric undisturbed flow on blade" # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: # Define outputs that are not on this mesh here: -typedef ^ OutputType ReKi WriteOutputForPE {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" -typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" -typedef ^ OutputType ReKi WriteOutputSep {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" -typedef ^ OutputType ReKi WriteOutputNodes {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" +typedef ^ OutputType ReKi WriteOutputForPE {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" +typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" +typedef ^ OutputType ReKi WriteOutputSep {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" +typedef ^ OutputType ReKi WriteOutputNodes {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" diff --git a/modules/aerodyn/src/AeroAcoustics_TNO.f90 b/modules/aerodyn/src/AeroAcoustics_TNO.f90 index 7cf5941b0..00053096f 100644 --- a/modules/aerodyn/src/AeroAcoustics_TNO.f90 +++ b/modules/aerodyn/src/AeroAcoustics_TNO.f90 @@ -72,6 +72,7 @@ function SPL_integrate(Omega,limits,ISSUCTION, & co = real(SpdSound, TNOKi) rho = real(AirDens, TNOKi) nu = real(KinVisc, TNOKi) + ! Blade node values Cf = real(Cfall, TNOKi) d99 = real(d99all, TNOKi) diff --git a/modules/aerodyn/src/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics_Types.f90 index 2d38eebef..c7bec5de2 100644 --- a/modules/aerodyn/src/AeroAcoustics_Types.f90 +++ b/modules/aerodyn/src/AeroAcoustics_Types.f90 @@ -53,7 +53,6 @@ MODULE AeroAcoustics_Types REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound [m/s] REAL(ReKi) :: HubHeight = 0.0_ReKi !< Hub Height [m] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: BlAFID !< Index of airfoil data file for blade node location [array of numBladeNodes by numBlades] [-] - TYPE(AFI_ParameterType) , DIMENSION(:), ALLOCATABLE :: AFInfo !< Airfoil information structure containing the aerodynamic center and airfoil shape coordinates [-] END TYPE AA_InitInputType ! ======================= ! ========= AA_InitOutputType ======= @@ -106,24 +105,12 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Suct_EdgeVelRat !< [-] END TYPE AA_InputFile ! ======================= -! ========= AA_ContinuousStateType ======= - TYPE, PUBLIC :: AA_ContinuousStateType - REAL(SiKi) :: DummyContState = 0.0_R4Ki !< Remove this variable if you have continuous states [-] - END TYPE AA_ContinuousStateType -! ======================= ! ========= AA_DiscreteStateType ======= TYPE, PUBLIC :: AA_DiscreteStateType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TIVx !< Vx St. deviat [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MeanVxVyVz !< Vrel Cumu. Mean [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: RegVxStor !< VxVyVz Store for fft or TI - dissipation [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: RegionTIDelete !< [-] END TYPE AA_DiscreteStateType ! ======================= -! ========= AA_ConstraintStateType ======= - TYPE, PUBLIC :: AA_ConstraintStateType - REAL(SiKi) :: DummyConstrState = 0.0_R4Ki !< Remove this variable if you have states [-] - END TYPE AA_ConstraintStateType -! ======================= ! ========= AA_OtherStateType ======= TYPE, PUBLIC :: AA_OtherStateType INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: allregcounter !< [-] @@ -148,10 +135,10 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLTI !< C [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLTIGui !< C [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLBLUNT !< C [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: CfVar !< Output Skin friction coef Pressure Side [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: d99Var !< BL Output [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dStarVar !< BL Output [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: EdgeVelVar !< BL Output [-] + REAL(ReKi) , DIMENSION(1:2) :: CfVar = 0.0_ReKi !< Output Skin friction coef Pressure Side [-] + REAL(ReKi) , DIMENSION(1:2) :: d99Var = 0.0_ReKi !< BL Output [-] + REAL(ReKi) , DIMENSION(1:2) :: dStarVar = 0.0_ReKi !< BL Output [-] + REAL(ReKi) , DIMENSION(1:2) :: EdgeVelVar = 0.0_ReKi !< BL Output [-] INTEGER(IntKi) , DIMENSION(1:2) :: LastIndex = 0_IntKi !< index for BL param interpolation [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SumSpecNoiseSep !< Spectra of summed noise level of all blades and blade nodes for each receiver and frequency [SPL] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: OASPL !< summed noise level for each blade and blade nodes and receiver [SPL] @@ -178,12 +165,9 @@ MODULE AeroAcoustics_Types REAL(ReKi) :: KinVisc = 0.0_ReKi !< Kinematic air viscosity [m^2/s] REAL(ReKi) :: SpdSound = 0.0_ReKi !< Speed of sound [m/s] REAL(ReKi) :: HubHeight = 0.0_ReKi !< Hub height [m] - REAL(ReKi) :: toptip = 0.0_ReKi !< Top Tip Height = Hub height plus radius [m] - REAL(ReKi) :: bottip = 0.0_ReKi !< Bottom Tip Height = Hub height minus radius [m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsVert !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsHorz !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsalph !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rotorregionlimitsrad !< [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: RotorRegion_k_minus1 !< index array for RotorRegion blade span location [-] + INTEGER(IntKi) :: NumRotorRegionLimitsAlph = 0_IntKi !< size of RotorRegionLimitsAlph array [-] + INTEGER(IntKi) :: NumRotorRegionLimitsRad = 0_IntKi !< size of RotorRegionLimitsRad array [-] INTEGER(IntKi) :: NrObsLoc = 0_IntKi !< Number of observer locations [-] LOGICAL :: aweightflag = .false. !< [-] LOGICAL :: TxtFileOutput = .false. !< [-] @@ -191,8 +175,7 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: ObsXYZ !< Observer location in tower-base coordinate (X-Y-Z) [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FreqList !< List of Acoustic Frequencies to Calculate [Hz] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Aweight !< List of Acoustic Frequencies a weighting [dB] - INTEGER(IntKi) :: total_sampleTI = 0_IntKi !< Total FFT Sample amount for dissipation calculation [-] - INTEGER(IntKi) :: AA_Bl_Prcntge = 0_IntKi !< The Percentage of the Blade which the noise is calculated [%] + INTEGER(IntKi) :: Num_total_sampleTI = 0_IntKi !< Total FFT Sample amount for dissipation calculation [-] INTEGER(IntKi) :: startnode = 0_IntKi !< Corersponding node to the noise calculation percentage of the blade [-] REAL(ReKi) :: Lturb = 0.0_ReKi !< Turbulent lengthscale in Amiet model [m] REAL(ReKi) :: avgV = 0.0_ReKi !< Average wind speed to compute incident turbulence intensity [m] @@ -209,10 +192,10 @@ MODULE AeroAcoustics_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TEAngle !< ation [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AerCent !< ation [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: BlAFID !< Index of airfoil data file for blade node location [array of numBladeNodes by numBlades] [-] - TYPE(AFI_ParameterType) , DIMENSION(:), ALLOCATABLE :: AFInfo !< Airfoil information structure containing the aerodynamic center and airfoil shape coordinates [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AFLECo !< Dimensionalized [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AFTECo REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlSpn !< Span at blade node [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlElemSpn !< Element span at blade node [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlChord !< Chord at blade node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ReListBL !< BL list of Reynolds [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AOAListBL !< BL list of Angle Of Attack [deg] @@ -293,10 +276,8 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_CopyInitInput' ErrStat = ErrID_None ErrMsg = '' @@ -344,32 +325,12 @@ subroutine AA_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrSta end if DstInitInputData%BlAFID = SrcInitInputData%BlAFID end if - if (allocated(SrcInitInputData%AFInfo)) then - LB(1:1) = lbound(SrcInitInputData%AFInfo) - UB(1:1) = ubound(SrcInitInputData%AFInfo) - if (.not. allocated(DstInitInputData%AFInfo)) then - allocate(DstInitInputData%AFInfo(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AFInfo.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call AFI_CopyParam(SrcInitInputData%AFInfo(i1), DstInitInputData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if end subroutine subroutine AA_DestroyInitInput(InitInputData, ErrStat, ErrMsg) type(AA_InitInputType), intent(inout) :: InitInputData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_DestroyInitInput' ErrStat = ErrID_None ErrMsg = '' @@ -382,23 +343,12 @@ subroutine AA_DestroyInitInput(InitInputData, ErrStat, ErrMsg) if (allocated(InitInputData%BlAFID)) then deallocate(InitInputData%BlAFID) end if - if (allocated(InitInputData%AFInfo)) then - LB(1:1) = lbound(InitInputData%AFInfo) - UB(1:1) = ubound(InitInputData%AFInfo) - do i1 = LB(1), UB(1) - call AFI_DestroyParam(InitInputData%AFInfo(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(InitInputData%AFInfo) - end if end subroutine subroutine AA_PackInitInput(RF, Indata) type(RegFile), intent(inout) :: RF type(AA_InitInputType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackInitInput' - integer(B4Ki) :: i1, i2 - integer(B4Ki) :: LB(2), UB(2) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%InputFile) call RegPack(RF, InData%NumBlades) @@ -411,15 +361,6 @@ subroutine AA_PackInitInput(RF, Indata) call RegPack(RF, InData%SpdSound) call RegPack(RF, InData%HubHeight) call RegPackAlloc(RF, InData%BlAFID) - call RegPack(RF, allocated(InData%AFInfo)) - if (allocated(InData%AFInfo)) then - call RegPackBounds(RF, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) - LB(1:1) = lbound(InData%AFInfo) - UB(1:1) = ubound(InData%AFInfo) - do i1 = LB(1), UB(1) - call AFI_PackParam(RF, InData%AFInfo(i1)) - end do - end if if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -427,7 +368,6 @@ subroutine AA_UnPackInitInput(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_InitInputType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackInitInput' - integer(B4Ki) :: i1, i2 integer(B4Ki) :: LB(2), UB(2) integer(IntKi) :: stat logical :: IsAllocAssoc @@ -443,19 +383,6 @@ subroutine AA_UnPackInitInput(RF, OutData) call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%HubHeight); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%BlAFID); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%AFInfo)) deallocate(OutData%AFInfo) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%AFInfo(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call AFI_UnpackParam(RF, OutData%AFInfo(i1)) ! AFInfo - end do - end if end subroutine subroutine AA_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -983,44 +910,6 @@ subroutine AA_UnPackInputFile(RF, OutData) call RegUnpackAlloc(RF, OutData%Suct_EdgeVelRat); if (RegCheckErr(RF, RoutineName)) return end subroutine -subroutine AA_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) - type(AA_ContinuousStateType), intent(in) :: SrcContStateData - type(AA_ContinuousStateType), intent(inout) :: DstContStateData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'AA_CopyContState' - ErrStat = ErrID_None - ErrMsg = '' - DstContStateData%DummyContState = SrcContStateData%DummyContState -end subroutine - -subroutine AA_DestroyContState(ContStateData, ErrStat, ErrMsg) - type(AA_ContinuousStateType), intent(inout) :: ContStateData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'AA_DestroyContState' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine AA_PackContState(RF, Indata) - type(RegFile), intent(inout) :: RF - type(AA_ContinuousStateType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AA_PackContState' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%DummyContState) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AA_UnPackContState(RF, OutData) - type(RegFile), intent(inout) :: RF - type(AA_ContinuousStateType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AA_UnPackContState' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%DummyContState); if (RegCheckErr(RF, RoutineName)) return -end subroutine - subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg) type(AA_DiscreteStateType), intent(in) :: SrcDiscStateData type(AA_DiscreteStateType), intent(inout) :: DstDiscStateData @@ -1044,18 +933,6 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if DstDiscStateData%TIVx = SrcDiscStateData%TIVx end if - if (allocated(SrcDiscStateData%MeanVxVyVz)) then - LB(1:2) = lbound(SrcDiscStateData%MeanVxVyVz) - UB(1:2) = ubound(SrcDiscStateData%MeanVxVyVz) - if (.not. allocated(DstDiscStateData%MeanVxVyVz)) then - allocate(DstDiscStateData%MeanVxVyVz(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%MeanVxVyVz.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstDiscStateData%MeanVxVyVz = SrcDiscStateData%MeanVxVyVz - end if if (allocated(SrcDiscStateData%RegVxStor)) then LB(1:3) = lbound(SrcDiscStateData%RegVxStor) UB(1:3) = ubound(SrcDiscStateData%RegVxStor) @@ -1068,18 +945,6 @@ subroutine AA_CopyDiscState(SrcDiscStateData, DstDiscStateData, CtrlCode, ErrSta end if DstDiscStateData%RegVxStor = SrcDiscStateData%RegVxStor end if - if (allocated(SrcDiscStateData%RegionTIDelete)) then - LB(1:2) = lbound(SrcDiscStateData%RegionTIDelete) - UB(1:2) = ubound(SrcDiscStateData%RegionTIDelete) - if (.not. allocated(DstDiscStateData%RegionTIDelete)) then - allocate(DstDiscStateData%RegionTIDelete(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%RegionTIDelete.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstDiscStateData%RegionTIDelete = SrcDiscStateData%RegionTIDelete - end if end subroutine subroutine AA_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) @@ -1092,15 +957,9 @@ subroutine AA_DestroyDiscState(DiscStateData, ErrStat, ErrMsg) if (allocated(DiscStateData%TIVx)) then deallocate(DiscStateData%TIVx) end if - if (allocated(DiscStateData%MeanVxVyVz)) then - deallocate(DiscStateData%MeanVxVyVz) - end if if (allocated(DiscStateData%RegVxStor)) then deallocate(DiscStateData%RegVxStor) end if - if (allocated(DiscStateData%RegionTIDelete)) then - deallocate(DiscStateData%RegionTIDelete) - end if end subroutine subroutine AA_PackDiscState(RF, Indata) @@ -1109,9 +968,7 @@ subroutine AA_PackDiscState(RF, Indata) character(*), parameter :: RoutineName = 'AA_PackDiscState' if (RF%ErrStat >= AbortErrLev) return call RegPackAlloc(RF, InData%TIVx) - call RegPackAlloc(RF, InData%MeanVxVyVz) call RegPackAlloc(RF, InData%RegVxStor) - call RegPackAlloc(RF, InData%RegionTIDelete) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -1124,47 +981,7 @@ subroutine AA_UnPackDiscState(RF, OutData) logical :: IsAllocAssoc if (RF%ErrStat /= ErrID_None) return call RegUnpackAlloc(RF, OutData%TIVx); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%MeanVxVyVz); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%RegVxStor); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%RegionTIDelete); if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AA_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg) - type(AA_ConstraintStateType), intent(in) :: SrcConstrStateData - type(AA_ConstraintStateType), intent(inout) :: DstConstrStateData - integer(IntKi), intent(in ) :: CtrlCode - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'AA_CopyConstrState' - ErrStat = ErrID_None - ErrMsg = '' - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState -end subroutine - -subroutine AA_DestroyConstrState(ConstrStateData, ErrStat, ErrMsg) - type(AA_ConstraintStateType), intent(inout) :: ConstrStateData - integer(IntKi), intent( out) :: ErrStat - character(*), intent( out) :: ErrMsg - character(*), parameter :: RoutineName = 'AA_DestroyConstrState' - ErrStat = ErrID_None - ErrMsg = '' -end subroutine - -subroutine AA_PackConstrState(RF, Indata) - type(RegFile), intent(inout) :: RF - type(AA_ConstraintStateType), intent(in) :: InData - character(*), parameter :: RoutineName = 'AA_PackConstrState' - if (RF%ErrStat >= AbortErrLev) return - call RegPack(RF, InData%DummyConstrState) - if (RegCheckErr(RF, RoutineName)) return -end subroutine - -subroutine AA_UnPackConstrState(RF, OutData) - type(RegFile), intent(inout) :: RF - type(AA_ConstraintStateType), intent(inout) :: OutData - character(*), parameter :: RoutineName = 'AA_UnPackConstrState' - if (RF%ErrStat /= ErrID_None) return - call RegUnpack(RF, OutData%DummyConstrState); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine AA_CopyOtherState(SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg) @@ -1428,54 +1245,10 @@ subroutine AA_CopyMisc(SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg) end if DstMiscData%SPLBLUNT = SrcMiscData%SPLBLUNT end if - if (allocated(SrcMiscData%CfVar)) then - LB(1:1) = lbound(SrcMiscData%CfVar) - UB(1:1) = ubound(SrcMiscData%CfVar) - if (.not. allocated(DstMiscData%CfVar)) then - allocate(DstMiscData%CfVar(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%CfVar.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%CfVar = SrcMiscData%CfVar - end if - if (allocated(SrcMiscData%d99Var)) then - LB(1:1) = lbound(SrcMiscData%d99Var) - UB(1:1) = ubound(SrcMiscData%d99Var) - if (.not. allocated(DstMiscData%d99Var)) then - allocate(DstMiscData%d99Var(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%d99Var.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%d99Var = SrcMiscData%d99Var - end if - if (allocated(SrcMiscData%dStarVar)) then - LB(1:1) = lbound(SrcMiscData%dStarVar) - UB(1:1) = ubound(SrcMiscData%dStarVar) - if (.not. allocated(DstMiscData%dStarVar)) then - allocate(DstMiscData%dStarVar(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%dStarVar.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%dStarVar = SrcMiscData%dStarVar - end if - if (allocated(SrcMiscData%EdgeVelVar)) then - LB(1:1) = lbound(SrcMiscData%EdgeVelVar) - UB(1:1) = ubound(SrcMiscData%EdgeVelVar) - if (.not. allocated(DstMiscData%EdgeVelVar)) then - allocate(DstMiscData%EdgeVelVar(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%EdgeVelVar.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstMiscData%EdgeVelVar = SrcMiscData%EdgeVelVar - end if + DstMiscData%CfVar = SrcMiscData%CfVar + DstMiscData%d99Var = SrcMiscData%d99Var + DstMiscData%dStarVar = SrcMiscData%dStarVar + DstMiscData%EdgeVelVar = SrcMiscData%EdgeVelVar DstMiscData%LastIndex = SrcMiscData%LastIndex if (allocated(SrcMiscData%SumSpecNoiseSep)) then LB(1:3) = lbound(SrcMiscData%SumSpecNoiseSep) @@ -1582,18 +1355,6 @@ subroutine AA_DestroyMisc(MiscData, ErrStat, ErrMsg) if (allocated(MiscData%SPLBLUNT)) then deallocate(MiscData%SPLBLUNT) end if - if (allocated(MiscData%CfVar)) then - deallocate(MiscData%CfVar) - end if - if (allocated(MiscData%d99Var)) then - deallocate(MiscData%d99Var) - end if - if (allocated(MiscData%dStarVar)) then - deallocate(MiscData%dStarVar) - end if - if (allocated(MiscData%EdgeVelVar)) then - deallocate(MiscData%EdgeVelVar) - end if if (allocated(MiscData%SumSpecNoiseSep)) then deallocate(MiscData%SumSpecNoiseSep) end if @@ -1630,10 +1391,10 @@ subroutine AA_PackMisc(RF, Indata) call RegPackAlloc(RF, InData%SPLTI) call RegPackAlloc(RF, InData%SPLTIGui) call RegPackAlloc(RF, InData%SPLBLUNT) - call RegPackAlloc(RF, InData%CfVar) - call RegPackAlloc(RF, InData%d99Var) - call RegPackAlloc(RF, InData%dStarVar) - call RegPackAlloc(RF, InData%EdgeVelVar) + call RegPack(RF, InData%CfVar) + call RegPack(RF, InData%d99Var) + call RegPack(RF, InData%dStarVar) + call RegPack(RF, InData%EdgeVelVar) call RegPack(RF, InData%LastIndex) call RegPackAlloc(RF, InData%SumSpecNoiseSep) call RegPackAlloc(RF, InData%OASPL) @@ -1667,10 +1428,10 @@ subroutine AA_UnPackMisc(RF, OutData) call RegUnpackAlloc(RF, OutData%SPLTI); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%SPLTIGui); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%SPLBLUNT); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%CfVar); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%d99Var); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%dStarVar); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%EdgeVelVar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%CfVar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%d99Var); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%dStarVar); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%EdgeVelVar); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%LastIndex); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%SumSpecNoiseSep); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%OASPL); if (RegCheckErr(RF, RoutineName)) return @@ -1684,10 +1445,8 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) integer(IntKi), intent(in ) :: CtrlCode integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2, i3 integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_CopyParam' ErrStat = ErrID_None ErrMsg = '' @@ -1708,56 +1467,20 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%KinVisc = SrcParamData%KinVisc DstParamData%SpdSound = SrcParamData%SpdSound DstParamData%HubHeight = SrcParamData%HubHeight - DstParamData%toptip = SrcParamData%toptip - DstParamData%bottip = SrcParamData%bottip - if (allocated(SrcParamData%rotorregionlimitsVert)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsVert) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsVert) - if (.not. allocated(DstParamData%rotorregionlimitsVert)) then - allocate(DstParamData%rotorregionlimitsVert(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsVert.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%rotorregionlimitsVert = SrcParamData%rotorregionlimitsVert - end if - if (allocated(SrcParamData%rotorregionlimitsHorz)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsHorz) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsHorz) - if (.not. allocated(DstParamData%rotorregionlimitsHorz)) then - allocate(DstParamData%rotorregionlimitsHorz(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsHorz.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%rotorregionlimitsHorz = SrcParamData%rotorregionlimitsHorz - end if - if (allocated(SrcParamData%rotorregionlimitsalph)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsalph) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsalph) - if (.not. allocated(DstParamData%rotorregionlimitsalph)) then - allocate(DstParamData%rotorregionlimitsalph(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsalph.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstParamData%rotorregionlimitsalph = SrcParamData%rotorregionlimitsalph - end if - if (allocated(SrcParamData%rotorregionlimitsrad)) then - LB(1:1) = lbound(SrcParamData%rotorregionlimitsrad) - UB(1:1) = ubound(SrcParamData%rotorregionlimitsrad) - if (.not. allocated(DstParamData%rotorregionlimitsrad)) then - allocate(DstParamData%rotorregionlimitsrad(LB(1):UB(1)), stat=ErrStat2) + if (allocated(SrcParamData%RotorRegion_k_minus1)) then + LB(1:2) = lbound(SrcParamData%RotorRegion_k_minus1) + UB(1:2) = ubound(SrcParamData%RotorRegion_k_minus1) + if (.not. allocated(DstParamData%RotorRegion_k_minus1)) then + allocate(DstParamData%RotorRegion_k_minus1(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%rotorregionlimitsrad.', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%RotorRegion_k_minus1.', ErrStat, ErrMsg, RoutineName) return end if end if - DstParamData%rotorregionlimitsrad = SrcParamData%rotorregionlimitsrad + DstParamData%RotorRegion_k_minus1 = SrcParamData%RotorRegion_k_minus1 end if + DstParamData%NumRotorRegionLimitsAlph = SrcParamData%NumRotorRegionLimitsAlph + DstParamData%NumRotorRegionLimitsRad = SrcParamData%NumRotorRegionLimitsRad DstParamData%NrObsLoc = SrcParamData%NrObsLoc DstParamData%aweightflag = SrcParamData%aweightflag DstParamData%TxtFileOutput = SrcParamData%TxtFileOutput @@ -1798,8 +1521,7 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%Aweight = SrcParamData%Aweight end if - DstParamData%total_sampleTI = SrcParamData%total_sampleTI - DstParamData%AA_Bl_Prcntge = SrcParamData%AA_Bl_Prcntge + DstParamData%Num_total_sampleTI = SrcParamData%Num_total_sampleTI DstParamData%startnode = SrcParamData%startnode DstParamData%Lturb = SrcParamData%Lturb DstParamData%avgV = SrcParamData%avgV @@ -1871,22 +1593,6 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%BlAFID = SrcParamData%BlAFID end if - if (allocated(SrcParamData%AFInfo)) then - LB(1:1) = lbound(SrcParamData%AFInfo) - UB(1:1) = ubound(SrcParamData%AFInfo) - if (.not. allocated(DstParamData%AFInfo)) then - allocate(DstParamData%AFInfo(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFInfo.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - do i1 = LB(1), UB(1) - call AFI_CopyParam(SrcParamData%AFInfo(i1), DstParamData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end do - end if if (allocated(SrcParamData%AFLECo)) then LB(1:3) = lbound(SrcParamData%AFLECo) UB(1:3) = ubound(SrcParamData%AFLECo) @@ -1923,6 +1629,18 @@ subroutine AA_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) end if DstParamData%BlSpn = SrcParamData%BlSpn end if + if (allocated(SrcParamData%BlElemSpn)) then + LB(1:2) = lbound(SrcParamData%BlElemSpn) + UB(1:2) = ubound(SrcParamData%BlElemSpn) + if (.not. allocated(DstParamData%BlElemSpn)) then + allocate(DstParamData%BlElemSpn(LB(1):UB(1),LB(2):UB(2)), stat=ErrStat2) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlElemSpn.', ErrStat, ErrMsg, RoutineName) + return + end if + end if + DstParamData%BlElemSpn = SrcParamData%BlElemSpn + end if if (allocated(SrcParamData%BlChord)) then LB(1:2) = lbound(SrcParamData%BlChord) UB(1:2) = ubound(SrcParamData%BlChord) @@ -2073,24 +1791,11 @@ subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) type(AA_ParameterType), intent(inout) :: ParamData integer(IntKi), intent( out) :: ErrStat character(*), intent( out) :: ErrMsg - integer(B4Ki) :: i1, i2, i3 - integer(B4Ki) :: LB(3), UB(3) - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AA_DestroyParam' ErrStat = ErrID_None ErrMsg = '' - if (allocated(ParamData%rotorregionlimitsVert)) then - deallocate(ParamData%rotorregionlimitsVert) - end if - if (allocated(ParamData%rotorregionlimitsHorz)) then - deallocate(ParamData%rotorregionlimitsHorz) - end if - if (allocated(ParamData%rotorregionlimitsalph)) then - deallocate(ParamData%rotorregionlimitsalph) - end if - if (allocated(ParamData%rotorregionlimitsrad)) then - deallocate(ParamData%rotorregionlimitsrad) + if (allocated(ParamData%RotorRegion_k_minus1)) then + deallocate(ParamData%RotorRegion_k_minus1) end if if (allocated(ParamData%ObsXYZ)) then deallocate(ParamData%ObsXYZ) @@ -2116,15 +1821,6 @@ subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%BlAFID)) then deallocate(ParamData%BlAFID) end if - if (allocated(ParamData%AFInfo)) then - LB(1:1) = lbound(ParamData%AFInfo) - UB(1:1) = ubound(ParamData%AFInfo) - do i1 = LB(1), UB(1) - call AFI_DestroyParam(ParamData%AFInfo(i1), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end do - deallocate(ParamData%AFInfo) - end if if (allocated(ParamData%AFLECo)) then deallocate(ParamData%AFLECo) end if @@ -2134,6 +1830,9 @@ subroutine AA_DestroyParam(ParamData, ErrStat, ErrMsg) if (allocated(ParamData%BlSpn)) then deallocate(ParamData%BlSpn) end if + if (allocated(ParamData%BlElemSpn)) then + deallocate(ParamData%BlElemSpn) + end if if (allocated(ParamData%BlChord)) then deallocate(ParamData%BlChord) end if @@ -2176,8 +1875,6 @@ subroutine AA_PackParam(RF, Indata) type(RegFile), intent(inout) :: RF type(AA_ParameterType), intent(in) :: InData character(*), parameter :: RoutineName = 'AA_PackParam' - integer(B4Ki) :: i1, i2, i3 - integer(B4Ki) :: LB(3), UB(3) if (RF%ErrStat >= AbortErrLev) return call RegPack(RF, InData%DT) call RegPack(RF, InData%IBLUNT) @@ -2196,12 +1893,9 @@ subroutine AA_PackParam(RF, Indata) call RegPack(RF, InData%KinVisc) call RegPack(RF, InData%SpdSound) call RegPack(RF, InData%HubHeight) - call RegPack(RF, InData%toptip) - call RegPack(RF, InData%bottip) - call RegPackAlloc(RF, InData%rotorregionlimitsVert) - call RegPackAlloc(RF, InData%rotorregionlimitsHorz) - call RegPackAlloc(RF, InData%rotorregionlimitsalph) - call RegPackAlloc(RF, InData%rotorregionlimitsrad) + call RegPackAlloc(RF, InData%RotorRegion_k_minus1) + call RegPack(RF, InData%NumRotorRegionLimitsAlph) + call RegPack(RF, InData%NumRotorRegionLimitsRad) call RegPack(RF, InData%NrObsLoc) call RegPack(RF, InData%aweightflag) call RegPack(RF, InData%TxtFileOutput) @@ -2209,8 +1903,7 @@ subroutine AA_PackParam(RF, Indata) call RegPackAlloc(RF, InData%ObsXYZ) call RegPackAlloc(RF, InData%FreqList) call RegPackAlloc(RF, InData%Aweight) - call RegPack(RF, InData%total_sampleTI) - call RegPack(RF, InData%AA_Bl_Prcntge) + call RegPack(RF, InData%Num_total_sampleTI) call RegPack(RF, InData%startnode) call RegPack(RF, InData%Lturb) call RegPack(RF, InData%avgV) @@ -2227,18 +1920,10 @@ subroutine AA_PackParam(RF, Indata) call RegPackAlloc(RF, InData%TEAngle) call RegPackAlloc(RF, InData%AerCent) call RegPackAlloc(RF, InData%BlAFID) - call RegPack(RF, allocated(InData%AFInfo)) - if (allocated(InData%AFInfo)) then - call RegPackBounds(RF, 1, lbound(InData%AFInfo), ubound(InData%AFInfo)) - LB(1:1) = lbound(InData%AFInfo) - UB(1:1) = ubound(InData%AFInfo) - do i1 = LB(1), UB(1) - call AFI_PackParam(RF, InData%AFInfo(i1)) - end do - end if call RegPackAlloc(RF, InData%AFLECo) call RegPackAlloc(RF, InData%AFTECo) call RegPackAlloc(RF, InData%BlSpn) + call RegPackAlloc(RF, InData%BlElemSpn) call RegPackAlloc(RF, InData%BlChord) call RegPackAlloc(RF, InData%ReListBL) call RegPackAlloc(RF, InData%AOAListBL) @@ -2258,7 +1943,6 @@ subroutine AA_UnPackParam(RF, OutData) type(RegFile), intent(inout) :: RF type(AA_ParameterType), intent(inout) :: OutData character(*), parameter :: RoutineName = 'AA_UnPackParam' - integer(B4Ki) :: i1, i2, i3 integer(B4Ki) :: LB(3), UB(3) integer(IntKi) :: stat logical :: IsAllocAssoc @@ -2280,12 +1964,9 @@ subroutine AA_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%KinVisc); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SpdSound); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%HubHeight); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%toptip); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%bottip); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%rotorregionlimitsVert); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%rotorregionlimitsHorz); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%rotorregionlimitsalph); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%rotorregionlimitsrad); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%RotorRegion_k_minus1); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumRotorRegionLimitsAlph); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%NumRotorRegionLimitsRad); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NrObsLoc); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%aweightflag); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%TxtFileOutput); if (RegCheckErr(RF, RoutineName)) return @@ -2293,8 +1974,7 @@ subroutine AA_UnPackParam(RF, OutData) call RegUnpackAlloc(RF, OutData%ObsXYZ); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%FreqList); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%Aweight); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%total_sampleTI); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%AA_Bl_Prcntge); if (RegCheckErr(RF, RoutineName)) return + call RegUnpack(RF, OutData%Num_total_sampleTI); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%startnode); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%Lturb); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%avgV); if (RegCheckErr(RF, RoutineName)) return @@ -2311,22 +1991,10 @@ subroutine AA_UnPackParam(RF, OutData) call RegUnpackAlloc(RF, OutData%TEAngle); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%AerCent); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%BlAFID); if (RegCheckErr(RF, RoutineName)) return - if (allocated(OutData%AFInfo)) deallocate(OutData%AFInfo) - call RegUnpack(RF, IsAllocAssoc); if (RegCheckErr(RF, RoutineName)) return - if (IsAllocAssoc) then - call RegUnpackBounds(RF, 1, LB, UB); if (RegCheckErr(RF, RoutineName)) return - allocate(OutData%AFInfo(LB(1):UB(1)),stat=stat) - if (stat /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', RF%ErrStat, RF%ErrMsg, RoutineName) - return - end if - do i1 = LB(1), UB(1) - call AFI_UnpackParam(RF, OutData%AFInfo(i1)) ! AFInfo - end do - end if call RegUnpackAlloc(RF, OutData%AFLECo); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%AFTECo); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%BlSpn); if (RegCheckErr(RF, RoutineName)) return + call RegUnpackAlloc(RF, OutData%BlElemSpn); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%BlChord); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%ReListBL); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%AOAListBL); if (RegCheckErr(RF, RoutineName)) return diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 6faca45a3..f70b8d71b 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -474,7 +474,7 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! Initialize the AeroAcoustics Module if the CompAA flag is set !............................................................................................ if (p%rotors(iR)%CompAA) then - call Init_AAmodule( InitInp%rotors(iR), InputFileData, InputFileData%rotors(iR), u%rotors(iR), m%rotors(iR)%AA_u, p%rotors(iR), p, x%rotors(iR)%AA, xd%rotors(iR)%AA, z%rotors(iR)%AA, OtherState%rotors(iR)%AA, m%rotors(iR)%AA_y, m%rotors(iR)%AA, AA_InitOut, ErrStat2, ErrMsg2 ) + call Init_AAmodule( InitInp%rotors(iR), InputFileData, InputFileData%rotors(iR), u%rotors(iR), m%rotors(iR)%AA_u, p%rotors(iR), p, xd%rotors(iR)%AA, OtherState%rotors(iR)%AA, m%rotors(iR)%AA_y, m%rotors(iR)%AA, AA_InitOut, ErrStat2, ErrMsg2 ) if (Failed()) return; end if enddo @@ -1679,7 +1679,7 @@ subroutine AD_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) do iR = 1, SIZE(p%rotors) if (p%rotors(iR)%CompAA) then - call AA_End( m%rotors(iR)%AA_u, p%rotors(iR)%AA, x%rotors(iR)%AA, xd%rotors(iR)%AA, z%rotors(iR)%AA, OtherState%rotors(iR)%AA, m%rotors(iR)%AA_y, m%rotors(iR)%AA, ErrStat, ErrMsg ) + call AA_End( m%rotors(iR)%AA_u, p%rotors(iR)%AA, xd%rotors(iR)%AA, OtherState%rotors(iR)%AA, m%rotors(iR)%AA_y, m%rotors(iR)%AA, ErrStat, ErrMsg ) end if enddo @@ -2145,7 +2145,7 @@ subroutine RotCalcOutput( t, u, RotInflow, p, p_AD, x, xd, z, OtherState, y, m, ! Also, SetInputs() [called above] calls SetInputsForBEMT() which in turn establishes current versions of the Global to local transformations we need as inputs to AA call SetInputsForAA(p, u, RotInflow, m, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AA_CalcOutput(t, m%AA_u, p%AA, x%AA, xd%AA, z%AA, OtherState%AA, m%AA_y, m%AA, errStat2, errMsg2) + call AA_CalcOutput(t, m%AA_u, p%AA, xd%AA, OtherState%AA, m%AA_y, m%AA, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! end if @@ -4446,7 +4446,7 @@ SUBROUTINE Init_AFIparams( InputFileData, p_AFI, UnEc, RootName, ErrStat, ErrMsg END SUBROUTINE Init_AFIparams !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes the Airfoil Noise module from within AeroDyn. -SUBROUTINE Init_AAmodule( DrvInitInp, AD_InputFileData, RotInputFileData, u_AD, u, p, p_AD, x, xd, z, OtherState, y, m, InitOut, ErrStat, ErrMsg ) +SUBROUTINE Init_AAmodule( DrvInitInp, AD_InputFileData, RotInputFileData, u_AD, u, p, p_AD, xd, OtherState, y, m, InitOut, ErrStat, ErrMsg ) !.................................................................................................................................. type(RotInitInputType), intent(in ) :: DrvInitInp !< AeroDyn-level initialization inputs type(AD_InputFile), intent(in ) :: AD_InputFileData !< All the data in the AeroDyn input file @@ -4455,9 +4455,9 @@ SUBROUTINE Init_AAmodule( DrvInitInp, AD_InputFileData, RotInputFileData, u_AD, type(AA_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined type(RotParameterType), intent(inout) :: p !< Parameters ! intent out b/c we set the AA parameters here type(AD_ParameterType), intent(inout) :: p_AD !< Parameters ! intent out b/c we set the AA parameters here - type(AA_ContinuousStateType), intent( out) :: x !< Initial continuous states + !type(AA_ContinuousStateType), intent( out) :: x !< Initial continuous states type(AA_DiscreteStateType), intent( out) :: xd !< Initial discrete states - type(AA_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states + !type(AA_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states type(AA_OtherStateType), intent( out) :: OtherState !< Initial other states type(AA_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; !! only the output mesh is initialized) @@ -4493,17 +4493,6 @@ SUBROUTINE Init_AAmodule( DrvInitInp, AD_InputFileData, RotInputFileData, u_AD, InitInp%SpdSound = AD_InputFileData%SpdSound InitInp%HubHeight = DrvInitInp%HubPosition(3) - ! --- Transfer of airfoil info - ALLOCATE ( InitInp%AFInfo( size(p_AD%AFI) ), STAT=ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat ( ErrID_Fatal, 'Error allocating memory for the InitInp%AFInfo array.', ErrStat2, ErrMsg2, RoutineName ) - RETURN - ENDIF - do i=1,size(p_AD%AFI) - call AFI_CopyParam( p_AD%AFI(i), InitInp%AFInfo(i), MESH_NEWCOPY, errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - end do - ! --- Allocate and set AirfoilID, chord and Span for each blades ! note here that each blade is required to have the same number of nodes call AllocAry( InitInp%BlAFID, p%NumBlNds, p%NumBlades,'InitInp%BlAFID', errStat2, ErrMsg2 ) @@ -4518,14 +4507,14 @@ SUBROUTINE Init_AAmodule( DrvInitInp, AD_InputFileData, RotInputFileData, u_AD, end if do k = 1, p%NumBlades do j=1, RotInputFileData%BladeProps(k)%NumBlNds - InitInp%BlChord(j,k) = RotInputFileData%BladeProps(k)%BlChord( j) + InitInp%BlChord(j,k) = RotInputFileData%BladeProps(k)%BlChord(j) InitInp%BlSpn (j,k) = RotInputFileData%BladeProps(k)%BlSpn(j) - InitInp%BlAFID(j,k) = RotInputFileData%BladeProps(k)%BlAFID(j) + InitInp%BlAFID(j,k) = RotInputFileData%BladeProps(k)%BlAFID(j) end do end do ! --- AeroAcoustics initialization call - call AA_Init(InitInp, u, p%AA, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat2, ErrMsg2 ) + call AA_Init(InitInp, u, p%AA, xd, OtherState, y, m, Interval, p_AD%AFI, InitOut, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) call Cleanup() @@ -4533,7 +4522,7 @@ SUBROUTINE Init_AAmodule( DrvInitInp, AD_InputFileData, RotInputFileData, u_AD, contains subroutine Cleanup() - call AA_DestroyInitInput ( InitInp, ErrStat2, ErrMsg2 ) + call AA_DestroyInitInput ( InitInp, ErrStat2, ErrMsg2 ) end subroutine Cleanup END SUBROUTINE Init_AAmodule diff --git a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 index b5dcbea39..8f2483211 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 @@ -99,8 +99,7 @@ subroutine Dvr_Init(dvr, ADI, FED, errStat, errMsg ) ! local variables integer(IntKi) :: errStat2 ! local status of error message character(ErrMsgLen) :: errMsg2 ! local error message if errStat /= ErrID_None - character(1000) :: inputFile ! String to hold the file name. - character(200) :: git_commit ! String containing the current git commit hash + character(1000) :: InputFile ! String to hold the file name. character(20) :: FlagArg ! flag argument from command line integer :: iWT ! Index on wind turbines/rotors errStat = ErrID_None @@ -111,7 +110,7 @@ subroutine Dvr_Init(dvr, ADI, FED, errStat, errMsg ) InputFile = "" ! initialize to empty string to make sure it's input from the command line CALL CheckArgs( InputFile, Flag=FlagArg ) - IF ( LEN( TRIM(FlagArg) ) > 0 ) CALL NormStop() + IF ( LEN( TRIM(FlagArg) ) > 0 ) CALL NormStop() ! stop if user set a flag argument (like '-h' or '-v') ! Display the copyright notice and compile info: CALL DispCopyrightLicense( version%Name ) diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 9060a0885..d88fcb947 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -253,7 +253,6 @@ typedef ^ AD_InputFile RotInputFile rotors {:} - - "Rotor (blades and tower # ..... States .................................................................................................................... # Define continuous (differentiable) states here: typedef ^ RotContinuousStateType BEMT_ContinuousStateType BEMT - - - "Continuous states from the BEMT module" - -typedef ^ RotContinuousStateType AA_ContinuousStateType AA - - - "Continuous states from the AA module" - typedef ^ ContinuousStateType RotContinuousStateType rotors {:} - - "Continuous states for each rotor" - typedef ^ ContinuousStateType FVW_ContinuousStateType FVW - - - "Continuous states from the FVW module" - @@ -268,7 +267,6 @@ typedef ^ DiscreteStateType FVW_DiscreteStateType FVW - - - "Discrete states fro # Define constraint states here: typedef ^ RotConstraintStateType BEMT_ConstraintStateType BEMT - - - "Constraint states from the BEMT module" - -typedef ^ RotConstraintStateType AA_ConstraintStateType AA - - - "Constraint states from the AA module" - typedef ^ ConstraintStateType RotConstraintStateType rotors {:} - - "Constraint states for each rotor" - typedef ^ ConstraintStateType FVW_ConstraintStateType FVW - - - "Constraint states from the FVW module" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 68cc48710..19a004baa 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -273,7 +273,6 @@ MODULE AeroDyn_Types ! ========= RotContinuousStateType ======= TYPE, PUBLIC :: RotContinuousStateType TYPE(BEMT_ContinuousStateType) :: BEMT !< Continuous states from the BEMT module [-] - TYPE(AA_ContinuousStateType) :: AA !< Continuous states from the AA module [-] END TYPE RotContinuousStateType ! ======================= ! ========= AD_ContinuousStateType ======= @@ -297,7 +296,6 @@ MODULE AeroDyn_Types ! ========= RotConstraintStateType ======= TYPE, PUBLIC :: RotConstraintStateType TYPE(BEMT_ConstraintStateType) :: BEMT !< Constraint states from the BEMT module [-] - TYPE(AA_ConstraintStateType) :: AA !< Constraint states from the AA module [-] END TYPE RotConstraintStateType ! ======================= ! ========= AD_ConstraintStateType ======= @@ -2446,9 +2444,6 @@ subroutine AD_CopyRotContinuousStateType(SrcRotContinuousStateTypeData, DstRotCo call BEMT_CopyContState(SrcRotContinuousStateTypeData%BEMT, DstRotContinuousStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call AA_CopyContState(SrcRotContinuousStateTypeData%AA, DstRotContinuousStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end subroutine subroutine AD_DestroyRotContinuousStateType(RotContinuousStateTypeData, ErrStat, ErrMsg) @@ -2462,8 +2457,6 @@ subroutine AD_DestroyRotContinuousStateType(RotContinuousStateTypeData, ErrStat, ErrMsg = '' call BEMT_DestroyContState(RotContinuousStateTypeData%BEMT, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AA_DestroyContState(RotContinuousStateTypeData%AA, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_PackRotContinuousStateType(RF, Indata) @@ -2472,7 +2465,6 @@ subroutine AD_PackRotContinuousStateType(RF, Indata) character(*), parameter :: RoutineName = 'AD_PackRotContinuousStateType' if (RF%ErrStat >= AbortErrLev) return call BEMT_PackContState(RF, InData%BEMT) - call AA_PackContState(RF, InData%AA) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -2482,7 +2474,6 @@ subroutine AD_UnPackRotContinuousStateType(RF, OutData) character(*), parameter :: RoutineName = 'AD_UnPackRotContinuousStateType' if (RF%ErrStat /= ErrID_None) return call BEMT_UnpackContState(RF, OutData%BEMT) ! BEMT - call AA_UnpackContState(RF, OutData%AA) ! AA end subroutine subroutine AD_CopyContState(SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg) @@ -2758,9 +2749,6 @@ subroutine AD_CopyRotConstraintStateType(SrcRotConstraintStateTypeData, DstRotCo call BEMT_CopyConstrState(SrcRotConstraintStateTypeData%BEMT, DstRotConstraintStateTypeData%BEMT, CtrlCode, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return - call AA_CopyConstrState(SrcRotConstraintStateTypeData%AA, DstRotConstraintStateTypeData%AA, CtrlCode, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return end subroutine subroutine AD_DestroyRotConstraintStateType(RotConstraintStateTypeData, ErrStat, ErrMsg) @@ -2774,8 +2762,6 @@ subroutine AD_DestroyRotConstraintStateType(RotConstraintStateTypeData, ErrStat, ErrMsg = '' call BEMT_DestroyConstrState(RotConstraintStateTypeData%BEMT, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AA_DestroyConstrState(RotConstraintStateTypeData%AA, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end subroutine subroutine AD_PackRotConstraintStateType(RF, Indata) @@ -2784,7 +2770,6 @@ subroutine AD_PackRotConstraintStateType(RF, Indata) character(*), parameter :: RoutineName = 'AD_PackRotConstraintStateType' if (RF%ErrStat >= AbortErrLev) return call BEMT_PackConstrState(RF, InData%BEMT) - call AA_PackConstrState(RF, InData%AA) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -2794,7 +2779,6 @@ subroutine AD_UnPackRotConstraintStateType(RF, OutData) character(*), parameter :: RoutineName = 'AD_UnPackRotConstraintStateType' if (RF%ErrStat /= ErrID_None) return call BEMT_UnpackConstrState(RF, OutData%BEMT) ! BEMT - call AA_UnpackConstrState(RF, OutData%AA) ! AA end subroutine subroutine AD_CopyConstrState(SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg)