diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index a263e18e28..c4db5b2631 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -233,6 +233,8 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut integer(IntKi) :: UnEcho ! Unit number for the echo file integer(IntKi) :: nRotors ! Number of rotors integer(IntKi), allocatable, dimension(:) :: NumBlades ! Number of blades per rotor + integer(IntKi) , allocatable, dimension(:) :: AeroProjMod ! AeroProjMod per rotor + character(*), parameter :: RoutineName = 'AD_Init' @@ -262,7 +264,10 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut allocate(p%rotors(nRotors), m%rotors(nRotors), stat=errStat) if (errStat/=0) call SetErrStat( ErrID_Fatal, 'Allocating rotor params/misc', errStat, errMsg, RoutineName ) allocate(NumBlades(nRotors), stat=errStat ) ! temp array to pass NumBlades - if (errStat/=0) call SetErrStat( ErrID_Fatal, 'Allocating rotor params/misc', errStat, errMsg, RoutineName ) + if (errStat/=0) call SetErrStat( ErrID_Fatal, 'Allocating numblades per rotor', errStat, errMsg, RoutineName ) + allocate(AeroProjMod(nRotors), stat=errStat ) ! temp array to pass AeroProjMod + AeroProjMod=-1 + if (errStat/=0) call SetErrStat( ErrID_Fatal, 'Allocating AeroProjMod per rotor', errStat, errMsg, RoutineName ) if (errStat/=ErrID_None) then call Cleanup() return @@ -276,6 +281,7 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut if (Failed()) return; NumBlades(iR) = InitInp%rotors(iR)%NumBlades p%rotors(iR)%NumBlades = InitInp%rotors(iR)%NumBlades + AeroProjMod(iR) = InitInp%rotors(iR)%AeroProjMod if (nRotors > 1) then p%rotors(iR)%RootName = TRIM(InitInp%RootName)//'.AD.R'//trim(num2lstr(iR)) else @@ -308,7 +314,7 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut ! ----------------------------------------------------------------- ! Read the AeroDyn blade files, or copy from passed input !FIXME: add handling for passing of blade files and other types of files. - call ReadInputFiles( InitInp%InputFile, InputFileData, interval, p%RootName, NumBlades, UnEcho, ErrStat2, ErrMsg2 ) + call ReadInputFiles( InitInp%InputFile, InputFileData, interval, p%RootName, NumBlades, AeroProjMod, UnEcho, ErrStat2, ErrMsg2 ) if (Failed()) return; ! Validate the inputs @@ -561,7 +567,7 @@ subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) call AllocAry( m%DisturbedInflow, 3_IntKi, p%NumBlNds, p%numBlades, 'OtherState%DisturbedInflow', ErrStat2, ErrMsg2 ) ! must be same size as u%InflowOnBlade call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( m%WithoutSweepPitchTwist, 3_IntKi, 3_IntKi, p%NumBlNds, p%numBlades, 'OtherState%WithoutSweepPitchTwist', ErrStat2, ErrMsg2 ) + call AllocAry( m%orientationAnnulus, 3_IntKi, 3_IntKi, p%NumBlNds, p%numBlades, 'OtherState%orientationAnnulus', ErrStat2, ErrMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) call allocAry( m%SigmaCavit, p%NumBlNds, p%numBlades, 'm%SigmaCavit', errStat2, errMsg2); call setErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -596,9 +602,16 @@ subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) call AllocAry( m%Y, p%NumBlNds, p%NumBlades, 'm%Y', ErrStat2, ErrMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( m%M, p%NumBlNds, p%NumBlades, 'm%M', ErrStat2, ErrMsg2 ) + call AllocAry( m%Z, p%NumBlNds, p%NumBlades, 'm%Z', ErrStat2, ErrMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) call AllocAry( m%hub_theta_x_root, p%NumBlades, 'm%hub_theta_x_root', ErrStat2, ErrMsg2 ) + call AllocAry( m%M, p%NumBlNds, p%NumBlades, 'm%M', ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry( m%Mx, p%NumBlNds, p%NumBlades, 'm%Mx', ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry( m%My, p%NumBlNds, p%NumBlades, 'm%My', ErrStat2, ErrMsg2 ) + call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry( m%Mz, p%NumBlNds, p%NumBlades, 'm%Mz', ErrStat2, ErrMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) ! mesh mapping data for integrating load over entire rotor: allocate( m%B_L_2_H_P(p%NumBlades), Stat = ErrStat2) @@ -813,7 +826,7 @@ subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) m%Y_Twr = 0.0_ReKi end if - + m%FirstWarn_TowerStrike = .true. end subroutine Init_MiscVars !---------------------------------------------------------------------------------------------------------------------------------- @@ -880,6 +893,7 @@ subroutine Init_y(y, u, p, errStat, errMsg) y%TowerLoad%nnodes = 0 end if + call MeshCopy ( SrcMesh = u%NacelleMotion & , DestMesh = y%NacelleLoad & , CtrlCode = MESH_SIBLING & @@ -1000,6 +1014,7 @@ subroutine Init_u( u, p, p_AD, InputFileData, InitInp, errStat, errMsg ) ,Orientation = .true. & ,TranslationDisp = .true. & ,TranslationVel = .true. & + ,TranslationAcc = .TRUE. & ! tower acceleration used for tower VIV ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) @@ -1230,10 +1245,10 @@ subroutine SetParameters( InitInp, InputFileData, RotData, p, p_AD, ErrStat, Err ! Local variables - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - INTEGER(IntKi) :: k ! loop counter for blades - character(*), parameter :: RoutineName = 'SetParameters' + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation + INTEGER(IntKi) :: j, k + character(*), parameter :: RoutineName = 'SetParameters' ! Initialize variables for this routine @@ -1312,6 +1327,18 @@ subroutine SetParameters( InitInp, InputFileData, RotData, p, p_AD, ErrStat, Err p%SpdSound = InputFileData%SpdSound p%WtrDpth = InitInp%WtrDpth p%MSL2SWL = InitInp%MSL2SWL + + call AllocAry(p%BlTwist, p%NumBlNds, p%numBlades, 'p%BlTwist', ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return + + do k=1,p%numBlades + do j=1,p%NumBlNds + p%BlTwist(j,k) = RotData%BladeProps(k)%BlTwist(j) + end do + end do + + !p%AFI ! set in call to AFI_Init() [called early because it wants to use the same echo file as AD] !p%BEMT ! set in call to BEMT_Init() @@ -1333,8 +1360,6 @@ subroutine SetParameters( InitInp, InputFileData, RotData, p, p_AD, ErrStat, Err if (ErrStat >= AbortErrLev) return - - ! Set the nodal output parameters. Note there is some validation in this, so we might get an error from here. CALL AllBldNdOuts_SetParameters( InputFileData, p, p_AD, ErrStat2, ErrMsg2 ) call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -1524,6 +1549,8 @@ subroutine AD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errStat ! local variables integer(intKi) :: iR ! Counter on rotors + integer :: i + real(DbKi) :: BEMT_utimes(2) !< Times associated with m%BEMT_u(:), in seconds type(AD_InputType) :: uInterp ! Interpolated/Extrapolated input integer(intKi) :: ErrStat2 ! temporary Error status character(ErrMsgLen) :: ErrMsg2 ! temporary Error message @@ -1540,33 +1567,27 @@ subroutine AD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errStat return end if - ! set values of m%BEMT_u(2) from inputs interpolated at t+dt: - ! NOTE: this is different than OpenFAST, which has t+dt at u(1) - call AD_Input_ExtrapInterp(u,utimes,uInterp,t+p%DT, errStat2, errMsg2) + ! set values of m%BEMT_u(2) from inputs interpolated at t+dt; + ! set values of m%BEMT_u(1) from inputs (uInterp) interpolated at t + ! NOTE: this is different than glue code, which has t+dt at u(1) + BEMT_utimes(2) = t+p%DT + BEMT_utimes(1) = t + do i=2,1,-1 ! I'm calculating values for t second in case we want the other misc vars at t as before, but I don't think it matters) + call AD_Input_ExtrapInterp(u,utimes,uInterp,BEMT_utimes(i), errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) do iR = 1,size(p%rotors) - call SetInputs(p%rotors(iR), p, uInterp%rotors(iR), m%rotors(iR), 2, errStat2, errMsg2) + call SetInputs(p%rotors(iR), p, uInterp%rotors(iR), m%rotors(iR), i, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) enddo - - ! set values of m%BEMT_u(1) from inputs (uInterp) interpolated at t: - ! NOTE: this is different than OpenFAST, which has t at u(2) - ! I'm doing this second in case we want the other misc vars at t as before, but I don't think it matters - call AD_Input_ExtrapInterp(u,utimes,uInterp, t, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - do iR = 1,size(p%rotors) - call SetInputs(p%rotors(iR), p, uInterp%rotors(iR), m%rotors(iR), 1, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) enddo + if (p%WakeMod /= WakeMod_FVW) then do iR = 1,size(p%rotors) ! Call into the BEMT update states NOTE: This is a non-standard framework interface!!!!! GJH - ! Also note BEMT_u(1) and BEMT_u(2) are not following the OpenFAST convention for t+dt, t - call BEMT_UpdateStates(t, n, m%rotors(iR)%BEMT_u(1), m%rotors(iR)%BEMT_u(2), p%rotors(iR)%BEMT, x%rotors(iR)%BEMT, xd%rotors(iR)%BEMT, z%rotors(iR)%BEMT, OtherState%rotors(iR)%BEMT, p%AFI, m%rotors(iR)%BEMT, errStat2, errMsg2) + call BEMT_UpdateStates(t, n, m%rotors(iR)%BEMT_u(:), BEMT_utimes, p%rotors(iR)%BEMT, x%rotors(iR)%BEMT, xd%rotors(iR)%BEMT, z%rotors(iR)%BEMT, OtherState%rotors(iR)%BEMT, p%AFI, m%rotors(iR)%BEMT, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! Call AeroAcoustics updates states @@ -1629,8 +1650,6 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, LOGICAL, OPTIONAL, INTENT(IN ) :: NeedWriteOutput !< Flag to determine if WriteOutput values need to be calculated in this call - ! NOTE: m%BEMT_u(i) indices are set differently from the way OpenFAST typically sets up the u and uTimes arrays - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt integer(intKi) :: iR ! Loop on rotors integer(intKi) :: ErrStat2 @@ -1689,7 +1708,6 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, end if end subroutine AD_CalcOutput - !---------------------------------------------------------------------------------------------------------------------------------- subroutine RotCalcOutput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, ErrStat, ErrMsg, NeedWriteOutput) ! NOTE: no matter how many channels are selected for output, all of the outputs are calculated @@ -1742,7 +1760,7 @@ subroutine RotCalcOutput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, call BEMT_CalcOutput(t, m%BEMT_u(indx), p%BEMT, x%BEMT, xd%BEMT, z%BEMT, OtherState%BEMT, p_AD%AFI, m%BEMT_y, m%BEMT, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call SetOutputsFromBEMT( p, m, y ) + call SetOutputsFromBEMT( p, u, m, y ) if ( p%CompAA ) then ! We need the outputs from BEMT as inputs to AeroAcoustics module @@ -1754,6 +1772,7 @@ subroutine RotCalcOutput( t, u, p, p_AD, x, xd, z, OtherState, y, m, m_AD, iRot, end if endif + if ( p%TwrAero ) then call ADTwr_CalcOutput(p, u, m, y, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2468,6 +2487,7 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) ! local variables real(R8Ki) :: x_hat(3) real(R8Ki) :: y_hat(3) + real(R8Ki) :: z_hat(3) real(R8Ki) :: x_hat_disk(3) real(R8Ki) :: y_hat_disk(3) real(R8Ki) :: z_hat_disk(3) @@ -2476,82 +2496,238 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) real(ReKi) :: rmax real(R8Ki) :: thetaBladeNds(p%NumBlNds,p%NumBlades) real(R8Ki) :: Azimuth(p%NumBlades) - integer(intKi) :: j ! loop counter for nodes integer(intKi) :: k ! loop counter for blades -! integer(intKi) :: ErrStat2 -! character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SetInputsForBEMT' - - ! note ErrStat and ErrMsg are set in GeomWithoutSweepPitchTwist: + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'SetInputsForBEMT' + ! NEW VAR + real(ReKi) :: numer, denom, ratio, signOfAngle ! helper variables for calculating u%chi0 + real(ReKi) :: tilt, yaw + real(ReKi) :: SkewVec(3), tmp_skewVec(3), x_hat_wind(3), tmpD(3), tmpW(3) + real(R8Ki) :: windCrossDisk(3) + real(R8Ki) :: windCrossDiskMag + real(R8Ki) :: x_vec(3), y_vec(3), z_vec(3) + real(R8Ki) :: elemPosRelToHub(3,p%NUMBLNDS) + real(R8Ki) :: elemPosRotorProj(3,p%NUMBLNDS) + real(R8Ki) :: dr(3), dz(3) + real(R8Ki) :: theta(3) + real(R8Ki) :: orientation(3,3) + real(R8Ki) :: orientationBladeAzimuth(3,3,1) + ErrStat = ErrID_None + ErrMsg = "" ! Get disk average values and orientations call DiskAvgValues(p, u, m, x_hat_disk, y_hat_disk, z_hat_disk, Azimuth) ! also sets m%V_diskAvg, m%V_dot_x - call GeomWithoutSweepPitchTwist(p,u,x_hat_disk,m,thetaBladeNds,ErrStat,ErrMsg) + + if (p%AeroProjMod==APM_BEM_NoSweepPitchTwist) then + call GeomWithoutSweepPitchTwist(p,u,x_hat_disk,m,ErrStat=ErrStat,ErrMsg=ErrMsg,thetaBladeNds=thetaBladeNds) + elseif (p%AeroProjMod==APM_LiftingLine) then + ! TODO we might want to do something different here + call GeomWithoutSweepPitchTwist(p,u,x_hat_disk,m,ErrStat=ErrStat,ErrMsg=ErrMsg,thetaBladeNds=thetaBladeNds) + elseif (p%AeroProjMod==APM_BEM_Polar) then + !pass + !call GeomWithoutSweepPitchTwist(p,u, x_hat_disk, m, ErrStat=ErrStat,ErrMsg=ErrMsg, thetaBladeNds=m%BEMT_u(indx)%theta, toeBladeNds=m%BEMT_u(indx)%toeAngle) ! sets m%orientationAnnulus, m%Curve, m%hub_theta_x_root, m%AllOuts( BPitch( k) ) + else + call WrScr('AeroProjMod not supported - should never happen') + STOP + endif + if (ErrStat >= AbortErrLev) return - ! Velocity in disk normal - m%BEMT_u(indx)%Un_disk = m%V_dot_x - + ! Velocity in disk normal + m%BEMT_u(indx)%V0 = m%AvgDiskVel + m%BEMT_u(indx)%x_hat_disk = x_hat_disk + if (p%AeroProjMod==APM_BEM_NoSweepPitchTwist .or. p%AeroProjMod==APM_LiftingLine) then + ! NOTE: OpenFAST: Contains translational velocity!!! m%V_dot_x = dot_product( m%V_diskAvg, x_hat_disk ) + m%BEMT_u(indx)%Un_disk = dot_product( m%V_diskAvg, x_hat_disk ) + elseif (p%AeroProjMod==APM_BEM_Polar) then + m%BEMT_u(indx)%Un_disk = dot_product( m%AvgDiskVel, x_hat_disk ) + endif + ! Calculate Yaw and Tilt for use in xVelCorr + ! Define a vector wrt which the yaw is defined + x_hat_wind = m%V_diskAvg/twonorm(m%V_diskAvg) + ! Yaw + tmpD = x_hat_disk + tmpD(3) = 0.0 + tmpW = x_hat_wind + tmpW(3) = 0.0 + yaw = acos(max(-1.0_ReKi,min(1.0_ReKi,dot_product(tmpD,tmpW)/(twonorm(tmpD)*TwoNorm(tmpW))))) + tmp_skewVec = cross_product(tmpW,tmpD); + yaw = sign(yaw,tmp_skewVec(3)) + m%Yaw = yaw + + ! Tilt + tmpD = x_hat_disk + tmpD(2) = 0.0 + tmpW = x_hat_wind + tmpW(2) = 0.0 + tilt = acos(max(-1.0_ReKi,min(1.0_ReKi,dot_product(tmpD,tmpW)/(twonorm(tmpD)*TwoNorm(tmpW))))) + tmp_skewVec = cross_product(tmpD,tmpW) + tilt = sign(tilt,-tmp_skewVec(2)) + m%tilt = tilt + ! "Angular velocity of rotor" rad/s m%BEMT_u(indx)%omega = dot_product( u%HubMotion%RotationVel(:,1), x_hat_disk ) - ! "Angle between the vector normal to the rotor plane and the wind vector (e.g., the yaw angle in the case of no tilt)" rad - tmp_sz = TwoNorm( m%V_diskAvg ) - if ( EqualRealNos( tmp_sz, 0.0_ReKi ) ) then + ! "Angle between the vector normal to the rotor plane and the wind vector (e.g., the yaw angle in the case of no tilt)" rad + denom = TwoNorm( m%V_diskAvg ) + if (EqualRealNos(0.0_ReKi, denom)) then m%BEMT_u(indx)%chi0 = 0.0_ReKi else ! make sure we don't have numerical issues that make the ratio outside +/-1 - tmp_sz_y = min( 1.0_ReKi, m%V_dot_x / tmp_sz ) + tmp_sz_y = min( 1.0_ReKi, m%V_dot_x / denom ) tmp_sz_y = max( -1.0_ReKi, tmp_sz_y ) m%BEMT_u(indx)%chi0 = acos( tmp_sz_y ) end if - ! "Azimuth angle" rad + ! "Azimuth angle" rad m%bemt_u(indx)%psi = Azimuth - ! theta, "Twist angle (includes all sources of twist)" rad - ! Vx, "Local axial velocity at node" m/s - ! Vy, "Local tangential velocity at node" m/s + ! Local radius (and orientation) + if (p%AeroProjMod==APM_BEM_NoSweepPitchTwist .or. p%AeroProjMod==APM_LiftingLine) then + + ! "Radial distance from center-of-rotation to node" m + do k=1,p%NumBlades + do j=1,p%NumBlNds + ! displaced position of the jth node in the kth blade relative to the hub: + tmp = u%BladeMotion(k)%Position(:,j) + u%BladeMotion(k)%TranslationDisp(:,j) & + - u%HubMotion%Position(:,1) - u%HubMotion%TranslationDisp(:,1) + ! local radius (normalized distance from rotor centerline) + tmp_sz_y = dot_product( tmp, y_hat_disk )**2 + tmp_sz = dot_product( tmp, z_hat_disk )**2 + m%BEMT_u(indx)%rLocal(j,k) = sqrt( tmp_sz + tmp_sz_y ) + end do !j=nodes + end do !k=blades + + elseif (p%AeroProjMod==APM_BEM_Polar) then + do k=1,p%NumBlades + + ! Determine current azimuth angle and pitch axis vector of blade k + call Calculate_MeshOrientation_Rel2Hub(u%BladeRootMotion(k), u%HubMotion, x_hat_disk, orientationBladeAzimuth) + + ! Extract azimuth angle for blade k + theta = -EulerExtract( transpose(orientationBladeAzimuth(:,:,1)) ) + m%BEMT_u(indx)%psi(k) = theta(1) + + !......................... + ! Values for output and/or FAST.Farm + !......................... + ! construct system equivalent to u%BladeRootMotion(k)%Orientation, but without the blade-pitch angle: + orientation = matmul( u%BladeRootMotion(k)%Orientation(:,:,1), transpose( u%HubMotion%Orientation(:,:,1) ) ) + theta = EulerExtract( orientation ) !hub_theta_root(k) + ! theta(1) = Azimuth, theta(2) = cant+precone+rotorTilt, theta(3) = pitch+twist + + if (k<=size(m%hub_theta_x_root)) then + m%hub_theta_x_root(k) = theta(1) ! save this value for FAST.Farm + end if + + ! Get orientation of blade root with pitch set to zero + if (k<=size(BPitch)) then + m%AllOuts( BPitch(k) ) = -theta(3)*R2D ! save this value of pitch for potential output + end if + + ! Determine current azimuth angle and pitch axis vector of blade k, element j + call Calculate_MeshOrientation_Rel2Hub(u%BladeMotion(k), u%HubMotion, x_hat_disk, m%orientationAnnulus(:,:,:,k), elemPosRelToHub_save=elemPosRelToHub, elemPosRotorProj_save=elemPosRotorProj) + + !.......................... + ! Compute local radius + !.......................... + do j=1,p%NumBlNds + m%BEMT_u(indx)%rLocal(j,k) = TwoNorm( elemPosRotorProj(:,j) ) + end do !j=nodes + + !.......................... + ! Determine local J = dr/dz + !.......................... + do j=2,p%NumBlNds + ! Get element orientation vectors to compute J = dr/dz + ! and (future) override orientation information in BladeMotion%Orientation + dr(:) = elemPosRotorProj(:,j) - elemPosRotorProj(:,j-1) + dz(:) = elemPosRelToHub(:,j) - elemPosRelToHub(:,j-1) + + m%BEMT_u(indx)%drdz(j,k) = TwoNorm(dr(:)) / TwoNorm(dz(:)) + end do ! j + m%BEMT_u(indx)%drdz(1,k) = m%BEMT_u(indx)%drdz(2,k) + end do !k=blades + else + call WrScr('AeroProjMod not supported - should never happen') + STOP + endif ! ProjMod + + + !.......................... + ! local blade angles + !.......................... + !!! if !GeomWithoutSweepPitchTwist is called in this routine, use the commented-out lines instead of the calculations in this section + !!! ! whole array operations (values calculated in GeomWithoutSweepPitchTwist): + !!! m%BEMT_u(indx)%cantAngle = m%Curve ! cant angle (including aeroelastic deformation) + !!!!m%BEMT_u(indx)%theta = ! twist (including pitch and aeroelastic deformation) + !!!!m%BEMT_u(indx)%toeAngle = ! toe angle + if (p%AeroProjMod==APM_BEM_NoSweepPitchTwist .or. p%AeroProjMod==APM_LiftingLine) then + ! Theta + do k=1,p%NumBlades + do j=1,p%NumBlNds + m%BEMT_u(indx)%theta(j,k) = thetaBladeNds(j,k) ! local pitch + twist (aerodyanmic + elastic) angle of the jth node in the kth blade + + ! NOTE: curve computed by GeomWithoutSweepPitchTwist + m%BEMT_u(indx)%toeAngle(j,k) = 0.0_ReKi + m%BEMT_u(indx)%cantAngle(j,k) = 0.0_ReKi + end do !j=nodes + end do !k=blades + elseif (p%AeroProjMod==APM_BEM_Polar) then + do k=1,p%NumBlades + do j=1,p%NumBlNds + ! Get local blade cant angle and twist + orientation = matmul( u%BladeMotion(k)%Orientation(:,:,j), transpose( m%orientationAnnulus(:,:,j,k) ) ) + theta = EulerExtract( orientation ) + ! Get toe angle + m%BEMT_u(indx)%toeAngle(j,k) = theta(1) + ! cant angle (including aeroelastic deformation) + m%BEMT_u(indx)%cantAngle(j,k) = theta(2) + m%Curve(j,k) = theta(2) + ! twist (including pitch and aeroelastic deformation) + m%BEMT_u(indx)%theta(j,k) = -theta(3) + end do !j=nodes + end do !k=blades + else + call WrScr('AeroProjMod not supported - should never happen') + STOP + endif ! ProjMod + + !.......................... + ! Get normal, tangential and radial velocity components of the jth node in the kth blade + !.......................... do k=1,p%NumBlades do j=1,p%NumBlNds - - m%BEMT_u(indx)%theta(j,k) = thetaBladeNds(j,k) ! local pitch + twist (aerodyanmic + elastic) angle of the jth node in the kth blade - - x_hat = m%WithoutSweepPitchTwist(1,:,j,k) - y_hat = m%WithoutSweepPitchTwist(2,:,j,k) tmp = m%DisturbedInflow(:,j,k) - u%BladeMotion(k)%TranslationVel(:,j) ! rel_V(j)_Blade(k) - - m%BEMT_u(indx)%Vx(j,k) = dot_product( tmp, x_hat ) ! normal component (normal to the plane, not chord) of the inflow velocity of the jth node in the kth blade - m%BEMT_u(indx)%Vy(j,k) = dot_product( tmp, y_hat ) ! tangential component (tangential to the plane, not chord) of the inflow velocity of the jth node in the kth blade + m%BEMT_u(indx)%Vx(j,k) = dot_product( tmp, m%orientationAnnulus(1,:,j,k) ) ! normal component (normal to the plane, not chord) of the inflow velocity of the jth node in the kth blade + m%BEMT_u(indx)%Vy(j,k) = dot_product( tmp, m%orientationAnnulus(2,:,j,k) ) !+ TwoNorm(m%DisturbedInflow(:,j,k))*(sin()*sin(tilt)*)! tangential component (tangential to the plane, not chord) of the inflow velocity of the jth node in the kth blade + m%BEMT_u(indx)%Vz(j,k) = dot_product( tmp, m%orientationAnnulus(3,:,j,k) ) ! radial component (tangential to the plane, not chord) of the inflow velocity of the jth node in the kth blade + m%BEMT_u(indx)%xVelCorr(j,k) = TwoNorm(m%DisturbedInflow(:,j,k))*( sin(yaw)*sin(-m%BEMT_u(indx)%cantAngle(j,k))*sin(m%BEMT_u(indx)%psi(k)) & + + sin(tilt)*cos(yaw)*sin(-m%BEMT_u(indx)%cantAngle(j,k))*cos(m%BEMT_u(indx)%psi(k)) ) !m%BEMT_u(indx)%Vy(j,k)*sin(-theta(2))*sin(m%BEMT_u(indx)%psi(k)) + end do !j=nodes + end do !k=blades + + !.......................... + ! inputs for CDBEMT and CUA + !.......................... + do k=1,p%NumBlades + do j=1,p%NumBlNds ! inputs for CUA (and CDBEMT): - m%BEMT_u(indx)%omega_z(j,k) = dot_product( u%BladeMotion(k)%RotationVel( :,j), m%WithoutSweepPitchTwist(3,:,j,k) ) ! rotation of no-sweep-pitch coordinate system around z of the jth node in the kth blade + m%BEMT_u(indx)%omega_z(j,k) = dot_product( u%BladeMotion(k)%RotationVel( :,j), m%orientationAnnulus(3,:,j,k) ) ! rotation of no-sweep-pitch coordinate system around z of the jth node in the kth blade end do !j=nodes end do !k=blades - ! "Radial distance from center-of-rotation to node" m - - do k=1,p%NumBlades - do j=1,p%NumBlNds - - ! displaced position of the jth node in the kth blade relative to the hub: - tmp = u%BladeMotion(k)%Position(:,j) + u%BladeMotion(k)%TranslationDisp(:,j) & - - u%HubMotion%Position(:,1) - u%HubMotion%TranslationDisp(:,1) - - ! local radius (normalized distance from rotor centerline) - tmp_sz_y = dot_product( tmp, y_hat_disk )**2 - tmp_sz = dot_product( tmp, z_hat_disk )**2 - m%BEMT_u(indx)%rLocal(j,k) = sqrt( tmp_sz + tmp_sz_y ) - - end do !j=nodes - end do !k=blades - + !.......................... + ! User/Control property for AFI + !.......................... m%BEMT_u(indx)%UserProp = u%UserProp @@ -2586,22 +2762,39 @@ subroutine DiskAvgValues(p, u, m, x_hat_disk, y_hat_disk, z_hat_disk, Azimuth) integer(intKi) :: j ! loop counter for nodes integer(intKi) :: k ! loop counter for blades + ! calculate disk-averaged undisturbed wind + m%AvgDiskVel = 0.0_ReKi + do k=1,p%NumBlades + do j=1,p%NumBlNds + m%AvgDiskVel = m%AvgDiskVel + m%DisturbedInflow(:,j,k) + end do + end do + m%AvgDiskVel = m%AvgDiskVel / real( p%NumBlades * p%NumBlNds, ReKi ) + ! calculate disk-averaged relative wind speed, V_DiskAvg m%V_diskAvg = 0.0_ReKi do k=1,p%NumBlades do j=1,p%NumBlNds - tmp = m%DisturbedInflow(:,j,k) - u%BladeMotion(k)%TranslationVel(:,j) - m%V_diskAvg = m%V_diskAvg + tmp + ! !tmp = m%DisturbedInflow(:,j,k) - u%BladeMotion(k)%TranslationVel(:,j) + ! !tmp = u%InflowOnBlade(:,j,k) - u%BladeMotion(k)%TranslationVel(:,j) + ! !m%V_diskAvg = m%V_diskAvg + tmp + m%V_diskAvg = m%V_diskAvg + u%BladeMotion(k)%TranslationVel(:,j) end do end do m%V_diskAvg = m%V_diskAvg / real( p%NumBlades * p%NumBlNds, ReKi ) + m%V_diskAvg = m%AvgDiskVel - m%V_diskAvg + + ! orientation vectors: x_hat_disk = u%HubMotion%Orientation(1,:,1) !actually also x_hat_hub +! x_hat_disk = x_hat_disk / TwoNorm( x_hat_disk ) ! not necessary since Orientation(1,:,1) is already unit length + m%V_dot_x = dot_product( m%V_diskAvg, x_hat_disk ) + ! These values are not used in the Envision code base; stored here only for easier merging from OpenFAST: if (present(y_hat_disk)) then tmp = m%V_dot_x * x_hat_disk - m%V_diskAvg @@ -2634,7 +2827,7 @@ subroutine Calculate_MeshOrientation_Rel2Hub(Mesh1, HubMotion, x_hat_disk, orien TYPE(MeshType), intent(in) :: Mesh1 !< either BladeMotion or BladeRootMotion mesh TYPE(MeshType), intent(in) :: HubMotion !< HubMotion mesh REAL(R8Ki), intent(in) :: x_hat_disk(3) - REAL(ReKi), intent(out) :: orientationAnnulus(3,3,Mesh1%NNodes) + REAL(R8Ki), optional, intent(out) :: orientationAnnulus(3,3,Mesh1%NNodes) real(R8Ki), optional, intent(out) :: elemPosRelToHub_save( 3,Mesh1%NNodes) real(R8Ki), optional, intent(out) :: elemPosRotorProj_save(3,Mesh1%NNodes) @@ -2662,15 +2855,17 @@ subroutine Calculate_MeshOrientation_Rel2Hub(Mesh1, HubMotion, x_hat_disk, orien elemPosRelToHub = Mesh1%Position(:,j) + Mesh1%TranslationDisp(:,j) - HubAbsPosition ! + 0.00_ReKi*chordVec(:,j)*p%BEMT%chord(j,k) elemPosRotorProj = elemPosRelToHub - x_hat_disk * dot_product( x_hat_disk, elemPosRelToHub ) - ! Get unit vectors of the local annulus reference frame - z_hat_annulus = elemPosRotorProj / TwoNorm( elemPosRotorProj ) - x_hat_annulus = x_hat_disk - y_hat_annulus = cross_product( z_hat_annulus, x_hat_annulus ) + if (present(orientationAnnulus)) then + ! Get unit vectors of the local annulus reference frame + z_hat_annulus = elemPosRotorProj / TwoNorm( elemPosRotorProj ) + x_hat_annulus = x_hat_disk + y_hat_annulus = cross_product( z_hat_annulus, x_hat_annulus ) - ! Form a orientation matrix for the annulus reference frame - orientationAnnulus(1,:,j) = x_hat_annulus - orientationAnnulus(2,:,j) = y_hat_annulus - orientationAnnulus(3,:,j) = z_hat_annulus + ! Form a orientation matrix for the annulus reference frame + orientationAnnulus(1,:,j) = x_hat_annulus + orientationAnnulus(2,:,j) = y_hat_annulus + orientationAnnulus(3,:,j) = z_hat_annulus + end if if (present(elemPosRelToHub_save) ) elemPosRelToHub_save( :,j) = elemPosRelToHub if (present(elemPosRotorProj_save)) elemPosRotorProj_save(:,j) = elemPosRotorProj @@ -2678,12 +2873,19 @@ subroutine Calculate_MeshOrientation_Rel2Hub(Mesh1, HubMotion, x_hat_disk, orien end subroutine Calculate_MeshOrientation_Rel2Hub !---------------------------------------------------------------------------------------------------------------------------------- -subroutine GeomWithoutSweepPitchTwist(p,u,x_hat_disk,m,thetaBladeNds,ErrStat,ErrMsg) +! GeomWithoutSweepPitchTwist sets these variables: +! m%orientationAnnulus +! m%Curve +! m%hub_theta_x_root +! m%AllOuts( BPitch( k) ) +! thetaBladeNds (optional) +subroutine GeomWithoutSweepPitchTwist(p,u,x_hat_disk,m,thetaBladeNds,toeBladeNds,ErrStat,ErrMsg) type(RotParameterType), intent(in ) :: p !< AD parameters type(RotInputType), intent(in ) :: u !< AD Inputs at Time real(R8Ki), intent(in ) :: x_hat_disk(3) type(RotMiscVarType), intent(inout) :: m !< Misc/optimization variables - real(R8Ki), intent( out) :: thetaBladeNds(p%NumBlNds,p%NumBlades) + real(R8Ki), optional, intent( out) :: thetaBladeNds(p%NumBlNds,p%NumBlades) + real(R8Ki), optional, intent( out) :: toeBladeNds(p%NumBlNds,p%NumBlades) integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None real(R8Ki) :: theta(3) @@ -2699,7 +2901,7 @@ subroutine GeomWithoutSweepPitchTwist(p,u,x_hat_disk,m,thetaBladeNds,ErrStat,Err ErrStat = ErrID_None ErrMsg = "" - if (p%AeroProjMod==0) then + if (p%AeroProjMod==APM_BEM_NoSweepPitchTwist) then ! theta, "Twist angle (includes all sources of twist)" rad ! Vx, "Local axial velocity at node" m/s @@ -2714,7 +2916,9 @@ subroutine GeomWithoutSweepPitchTwist(p,u,x_hat_disk,m,thetaBladeNds,ErrStat,Err m%AllOuts( BPitch( k) ) = -theta(3)*R2D ! save this value of pitch for potential output endif theta(3) = 0.0_ReKi - m%hub_theta_x_root(k) = theta(1) ! save this value for FAST.Farm + if (k<=size(m%hub_theta_x_root)) then + m%hub_theta_x_root(k) = theta(1) ! save this value for FAST.Farm + end if orientation = EulerConstruct( theta ) ! rotation from hub 2 non-pitched blade orientation_nopitch = matmul( orientation, u%HubMotion%Orientation(:,:,1) ) ! withoutPitch_theta_Root(k) ! rotation from global 2 non-pitched blade @@ -2731,43 +2935,60 @@ subroutine GeomWithoutSweepPitchTwist(p,u,x_hat_disk,m,thetaBladeNds,ErrStat,Err theta = EulerExtract( orientation ) !root(k)WithoutPitch_theta(j)_blade(k) m%Curve( j,k) = theta(2) ! save value for possible output later - thetaBladeNds(j,k) = -theta(3) ! local pitch + twist (aerodyanmic + elastic) angle of the jth node in the kth blade + if (present(thetaBladeNds)) thetaBladeNds(j,k) = -theta(3) ! local pitch + twist (aerodyanmic + elastic) angle of the jth node in the kth blade + if (present(toeBladeNds )) toeBladeNds( j,k) = theta(1) theta(1) = 0.0_ReKi theta(3) = 0.0_ReKi - m%WithoutSweepPitchTwist(:,:,j,k) = matmul( EulerConstruct( theta ), orientation_nopitch ) ! WithoutSweepPitch+Twist_theta(j)_Blade(k) + m%orientationAnnulus(:,:,j,k) = matmul( EulerConstruct( theta ), orientation_nopitch ) ! WithoutSweepPitch+Twist_theta(j)_Blade(k) end do !j=nodes end do !k=blades - else if (p%AeroProjMod==1) then + else if (p%AeroProjMod==APM_LiftingLine) then do k=1,p%NumBlades + ! construct system equivalent to u%BladeRootMotion(k)%Orientation, but without the blade-pitch angle: + !orientation = matmul( u%BladeRootMotion(k)%Orientation(:,:,1), transpose( u%HubMotion%Orientation(:,:,1) ) ) : equivalent, without taking the transpose: call LAPACK_gemm( 'n', 't', 1.0_R8Ki, u%BladeRootMotion(k)%Orientation(:,:,1), u%HubMotion%Orientation(:,:,1), 0.0_R8Ki, orientation, errStat2, errMsg2) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) theta = EulerExtract( orientation ) !hub_theta_root(k) - if (k<=3) then + ! theta(1) = Azimuth, theta(2) = cant+precone+rotorTilt, theta(3) = pitch+twist + + if (k<=size(BPitch)) then m%AllOuts( BPitch( k) ) = -theta(3)*R2D ! save this value of pitch for potential output endif - theta(3) = 0.0_ReKi - m%hub_theta_x_root(k) = theta(1) ! save this value for FAST.Farm + + if (k<=size(m%hub_theta_x_root)) then + m%hub_theta_x_root(k) = theta(1) ! save this value for FAST.Farm + end if end do + !......................... + ! Set orientation Annulus: + !......................... + do k=1,p%NumBlades - call Calculate_MeshOrientation_Rel2Hub(u%BladeMotion(k), u%HubMotion, x_hat_disk, m%WithoutSweepPitchTwist(:,:,:,k)) + call Calculate_MeshOrientation_Rel2Hub(u%BladeMotion(k), u%HubMotion, x_hat_disk, m%orientationAnnulus(:,:,:,k)) + ! NOTE: important for AeroProjMod=APM_LiftingLine we use BladeMotion Orientation directly for annulus + ! otherwise ad_EllipticalWingInf_OLAF fails. Might need double checking... do j=1,p%NumBlNds - m%WithoutSweepPitchTwist(:,:,j,k) = u%BladeMotion(k)%Orientation(:,:,j) + m%orientationAnnulus(:,:,j,k) = u%BladeMotion(k)%Orientation(:,:,j) enddo enddo + !......................... + ! Set Curve and possibly thetaBladeNds: + !......................... do k=1,p%NumBlades do j=1,p%NumBlNds - orientation = matmul( u%BladeMotion(k)%Orientation(:,:,j), transpose( m%WithoutSweepPitchTwist(:,:,j,k) ) ) + orientation = matmul( u%BladeMotion(k)%Orientation(:,:,j), transpose( m%orientationAnnulus(:,:,j,k) ) ) theta = EulerExtract( orientation ) m%Curve( j,k) = theta(2) - thetaBladeNds(j,k) = -theta(3) + if (present(thetaBladeNds)) thetaBladeNds(j,k) = -theta(3) + if (present(toeBladeNds )) toeBladeNds( j,k) = theta(1) enddo enddo @@ -2792,16 +3013,22 @@ subroutine SetInputsForFVW(p, u, m, errStat, errMsg) integer(intKi) :: tIndx integer(intKi) :: iR ! Loop on rotors integer(intKi) :: j, k ! loop counter for blades + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'SetInputsForFVW' integer :: iW + ErrStat = ErrID_None + ErrMsg = "" + do tIndx=1,size(u) do iR =1, size(p%rotors) allocate(thetaBladeNds(p%rotors(iR)%NumBlNds, p%rotors(iR)%NumBlades)) ! Get disk average values and orientations ! NOTE: needed because it sets m%V_diskAvg and m%V_dot_x, needed by CalcOutput.. call DiskAvgValues(p%rotors(iR), u(tIndx)%rotors(iR), m%rotors(iR), x_hat_disk) ! also sets m%V_diskAvg and m%V_dot_x - call GeomWithoutSweepPitchTwist(p%rotors(iR),u(tIndx)%rotors(iR), x_hat_disk, m%rotors(iR), thetaBladeNds,ErrStat,ErrMsg) + call GeomWithoutSweepPitchTwist(p%rotors(iR),u(tIndx)%rotors(iR), x_hat_disk, m%rotors(iR), thetaBladeNds,ErrStat=ErrStat2,ErrMsg=ErrMsg2) ! also sets m%orientationAnnulus, m%Curve, m%hub_theta_x_root, m%AllOuts( BPitch( k) ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) return ! Rather than use a meshcopy, we will just copy what we need to the WingsMesh @@ -2811,8 +3038,7 @@ subroutine SetInputsForFVW(p, u, m, errStat, errMsg) iW=p%FVW%Bld2Wings(iR,k) if ( u(tIndx)%rotors(iR)%BladeMotion(k)%nNodes /= m%FVW_u(tIndx)%WingsMesh(iW)%nNodes ) then - ErrStat = ErrID_Fatal - ErrMsg = RoutineName//": WingsMesh contains different number of nodes than the BladeMotion mesh" + call SetErrStat(ErrID_Fatal,"WingsMesh contains different number of nodes than the BladeMotion mesh",ErrStat,ErrMsg,RoutineName) return endif m%FVW%W(iW)%PitchAndTwist(:) = thetaBladeNds(:,k) ! local pitch + twist (aerodyanmic + elastic) angle of the jth node in the kth blade @@ -2825,7 +3051,7 @@ subroutine SetInputsForFVW(p, u, m, errStat, errMsg) ! Inputs for dynamic stall (see SetInputsForBEMT) do j=1,p%rotors(iR)%NumBlNds ! inputs for CUA, section pitch/torsion rate - m%FVW_u(tIndx)%W(iW)%omega_z(j) = dot_product( u(tIndx)%rotors(iR)%BladeMotion(k)%RotationVel( :,j), m%rotors(iR)%WithoutSweepPitchTwist(3,:,j,k) ) ! rotation of no-sweep-pitch coordinate system around z of the jth node in the kth blade + m%FVW_u(tIndx)%W(iW)%omega_z(j) = dot_product( u(tIndx)%rotors(iR)%BladeMotion(k)%RotationVel( :,j), m%rotors(iR)%orientationAnnulus(3,:,j,k) ) ! rotation of no-sweep-pitch coordinate system around z of the jth node in the kth blade end do !j=nodes enddo ! k blades if (allocated(thetaBladeNds)) deallocate(thetaBladeNds) @@ -2838,7 +3064,8 @@ subroutine SetInputsForFVW(p, u, m, errStat, errMsg) if (p%FVW%TwrShadowOnWake) then do iR =1, size(p%rotors) if (p%rotors(iR)%TwrPotent /= TwrPotent_none .or. p%rotors(iR)%TwrShadow /= TwrShadow_none) then - call TwrInflArray( p%rotors(iR), u(tIndx)%rotors(iR), m%rotors(iR), m%FVW%r_wind, m%FVW_u(tIndx)%V_wind, ErrStat, ErrMsg ) + call TwrInflArray( p%rotors(iR), u(tIndx)%rotors(iR), m%rotors(iR), m%FVW%r_wind, m%FVW_u(tIndx)%V_wind, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) return endif enddo @@ -2846,7 +3073,8 @@ subroutine SetInputsForFVW(p, u, m, errStat, errMsg) endif do iR =1, size(p%rotors) ! Disturbed inflow for UA on Lifting line Mesh Points - call SetDisturbedInflow(p%rotors(iR), p, u(tIndx)%rotors(iR), m%rotors(iR), errStat, errMsg) + call SetDisturbedInflow(p%rotors(iR), p, u(tIndx)%rotors(iR), m%rotors(iR), errStat2, errMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) do k=1,p%rotors(iR)%NumBlades iW=p%FVW%Bld2Wings(iR,k) m%FVW_u(tIndx)%W(iW)%Vwnd_LL(1:3,:) = m%rotors(iR)%DisturbedInflow(1:3,:,k) @@ -2893,39 +3121,69 @@ subroutine SetInputsForAA(p, u, m, errStat, errMsg) end subroutine SetInputsForAA !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine converts outputs from BEMT (stored in m%BEMT_y) into values on the AeroDyn BladeLoad output mesh. -subroutine SetOutputsFromBEMT(p, m, y ) +subroutine SetOutputsFromBEMT( p, u, m, y ) type(RotParameterType), intent(in ) :: p !< AD parameters + type(RotInputType), intent(in ) :: u !< AD Inputs at Time type(RotOutputType), intent(inout) :: y !< AD outputs type(RotMiscVarType), intent(inout) :: m !< Misc/optimization variables integer(intKi) :: j ! loop counter for nodes integer(intKi) :: k ! loop counter for blades - real(reki) :: force(3) - real(reki) :: moment(3) - real(reki) :: q + real(reki) :: force(3),forceAirfoil(3) + real(reki) :: moment(3),momentAirfoil(3) + real(reki) :: q ! local dynamic pressure + real(reki) :: c ! local chord length + real(reki) :: aoa ! local angle of attack + real(reki) :: Cl,Cd,Cm ! local airfoil lift, drag and pitching moment coefficients + real(reki) :: Cn,Ct ! local airfoil normal and tangential force coefficients - - force(3) = 0.0_ReKi - moment(1:2) = 0.0_ReKi do k=1,p%NumBlades do j=1,p%NumBlNds + ! Compute local Cn and Ct in the airfoil reference frame + aoa = m%BEMT_y%AOA(j,k) + Cl = m%BEMT_y%cl(j,k) + Cd = m%BEMT_y%cd(j,k) + Cm = m%BEMT_y%cm(j,k) + Cn = Cl*cos(aoa) + Cd*sin(aoa) + Ct = -Cl*sin(aoa) + Cd*cos(aoa) ! NOTE: this is not Ct but Cy_a (y_a going towards the TE) + + ! Dimensionalize the aero forces and moment q = 0.5 * p%airDens * m%BEMT_y%Vrel(j,k)**2 ! dynamic pressure of the jth node in the kth blade + c = p%BEMT%chord(j,k) + forceAirfoil(1) = Cn * q * c + forceAirfoil(2) = Ct * q * c + forceAirfoil(3) = 0.0_reki + momentAirfoil(1) = 0.0_reki + momentAirfoil(2) = 0.0_reki + momentAirfoil(3) = Cm * q * c**2 + m%M(j,k) = momentAirfoil(3) ! TODO EB + + ! NOTE! - NOTE! - NOTE! - NOTE! - NOTE! - NOTE! - NOTE! - NOTE! - NOTE! - NOTE! - NOTE! - NOTE! - NOTE! - NOTE! + !EAM (fix this!) These output variables are possibly not what they should be + ! relative to the original AeroDyn manual and intent !!!! force(1) = m%BEMT_y%cx(j,k) * q * p%BEMT%chord(j,k) ! X = normal force per unit length (normal to the plane, not chord) of the jth node in the kth blade force(2) = -m%BEMT_y%cy(j,k) * q * p%BEMT%chord(j,k) ! Y = tangential force per unit length (tangential to the plane, not chord) of the jth node in the kth blade - moment(3)= m%BEMT_y%cm(j,k) * q * p%BEMT%chord(j,k)**2 ! M = pitching moment per unit length of the jth node in the kth blade + force(3) = m%BEMT_y%cz(j,k) * q * p%BEMT%chord(j,k) ! Z = axial force per unit length of the jth node in the kth blade + + moment(1)= m%BEMT_y%Cmx(j,k) * q * p%BEMT%chord(j,k)**2 ! Mx = pitching moment (x-component) per unit length of the jth node in the kth blade + moment(2)= m%BEMT_y%Cmy(j,k) * q * p%BEMT%chord(j,k)**2 ! My = pitching moment (y-component) per unit length of the jth node in the kth blade + moment(3)= m%BEMT_y%Cmz(j,k) * q * p%BEMT%chord(j,k)**2 ! Mz = pitching moment (z-component) per unit length of the jth node in the kth blade ! save these values for possible output later: m%X(j,k) = force(1) m%Y(j,k) = force(2) - m%M(j,k) = moment(3) + m%Z(j,k) = force(3) + m%Mx(j,k) = moment(1) + m%My(j,k) = moment(2) + m%Mz(j,k) = moment(3) ! note: because force and moment are 1-d arrays, I'm calculating the transpose of the force and moment outputs - ! so that I don't have to take the transpose of WithoutSweepPitchTwist(:,:,j,k) - y%BladeLoad(k)%Force(:,j) = matmul( force, m%WithoutSweepPitchTwist(:,:,j,k) ) ! force per unit length of the jth node in the kth blade - y%BladeLoad(k)%Moment(:,j) = matmul( moment, m%WithoutSweepPitchTwist(:,:,j,k) ) ! moment per unit length of the jth node in the kth blade + ! so that I don't have to take the transpose of orientationAnnulus(:,:,j,k) + y%BladeLoad(k)%Force(:,j) = matmul( force, m%orientationAnnulus(:,:,j,k) ) ! force per unit length of the jth node in the kth blade + y%BladeLoad(k)%Moment(:,j) = matmul( moment, m%orientationAnnulus(:,:,j,k) ) ! moment per unit length of the jth node in the kth blade end do !j=nodes end do !k=blades @@ -2989,7 +3247,7 @@ subroutine SetOutputsFromFVW(t, u, p, OtherState, x, xd, m, y, ErrStat, ErrMsg) Vstr = u%rotors(iR)%BladeMotion(k)%TranslationVel(1:3,j) Vwnd = m%rotors(iR)%DisturbedInflow(1:3,j,k) ! NOTE: contains tower shadow theta = m%FVW%W(iW)%PitchAndTwist(j) ! TODO - call FVW_AeroOuts( m%rotors(iR)%WithoutSweepPitchTwist(1:3,1:3,j,k), u%rotors(iR)%BladeMotion(k)%Orientation(1:3,1:3,j), & ! inputs + call FVW_AeroOuts( m%rotors(iR)%orientationAnnulus(1:3,1:3,j,k), u%rotors(iR)%BladeMotion(k)%Orientation(1:3,1:3,j), & ! inputs theta, Vstr(1:3), Vind(1:3), VWnd(1:3), p%rotors(iR)%KinVisc, p%FVW%W(iW)%chord_LL(j), & ! inputs AxInd, TanInd, Vrel, phi, alpha, Re, UrelWind_s(1:3), ErrStat2, ErrMsg2 ) ! outputs call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SetOutputsFromFVW') @@ -3016,7 +3274,7 @@ subroutine SetOutputsFromFVW(t, u, p, OtherState, x, xd, m, y, ErrStat, ErrMsg) u_UA%v_ac(1) = sin(u_UA%alpha)*u_UA%U u_UA%v_ac(2) = cos(u_UA%alpha)*u_UA%U - ! calculated in m%FVW%u_UA??? : u_UA%omega = dot_product( u%rotors(iR)%BladeMotion(k)%RotationVel( :,j), m%rotors(iR)%WithoutSweepPitchTwist(3,:,j,k) ) ! rotation of no-sweep-pitch coordinate system around z of the jth node in the kth blade + ! calculated in m%FVW%u_UA??? : u_UA%omega = dot_product( u%rotors(iR)%BladeMotion(k)%RotationVel( :,j), m%rotors(iR)%orientationAnnulus(3,:,j,k) ) ! rotation of no-sweep-pitch coordinate system around z of the jth node in the kth blade call UA_CalcOutput(j, 1, t, u_UA, m%FVW%W(iW)%p_UA, x%FVW%UA(iW), xd%FVW%UA(iW), OtherState%FVW%UA(iW), p%AFI(p%FVW%W(iW)%AFindx(j,1)), m%FVW%W(iW)%y_UA, m%FVW%W(iW)%m_UA, errStat2, errMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SetOutputsFromFVW') Cl_dyn = m%FVW%W(iW)%y_UA%Cl @@ -3036,12 +3294,16 @@ subroutine SetOutputsFromFVW(t, u, p, OtherState, x, xd, m, y, ErrStat, ErrMsg) ! save these values for possible output later: m%rotors(iR)%X(j,k) = force(1) m%rotors(iR)%Y(j,k) = force(2) - m%rotors(iR)%M(j,k) = moment(3) + m%rotors(iR)%Z(j,k) = 0.0_ReKi + m%rotors(iR)%Mx(j,k) = 0.0_ReKi + m%rotors(iR)%My(j,k) = 0.0_ReKi + m%rotors(iR)%Mz(j,k) = moment(3) + m%rotors(iR)%M(j,k) = moment(3) ! TODO EB ! note: because force and moment are 1-d arrays, I'm calculating the transpose of the force and moment outputs - ! so that I don't have to take the transpose of WithoutSweepPitchTwist(:,:,j,k) - y%rotors(iR)%BladeLoad(k)%Force(:,j) = matmul( force, m%rotors(iR)%WithoutSweepPitchTwist(:,:,j,k) ) ! force per unit length of the jth node in the kth blade - y%rotors(iR)%BladeLoad(k)%Moment(:,j) = matmul( moment, m%rotors(iR)%WithoutSweepPitchTwist(:,:,j,k) ) ! moment per unit length of the jth node in the kth blade + ! so that I don't have to take the transpose of orientationAnnulus(:,:,j,k) + y%rotors(iR)%BladeLoad(k)%Force(:,j) = matmul( force, m%rotors(iR)%orientationAnnulus(:,:,j,k) ) ! force per unit length of the jth node in the kth blade + y%rotors(iR)%BladeLoad(k)%Moment(:,j) = matmul( moment, m%rotors(iR)%orientationAnnulus(:,:,j,k) ) ! moment per unit length of the jth node in the kth blade ! Save results for outputs so we don't have to recalculate them all when we write outputs m%FVW%W(iW)%BN_AxInd(j) = AxInd @@ -3693,8 +3955,17 @@ SUBROUTINE Init_BEMTmodule( InputFileData, RotInputFileData, u_AD, u, p, p_AD, x InitInp%UAMod = InputFileData%UAMod InitInp%Flookup = InputFileData%Flookup InitInp%a_s = InputFileData%SpdSound + InitInp%MomentumCorr = .FALSE. ! TODO EB InitInp%SumPrint = InputFileData%SumPrint InitInp%RootName = p%RootName + if (p%AeroProjMod == APM_BEM_NoSweepPitchTwist) then + InitInp%BEM_Mod = BEMMod_2D + else if (p%AeroProjMod == APM_BEM_Polar) then + InitInp%BEM_Mod = BEMMod_3D + else + InitInp%BEM_Mod = -1 + call SetErrStat(ErrID_Fatal, "AeroProjMod needs to be 0 or 2 when used with BEM", ErrStat, ErrMsg, RoutineName) + endif ! remove the ".AD" from the RootName k = len_trim(InitInp%RootName) if (k>3) then @@ -3866,6 +4137,7 @@ SUBROUTINE Init_OLAF( InputFileData, u_AD, u, p, x, xd, z, OtherState, m, ErrSta ! set the size of the input and xd arrays for passing wind info to FVW. call AllocAry(u_AD%InflowWakeVel, 3, size(m%FVW%r_wind,DIM=2), 'InflowWakeVel', ErrStat2,ErrMsg2); if(Failed()) return + u_AD%InflowWakeVel = 0.0_ReKi ! initialize for safety if (.not. equalRealNos(Interval, p%DT) ) then errStat2=ErrID_Fatal; errMsg2="DTAero was changed in Init_FVWmodule(); this is not allowed yet."; if(Failed()) return diff --git a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 index f07f05c6bd..72a199cce9 100644 --- a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 @@ -19,7 +19,6 @@ MODULE AeroDyn_AllBldNdOuts_IO ! Parameters related to output length (number of characters allowed in the output data headers): -! INTEGER(IntKi), PARAMETER :: OutStrLenM1_Msuffix = ChanLen - 6 ! The NREL allowed channel name length is usually 20. We are making these of the form B#N##namesuffix ! =================================================================================================== @@ -253,7 +252,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx CASE ( BldNd_VUndx ) DO IdxBlade=1,p%BldNd_BladesOut DO IdxNode=1,p%NumBlNds - y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(1,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) + y%WriteOutput( OutIdx ) = dot_product( m%orientationAnnulus(1,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) OutIdx = OutIdx + 1 END DO END DO @@ -262,7 +261,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx CASE ( BldNd_VUndy ) DO IdxBlade=1,p%BldNd_BladesOut DO IdxNode=1,p%NumBlNds - y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(2,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) + y%WriteOutput( OutIdx ) = dot_product( m%orientationAnnulus(2,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) OutIdx = OutIdx + 1 END DO END DO @@ -270,7 +269,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx CASE ( BldNd_VUndz ) DO IdxBlade=1,p%BldNd_BladesOut DO IdxNode=1,p%NumBlNds - y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(3,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) + y%WriteOutput( OutIdx ) = dot_product( m%orientationAnnulus(3,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) OutIdx = OutIdx + 1 END DO END DO @@ -309,7 +308,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx CASE ( BldNd_VDisx ) DO IdxBlade=1,p%BldNd_BladesOut DO IdxNode=1,p%NumBlNds - y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(1,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) + y%WriteOutput( OutIdx ) = dot_product( m%orientationAnnulus(1,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) OutIdx = OutIdx + 1 END DO END DO @@ -317,7 +316,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx CASE ( BldNd_VDisy ) DO IdxBlade=1,p%BldNd_BladesOut DO IdxNode=1,p%NumBlNds - y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(2,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) + y%WriteOutput( OutIdx ) = dot_product( m%orientationAnnulus(2,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) OutIdx = OutIdx + 1 END DO END DO @@ -325,7 +324,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx CASE ( BldNd_VDisz ) DO IdxBlade=1,p%BldNd_BladesOut DO IdxNode=1,p%NumBlNds - y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(3,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) + y%WriteOutput( OutIdx ) = dot_product( m%orientationAnnulus(3,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) OutIdx = OutIdx + 1 END DO END DO @@ -335,7 +334,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx CASE ( BldNd_STVx ) DO IdxBlade=1,p%BldNd_BladesOut DO IdxNode=1,p%NumBlNds - y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(1,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) + y%WriteOutput( OutIdx ) = dot_product( m%orientationAnnulus(1,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) OutIdx = OutIdx + 1 END DO END DO @@ -343,7 +342,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx CASE ( BldNd_STVy ) DO IdxBlade=1,p%BldNd_BladesOut DO IdxNode=1,p%NumBlNds - y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(2,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) + y%WriteOutput( OutIdx ) = dot_product( m%orientationAnnulus(2,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) OutIdx = OutIdx + 1 END DO END DO @@ -351,7 +350,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx CASE ( BldNd_STVz ) DO IdxBlade=1,p%BldNd_BladesOut DO IdxNode=1,p%NumBlNds - y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(3,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) + y%WriteOutput( OutIdx ) = dot_product( m%orientationAnnulus(3,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) OutIdx = OutIdx + 1 END DO END DO @@ -1166,7 +1165,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx DO IdxBlade=1,p%BldNd_BladesOut DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes Vind_s = (/ -m%BEMT_u(Indx)%Vx(IdxNode,IdxBlade)*m%BEMT_y%axInduction(IdxNode,IdxBlade), m%BEMT_u(Indx)%Vy(IdxNode,IdxBlade)*m%BEMT_y%tanInduction(IdxNode,IdxBlade), 0.0_ReKi /) - Vind_g = matmul(Vind_s, m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade)) + Vind_g = matmul(Vind_s, m%orientationAnnulus(:,:,IdxNode,IdxBlade)) y%WriteOutput( OutIdx ) = dot_product(M_pg(1,1:3,IdxBlade), Vind_g(1:3) ) ! Uihn, hub normal OutIdx = OutIdx + 1 ENDDO @@ -1187,7 +1186,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx DO IdxBlade=1,p%BldNd_BladesOut DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes Vind_s = (/ -m%BEMT_u(Indx)%Vx(IdxNode,IdxBlade)*m%BEMT_y%axInduction(IdxNode,IdxBlade), m%BEMT_u(Indx)%Vy(IdxNode,IdxBlade)*m%BEMT_y%tanInduction(IdxNode,IdxBlade), 0.0_ReKi /) - Vind_g = matmul(Vind_s, m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade)) + Vind_g = matmul(Vind_s, m%orientationAnnulus(:,:,IdxNode,IdxBlade)) y%WriteOutput( OutIdx ) = dot_product(M_pg(2,1:3,IdxBlade), Vind_g(1:3) ) ! Uiht, hub tangential OutIdx = OutIdx + 1 ENDDO @@ -1208,7 +1207,7 @@ SUBROUTINE Calc_WriteAllBldNdOutput( p, p_AD, u, m, m_AD, x, y, OtherState, Indx DO IdxBlade=1,p%BldNd_BladesOut DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes Vind_s = (/ -m%BEMT_u(Indx)%Vx(IdxNode,IdxBlade)*m%BEMT_y%axInduction(IdxNode,IdxBlade), m%BEMT_u(Indx)%Vy(IdxNode,IdxBlade)*m%BEMT_y%tanInduction(IdxNode,IdxBlade), 0.0_ReKi /) - Vind_g = matmul(Vind_s, m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade)) + Vind_g = matmul(Vind_s, m%orientationAnnulus(:,:,IdxNode,IdxBlade)) y%WriteOutput( OutIdx ) = dot_product(M_pg(3,1:3,IdxBlade), Vind_g(1:3) ) ! Uihr, hub radial OutIdx = OutIdx + 1 ENDDO @@ -1304,7 +1303,7 @@ SUBROUTINE AllBldNdOuts_SetParameters( InputFileData, p, p_AD, ErrStat, ErrMsg ) ! Check if the requested blades exist - IF ( (InputFileData%BldNd_BladesOut < 0_IntKi) ) then + IF ( (InputFileData%BldNd_BladesOut < 0_IntKi) ) THEN p%BldNd_BladesOut = 0_IntKi ELSE IF ((InputFileData%BldNd_BladesOut > p%NumBlades) ) THEN CALL SetErrStat( ErrID_Warn, " Number of blades to output data at all blade nodes (BldNd_BladesOut) must be no more than the total number of blades, "//TRIM(Num2LStr(p%NumBlades))//".", ErrStat, ErrMsg, RoutineName) diff --git a/modules/aerodyn/src/AeroDyn_Driver_Registry.txt b/modules/aerodyn/src/AeroDyn_Driver_Registry.txt index ca84d6e9e8..9451bdd747 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Driver_Registry.txt @@ -145,6 +145,7 @@ typedef ^ ^ TwrData twr typedef ^ ^ IntKi numBlades - - - "" - typedef ^ ^ logical basicHAWTFormat - - - "If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs" - typedef ^ ^ logical hasTower - - - "" - +typedef ^ ^ IntKi projMod - - - "If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs" - typedef ^ ^ logical HAWTprojection - - - "" - typedef ^ ^ IntKi motionType - - - "" - typedef ^ ^ ReKi motion :: - - "" "-" diff --git a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 index 07735a1fb7..51f6986499 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 @@ -432,11 +432,17 @@ subroutine Init_AeroDyn(iCase, dvr, AD, dt, InitOutData, errStat, errMsg) InitInData%rotors(iWT)%numBlades = wt%numBlades call AllocAry(InitInData%rotors(iWT)%BladeRootPosition, 3, wt%numBlades, 'BladeRootPosition', errStat2, ErrMsg2 ); if (Failed()) return call AllocAry(InitInData%rotors(iWT)%BladeRootOrientation, 3, 3, wt%numBlades, 'BladeRootOrientation', errStat2, ErrMsg2 ); if (Failed()) return - if (wt%HAWTprojection) then - InitInData%rotors(iWT)%AeroProjMod = 0 ! default, with WithoutSweepPitchTwist + if (wt%projMod==-1)then + call WrScr('>>> Using HAWTprojection to determine projMod') + if (wt%HAWTprojection) then + InitInData%rotors(iWT)%AeroProjMod = APM_BEM_NoSweepPitchTwist ! default, with WithoutSweepPitchTwist + else + InitInData%rotors(iWT)%AeroProjMod = APM_LiftingLine + endif else - InitInData%rotors(iWT)%AeroProjMod = 1 + InitInData%rotors(iWT)%AeroProjMod = wt%projMod endif + call WrScr('>>> Using projection method '//trim(num2lstr(InitInData%rotors(iWT)%AeroProjMod))) InitInData%rotors(iWT)%HubPosition = wt%hub%ptMesh%Position(:,1) InitInData%rotors(iWT)%HubOrientation = wt%hub%ptMesh%RefOrientation(:,:,1) InitInData%rotors(iWT)%NacellePosition = wt%nac%ptMesh%Position(:,1) @@ -1350,6 +1356,13 @@ subroutine Dvr_ReadInputFile(fileName, dvr, errStat, errMsg ) wt => dvr%WT(iWT) sWT = '('//trim(num2lstr(iWT))//')' call ParseCom(FileInfo_In, CurLine, Line, errStat2, errMsg2, unEc); if(Failed()) return + ! Temporary hack, look if ProjMod is present on the line + !call ParseVar(FileInfo_In, CurLine, 'ProjMod'//sWT , wt%projMod , errStat2, errMsg2, unEc); if(Failed()) return + call ParseVar(FileInfo_In, CurLine, 'ProjMod'//sWT , wt%projMod , errStat2, errMsg2, unEc); + if (errStat2==ErrID_Fatal) then + call WrScr('>>> ProjMod is not present in AeroDyn driver input file.') + wt%projMod = -1 + endif call ParseVar(FileInfo_In, CurLine, 'BasicHAWTFormat'//sWT , wt%basicHAWTFormat , errStat2, errMsg2, unEc); if(Failed()) return ! Basic init diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index 6169d5dde3..cdcee60a71 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -190,6 +190,7 @@ MODULE AeroDyn_Driver_Types INTEGER(IntKi) :: numBlades !< [-] LOGICAL :: basicHAWTFormat !< If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs [-] LOGICAL :: hasTower !< [-] + INTEGER(IntKi) :: projMod !< If true simply input HubRad/Pitch/Overhang/Cone, otherwise all turbine inputs [-] LOGICAL :: HAWTprojection !< [-] INTEGER(IntKi) :: motionType !< [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: motion !< [-] @@ -5821,6 +5822,7 @@ SUBROUTINE AD_Dvr_CopyWTData( SrcWTDataData, DstWTDataData, CtrlCode, ErrStat, E DstWTDataData%numBlades = SrcWTDataData%numBlades DstWTDataData%basicHAWTFormat = SrcWTDataData%basicHAWTFormat DstWTDataData%hasTower = SrcWTDataData%hasTower + DstWTDataData%projMod = SrcWTDataData%projMod DstWTDataData%HAWTprojection = SrcWTDataData%HAWTprojection DstWTDataData%motionType = SrcWTDataData%motionType IF (ALLOCATED(SrcWTDataData%motion)) THEN @@ -6070,6 +6072,7 @@ SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 1 ! numBlades Int_BufSz = Int_BufSz + 1 ! basicHAWTFormat Int_BufSz = Int_BufSz + 1 ! hasTower + Int_BufSz = Int_BufSz + 1 ! projMod Int_BufSz = Int_BufSz + 1 ! HAWTprojection Int_BufSz = Int_BufSz + 1 ! motionType Int_BufSz = Int_BufSz + 1 ! motion allocated yes/no @@ -6337,6 +6340,8 @@ SUBROUTINE AD_Dvr_PackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%hasTower, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%projMod + Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%HAWTprojection, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%motionType @@ -6732,6 +6737,8 @@ SUBROUTINE AD_Dvr_UnPackWTData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Xferred = Int_Xferred + 1 OutData%hasTower = TRANSFER(IntKiBuf(Int_Xferred), OutData%hasTower) Int_Xferred = Int_Xferred + 1 + OutData%projMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%HAWTprojection = TRANSFER(IntKiBuf(Int_Xferred), OutData%HAWTprojection) Int_Xferred = Int_Xferred + 1 OutData%motionType = IntKiBuf(Int_Xferred) diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index 015f39290b..257100e717 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -22,7 +22,7 @@ MODULE AeroDyn_IO use NWTC_Library use AeroDyn_Types - use BEMTUncoupled, only : SkewMod_Orthogonal, SkewMod_Uncoupled, SkewMod_PittPeters, VelocityIsZero + use BEMTUncoupled, only : VelocityIsZero use FVW_Subs, only : FVW_AeroOuts USE AeroDyn_AllBldNdOuts_IO @@ -2048,21 +2048,21 @@ subroutine Calc_WriteOutput_AD() end if ! blade outputs - do k=1,min(p%numBlades,3) ! limit this + do k=1,min(p%numBlades,AD_MaxBl_Out) ! limit this do beta=1,p%NBlOuts j=p%BlOutNd(beta) - tmp = matmul( m%WithoutSweepPitchTwist(:,:,j,k), u%InflowOnBlade(:,j,k) ) + tmp = matmul( m%orientationAnnulus(:,:,j,k), u%InflowOnBlade(:,j,k) ) m%AllOuts( BNVUndx(beta,k) ) = tmp(1) m%AllOuts( BNVUndy(beta,k) ) = tmp(2) m%AllOuts( BNVUndz(beta,k) ) = tmp(3) - tmp = matmul( m%WithoutSweepPitchTwist(:,:,j,k), m%DisturbedInflow(:,j,k) ) + tmp = matmul( m%orientationAnnulus(:,:,j,k), m%DisturbedInflow(:,j,k) ) m%AllOuts( BNVDisx(beta,k) ) = tmp(1) m%AllOuts( BNVDisy(beta,k) ) = tmp(2) m%AllOuts( BNVDisz(beta,k) ) = tmp(3) - tmp = matmul( m%WithoutSweepPitchTwist(:,:,j,k), u%BladeMotion(k)%TranslationVel(:,j) ) + tmp = matmul( m%orientationAnnulus(:,:,j,k), u%BladeMotion(k)%TranslationVel(:,j) ) m%AllOuts( BNSTVx( beta,k) ) = tmp(1) m%AllOuts( BNSTVy( beta,k) ) = tmp(2) m%AllOuts( BNSTVz( beta,k) ) = tmp(3) @@ -2091,7 +2091,7 @@ subroutine Calc_WriteOutput_AD() ! blade node tower clearance (requires tower influence calculation): if (p%TwrPotent /= TwrPotent_none .or. p%TwrShadow /= TwrShadow_none) then - do k=1,p%numBlades + do k=1,min(p%numBlades,AD_MaxBl_Out) do beta=1,p%NBlOuts j=p%BlOutNd(beta) m%AllOuts( BNClrnc( beta,k) ) = m%TwrClrnc(j,k) @@ -2204,7 +2204,7 @@ subroutine Calc_WriteOutput_BEMT() ! blade outputs - do k=1,min(p%numBlades,size(BAzimuth) ) ! limit this + do k=1,min(p%numBlades,AD_MaxBl_Out) ! limit this m%AllOuts( BAzimuth(k) ) = MODULO( m%BEMT_u(indx)%psi(k)*R2D, 360.0_ReKi ) ! m%AllOuts( BPitch( k) ) = calculated in SetInputsForBEMT @@ -2338,7 +2338,7 @@ end subroutine Calc_WriteOutput_FVW END SUBROUTINE Calc_WriteOutput !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadInputFiles( InputFileName, InputFileData, Default_DT, OutFileRoot, NumBlades, UnEcho, ErrStat, ErrMsg ) +SUBROUTINE ReadInputFiles( InputFileName, InputFileData, Default_DT, OutFileRoot, NumBlades, AeroProjMod, UnEcho, ErrStat, ErrMsg ) ! This subroutine reads the input file and stores all the data in the AD_InputFile structure. ! It does not perform data validation. !.................................................................................................................................. @@ -2353,6 +2353,7 @@ SUBROUTINE ReadInputFiles( InputFileName, InputFileData, Default_DT, OutFileRoot INTEGER(IntKi), INTENT(INOUT) :: UnEcho ! Unit number for the echo file INTEGER(IntKi), INTENT(IN) :: NumBlades(:) ! Number of blades per rotor + INTEGER(IntKi), INTENT(IN) :: AeroProjMod(:) ! AeroProjMod per rotor INTEGER(IntKi), INTENT(OUT) :: ErrStat ! The error status code CHARACTER(*), INTENT(OUT) :: ErrMsg ! The error message, if an error occurred @@ -2387,7 +2388,7 @@ SUBROUTINE ReadInputFiles( InputFileName, InputFileData, Default_DT, OutFileRoot !FIXME: add options for passing the blade files. This routine will need restructuring to handle that. DO I=1,NumBlades(iR) - CALL ReadBladeInputs ( InputFileData%ADBlFile(iBld), InputFileData%rotors(iR)%BladeProps(I), UnEcho, ErrStat2, ErrMsg2 ) + CALL ReadBladeInputs ( InputFileData%ADBlFile(iBld), InputFileData%rotors(iR)%BladeProps(I), AeroProjMod(iR), UnEcho, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName//TRIM(':Blade')//TRIM(Num2LStr(I))) IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() @@ -2803,7 +2804,7 @@ end function FailedNodal !------------------------------------------------------------------------------------------------- END SUBROUTINE ParsePrimaryFileInfo !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, UnEc, ErrStat, ErrMsg ) +SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, AeroProjMod, UnEc, ErrStat, ErrMsg ) ! This routine reads a blade input file. !.................................................................................................................................. @@ -2812,6 +2813,7 @@ SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, UnEc, ErrStat, ErrMs TYPE(AD_BladePropsType), INTENT(INOUT) :: BladeKInputFileData ! Data for Blade K stored in the module's input file CHARACTER(*), INTENT(IN) :: ADBlFile ! Name of the blade input file data + INTEGER(IntKi), INTENT(IN) :: AeroProjMod ! AeroProjMod INTEGER(IntKi), INTENT(IN) :: UnEc ! I/O unit for echo file. If present and > 0, write to UnEc INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Error status @@ -2947,6 +2949,22 @@ SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, UnEc, ErrStat, ErrMs BladeKInputFileData%BlAFID(I), BladeKInputFileData%BlCb(I), BladeKInputFileData%BlCenBn(I), BladeKInputFileData%BlCenBt(I) END IF END DO + + + if (all(BladeKInputFileData%BlCrvAC.eq.0.0_ReKi)) then + BladeKInputFileData%BlCrvAng = 0.0_ReKi + else + if (AeroProjMod==APM_BEM_NoSweepPitchTwist .or. AeroProjMod==APM_LiftingLine) then + !call WrScr('>>> ReadBladeInputs: Not computing cant angle (BlCrvAng), AeroProjMod='//trim(num2lstr(AeroProjMod))) + else if (AeroProjMod==APM_BEM_Polar) then + call WrScr('>>> ReadBladeInputs: Computing cant angle (BlCrvAng), AeroProjMod='//trim(num2lstr(AeroProjMod))) + call calcCantAngle(BladeKInputFileData%BlCrvAC,BladeKInputFileData%BlSpn,3, size(BladeKInputFileData%BlSpn),BladeKInputFileData%BlCrvAng) + else + call SetErrStat(ErrID_Fatal, 'Unsupported AeroProjMod='//trim(num2lstr(AeroProjMod)), ErrStat, ErrMsg, RoutineName) + call Cleanup() + return + endif + endif BladeKInputFileData%BlCrvAng = BladeKInputFileData%BlCrvAng*D2R BladeKInputFileData%BlTwist = BladeKInputFileData%BlTwist*D2R @@ -4101,4 +4119,413 @@ END SUBROUTINE SetOutParam +subroutine calcCantAngle(f, xi,stencilSize,n,cantAngle) +! This subroutine calculates implicit cant angle based on the blade reference line that includes prebend. + implicit none + integer(IntKi), intent(in) :: stencilSize, n + integer(IntKi) :: i, j + integer(IntKi) :: sortInd(n) + integer(IntKi) :: info + real(ReKi), intent(in) :: f(n), xi(n) + real(ReKi) :: cx(stencilSize), cf(stencilSize), xiIn(stencilSize) + real(ReKi) :: fIn(stencilSize), cPrime(n), fPrime(n), xiAbs(n) + real(ReKi), intent(inout) :: cantAngle(n) + + !dimension :: f(n),xi(n), sortInd(n), cx(stencilSize),cf(stencilSize), xiIn(stencilSize) + !dimension :: cantAngle(n), fIn(stencilSize), cPrime(n), fPrime(n), indexIn(stencilSize), xiAbs(n) + + + + do i = 1,size(xi) + + xiAbs = abs(xi-xi(i)) + call hpsort_eps_epw (n, xiAbs, sortInd, 1e-6) + + if (i.eq.1) then + fIn = f(1:stencilSize) + xiIn = xi(1:stencilSize) + call differ_stencil ( xi(i), 1, 2, xiIn, cx, info ) + if (info /= 0) return ! use default cantAngle in this case + call differ_stencil ( xi(i), 1, 2, fIn, cf, info ) + if (info /= 0) return ! use default cantAngle in this case + elseif (i.eq.size(xi)) then + fIn = f(size(xi)-stencilSize +1:size(xi)) + xiIn = xi(size(xi)-stencilSize+1:size(xi)) + call differ_stencil ( xi(i), 1, 2, xiIn, cx, info ) + if (info /= 0) return ! use default cantAngle in this case + call differ_stencil ( xi(i), 1, 2, fIn, cf, info ) + if (info /= 0) return ! use default cantAngle in this case + else + fIn = f(i-1:i+1) + xiIn = xi(i-1:i+1) + call differ_stencil ( xi(i), 1, 2, xiIn, cx, info ) + if (info /= 0) return ! use default cantAngle in this case + call differ_stencil ( xi(i), 1, 2, fIn, cf, info ) + if (info /= 0) return ! use default cantAngle in this case + endif + + cPrime(i) = 0.0 + fPrime(i) = 0.0 + + do j = 1,size(cx) + cPrime(i) = cPrime(i) + cx(j)*xiIn(j) + fPrime(i) = fPrime(i) + cx(j)*fIn(j) + end do + cantAngle(i) = atan2(fPrime(i),cPrime(i))*180_ReKi/pi + end do + +end subroutine calcCantAngle + + + +subroutine differ_stencil ( x0, o, p, x, c, info ) + +!*****************************************************************************80 +! +!! DIFFER_STENCIL computes finite difference coefficients. +! +! Discussion: +! +! We determine coefficients C to approximate the derivative at X0 +! of order O and precision P, using finite differences, so that +! +! d^o f(x)/dx^o (x0) = sum ( 0 <= i <= o+p-1 ) c(i) f(x(i)) +! + O(h^(p)) +! +! where H is the maximum spacing between X0 and any X(I). +! +! Licensing: +! +! This code is distributed under the GNU LGPL license. +! +! Modified: +! +! 10 November 2013 +! +! Author: +! +! John Burkardt +! +! Parameters: +! +! Input, real ( kind = 8 ) X0, the point where the derivative is to +! be approximated. +! +! Input, integer ( kind = 4 ) O, the order of the derivative to be +! approximated. 1 <= O. +! +! Input, integer ( kind = 4 ) P, the order of the error, as a power of H. +! +! Input, real ( kind = 8 ) X(O+P), the evaluation points. +! +! Output, real ( kind = 8 ) C(O+P), the coefficients. +! + implicit none + + integer(IntKi), intent(in) :: o + integer(IntKi), intent(in) :: p + + real(ReKi) :: b(o+p) + real(ReKi), intent(out) :: c(o+p) + real(ReKi) :: dx(o+p) + integer(IntKi) :: i + integer(IntKi), intent(out) :: info + integer(IntKi) :: job + integer(IntKi) :: n + real(R8Ki) :: r8_factorial + real(ReKi), intent(in) :: x(o+p) + real(ReKi), intent(in) :: x0 + + n = o + p + + dx(1:n) = x(1:n) - x0 + + b(1:o+p) = 0.0D+00 + b(o+1) = 1.0D+00 + + job = 0 + call r8vm_sl ( n, dx, b, c, job, info ) + + if ( info /= 0 ) then + call WrScr('DIFFER_STENCIL: Vandermonde linear system is singular.') + return + end if + r8_factorial = 1.0D+00 + do i = 1,o + r8_factorial = r8_factorial*i + end do + c(1:n) = c(1:n) * r8_factorial + + return + +end subroutine differ_stencil + +subroutine r8vm_sl ( n, a, b, x, job, info ) + +!*****************************************************************************80 +! +!! R8VM_SL solves an R8VM linear system. +! +! Discussion: +! +! The R8VM storage format is used for an M by N Vandermonde matrix. +! An M by N Vandermonde matrix is defined by the values in its second +! row, which will be written here as X(1:N). The matrix has a first +! row of 1's, a second row equal to X(1:N), a third row whose entries +! are the squares of the X values, up to the M-th row whose entries +! are the (M-1)th powers of the X values. The matrix can be stored +! compactly by listing just the values X(1:N). +! +! Vandermonde systems are very close to singularity. The singularity +! gets worse as N increases, and as any pair of values defining +! the matrix get close. Even a system as small as N = 10 will +! involve the 9th power of the defining values. +! +! Licensing: +! +! This code is distributed under the GNU LGPL license. +! +! Modified: +! +! 29 September 2003 +! +! Author: +! +! John Burkardt. +! +! Reference: +! +! Gene Golub, Charles Van Loan, +! Matrix Computations, +! Third Edition, +! Johns Hopkins, 1996. +! +! Parameters: +! +! Input, integer ( kind = 4 ) N, the number of rows and columns of +! the matrix. +! +! Input, real ( kind = 8 ) A(N), the R8VM matrix. +! +! Input, real ( kind = 8 ) B(N), the right hand side. +! +! Output, real ( kind = 8 ) X(N), the solution of the linear system. +! +! Input, integer ( kind = 4 ) JOB, specifies the system to solve. +! 0, solve A * x = b. +! nonzero, solve A' * x = b. +! +! Output, integer ( kind = 4 ) INFO. +! 0, no error. +! nonzero, at least two of the values in A are equal. +! + implicit none + + integer (IntKi ), intent(in) :: n + + real(ReKi), intent(in) :: a(n) + real(ReKi), intent(in) :: b(n) + integer(IntKi) :: i + integer(IntKi), intent(out) :: info + integer(IntKi) :: j + integer(IntKi), intent(in) :: job + real(ReKi), intent(out) :: x(n) +! +! Check for explicit singularity. +! + info = 0 + + do j = 1, n - 1 + do i = j + 1, n + if ( a(i) == a(j) ) then + info = 1 + return + end if + end do + end do + + x(1:n) = b(1:n) + + if ( job == 0 ) then + + do j = 1, n - 1 + do i = n, j + 1, -1 + x(i) = x(i) - a(j) * x(i-1) + end do + end do + + do j = n - 1, 1, -1 + + do i = j + 1, n + x(i) = x(i) / ( a(i) - a(i-j) ) + end do + + do i = j, n - 1 + x(i) = x(i) - x(i+1) + end do + + end do + + else + + do j = 1, n - 1 + do i = n, j + 1, -1 + x(i) = ( x(i) - x(i-1) ) / ( a(i) - a(i-j) ) + end do + end do + + do j = n - 1, 1, -1 + do i = j, n - 1 + x(i) = x(i) - x(i+1) * a(j) + end do + end do + + end if + + return +end subroutine r8vm_sl + +! + ! Copyright (C) 2010-2016 Samuel Ponce', Roxana Margine, Carla Verdi, Feliciano Giustino + ! Copyright (C) 2007-2009 Jesse Noffsinger, Brad Malone, Feliciano Giustino + ! + ! This file is distributed under the terms of the GNU General Public + ! License. See the file `LICENSE' in the root directory of the + ! present distribution, or http://www.gnu.org/copyleft.gpl.txt . + ! + ! Adapted from flib/hpsort_eps + !--------------------------------------------------------------------- + subroutine hpsort_eps_epw (n, ra, ind, eps) + !--------------------------------------------------------------------- + ! sort an array ra(1:n) into ascending order using heapsort algorithm, + ! and considering two elements being equal if their values differ + ! for less than "eps". + ! n is input, ra is replaced on output by its sorted rearrangement. + ! create an index table (ind) by making an exchange in the index array + ! whenever an exchange is made on the sorted data array (ra). + ! in case of equal values in the data array (ra) the values in the + ! index array (ind) are used to order the entries. + ! if on input ind(1) = 0 then indices are initialized in the routine, + ! if on input ind(1) != 0 then indices are assumed to have been + ! initialized before entering the routine and these + ! indices are carried around during the sorting process + ! + ! no work space needed ! + ! free us from machine-dependent sorting-routines ! + ! + ! adapted from Numerical Recipes pg. 329 (new edition) + ! + !use kinds, ONLY : DP + implicit none + !-input/output variables + integer(IntKi), intent(in) :: n + real(ReKi), intent(in) :: eps + integer(IntKi) :: ind (n) + real(ReKi) :: ra (n) + !-local variables + integer(IntKi) :: i, ir, j, l, iind + real(ReKi) :: rra +! + ! initialize index array + IF (ind (1) .eq.0) then + DO i = 1, n + ind (i) = i + ENDDO + ENDIF + ! nothing to order + IF (n.lt.2) return + ! initialize indices for hiring and retirement-promotion phase + l = n / 2 + 1 + + ir = n + + sorting: do + + ! still in hiring phase + IF ( l .gt. 1 ) then + l = l - 1 + rra = ra (l) + iind = ind (l) + ! in retirement-promotion phase. + ELSE + ! clear a space at the end of the array + rra = ra (ir) + ! + iind = ind (ir) + ! retire the top of the heap into it + ra (ir) = ra (1) + ! + ind (ir) = ind (1) + ! decrease the size of the corporation + ir = ir - 1 + ! done with the last promotion + IF ( ir .eq. 1 ) then + ! the least competent worker at all ! + ra (1) = rra + ! + ind (1) = iind + exit sorting + ENDIF + ENDIF + ! wheter in hiring or promotion phase, we + i = l + ! set up to place rra in its proper level + j = l + l + ! + DO while ( j .le. ir ) + IF ( j .lt. ir ) then + ! compare to better underling + IF ( hslt( ra (j), ra (j + 1) ) ) then + j = j + 1 + !else if ( .not. hslt( ra (j+1), ra (j) ) ) then + ! this means ra(j) == ra(j+1) within tolerance + ! if (ind (j) .lt.ind (j + 1) ) j = j + 1 + ENDIF + ENDIF + ! demote rra + IF ( hslt( rra, ra (j) ) ) then + ra (i) = ra (j) + ind (i) = ind (j) + i = j + j = j + j + !else if ( .not. hslt ( ra(j) , rra ) ) then + !this means rra == ra(j) within tolerance + ! demote rra + ! if (iind.lt.ind (j) ) then + ! ra (i) = ra (j) + ! ind (i) = ind (j) + ! i = j + ! j = j + j + ! else + ! set j to terminate do-while loop + ! j = ir + 1 + ! endif + ! this is the right place for rra + ELSE + ! set j to terminate do-while loop + j = ir + 1 + ENDIF + ENDDO + ra (i) = rra + ind (i) = iind + + END DO sorting +contains + + ! internal function + ! compare two real number and return the result + + logical function hslt( a, b ) + REAL(ReKi) :: a, b + IF( abs(a-b) < eps ) then + hslt = .false. + ELSE + hslt = ( a < b ) + end if + end function hslt + + ! +end subroutine hpsort_eps_epw + +!---------------------------------------------------------------------------------------------------------------------------------- END MODULE AeroDyn_IO diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index 4cc668e739..07b82543c0 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -34,6 +34,16 @@ param ^ - IntKi TwrShadow_none - 0 - "no tower s param ^ - IntKi TwrShadow_Powles - 1 - "Powles tower shadow model" - param ^ - IntKi TwrShadow_Eames - 2 - "Eames tower shadow model" - +# AeroProjMod (APM) +param ^ - IntKi APM_BEM_NoSweepPitchTwist - 1 - "Original AeroDyn model where momentum balance is done in the WithoutSweepPitchTwist system" - +param ^ - IntKi APM_BEM_Polar - 2 - "Use staggered polar grid for momentum balance in each annulus" - +param ^ - IntKi APM_LiftingLine - 3 - "Use the blade lifting line (i.e. the structural) orientation (currently for OLAF with VAWT)" - + + +# if more than AD_MaxBl_Out blades are used in the simulation, not all channels will have output information for the "extra" blades. +# Also, the AD input file will require more lines for the additional blades. +param ^ - IntKi AD_MaxBl_Out - 3 - "Maximum number of blades for information output (or linearization)" - + # ..... Initialization data ....................................................................................................... # Define inputs that the initialization routine may need here: @@ -44,7 +54,7 @@ typedef ^ RotInitInputType ReKi BladeRootPosition {:}{:} - - "X-Y-Z reference po typedef ^ RotInitInputType R8Ki BladeRootOrientation {:}{:}{:} - - "DCM reference orientation of blade roots (3x3 x NumBlades)" - typedef ^ RotInitInputType R8Ki NacellePosition {3} - - "X-Y-Z reference position of nacelle" m typedef ^ RotInitInputType R8Ki NacelleOrientation {3}{3} - - "DCM reference orientation of nacelle" - -typedef ^ RotInitInputType IntKi AeroProjMod - 0 - "Flag to switch between different projection models" - +typedef ^ RotInitInputType IntKi AeroProjMod - 1 - "Flag to switch between different projection models" - typedef ^ InitInputType RotInitInputType rotors {:} - - "Init Input Types for rotors" - typedef ^ InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - @@ -62,7 +72,6 @@ typedef ^ InitInputType ReKi defPvap - - - "Default vapor press typedef ^ InitInputType ReKi WtrDpth - - - "Water depth" m typedef ^ InitInputType ReKi MSL2SWL - - - "Offset between still-water level and mean sea level" m - # This is data defined in the Input File for this module (or could otherwise be passed in) # ..... Blade Input file data ..................................................................................................... typedef ^ AD_BladePropsType IntKi NumBlNds - - - "Number of blade nodes used in the analysis" - @@ -218,7 +227,7 @@ typedef ^ RotMiscVarType AA_OutputType AA_y - - - "Outputs from the AA module" - typedef ^ RotMiscVarType AA_InputType AA_u - - - "Inputs to the AA module" - typedef ^ RotMiscVarType ReKi DisturbedInflow {:}{:}{:} - - "InflowOnBlade values modified by tower influence" m/s -typedef ^ RotMiscVarType ReKi WithoutSweepPitchTwist {:}{:}{:}{:} - - "Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles" - +typedef ^ RotMiscVarType R8Ki orientationAnnulus {:}{:}{:}{:} - - "Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles" - typedef ^ RotMiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" - typedef ^ RotMiscVarType ReKi W_Twr {:} - - "relative wind speed normal to the tower at node j" m/s typedef ^ RotMiscVarType ReKi X_Twr {:} - - "local x-component of force per unit length of the jth node in the tower" m/s @@ -227,8 +236,14 @@ typedef ^ RotMiscVarType ReKi Curve {:}{:} - - "curvature angle, saved for possi typedef ^ RotMiscVarType ReKi TwrClrnc {:}{:} - - "Distance between tower (including tower radius) and blade node (not including blade width), saved for possible output to file" m typedef ^ RotMiscVarType ReKi X {:}{:} - - "normal force per unit length (normal to the plane, not chord) of the jth node in the kth blade" N/m typedef ^ RotMiscVarType ReKi Y {:}{:} - - "tangential force per unit length (tangential to the plane, not chord) of the jth node in the kth blade" N/m +typedef ^ RotMiscVarType ReKi Z {:}{:} - - "axial force per unit length (tangential to the plane, not chord) of the jth node in the kth blade" N/m typedef ^ RotMiscVarType ReKi M {:}{:} - - "pitching moment per unit length of the jth node in the kth blade" Nm/m +typedef ^ RotMiscVarType ReKi Mx {:}{:} - - "pitching moment per unit length of the jth node in the kth blade (in x direction)" Nm/m +typedef ^ RotMiscVarType ReKi My {:}{:} - - "pitching moment per unit length of the jth node in the kth blade (in y direction)" Nm/m +typedef ^ RotMiscVarType ReKi Mz {:}{:} - - "pitching moment per unit length of the jth node in the kth blade (in z direction)" Nm/m typedef ^ RotMiscVarType ReKi V_DiskAvg {3} - - "disk-average relative wind speed" m/s +typedef ^ RotMiscVarType ReKi yaw - - - "Yaw calculated in SetInputsForBEMT" rad +typedef ^ RotMiscVarType ReKi tilt - - - "tilt calculated in SetInputsForBEMT" rad typedef ^ RotMiscVarType ReKi hub_theta_x_root {:} - - "angles saved for FAST.Farm" rad typedef ^ RotMiscVarType ReKi V_dot_x - - - typedef ^ RotMiscVarType MeshType HubLoad - - - "mesh at hub; used to compute an integral for mapping the output blade loads to a single point (for writing to file only)" - @@ -252,6 +267,8 @@ typedef ^ RotMiscVarType MeshMapType B_P_2_B_L {:} - - "mapping data structure t typedef ^ RotMiscVarType MeshType TwrBuoyLoadPoint - - - "point mesh for lumped buoyant tower loads" - typedef ^ RotMiscVarType MeshType TwrBuoyLoad - - - "line mesh for per unit length buoyant tower loads" - typedef ^ RotMiscVarType MeshMapType T_P_2_T_L - - - "mapping data structure to map buoyant tower point loads (m%TwrBuoyLoadPoint) to buoyant tower line loads (m%TwrBuoyLoad)" +typedef ^ RotMiscVarType Logical FirstWarn_TowerStrike - - - "flag to avoid printing tower strike multiple times" - +typedef ^ RotMiscVarType ReKi AvgDiskVel {3} - - "disk-averaged U,V,W" m/s typedef ^ MiscVarType RotMiscVarType rotors {:}- - - "MiscVars for each rotor" - typedef ^ MiscVarType FVW_InputType FVW_u : - - "Inputs to the FVW module" - @@ -267,6 +284,7 @@ typedef ^ RotParameterType IntKi NumTwrNds - - - "Number of nodes on the tower" typedef ^ RotParameterType ReKi TwrDiam {:} - - "Diameter of tower at node" m typedef ^ RotParameterType ReKi TwrCd {:} - - "Coefficient of drag at tower node" - typedef ^ RotParameterType ReKi TwrTI {:} - - "Turbulence intensity for tower shadow at tower node" - +typedef ^ ^ ReKi BlTwist {:}{:} - - "Twist at blade node" radians typedef ^ RotParameterType ReKi TwrCb {:} - - "Coefficient of buoyancy at tower node" - typedef ^ RotParameterType ReKi BlCenBn {:}{:} - - "Normal offset between aerodynamic center and center of buoyancy at blade node" m typedef ^ RotParameterType ReKi BlCenBt {:}{:} - - "Tangential offset between aerodynamic center and center of buoyancy at blade node" m @@ -288,6 +306,8 @@ typedef ^ RotParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pa typedef ^ RotParameterType ReKi du {:} - - "vector that determines size of perturbation for u (inputs)" typedef ^ RotParameterType ReKi dx {:} - - "vector that determines size of perturbation for x (continuous states)" typedef ^ RotParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - +typedef ^ RotParameterType Integer NumBl_Lin - - - "number of blades in the jacobian" - + typedef ^ RotParameterType IntKi TwrPotent - - - "Type of tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - typedef ^ RotParameterType IntKi TwrShadow - - - "Type of tower influence on wind based on downstream tower shadow {0=none, 1=Powles model, 2=Eames model}" - typedef ^ RotParameterType LOGICAL TwrAero - - - "Calculate tower aerodynamic loads?" flag @@ -303,7 +323,7 @@ typedef ^ RotParameterType ReKi Patm - - - "Atmospheric pressu typedef ^ RotParameterType ReKi Pvap - - - "Vapour pressure" Pa typedef ^ RotParameterType ReKi WtrDpth - - - "Water depth" m typedef ^ RotParameterType ReKi MSL2SWL - - - "Offset between still-water level and mean sea level" m -typedef ^ RotParameterType IntKi AeroProjMod - 0 - "Flag to switch between different projection models" - +typedef ^ RotParameterType IntKi AeroProjMod - 1 - "Flag to switch between different projection models" - # parameters for output typedef ^ RotParameterType IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - typedef ^ RotParameterType CHARACTER(1024) RootName - - - "RootName for writing output files" - @@ -328,6 +348,7 @@ typedef ^ ParameterType AFI_ParameterType AFI {:} - - "AirfoilInfo parameters" typedef ^ ParameterType IntKi SkewMod - - - "Type of skewed-wake correction model {0=orthogonal, 1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0]" - typedef ^ ParameterType IntKi WakeMod - - - "Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW}" - typedef ^ ParameterType FVW_ParameterType FVW - - - "Parameters for FVW module" +typedef ^ ParameterType LOGICAL CompAeroMaps - .FALSE. - "flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false)" - typedef ^ ParameterType LOGICAL UA_Flag - - - "logical flag indicating whether to use UnsteadyAero" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 28bdc5849f..16d65e9e35 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -50,6 +50,10 @@ MODULE AeroDyn_Types INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_none = 0 ! no tower shadow [-] INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_Powles = 1 ! Powles tower shadow model [-] INTEGER(IntKi), PUBLIC, PARAMETER :: TwrShadow_Eames = 2 ! Eames tower shadow model [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: APM_BEM_NoSweepPitchTwist = 1 ! Original AeroDyn model where momentum balance is done in the WithoutSweepPitchTwist system [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: APM_BEM_Polar = 2 ! Use staggered polar grid for momentum balance in each annulus [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: APM_LiftingLine = 3 ! Use the blade lifting line (i.e. the structural) orientation (currently for OLAF with VAWT) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: AD_MaxBl_Out = 3 ! Maximum number of blades for information output (or linearization) [-] ! ========= RotInitInputType ======= TYPE, PUBLIC :: RotInitInputType INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] @@ -59,7 +63,7 @@ MODULE AeroDyn_Types REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: BladeRootOrientation !< DCM reference orientation of blade roots (3x3 x NumBlades) [-] REAL(R8Ki) , DIMENSION(1:3) :: NacellePosition !< X-Y-Z reference position of nacelle [m] REAL(R8Ki) , DIMENSION(1:3,1:3) :: NacelleOrientation !< DCM reference orientation of nacelle [-] - INTEGER(IntKi) :: AeroProjMod = 0 !< Flag to switch between different projection models [-] + INTEGER(IntKi) :: AeroProjMod = 1 !< Flag to switch between different projection models [-] END TYPE RotInitInputType ! ======================= ! ========= AD_InitInputType ======= @@ -258,7 +262,7 @@ MODULE AeroDyn_Types TYPE(AA_OutputType) :: AA_y !< Outputs from the AA module [-] TYPE(AA_InputType) :: AA_u !< Inputs to the AA module [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: DisturbedInflow !< InflowOnBlade values modified by tower influence [m/s] - REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WithoutSweepPitchTwist !< Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles [-] + REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: orientationAnnulus !< Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AllOuts !< An array holding the value of all of the calculated (not only selected) output channels [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: W_Twr !< relative wind speed normal to the tower at node j [m/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: X_Twr !< local x-component of force per unit length of the jth node in the tower [m/s] @@ -267,8 +271,14 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TwrClrnc !< Distance between tower (including tower radius) and blade node (not including blade width), saved for possible output to file [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: X !< normal force per unit length (normal to the plane, not chord) of the jth node in the kth blade [N/m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Y !< tangential force per unit length (tangential to the plane, not chord) of the jth node in the kth blade [N/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Z !< axial force per unit length (tangential to the plane, not chord) of the jth node in the kth blade [N/m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: M !< pitching moment per unit length of the jth node in the kth blade [Nm/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Mx !< pitching moment per unit length of the jth node in the kth blade (in x direction) [Nm/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: My !< pitching moment per unit length of the jth node in the kth blade (in y direction) [Nm/m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Mz !< pitching moment per unit length of the jth node in the kth blade (in z direction) [Nm/m] REAL(ReKi) , DIMENSION(1:3) :: V_DiskAvg !< disk-average relative wind speed [m/s] + REAL(ReKi) :: yaw !< Yaw calculated in SetInputsForBEMT [rad] + REAL(ReKi) :: tilt !< tilt calculated in SetInputsForBEMT [rad] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: hub_theta_x_root !< angles saved for FAST.Farm [rad] REAL(ReKi) :: V_dot_x TYPE(MeshType) :: HubLoad !< mesh at hub; used to compute an integral for mapping the output blade loads to a single point (for writing to file only) [-] @@ -292,6 +302,8 @@ MODULE AeroDyn_Types TYPE(MeshType) :: TwrBuoyLoadPoint !< point mesh for lumped buoyant tower loads [-] TYPE(MeshType) :: TwrBuoyLoad !< line mesh for per unit length buoyant tower loads [-] TYPE(MeshMapType) :: T_P_2_T_L !< mapping data structure to map buoyant tower point loads (m%TwrBuoyLoadPoint) to buoyant tower line loads (m%TwrBuoyLoad) [-] + LOGICAL :: FirstWarn_TowerStrike !< flag to avoid printing tower strike multiple times [-] + REAL(ReKi) , DIMENSION(1:3) :: AvgDiskVel !< disk-averaged U,V,W [m/s] END TYPE RotMiscVarType ! ======================= ! ========= AD_MiscVarType ======= @@ -310,6 +322,7 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrDiam !< Diameter of tower at node [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCd !< Coefficient of drag at tower node [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrTI !< Turbulence intensity for tower shadow at tower node [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlTwist !< Twist at blade node [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TwrCb !< Coefficient of buoyancy at tower node [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlCenBn !< Normal offset between aerodynamic center and center of buoyancy at blade node [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlCenBt !< Tangential offset between aerodynamic center and center of buoyancy at blade node [m] @@ -331,6 +344,7 @@ MODULE AeroDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] + INTEGER(IntKi) :: NumBl_Lin !< number of blades in the jacobian [-] INTEGER(IntKi) :: TwrPotent !< Type of tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] INTEGER(IntKi) :: TwrShadow !< Type of tower influence on wind based on downstream tower shadow {0=none, 1=Powles model, 2=Eames model} [-] LOGICAL :: TwrAero !< Calculate tower aerodynamic loads? [flag] @@ -346,7 +360,7 @@ MODULE AeroDyn_Types REAL(ReKi) :: Pvap !< Vapour pressure [Pa] REAL(ReKi) :: WtrDpth !< Water depth [m] REAL(ReKi) :: MSL2SWL !< Offset between still-water level and mean sea level [m] - INTEGER(IntKi) :: AeroProjMod = 0 !< Flag to switch between different projection models [-] + INTEGER(IntKi) :: AeroProjMod = 1 !< Flag to switch between different projection models [-] INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] @@ -370,6 +384,7 @@ MODULE AeroDyn_Types INTEGER(IntKi) :: SkewMod !< Type of skewed-wake correction model {0=orthogonal, 1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0] [-] INTEGER(IntKi) :: WakeMod !< Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT, 3=FVW} [-] TYPE(FVW_ParameterType) :: FVW !< Parameters for FVW module [-] + LOGICAL :: CompAeroMaps = .FALSE. !< flag to determine if AeroDyn is computing aero maps (true) or running a normal simulation (false) [-] LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] END TYPE AD_ParameterType ! ======================= @@ -7790,23 +7805,23 @@ SUBROUTINE AD_CopyRotMiscVarType( SrcRotMiscVarTypeData, DstRotMiscVarTypeData, END IF DstRotMiscVarTypeData%DisturbedInflow = SrcRotMiscVarTypeData%DisturbedInflow ENDIF -IF (ALLOCATED(SrcRotMiscVarTypeData%WithoutSweepPitchTwist)) THEN - i1_l = LBOUND(SrcRotMiscVarTypeData%WithoutSweepPitchTwist,1) - i1_u = UBOUND(SrcRotMiscVarTypeData%WithoutSweepPitchTwist,1) - i2_l = LBOUND(SrcRotMiscVarTypeData%WithoutSweepPitchTwist,2) - i2_u = UBOUND(SrcRotMiscVarTypeData%WithoutSweepPitchTwist,2) - i3_l = LBOUND(SrcRotMiscVarTypeData%WithoutSweepPitchTwist,3) - i3_u = UBOUND(SrcRotMiscVarTypeData%WithoutSweepPitchTwist,3) - i4_l = LBOUND(SrcRotMiscVarTypeData%WithoutSweepPitchTwist,4) - i4_u = UBOUND(SrcRotMiscVarTypeData%WithoutSweepPitchTwist,4) - IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%WithoutSweepPitchTwist)) THEN - ALLOCATE(DstRotMiscVarTypeData%WithoutSweepPitchTwist(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) +IF (ALLOCATED(SrcRotMiscVarTypeData%orientationAnnulus)) THEN + i1_l = LBOUND(SrcRotMiscVarTypeData%orientationAnnulus,1) + i1_u = UBOUND(SrcRotMiscVarTypeData%orientationAnnulus,1) + i2_l = LBOUND(SrcRotMiscVarTypeData%orientationAnnulus,2) + i2_u = UBOUND(SrcRotMiscVarTypeData%orientationAnnulus,2) + i3_l = LBOUND(SrcRotMiscVarTypeData%orientationAnnulus,3) + i3_u = UBOUND(SrcRotMiscVarTypeData%orientationAnnulus,3) + i4_l = LBOUND(SrcRotMiscVarTypeData%orientationAnnulus,4) + i4_u = UBOUND(SrcRotMiscVarTypeData%orientationAnnulus,4) + IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%orientationAnnulus)) THEN + ALLOCATE(DstRotMiscVarTypeData%orientationAnnulus(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%WithoutSweepPitchTwist.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%orientationAnnulus.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstRotMiscVarTypeData%WithoutSweepPitchTwist = SrcRotMiscVarTypeData%WithoutSweepPitchTwist + DstRotMiscVarTypeData%orientationAnnulus = SrcRotMiscVarTypeData%orientationAnnulus ENDIF IF (ALLOCATED(SrcRotMiscVarTypeData%AllOuts)) THEN i1_l = LBOUND(SrcRotMiscVarTypeData%AllOuts,1) @@ -7912,6 +7927,20 @@ SUBROUTINE AD_CopyRotMiscVarType( SrcRotMiscVarTypeData, DstRotMiscVarTypeData, END IF DstRotMiscVarTypeData%Y = SrcRotMiscVarTypeData%Y ENDIF +IF (ALLOCATED(SrcRotMiscVarTypeData%Z)) THEN + i1_l = LBOUND(SrcRotMiscVarTypeData%Z,1) + i1_u = UBOUND(SrcRotMiscVarTypeData%Z,1) + i2_l = LBOUND(SrcRotMiscVarTypeData%Z,2) + i2_u = UBOUND(SrcRotMiscVarTypeData%Z,2) + IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Z)) THEN + ALLOCATE(DstRotMiscVarTypeData%Z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotMiscVarTypeData%Z = SrcRotMiscVarTypeData%Z +ENDIF IF (ALLOCATED(SrcRotMiscVarTypeData%M)) THEN i1_l = LBOUND(SrcRotMiscVarTypeData%M,1) i1_u = UBOUND(SrcRotMiscVarTypeData%M,1) @@ -7925,8 +7954,52 @@ SUBROUTINE AD_CopyRotMiscVarType( SrcRotMiscVarTypeData, DstRotMiscVarTypeData, END IF END IF DstRotMiscVarTypeData%M = SrcRotMiscVarTypeData%M +ENDIF +IF (ALLOCATED(SrcRotMiscVarTypeData%Mx)) THEN + i1_l = LBOUND(SrcRotMiscVarTypeData%Mx,1) + i1_u = UBOUND(SrcRotMiscVarTypeData%Mx,1) + i2_l = LBOUND(SrcRotMiscVarTypeData%Mx,2) + i2_u = UBOUND(SrcRotMiscVarTypeData%Mx,2) + IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Mx)) THEN + ALLOCATE(DstRotMiscVarTypeData%Mx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotMiscVarTypeData%Mx = SrcRotMiscVarTypeData%Mx +ENDIF +IF (ALLOCATED(SrcRotMiscVarTypeData%My)) THEN + i1_l = LBOUND(SrcRotMiscVarTypeData%My,1) + i1_u = UBOUND(SrcRotMiscVarTypeData%My,1) + i2_l = LBOUND(SrcRotMiscVarTypeData%My,2) + i2_u = UBOUND(SrcRotMiscVarTypeData%My,2) + IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%My)) THEN + ALLOCATE(DstRotMiscVarTypeData%My(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%My.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotMiscVarTypeData%My = SrcRotMiscVarTypeData%My +ENDIF +IF (ALLOCATED(SrcRotMiscVarTypeData%Mz)) THEN + i1_l = LBOUND(SrcRotMiscVarTypeData%Mz,1) + i1_u = UBOUND(SrcRotMiscVarTypeData%Mz,1) + i2_l = LBOUND(SrcRotMiscVarTypeData%Mz,2) + i2_u = UBOUND(SrcRotMiscVarTypeData%Mz,2) + IF (.NOT. ALLOCATED(DstRotMiscVarTypeData%Mz)) THEN + ALLOCATE(DstRotMiscVarTypeData%Mz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotMiscVarTypeData%Mz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotMiscVarTypeData%Mz = SrcRotMiscVarTypeData%Mz ENDIF DstRotMiscVarTypeData%V_DiskAvg = SrcRotMiscVarTypeData%V_DiskAvg + DstRotMiscVarTypeData%yaw = SrcRotMiscVarTypeData%yaw + DstRotMiscVarTypeData%tilt = SrcRotMiscVarTypeData%tilt IF (ALLOCATED(SrcRotMiscVarTypeData%hub_theta_x_root)) THEN i1_l = LBOUND(SrcRotMiscVarTypeData%hub_theta_x_root,1) i1_u = UBOUND(SrcRotMiscVarTypeData%hub_theta_x_root,1) @@ -8198,6 +8271,8 @@ SUBROUTINE AD_CopyRotMiscVarType( SrcRotMiscVarTypeData, DstRotMiscVarTypeData, CALL NWTC_Library_Copymeshmaptype( SrcRotMiscVarTypeData%T_P_2_T_L, DstRotMiscVarTypeData%T_P_2_T_L, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + DstRotMiscVarTypeData%FirstWarn_TowerStrike = SrcRotMiscVarTypeData%FirstWarn_TowerStrike + DstRotMiscVarTypeData%AvgDiskVel = SrcRotMiscVarTypeData%AvgDiskVel END SUBROUTINE AD_CopyRotMiscVarType SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) @@ -8238,8 +8313,8 @@ SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg, DEALLO IF (ALLOCATED(RotMiscVarTypeData%DisturbedInflow)) THEN DEALLOCATE(RotMiscVarTypeData%DisturbedInflow) ENDIF -IF (ALLOCATED(RotMiscVarTypeData%WithoutSweepPitchTwist)) THEN - DEALLOCATE(RotMiscVarTypeData%WithoutSweepPitchTwist) +IF (ALLOCATED(RotMiscVarTypeData%orientationAnnulus)) THEN + DEALLOCATE(RotMiscVarTypeData%orientationAnnulus) ENDIF IF (ALLOCATED(RotMiscVarTypeData%AllOuts)) THEN DEALLOCATE(RotMiscVarTypeData%AllOuts) @@ -8265,9 +8340,21 @@ SUBROUTINE AD_DestroyRotMiscVarType( RotMiscVarTypeData, ErrStat, ErrMsg, DEALLO IF (ALLOCATED(RotMiscVarTypeData%Y)) THEN DEALLOCATE(RotMiscVarTypeData%Y) ENDIF +IF (ALLOCATED(RotMiscVarTypeData%Z)) THEN + DEALLOCATE(RotMiscVarTypeData%Z) +ENDIF IF (ALLOCATED(RotMiscVarTypeData%M)) THEN DEALLOCATE(RotMiscVarTypeData%M) ENDIF +IF (ALLOCATED(RotMiscVarTypeData%Mx)) THEN + DEALLOCATE(RotMiscVarTypeData%Mx) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%My)) THEN + DEALLOCATE(RotMiscVarTypeData%My) +ENDIF +IF (ALLOCATED(RotMiscVarTypeData%Mz)) THEN + DEALLOCATE(RotMiscVarTypeData%Mz) +ENDIF IF (ALLOCATED(RotMiscVarTypeData%hub_theta_x_root)) THEN DEALLOCATE(RotMiscVarTypeData%hub_theta_x_root) ENDIF @@ -8501,10 +8588,10 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*3 ! DisturbedInflow upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%DisturbedInflow) ! DisturbedInflow END IF - Int_BufSz = Int_BufSz + 1 ! WithoutSweepPitchTwist allocated yes/no - IF ( ALLOCATED(InData%WithoutSweepPitchTwist) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! WithoutSweepPitchTwist upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WithoutSweepPitchTwist) ! WithoutSweepPitchTwist + Int_BufSz = Int_BufSz + 1 ! orientationAnnulus allocated yes/no + IF ( ALLOCATED(InData%orientationAnnulus) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! orientationAnnulus upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%orientationAnnulus) ! orientationAnnulus END IF Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no IF ( ALLOCATED(InData%AllOuts) ) THEN @@ -8546,12 +8633,34 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*2 ! Y upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%Y) ! Y END IF + Int_BufSz = Int_BufSz + 1 ! Z allocated yes/no + IF ( ALLOCATED(InData%Z) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Z upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Z) ! Z + END IF Int_BufSz = Int_BufSz + 1 ! M allocated yes/no IF ( ALLOCATED(InData%M) ) THEN Int_BufSz = Int_BufSz + 2*2 ! M upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%M) ! M + END IF + Int_BufSz = Int_BufSz + 1 ! Mx allocated yes/no + IF ( ALLOCATED(InData%Mx) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Mx upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Mx) ! Mx + END IF + Int_BufSz = Int_BufSz + 1 ! My allocated yes/no + IF ( ALLOCATED(InData%My) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! My upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%My) ! My + END IF + Int_BufSz = Int_BufSz + 1 ! Mz allocated yes/no + IF ( ALLOCATED(InData%Mz) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Mz upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Mz) ! Mz END IF Re_BufSz = Re_BufSz + SIZE(InData%V_DiskAvg) ! V_DiskAvg + Re_BufSz = Re_BufSz + 1 ! yaw + Re_BufSz = Re_BufSz + 1 ! tilt Int_BufSz = Int_BufSz + 1 ! hub_theta_x_root allocated yes/no IF ( ALLOCATED(InData%hub_theta_x_root) ) THEN Int_BufSz = Int_BufSz + 2*1 ! hub_theta_x_root upper/lower bounds for each dimension @@ -8819,6 +8928,8 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 1 ! FirstWarn_TowerStrike + Re_BufSz = Re_BufSz + SIZE(InData%AvgDiskVel) ! AvgDiskVel IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -9041,31 +9152,31 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%WithoutSweepPitchTwist) ) THEN + IF ( .NOT. ALLOCATED(InData%orientationAnnulus) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WithoutSweepPitchTwist,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WithoutSweepPitchTwist,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%orientationAnnulus,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%orientationAnnulus,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WithoutSweepPitchTwist,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WithoutSweepPitchTwist,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%orientationAnnulus,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%orientationAnnulus,2) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WithoutSweepPitchTwist,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WithoutSweepPitchTwist,3) + IntKiBuf( Int_Xferred ) = LBOUND(InData%orientationAnnulus,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%orientationAnnulus,3) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WithoutSweepPitchTwist,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WithoutSweepPitchTwist,4) + IntKiBuf( Int_Xferred ) = LBOUND(InData%orientationAnnulus,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%orientationAnnulus,4) Int_Xferred = Int_Xferred + 2 - DO i4 = LBOUND(InData%WithoutSweepPitchTwist,4), UBOUND(InData%WithoutSweepPitchTwist,4) - DO i3 = LBOUND(InData%WithoutSweepPitchTwist,3), UBOUND(InData%WithoutSweepPitchTwist,3) - DO i2 = LBOUND(InData%WithoutSweepPitchTwist,2), UBOUND(InData%WithoutSweepPitchTwist,2) - DO i1 = LBOUND(InData%WithoutSweepPitchTwist,1), UBOUND(InData%WithoutSweepPitchTwist,1) - ReKiBuf(Re_Xferred) = InData%WithoutSweepPitchTwist(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 + DO i4 = LBOUND(InData%orientationAnnulus,4), UBOUND(InData%orientationAnnulus,4) + DO i3 = LBOUND(InData%orientationAnnulus,3), UBOUND(InData%orientationAnnulus,3) + DO i2 = LBOUND(InData%orientationAnnulus,2), UBOUND(InData%orientationAnnulus,2) + DO i1 = LBOUND(InData%orientationAnnulus,1), UBOUND(InData%orientationAnnulus,1) + DbKiBuf(Db_Xferred) = InData%orientationAnnulus(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 END DO END DO END DO @@ -9211,6 +9322,26 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO END DO END IF + IF ( .NOT. ALLOCATED(InData%Z) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Z,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Z,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Z,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Z,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Z,2), UBOUND(InData%Z,2) + DO i1 = LBOUND(InData%Z,1), UBOUND(InData%Z,1) + ReKiBuf(Re_Xferred) = InData%Z(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( .NOT. ALLOCATED(InData%M) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -9230,11 +9361,75 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Re_Xferred = Re_Xferred + 1 END DO END DO + END IF + IF ( .NOT. ALLOCATED(InData%Mx) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Mx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mx,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Mx,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mx,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Mx,2), UBOUND(InData%Mx,2) + DO i1 = LBOUND(InData%Mx,1), UBOUND(InData%Mx,1) + ReKiBuf(Re_Xferred) = InData%Mx(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%My) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%My,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%My,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%My,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%My,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%My,2), UBOUND(InData%My,2) + DO i1 = LBOUND(InData%My,1), UBOUND(InData%My,1) + ReKiBuf(Re_Xferred) = InData%My(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Mz) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Mz,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mz,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Mz,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mz,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Mz,2), UBOUND(InData%Mz,2) + DO i1 = LBOUND(InData%Mz,1), UBOUND(InData%Mz,1) + ReKiBuf(Re_Xferred) = InData%Mz(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF DO i1 = LBOUND(InData%V_DiskAvg,1), UBOUND(InData%V_DiskAvg,1) ReKiBuf(Re_Xferred) = InData%V_DiskAvg(i1) Re_Xferred = Re_Xferred + 1 END DO + ReKiBuf(Re_Xferred) = InData%yaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tilt + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%hub_theta_x_root) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -9820,6 +10015,12 @@ SUBROUTINE AD_PackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_TowerStrike, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%AvgDiskVel,1), UBOUND(InData%AvgDiskVel,1) + ReKiBuf(Re_Xferred) = InData%AvgDiskVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD_PackRotMiscVarType SUBROUTINE AD_UnPackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -10124,7 +10325,7 @@ SUBROUTINE AD_UnPackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WithoutSweepPitchTwist not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! orientationAnnulus not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -10140,18 +10341,18 @@ SUBROUTINE AD_UnPackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat i4_l = IntKiBuf( Int_Xferred ) i4_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%WithoutSweepPitchTwist)) DEALLOCATE(OutData%WithoutSweepPitchTwist) - ALLOCATE(OutData%WithoutSweepPitchTwist(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%orientationAnnulus)) DEALLOCATE(OutData%orientationAnnulus) + ALLOCATE(OutData%orientationAnnulus(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WithoutSweepPitchTwist.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%orientationAnnulus.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i4 = LBOUND(OutData%WithoutSweepPitchTwist,4), UBOUND(OutData%WithoutSweepPitchTwist,4) - DO i3 = LBOUND(OutData%WithoutSweepPitchTwist,3), UBOUND(OutData%WithoutSweepPitchTwist,3) - DO i2 = LBOUND(OutData%WithoutSweepPitchTwist,2), UBOUND(OutData%WithoutSweepPitchTwist,2) - DO i1 = LBOUND(OutData%WithoutSweepPitchTwist,1), UBOUND(OutData%WithoutSweepPitchTwist,1) - OutData%WithoutSweepPitchTwist(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 + DO i4 = LBOUND(OutData%orientationAnnulus,4), UBOUND(OutData%orientationAnnulus,4) + DO i3 = LBOUND(OutData%orientationAnnulus,3), UBOUND(OutData%orientationAnnulus,3) + DO i2 = LBOUND(OutData%orientationAnnulus,2), UBOUND(OutData%orientationAnnulus,2) + DO i1 = LBOUND(OutData%orientationAnnulus,1), UBOUND(OutData%orientationAnnulus,1) + OutData%orientationAnnulus(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 END DO END DO END DO @@ -10321,6 +10522,29 @@ SUBROUTINE AD_UnPackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Z not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Z)) DEALLOCATE(OutData%Z) + ALLOCATE(OutData%Z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Z,2), UBOUND(OutData%Z,2) + DO i1 = LBOUND(OutData%Z,1), UBOUND(OutData%Z,1) + OutData%Z(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -10343,6 +10567,75 @@ SUBROUTINE AD_UnPackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = Re_Xferred + 1 END DO END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mx not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Mx)) DEALLOCATE(OutData%Mx) + ALLOCATE(OutData%Mx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Mx,2), UBOUND(OutData%Mx,2) + DO i1 = LBOUND(OutData%Mx,1), UBOUND(OutData%Mx,1) + OutData%Mx(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! My not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%My)) DEALLOCATE(OutData%My) + ALLOCATE(OutData%My(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%My.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%My,2), UBOUND(OutData%My,2) + DO i1 = LBOUND(OutData%My,1), UBOUND(OutData%My,1) + OutData%My(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mz not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Mz)) DEALLOCATE(OutData%Mz) + ALLOCATE(OutData%Mz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Mz,2), UBOUND(OutData%Mz,2) + DO i1 = LBOUND(OutData%Mz,1), UBOUND(OutData%Mz,1) + OutData%Mz(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%V_DiskAvg,1) i1_u = UBOUND(OutData%V_DiskAvg,1) @@ -10350,6 +10643,10 @@ SUBROUTINE AD_UnPackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat OutData%V_DiskAvg(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO + OutData%yaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tilt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! hub_theta_x_root not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -11109,6 +11406,14 @@ SUBROUTINE AD_UnPackRotMiscVarType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%FirstWarn_TowerStrike = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_TowerStrike) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%AvgDiskVel,1) + i1_u = UBOUND(OutData%AvgDiskVel,1) + DO i1 = LBOUND(OutData%AvgDiskVel,1), UBOUND(OutData%AvgDiskVel,1) + OutData%AvgDiskVel(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD_UnPackRotMiscVarType SUBROUTINE AD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -11766,6 +12071,20 @@ SUBROUTINE AD_CopyRotParameterType( SrcRotParameterTypeData, DstRotParameterType END IF DstRotParameterTypeData%TwrTI = SrcRotParameterTypeData%TwrTI ENDIF +IF (ALLOCATED(SrcRotParameterTypeData%BlTwist)) THEN + i1_l = LBOUND(SrcRotParameterTypeData%BlTwist,1) + i1_u = UBOUND(SrcRotParameterTypeData%BlTwist,1) + i2_l = LBOUND(SrcRotParameterTypeData%BlTwist,2) + i2_u = UBOUND(SrcRotParameterTypeData%BlTwist,2) + IF (.NOT. ALLOCATED(DstRotParameterTypeData%BlTwist)) THEN + ALLOCATE(DstRotParameterTypeData%BlTwist(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstRotParameterTypeData%BlTwist.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstRotParameterTypeData%BlTwist = SrcRotParameterTypeData%BlTwist +ENDIF IF (ALLOCATED(SrcRotParameterTypeData%TwrCb)) THEN i1_l = LBOUND(SrcRotParameterTypeData%TwrCb,1) i1_u = UBOUND(SrcRotParameterTypeData%TwrCb,1) @@ -11959,6 +12278,7 @@ SUBROUTINE AD_CopyRotParameterType( SrcRotParameterTypeData, DstRotParameterType DstRotParameterTypeData%dx = SrcRotParameterTypeData%dx ENDIF DstRotParameterTypeData%Jac_ny = SrcRotParameterTypeData%Jac_ny + DstRotParameterTypeData%NumBl_Lin = SrcRotParameterTypeData%NumBl_Lin DstRotParameterTypeData%TwrPotent = SrcRotParameterTypeData%TwrPotent DstRotParameterTypeData%TwrShadow = SrcRotParameterTypeData%TwrShadow DstRotParameterTypeData%TwrAero = SrcRotParameterTypeData%TwrAero @@ -12060,6 +12380,9 @@ SUBROUTINE AD_DestroyRotParameterType( RotParameterTypeData, ErrStat, ErrMsg, DE IF (ALLOCATED(RotParameterTypeData%TwrTI)) THEN DEALLOCATE(RotParameterTypeData%TwrTI) ENDIF +IF (ALLOCATED(RotParameterTypeData%BlTwist)) THEN + DEALLOCATE(RotParameterTypeData%BlTwist) +ENDIF IF (ALLOCATED(RotParameterTypeData%TwrCb)) THEN DEALLOCATE(RotParameterTypeData%TwrCb) ENDIF @@ -12178,6 +12501,11 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! TwrTI upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%TwrTI) ! TwrTI END IF + Int_BufSz = Int_BufSz + 1 ! BlTwist allocated yes/no + IF ( ALLOCATED(InData%BlTwist) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BlTwist upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlTwist) ! BlTwist + END IF Int_BufSz = Int_BufSz + 1 ! TwrCb allocated yes/no IF ( ALLOCATED(InData%TwrCb) ) THEN Int_BufSz = Int_BufSz + 2*1 ! TwrCb upper/lower bounds for each dimension @@ -12288,6 +12616,7 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_BufSz = Re_BufSz + SIZE(InData%dx) ! dx END IF Int_BufSz = Int_BufSz + 1 ! Jac_ny + Int_BufSz = Int_BufSz + 1 ! NumBl_Lin Int_BufSz = Int_BufSz + 1 ! TwrPotent Int_BufSz = Int_BufSz + 1 ! TwrShadow Int_BufSz = Int_BufSz + 1 ! TwrAero @@ -12442,6 +12771,26 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_Xferred = Re_Xferred + 1 END DO END IF + IF ( .NOT. ALLOCATED(InData%BlTwist) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlTwist,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTwist,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlTwist,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTwist,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BlTwist,2), UBOUND(InData%BlTwist,2) + DO i1 = LBOUND(InData%BlTwist,1), UBOUND(InData%BlTwist,1) + ReKiBuf(Re_Xferred) = InData%BlTwist(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( .NOT. ALLOCATED(InData%TwrCb) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -12755,6 +13104,8 @@ SUBROUTINE AD_PackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF IntKiBuf(Int_Xferred) = InData%Jac_ny Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl_Lin + Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%TwrPotent Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%TwrShadow @@ -12998,6 +13349,29 @@ SUBROUTINE AD_UnPackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = Re_Xferred + 1 END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlTwist not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BlTwist)) DEALLOCATE(OutData%BlTwist) + ALLOCATE(OutData%BlTwist(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTwist.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BlTwist,2), UBOUND(OutData%BlTwist,2) + DO i1 = LBOUND(OutData%BlTwist,1), UBOUND(OutData%BlTwist,1) + OutData%BlTwist(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCb not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -13379,6 +13753,8 @@ SUBROUTINE AD_UnPackRotParameterType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt END IF OutData%Jac_ny = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + OutData%NumBl_Lin = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%TwrPotent = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%TwrShadow = IntKiBuf(Int_Xferred) @@ -13625,6 +14001,7 @@ SUBROUTINE AD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) CALL FVW_CopyParam( SrcParamData%FVW, DstParamData%FVW, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + DstParamData%CompAeroMaps = SrcParamData%CompAeroMaps DstParamData%UA_Flag = SrcParamData%UA_Flag END SUBROUTINE AD_CopyParam @@ -13770,6 +14147,7 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 1 ! CompAeroMaps Int_BufSz = Int_BufSz + 1 ! UA_Flag IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -13918,6 +14296,8 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + IntKiBuf(Int_Xferred) = TRANSFER(InData%CompAeroMaps, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD_PackParam @@ -14111,6 +14491,8 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%CompAeroMaps = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompAeroMaps) + Int_Xferred = Int_Xferred + 1 OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD_UnPackParam diff --git a/modules/aerodyn/src/BEMT.f90 b/modules/aerodyn/src/BEMT.f90 index 096e36ad0b..b784109e9a 100644 --- a/modules/aerodyn/src/BEMT.f90 +++ b/modules/aerodyn/src/BEMT.f90 @@ -66,18 +66,19 @@ module BEMT !---------------------------------------------------------------------------------------------------------------------------------- -real(ReKi) function ComputePhiWithInduction( Vx, Vy, a, aprime ) +real(ReKi) function ComputePhiWithInduction( Vx, Vy, a, aprime, cantAngle, xVelCorr) ! This routine is used to compute the inflow angle, phi, from the local velocities and the induction factors. !.................................................................................................................................. real(ReKi), intent(in ) :: Vx ! Local velocity component along the thrust direction real(ReKi), intent(in ) :: Vy ! Local velocity component along the rotor plane-of-rotation direction real(ReKi), intent(in ) :: a ! Axial induction factor real(ReKi), intent(in ) :: aprime ! Tangential induction factor - + real(ReKi), intent(in ) :: cantAngle + real(ReKi), intent(in ) :: xVelCorr real(ReKi) :: x real(ReKi) :: y - x = Vx*(1.0_ReKi-a) + x = (Vx*cos(cantAngle)+xVelCorr)*(1.0_R8Ki-a) y = Vy*(1.0_ReKi + aprime) if ( EqualRealNos(y, 0.0_ReKi) .AND. EqualRealNos(x, 0.0_ReKi) ) then @@ -155,6 +156,12 @@ subroutine BEMT_SetParameters( InitInp, p, errStat, errMsg ) character(*), parameter :: RoutineName = 'BEMT_SetParameters' integer(IntKi) :: i, j + real(ReKi), parameter :: FractionMax = 0.7 ! fraction of rotor disk where weighted average should be maximum + real(ReKi), parameter :: FractionRadius = 0.1 ! radius of smoothing (fraction of rotor disk around FractionMax) + ! constants for kernelType_TRIWEIGHT: + real(ReKi), parameter :: w = 35.0_ReKi/32.0_ReKi + real(ReKi), parameter :: Exp1 = 2 + real(ReKi), parameter :: Exp2 = 3 ! Initialize variables for this routine @@ -165,6 +172,14 @@ subroutine BEMT_SetParameters( InitInp, p, errStat, errMsg ) p%numBlades = InitInp%numBlades p%UA_Flag = InitInp%UA_Flag p%DBEMT_Mod = InitInp%DBEMT_Mod + p%MomentumCorr = InitInp%MomentumCorr + p%BEM_Mod = InitInp%BEM_Mod + call WrScr('>>>> BEM_Mod '//trim(num2lstr(p%BEM_Mod))) + if ((p%BEM_Mod/=BEMMod_2D .and. p%BEM_Mod/=BEMMod_3D )) then + call SetErrStat( ErrID_Fatal, 'BEM_Mod needs to be 0 or 2 for now', errStat, errMsg, RoutineName ) + return + endif + allocate ( p%chord(p%numBladeNodes, p%numBlades), STAT = errStat2 ) if ( errStat2 /= 0 ) then @@ -210,6 +225,7 @@ subroutine BEMT_SetParameters( InitInp, p, errStat, errMsg ) do i=1,p%numBladeNodes p%chord(i,j) = InitInp%chord(i,j) p%tipLossConst(i,j) = p%numBlades*(InitInp%zTip (j) - InitInp%zLocal(i,j)) / (2.0*InitInp%zLocal(i,j)) + ! NOTE different conventions are possible for hub losses p%hubLossConst(i,j) = p%numBlades*(InitInp%zLocal(i,j) - InitInp%zHub (j)) / (2.0*InitInp%zHub (j)) end do end do @@ -238,6 +254,7 @@ subroutine BEMT_SetParameters( InitInp, p, errStat, errMsg ) end do end do + p%rTipFixMax = maxval(InitInp%rTipFix) end subroutine BEMT_SetParameters !---------------------------------------------------------------------------------------------------------------------------------- @@ -352,6 +369,13 @@ subroutine BEMT_AllocInput( u, p, errStat, errMsg ) end if u%Vy = 0.0_ReKi + allocate ( u%Vz( p%numBladeNodes, p%numBlades ), STAT = errStat2 ) + if ( errStat2 /= 0 ) then + call SetErrStat( ErrID_Fatal, 'Error allocating memory for u%Vz.', errStat, errMsg, RoutineName ) + return + end if + u%Vz = 0.0_ReKi + allocate ( u%omega_z( p%numBladeNodes, p%numBlades ), STAT = errStat2 ) if ( errStat2 /= 0 ) then call SetErrStat( ErrID_Fatal, 'Error allocating memory for u%omega_z.', errStat, errMsg, RoutineName ) @@ -359,6 +383,13 @@ subroutine BEMT_AllocInput( u, p, errStat, errMsg ) end if u%omega_z = 0.0_ReKi + allocate ( u%xVelCorr( p%numBladeNodes, p%numBlades ), STAT = errStat2 ) + if ( errStat2 /= 0 ) then + call SetErrStat( ErrID_Fatal, 'Error allocating memory for u%Vz.', errStat, errMsg, RoutineName ) + return + end if + u%xVelCorr = 0.0_ReKi + allocate ( u%rLocal( p%numBladeNodes, p%numBlades ), STAT = errStat2 ) if ( errStat2 /= 0 ) then call SetErrStat( ErrID_Fatal, 'Error allocating memory for u%rLocal.', errStat, errMsg, RoutineName ) @@ -376,6 +407,26 @@ subroutine BEMT_AllocInput( u, p, errStat, errMsg ) u%omega = 0.0_ReKi + allocate ( u%cantAngle( p%numBladeNodes, p%numBlades ), STAT = errStat2 ) + if ( errStat2 /= 0 ) then + call SetErrStat( ErrID_Fatal, 'Error allocating memory for u%cantAngle.', errStat, errMsg, RoutineName ) + return + end if + u%cantAngle = 0.0_ReKi + + allocate ( u%drdz( p%numBladeNodes, p%numBlades ), STAT = errStat2 ) + if ( errStat2 /= 0 ) then + call SetErrStat( ErrID_Fatal, 'Error allocating memory for u%drdz.', errStat, errMsg, RoutineName ) + return + end if + u%drdz = 0.0_ReKi + + allocate ( u%toeAngle( p%numBladeNodes, p%numBlades ), STAT = errStat2 ) + if ( errStat2 /= 0 ) then + call SetErrStat( ErrID_Fatal, 'Error allocating memory for u%toeAngle.', errStat, errMsg, RoutineName ) + return + end if + u%toeAngle = 0.0_ReKi end subroutine BEMT_AllocInput @@ -411,6 +462,10 @@ subroutine BEMT_AllocOutput( y, p, errStat, errMsg ) call allocAry( y%AOA, p%numBladeNodes, p%numBlades, 'y%AOA', errStat2, errMsg2); call setErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call allocAry( y%Cx, p%numBladeNodes, p%numBlades, 'y%Cx', errStat2, errMsg2); call setErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call allocAry( y%Cy, p%numBladeNodes, p%numBlades, 'y%Cy', errStat2, errMsg2); call setErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call allocAry( y%Cz, p%numBladeNodes, p%numBlades, 'y%Cz', errStat2, errMsg2); call setErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call allocAry( y%Cmx, p%numBladeNodes, p%numBlades, 'y%Cmx', errStat2, errMsg2); call setErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call allocAry( y%Cmy, p%numBladeNodes, p%numBlades, 'y%Cmy', errStat2, errMsg2); call setErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call allocAry( y%Cmz, p%numBladeNodes, p%numBlades, 'y%Cmz', errStat2, errMsg2); call setErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call allocAry( y%Cm, p%numBladeNodes, p%numBlades, 'y%Cm', errStat2, errMsg2); call setErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call allocAry( y%Cl, p%numBladeNodes, p%numBlades, 'y%Cl', errStat2, errMsg2); call setErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call allocAry( y%Cd, p%numBladeNodes, p%numBlades, 'y%Cd', errStat2, errMsg2); call setErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -424,7 +479,10 @@ subroutine BEMT_AllocOutput( y, p, errStat, errMsg ) y%phi = 0.0_ReKi y%Cx = 0.0_ReKi y%Cy = 0.0_ReKi - y%Cm = 0.0_ReKi + y%Cz = 0.0_ReKi + y%Cmx = 0.0_ReKi + y%Cmy = 0.0_ReKi + y%Cmz = 0.0_ReKi ! others: y%chi = 0.0_ReKi @@ -434,6 +492,7 @@ subroutine BEMT_AllocOutput( y, p, errStat, errMsg ) y%AOA = 0.0_ReKi y%Cl = 0.0_ReKi y%Cd = 0.0_ReKi + y%Cm = 0.0_ReKi y%Cpmin = 0.0_ReKi end subroutine BEMT_AllocOutput @@ -518,12 +577,6 @@ subroutine BEMT_Init( InitInp, u, p, x, xd, z, OtherState, AFInfo, y, misc, Inte InitInp_DBEMT%numNodes = p%numBladeNodes InitInp_DBEMT%tau1_const = InitInp%tau1_const - allocate(misc%u_DBEMT(2),stat=errStat2) - if (errStat2 /= 0) then - call SetErrStat(ErrID_Fatal,"Error allocating u_DBEMT",errStat,errMsg,RoutineName) - return - end if - if (allocated(InitInp%rlocal)) then call MOVE_ALLOC( InitInp%rlocal, InitInp_DBEMT%rlocal ) else @@ -652,6 +705,7 @@ subroutine BEMT_ReInit(p,x,xd,z,OtherState,misc,ErrStat,ErrMsg) misc%BEM_weight = 0.0_ReKi OtherState%DBEMT%tau1 = 0.0_ReKi !we're going to output this value, so let's initialize it + OtherState%n = -1 if (p%UseInduction) then OtherState%ValidPhi = .true. @@ -729,7 +783,7 @@ END SUBROUTINE BEMT_End !---------------------------------------------------------------------------------------------------------------------------------- -subroutine BEMT_UpdateStates( t, n, u1, u2, p, x, xd, z, OtherState, AFInfo, m, errStat, errMsg ) +subroutine BEMT_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m, errStat, errMsg ) ! Loose coupling routine for solving for constraint states, integrating continuous states, and updating discrete states ! Continuous, constraint, discrete, and other states are updated for t + Interval ! @@ -738,8 +792,8 @@ subroutine BEMT_UpdateStates( t, n, u1, u2, p, x, xd, z, OtherState, AFInfo, m, real(DbKi), intent(in ) :: t ! Current simulation time in seconds integer(IntKi), intent(in ) :: n ! Current simulation time step n = 0,1,... - type(BEMT_InputType), intent(in ) :: u1,u2 ! Input at t and t+ dt - !real(DbKi), intent(in ) :: utime ! Times associated with u(:), in seconds + type(BEMT_InputType), intent(in ) :: u(2) ! Input at t and t+ dt + real(DbKi), intent(in ) :: uTimes(2) ! Times associated with u(:), in seconds type(BEMT_ParameterType), intent(in ) :: p ! Parameters type(BEMT_ContinuousStateType), intent(inout) :: x ! Input: Continuous states at t; ! Output: Continuous states at t + Interval @@ -757,49 +811,46 @@ subroutine BEMT_UpdateStates( t, n, u1, u2, p, x, xd, z, OtherState, AFInfo, m, integer(IntKi) :: i,j + integer(IntKi), parameter :: TimeIndex_t = 1 + integer(IntKi), parameter :: TimeIndex_t_plus_dt = 2 character(ErrMsgLen) :: errMsg2 ! temporary Error message if ErrStat /= ErrID_None integer(IntKi) :: errStat2 ! temporary Error status of the operation character(*), parameter :: RoutineName = 'BEMT_UpdateStates' - real(DbKi) :: uTimes(2) + ErrStat = ErrID_None ErrMsg = "" - uTimes(1) = t - uTimes(2) = t+p%dt - !............................................................................................................................... ! if we haven't initialized z%phi, we want to get a better guess as to what the actual values of phi at t are: !............................................................................................................................... - if (.not. OtherState%nodesInitialized) then - call UpdatePhi( u1, p, z%phi, AFInfo, m, OtherState%ValidPhi, errStat2, errMsg2 ) - OtherState%nodesInitialized = .true. ! otherState updated to t+dt (i.e., n+1) + call UpdatePhi( u(TimeIndex_t), p, z%phi, AFInfo, m, OtherState%ValidPhi, errStat2, errMsg2 ) end if !............................................................................................................................... - ! compute inputs to DBEMT at step n (also setting inductions--including DBEMT and skewed wake corrections--at time n) + ! compute inputs to DBEMT and SkewedWake at step n (also setting inductions--including DBEMT and skewed wake corrections--at time n) !............................................................................................................................... - call BEMT_CalcOutput_Inductions( 1, t, .true., .true., z%phi, u1, p, x, xd, z, OtherState, AFInfo, m%axInduction, m%tanInduction, m%chi, m, errStat2, errMsg2 ) + call BEMT_CalcOutput_Inductions( TimeIndex_t, t, .true., .true., z%phi, u(TimeIndex_t), p, x, xd, z, OtherState, AFInfo, m%axInduction, m%tanInduction, m%chi, m, errStat2, errMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) return #ifdef DEBUG_BEMT_RESIDUAL - if (p%useInduction) call WriteDEBUGValuesToFile(t, u1, p, x, xd, z, OtherState, m, AFInfo) + if (p%useInduction) call WriteDEBUGValuesToFile(t, u(TimeIndex_t), p, x, xd, z, OtherState, m, AFInfo) #endif !............................................................................................................................... ! compute inputs to UA at time n (also setting inductions--including DBEMT and skewed wake corrections--at time n) !............................................................................................................................... if (p%UA_Flag) then m%phi = z%phi - call SetInputs_for_UA_AllNodes(u1, p, m%phi, m%axInduction, m%tanInduction, m%u_UA(:,:,1)) + call SetInputs_for_UA_AllNodes(u(TimeIndex_t), p, m%phi, m%axInduction, m%tanInduction, m%u_UA(:,:,TimeIndex_t)) end if !............................................................................................................................... - ! update BEMT states to step n+1 + ! update BEMT constraint states to step n+1 !............................................................................................................................... - call UpdatePhi( u2, p, z%phi, AFInfo, m, OtherState%ValidPhi, errStat2, errMsg2 ) + call UpdatePhi( u(TimeIndex_t_plus_dt), p, z%phi, AFInfo, m, OtherState%ValidPhi, errStat2, errMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (errStat >= AbortErrLev) return @@ -807,7 +858,7 @@ subroutine BEMT_UpdateStates( t, n, u1, u2, p, x, xd, z, OtherState, AFInfo, m, !............................................................................................................................... ! compute inputs to DBEMT at step n+1 (also setting inductions--WITHOUT DBEMT or skewed wake corrections--at step n+1) !............................................................................................................................... - call BEMT_CalcOutput_Inductions( 2, t, .true., .false., z%phi, u2, p, x, xd, z, OtherState, AFInfo, m%axInduction, m%tanInduction, m%chi, m, errStat2, errMsg2 ) + call BEMT_CalcOutput_Inductions( TimeIndex_t_plus_dt, t, .true., .false., z%phi, u(TimeIndex_t_plus_dt), p, x, xd, z, OtherState, AFInfo, m%axInduction, m%tanInduction, m%chi, m, errStat2, errMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) return @@ -842,20 +893,20 @@ subroutine BEMT_UpdateStates( t, n, u1, u2, p, x, xd, z, OtherState, AFInfo, m, ! apply DBEMT correction to axInduction and tanInduction: !............................................ if (p%DBEMT_Mod /= DBEMT_none) then - call calculate_Inductions_from_DBEMT_AllNodes(2, uTimes(2), u2, p, x, OtherState, m, m%axInduction, m%tanInduction) + call calculate_Inductions_from_DBEMT_AllNodes(TimeIndex_t_plus_dt, uTimes(TimeIndex_t_plus_dt), u(TimeIndex_t_plus_dt), p, x, OtherState, m, m%axInduction, m%tanInduction) end if - call ApplySkewedWakeCorrection_AllNodes(p, u2, m, m%axInduction, m%chi) + call ApplySkewedWakeCorrection_AllNodes(p, u(TimeIndex_t_plus_dt), m, m%axInduction, m%chi) !............................................ ! If TSR is too low, (start to) turn off induction !............................................ - call check_turnOffBEMT(p, u2, m%BEM_weight, m%axInduction, m%tanInduction, m%FirstWarn_BEMoff) + call check_turnOffBEMT(p, u(TimeIndex_t_plus_dt), m%BEM_weight, m%axInduction, m%tanInduction, m%FirstWarn_BEMoff) end if m%phi = z%phi - call SetInputs_for_UA_AllNodes(u2, p, m%phi, m%axInduction, m%tanInduction, m%u_UA(:,:,2)) + call SetInputs_for_UA_AllNodes(u(TimeIndex_t_plus_dt), p, m%phi, m%axInduction, m%tanInduction, m%u_UA(:,:,TimeIndex_t_plus_dt)) !............................................................................................................................... ! compute UA states at t+dt @@ -876,6 +927,8 @@ subroutine BEMT_UpdateStates( t, n, u1, u2, p, x, xd, z, OtherState, AFInfo, m, end if ! is UA used? + OtherState%nodesInitialized = .true. ! otherState updated to t+dt (i.e., n+1) + end subroutine BEMT_UpdateStates !.................................................................................................................................. subroutine SetInputs_For_DBEMT(u_DBEMT, u, p, axInduction, tanInduction, Rtip) @@ -890,26 +943,30 @@ subroutine SetInputs_For_DBEMT(u_DBEMT, u, p, axInduction, tanInduction, Rtip) integer :: i, j - ! Locate the maximum rlocal value for all blades. - u_DBEMT%R_disk = Rtip(1) - do j = 2,p%numBlades - u_DBEMT%R_disk = max( u_DBEMT%R_disk , Rtip(j) ) + !............................. + ! calculate rotor-level inputs + !............................. + u_DBEMT%R_disk = maxval( Rtip ) ! Locate the maximum rlocal value for all blades. + u_DBEMT%Un_disk = u%Un_disk + u_DBEMT%AxInd_disk = 0.0_ReKi + do j = 1,p%numBlades + do i = 1,p%numBladeNodes + u_DBEMT%AxInd_disk = u_DBEMT%AxInd_disk + axInduction(i,j) + end do end do - + u_DBEMT%AxInd_disk = u_DBEMT%AxInd_disk / (p%numBladeNodes*p%numBlades) + + !............................. + ! calculate element-level inputs + !............................. if (p%DBEMT_Mod == DBEMT_tauVaries ) then - ! We need to generate a disk-averaged axial induction for this timestep - u_DBEMT%AxInd_disk = 0.0_ReKi + ! Compute span Ratio do j = 1,p%numBlades do i = 1,p%numBladeNodes - u_DBEMT%AxInd_disk = u_DBEMT%AxInd_disk + axInduction(i,j) - u_DBEMT%element(i,j)%spanRatio = u%rlocal(i,j)/u_DBEMT%R_disk end do end do - u_DBEMT%AxInd_disk = u_DBEMT%AxInd_disk / (p%numBladeNodes*p%numBlades) - - u_DBEMT%Un_disk = u%Un_disk end if @@ -969,7 +1026,7 @@ subroutine UpdatePhi( u, p, phi, AFInfo, m, ValidPhi, errStat, errMsg ) ! We'll simply compute a geometrical phi based on both induction factors being 0.0 do j = 1,p%numBlades ! Loop through all blades do i = 1,p%numBladeNodes ! Loop through the blade nodes / elements - phi(i,j) = ComputePhiWithInduction(u%Vx(i,j), u%Vy(i,j), 0.0_ReKi, 0.0_ReKi) + phi(i,j) = ComputePhiWithInduction(u%Vx(i,j), u%Vy(i,j), 0.0_ReKi, 0.0_ReKi, u%cantAngle(i,j), u%xVelCorr(i,j) ) end do end do @@ -1158,8 +1215,6 @@ subroutine BEMT_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, errStat ! nectivity information does not have to be recalculated) integer(IntKi), intent( out) :: errStat ! Error status of the operation character(*), intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None - - ! Local variables: integer(IntKi) :: i ! Generic index @@ -1181,7 +1236,7 @@ subroutine BEMT_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, errStat !!#endif y%phi = z%phi ! set this before possibly calling UpdatePhi() because phi is intent(inout) in the solve - m%ValidPhi = OtherState%ValidPhi ! set this so that we don't overwrite OtherSTate%ValidPhi + m%ValidPhi = OtherState%ValidPhi !............................................................................................................................... ! if we haven't initialized z%phi, we want to get a better guess as to what the actual values of phi are: @@ -1192,6 +1247,7 @@ subroutine BEMT_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, errStat !............................................ ! calculate inductions using BEMT, applying the DBEMT, and/or skewed wake corrections as applicable: + ! NOTE that we don't use the DBEMT inputs when calling its CalcOutput routine, so we'll skip calculating them here !............................................ call BEMT_CalcOutput_Inductions( InputIndex, t, .false., .true., y%phi, u, p, x, xd, z, OtherState, AFInfo, y%axInduction, y%tanInduction, y%chi, m, errStat, errMsg ) @@ -1263,8 +1319,18 @@ subroutine BEMT_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, errStat !............................................ do j = 1,p%numBlades ! Loop through all blades do i = 1,p%numBladeNodes ! Loop through the blade nodes / elements - ! NOTE: For these calculations we force the useAIDrag and useTIDrag flags to .TRUE. - call Transform_ClCd_to_CxCy( y%phi(i,j), .TRUE., .TRUE., y%Cl(i,j), y%Cd(i,j),y%Cx(i,j), y%Cy(i,j) ) + ! Compute Cx, Cy given Cl, Cd and phi + ! NOTE: For these calculations we force the useAIDrag and useTIDrag flags to .TRUE. + if(p%BEM_Mod==BEMMod_2D) then + call Transform_ClCd_to_CxCy( y%phi(i,j), .TRUE., .TRUE., y%Cl(i,j), y%Cd(i,j),y%Cx(i,j), y%Cy(i,j) ) + y%Cz(i,j) = 0.0_ReKi + y%Cmx(i,j) = 0.0_ReKi + y%Cmy(i,j) = 0.0_ReKi + y%Cmz(i,j) = y%Cm(i,j) + else + call Transform_ClCdCm_to_CxCyCzCmxCmyCmz( y%phi(i,j), u%theta(i,j), u%cantAngle(i,j),u%toeAngle(i,j), .TRUE., .TRUE., & + y%AOA(i,j), y%Cl(i,j), y%Cd(i,j), y%Cm(i,j), y%Cx(i,j), y%Cy(i,j), y%Cz(i,j), y%Cmx(i,j), y%Cmy(i,j), y%Cmz(i,j) ) + endif enddo ! I - Blade nodes / elements enddo ! J - All blades @@ -1526,7 +1592,7 @@ subroutine BEMT_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, AFIn call UpdatePhi( u, p, m%phi, AFInfo, m, m%ValidPhi, errStat2, errMsg2 ) !............................................................................................................................... - ! compute inputs to DBEMT (also setting inductions needed for UA inputs--including DBEMT and skewed wake corrections) + ! compute inputs to DBEMT and SkewedWake (also setting inductions needed for UA inputs--including DBEMT and skewed wake corrections) !............................................................................................................................... call BEMT_CalcOutput_Inductions( InputIndex, t, .true., .true., m%phi, u, p, x, xd, z, OtherState, AFInfo, m%axInduction, m%tanInduction, m%chi, m, errStat2, errMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -2127,7 +2193,7 @@ subroutine BEMT_UnCoupledSolve(p, u, iBladeNode, jBlade, phi, AFInfo, ValidPhi, if (.not. ValidPhi) then - phi = ComputePhiWithInduction(u%Vx(iBladeNode,jBlade), u%Vy(iBladeNode,jBlade), 0.0_ReKi, 0.0_ReKi) + phi = ComputePhiWithInduction(u%Vx(iBladeNode,jBlade), u%Vy(iBladeNode,jBlade), 0.0_ReKi, 0.0_ReKi, u%cantangle(iBladeNode,jBlade), u%xVelCorr(iBladeNode,jBlade)) if (abs(phi)>MsgLimit .and. abs(abs(phi)-PiBy2) > MsgLimit ) then if (FirstWarn) then @@ -2150,28 +2216,39 @@ function NodeText(i,j) NodeText = '(node '//trim(num2lstr(i))//', blade '//trim(num2lstr(j))//')' end function NodeText !---------------------------------------------------------------------------------------------------------------------------------- -subroutine SetInputs_for_UA(phi, theta, axInduction, tanInduction, Vx, Vy, omega, chord, kinVisc, UserProp, u_UA) +subroutine SetInputs_for_UA(BEM_Mod, phi, theta, cantAngle, toeAngle, axInduction, tanInduction, chord, Vx, Vy, Vz, omega, kinVisc, UserProp, xVelCorr, u_UA) + integer(IntKi), intent(in ) :: BEM_Mod real(ReKi), intent(in ) :: UserProp ! User property (for 2D Airfoil interp) real(ReKi), intent(in ) :: phi real(ReKi), intent(in ) :: theta + real(ReKi), intent(in ) :: cantAngle + real(ReKi), intent(in ) :: toeAngle real(ReKi), intent(in ) :: axInduction real(ReKi), intent(in ) :: tanInduction real(ReKi), intent(in ) :: Vx real(ReKi), intent(in ) :: Vy + real(ReKi), intent(in ) :: Vz real(ReKi), intent(in ) :: omega ! aka PitchRate real(ReKi), intent(in ) :: chord real(ReKi), intent(in ) :: kinVisc + real(ReKi), intent(in ) :: xVelCorr type(UA_InputType), intent( out) :: u_UA ! ....... compute inputs to UA ........... - u_UA%alpha = phi - theta ! angle of attack + call computeAirfoilOperatingAOA(BEM_Mod, phi, theta, cantAngle, toeAngle ,u_UA%alpha ) u_UA%UserProp = UserProp ! Need to compute relative velocity at the aerodynamic center, including both axial and tangential induction ! COMPUTE: u_UA%U, u_UA%Re, u_UA%v_ac - call GetRelativeVelocity( axInduction, tanInduction, Vx, Vy, u_UA%U, u_UA%v_ac ) - call GetReynoldsNumber( axInduction, tanInduction, Vx, Vy, chord, kinVisc, u_UA%Re) + if (BEM_Mod==BEMMod_2D) then + ! Setting Cant, Toe and xVelCorr to 0 + call GetRelativeVelocity( axInduction, tanInduction, Vx, Vy, 0.0_ReKi, 0.0_ReKi, u_UA%U, u_UA%v_ac ) + call GetReynoldsNumber(BEM_Mod, axInduction, tanInduction, Vx, Vy, Vz, chord, kinVisc, theta, phi, 0.0_ReKi, 0.0_ReKi, u_UA%Re) + else + call GetRelativeVelocity( axInduction, tanInduction, Vx, Vy, cantAngle, xVelCorr, u_UA%U, u_UA%v_ac ) + call GetReynoldsNumber(BEM_Mod, axInduction, tanInduction, Vx, Vy, Vz, chord, kinVisc, theta, phi, cantAngle, toeAngle, u_UA%Re) + endif u_UA%v_ac(1) = sin(u_UA%alpha)*u_UA%U u_UA%v_ac(2) = cos(u_UA%alpha)*u_UA%U @@ -2196,7 +2273,7 @@ subroutine SetInputs_for_UA_AllNodes(u, p, phi, axInduction, tanInduction, u_UA) !............................................ do j = 1,p%numBlades ! Loop through all blades do i = 1,p%numBladeNodes ! Loop through the blade nodes / elements - phi(i,j) = ComputePhiWithInduction( u%Vx(i,j), u%Vy(i,j), axInduction(i,j), tanInduction(i,j) ) + phi(i,j) = ComputePhiWithInduction( u%Vx(i,j), u%Vy(i,j), axInduction(i,j), tanInduction(i,j), u%cantAngle(i,j), u%xVelCorr(i,j) ) enddo ! I - Blade nodes / elements enddo ! J - All blades end if @@ -2208,7 +2285,7 @@ subroutine SetInputs_for_UA_AllNodes(u, p, phi, axInduction, tanInduction, u_UA) do i = 1,p%numBladeNodes ! Loop through the blade nodes / elements ! Compute AoA, Re, Vrel (inputs to UA) based on current values of axInduction, tanInduction: - call SetInputs_for_UA(phi(i,j), u%theta(i,j), axInduction(i,j), tanInduction(i,j), u%Vx(i,j), u%Vy(i,j), u%omega_z(i,j), p%chord(i,j), p%kinVisc, u%UserProp(i,j), u_UA(i,j)) + call SetInputs_for_UA(p%BEM_Mod, phi(i,j), u%theta(i,j), u%cantAngle(i,j), u%toeAngle(i,j), axInduction(i,j), tanInduction(i,j), p%chord(i,j), u%Vx(i,j), u%Vy(i,j), u%Vz(i,j), u%omega_z(i,j), p%kinVisc, u%UserProp(i,j), u%xVelCorr(i,j), u_UA(i,j)) end do end do diff --git a/modules/aerodyn/src/BEMTUncoupled.f90 b/modules/aerodyn/src/BEMTUncoupled.f90 index 1107f48aa6..ae5f3b1718 100644 --- a/modules/aerodyn/src/BEMTUncoupled.f90 +++ b/modules/aerodyn/src/BEMTUncoupled.f90 @@ -26,21 +26,19 @@ module BEMTUnCoupled use UnsteadyAero use UnsteadyAero_Types use BEMT_Types + use PolynomialRoots implicit none - integer(IntKi), public, parameter :: SkewMod_Orthogonal = 0 ! Inflow orthogonal to rotor [-] - integer(IntKi), public, parameter :: SkewMod_Uncoupled = 1 ! Uncoupled (no correction) [-] - integer(IntKi), public, parameter :: SkewMod_PittPeters = 2 ! Pitt/Peters [-] - integer(IntKi), public, parameter :: SkewMod_Coupled = 3 ! Coupled [-] - real(ReKi), public, parameter :: BEMT_MaxInduction(2) = (/1.5_ReKi, 1.0_ReKi /) ! largest magnitude of axial (1) and tangential (2) induction factors real(ReKi), public, parameter :: BEMT_MinInduction(2) = -1.0_ReKi real(ReKi), public, parameter :: BEMT_lowerBoundTSR = 1.0_ReKi real(ReKi), public, parameter :: BEMT_upperBoundTSR = 2.0_ReKi + real(R8Ki), parameter :: MaxTanChi0 = 100.0_R8Ki ! maximum absolute value allowed for tan(chi0), an arbitary large number + !1e-6 works for double precision, but not single precision real(ReKi), public, parameter :: BEMT_epsilon2 = 10.0_ReKi*sqrt(epsilon(1.0_ReKi)) !this is the tolerance in radians for values around singularities in phi (i.e., phi=0 and phi=pi/2); must be large enough so that EqualRealNos(BEMT_epsilon2, 0.0_ReKi) is false @@ -52,8 +50,12 @@ module BEMTUnCoupled public :: BEMTU_InductionWithResidual public :: ApplySkewedWakeCorrection public :: Transform_ClCd_to_CxCy + public :: getAirfoilOrientation + public :: computeAirfoilOperatingAOA + public :: Transform_ClCdCm_to_CxCyCzCmxCmyCmz public :: getHubTipLossCorrection public :: limitInductionFactors + public :: GetEulerAnglesFromOrientation public :: VelocityIsZero contains @@ -74,40 +76,145 @@ function VelocityIsZero ( v ) end function VelocityIsZero !.................................................................................................................................. - subroutine GetReynoldsNumber( axInduction, tanInduction, Vx, Vy, chord, nu, Re ) + subroutine GetReynoldsNumber(BEM_Mod, axInduction, tanInduction, Vx, Vy, Vz, chord, nu, theta, phi, cantAngle, toeAngle , Re ) + ! in - real(ReKi), intent(in) :: axInduction, tanInduction, Vx, Vy + integer(IntKi), intent(in) :: BEM_Mod + real(ReKi), intent(in) :: axInduction, tanInduction, Vx, Vy, Vz real(ReKi), intent(in) :: chord, nu - + real(ReKi), intent(in) :: cantAngle, theta, phi, toeAngle !note phi is unused + ! out real(ReKi), intent(out) :: Re ! Reynolds number - real(ReKi) :: W ! relative velocity + real(ReKi) :: Wxy ! relative velocity + real(ReKi) :: afAxialVec(3), afNormalVec(3), afRadialVec(3), inflowVec(3),inflowVecInAirfoilPlane(3) +!bjj: this doesn't seem consistent with computeAirfoilOperatingAOA, which uses phiN + inflowVec(1) = Vx*(1-axInduction) + inflowVec(2) = Vy*(1+tanInduction) + inflowVec(3) = Vz + + ! Project inflow vector onto airfoil plane + if(BEM_Mod==BEMMod_2D) then + ! TODO TODO TODO EB CHECK THAT THE SAME MIGHT BE OBTAINED IF cant=0, toe=0 + inflowVecInAirfoilPlane(1) = inflowVec(1) + inflowVecInAirfoilPlane(2) = inflowVec(2) + inflowVecInAirfoilPlane(3) = 0.0_ReKi + else + call getAirfoilOrientation( theta, cantAngle,toeAngle ,afAxialVec, afNormalVec, afRadialVec ) + inflowVecInAirfoilPlane = inflowVec - dot_product( inflowVec, afRadialVec ) * afRadialVec - W = sqrt((Vx*(1-axInduction))**2 + (Vy*(1+tanInduction))**2) + endif + + ! Wxy: resultant velocity in the xy airfoil plane. + Wxy = sqrt(inflowVecInAirfoilPlane(1)**2 + inflowVecInAirfoilPlane(2)**2) - Re = W * chord / nu - if ( EqualRealNos(Re, 0.0_ReKi) ) Re = 0.001 ! Do this to avoid a singularity when we take log(Re) in the airfoil lookup. + Re = Wxy * chord / nu + if ( Re <= 0.001 ) Re = 0.001 ! Do this to avoid a singularity when we take log(Re) in the airfoil lookup. end subroutine GetReynoldsNumber !.................................................................................................................................. - subroutine GetRelativeVelocity( axInduction, tanInduction, Vx, Vy, Vrel, v_ac ) + subroutine GetRelativeVelocity( axInduction, tanInduction, Vx, Vy, cantAngle, xVelCorr, Vrel, v_ac ) ! in - real(ReKi), intent(in) :: axInduction, tanInduction, Vx, Vy + real(ReKi), intent(in) :: axInduction, tanInduction, Vx, Vy, cantAngle, xVelCorr ! out real(ReKi), intent(out) :: Vrel ! relative velocity real(ReKi), intent(out) :: v_ac(2) ! components of relative velocity - v_ac(1) = Vx*(1-axInduction) - v_ac(2) = Vy*(1+tanInduction) +!bjj: check that the cantAngle modification works for UA!!!! + + v_ac(1) = (Vx*cos(cantAngle)+xVelCorr)*(1.0_ReKi-axInduction) + v_ac(2) = Vy*(1.0_ReKi+tanInduction) Vrel = TwoNorm(v_ac) + end subroutine GetRelativeVelocity !.................................................................................................................................. +!> getAirfoilOrientation = R_ap = transformation from from polar coordinate system of the section to the airfoil coordinate system + subroutine getAirfoilOrientation( theta, cantAngle, toeAngle, afAxialVec, afNormalVec, afRadialVec ) + ! Routine for creating the airfoil orientation vectors + + implicit none + + real(ReKi), intent(in ) :: theta + real(ReKi), intent(in ) :: cantAngle + real(ReKi), intent(in ) :: toeAngle + real(ReKi), intent( out) :: afAxialVec(3) + real(ReKi), intent( out) :: afNormalVec(3) + real(ReKi), intent( out) :: afRadialVec(3) + real(ReKi) :: orientation(3) + real(ReKi) :: rotMat(3,3) + + orientation(1) = toeAngle + orientation(2) = cantAngle + orientation(3) = -theta + rotMat = EulerConstruct( orientation ) + + ! unit vector normal to the chord line in the airfoil plane + afNormalVec = rotMat(1,:) + + ! unit vector tangent to the chord line in the airfoil plane + ! pointing from leading- to trailing-edge + afAxialVec = rotMat(2,:) + + ! Unit vector normal to airfoil plane + afRadialVec = rotMat(3,:) + + end subroutine getAirfoilOrientation +!.................................................................................................................................. + subroutine computeAirfoilOperatingAOA( BEM_Mod, phi, theta, cantAngle, toeAngle, AoA ) + ! Routine for computing local angle-of-attack in the airfoil reference frame + ! accounting for the current orientation of the airfoil relative to the inflow + ! defined by the phi angle. + + implicit none + + integer(IntKi), intent(in ) :: BEM_Mod + real(ReKi), intent(in ) :: phi + real(ReKi), intent(in ) :: theta + real(ReKi), intent(in ) :: cantAngle + real(ReKi), intent(in ) :: toeAngle + real(ReKi), intent( out) :: AoA + real(ReKi) :: afAxialVec(3) + real(ReKi) :: afNormalVec(3) + real(ReKi) :: afRadialVec(3) + real(ReKi) :: inflowVec(3) + real(ReKi) :: inflowVecInAirfoilPlane(3) + real(ReKi) :: signOfAngle + real(ReKi) :: numer, denom, ratio + real(ReKi) :: phiN + + if (BEM_Mod==BEMMod_2D) then + AoA = phi - theta ! angle of attack + else + ! get airfoil orientation vectors + call getAirfoilOrientation( theta, cantAngle, toeAngle ,afAxialVec, afNormalVec, afRadialVec ) + phiN = getNewPhi(phi,cantAngle) + + ! Create inflow vector + inflowVec(1) = sin( phiN) + inflowVec(2) = cos( phiN) + inflowVec(3) = 0.0_Reki + + ! Project inflow vector onto airfoil plane + inflowVecInAirfoilPlane = inflowVec - dot_product( inflowVec, afRadialVec ) * afRadialVec + + ! Determine angle of attack as angle between airfoil chordline (afAxialVec) and inflow (inflowVecInAirfoilPlane) + numer = dot_product( inflowVecInAirfoilPlane, afAxialVec ) + denom = TwoNorm( inflowVecInAirfoilPlane ) + ratio = numer / denom + AoA = acos( max( min( ratio, 1.0_ReKi ), -1.0_ReKi ) ) + signOfAngle = dot_product( cross_product( inflowVecInAirfoilPlane, afAxialVec ), afRadialVec ) + AoA = sign( AoA, signOfAngle ) + endif + + +end subroutine computeAirfoilOperatingAOA +!.................................................................................................................................. subroutine Transform_ClCd_to_CxCy( phi, useAIDrag, useTIDrag, Cl, Cd, Cx, Cy ) real(ReKi), intent(in ) :: phi logical, intent(in ) :: useAIDrag @@ -137,10 +244,59 @@ subroutine Transform_ClCd_to_CxCy( phi, useAIDrag, useTIDrag, Cl, Cd, Cx, Cy ) end subroutine Transform_ClCd_to_CxCy !---------------------------------------------------------------------------------------------------------------------------------- +subroutine Transform_ClCdCm_to_CxCyCzCmxCmyCmz( phi, theta, cant,toeAngle ,useAIDrag, useTIDrag, AOA, Cl, Cd, Cm, Cx, Cy, Cz, Cmx, Cmy, Cmz ) + implicit none + + real(ReKi), intent(in ) :: phi ! note that this is unused + real(ReKi), intent(in ) :: theta + real(ReKi), intent(in ) :: cant + real(ReKi), intent(in ) :: toeAngle + logical, intent(in ) :: useAIDrag + logical, intent(in ) :: useTIDrag + real(ReKi), intent(in ) :: AOA + real(ReKi), intent(in ) :: Cl + real(ReKi), intent(in ) :: Cd + real(ReKi), intent(in ) :: Cm + real(ReKi), intent( out) :: Cx, Cy, Cz + real(ReKi), intent( out) :: Cmx, Cmy, Cmz + real(ReKi) :: afAxialVec(3) + real(ReKi) :: afNormalVec(3) + real(ReKi) :: afRadialVec(3) + real(ReKi) :: coeffVec(3) + real(ReKi) :: Cn + real(ReKi) :: Ct + + ! get airfoil orientation vectors + call getAirfoilOrientation( theta, cant, toeAngle, afAxialVec, afNormalVec, afRadialVec ) + + ! transform force coefficients into airfoil frame + if ( useAIDrag ) then + Cn = Cl*cos(AOA) + Cd*sin(AOA) + else + Cn = Cl*cos(AOA) + end if + if ( useTIDrag ) then + Ct = -Cl*sin(AOA) + Cd*cos(AOA) + else + Ct = -Cl*sin(AOA) + end if + + ! Put force coefficients back into rotor plane reference frame + coeffVec = Cn*afNormalVec + Ct*afAxialVec + Cx = coeffVec(1) + Cy = -coeffVec(2) + Cz = coeffVec(3) + + ! Put moment coefficients into the rotor reference frame + coeffVec = Cm * afRadialVec + Cmx = coeffVec(1) + Cmy = coeffVec(2) + Cmz = coeffVec(3) +end subroutine Transform_ClCdCm_to_CxCyCzCmxCmyCmz !---------------------------------------------------------------------------------------------------------------------------------- !>This is the residual calculation for the uncoupled BEM solve -real(ReKi) function BEMTU_InductionWithResidual(p, u, i, j, phi, AFInfo, IsValidSolution, ErrStat, ErrMsg, a, ap ) result (ResidualVal) +real(ReKi) function BEMTU_InductionWithResidual(p, u, i, j, phi, AFInfo, IsValidSolution, ErrStat, ErrMsg, a, ap, k, kp, Cx_out, Cy_out ) result (ResidualVal) type(BEMT_ParameterType),intent(in ) :: p !< parameters @@ -155,6 +311,9 @@ real(ReKi) function BEMTU_InductionWithResidual(p, u, i, j, phi, AFInfo, IsValid character(*), intent( out) :: ErrMsg ! Error message if ErrStat /= ErrID_None real(ReKi), optional, intent( out) :: a ! computed axial induction real(ReKi), optional, intent( out) :: ap ! computed tangential induction + real(ReKi), optional, intent( out) :: k ! k in the induction factors routine + real(ReKi), optional, intent( out) :: kp ! kp in the induction factors routine + ! Local variables @@ -166,18 +325,22 @@ real(ReKi) function BEMTU_InductionWithResidual(p, u, i, j, phi, AFInfo, IsValid real(ReKi) :: axInduction real(ReKi) :: tanInduction + real(ReKi) :: F ! tip/hub loss factor real(ReKi) :: Re - real(ReKi) :: Cx, Cy + real(ReKi) :: Cx, Cy, Cz + real(ReKi), optional, intent( out) :: Cx_out, Cy_out + real(ReKi) :: dumX,dumY,dumZ, k_out, kp_out TYPE(AFI_OutputType) :: AFI_interp - ErrStat = ErrID_None ErrMsg = "" ResidualVal = 0.0_ReKi IsValidSolution = .true. + k_out = 0 + kp_out = 0 + ! make these return values consistent with what is returned in inductionFactors routine: - ! Set the local version of the induction factors if ( p%FixedInductions(i,j) ) then ! We are simply going to bail if we are using tiploss and tipLossConst = 0 or using hubloss and hubLossConst=0, regardless of phi! [do this before checking if Vx or Vy is zero or you'll get jumps in the induction and loads] @@ -187,29 +350,50 @@ real(ReKi) function BEMTU_InductionWithResidual(p, u, i, j, phi, AFInfo, IsValid axInduction = 0.0_ReKi tanInduction = 0.0_ReKi else !if ( (.NOT. VelocityIsZero(Vx)) .AND. (.NOT. VelocityIsZero(Vy)) ) then + + ! Compute operating conditions in the airfoil reference frame + call computeAirfoilOperatingAOA(p%BEM_Mod, phi, u%theta(i,j), u%cantAngle(i,j), u%toeAngle(i,j), AOA ) - AOA = phi - u%theta(i,j) - ! FIX ME: Note that the Re used here is computed assuming axInduction and tanInduction are 0. Is that a problem for 2D Re interpolation on airfoils? or should update solve method to take this into account? - call GetReynoldsNumber( 0.0_ReKi, 0.0_ReKi, u%Vx(i,j), u%Vy(i,j), p%chord(i,j), p%kinVisc, Re) + call GetReynoldsNumber(p%BEM_Mod, 0.0_ReKi, 0.0_ReKi, u%Vx(i,j), u%Vy(i,j), u%Vz(i,j), p%chord(i,j), p%kinVisc, u%theta(i,j), phi, u%cantAngle(i,j), u%toeAngle(i,j), Re) + call AFI_ComputeAirfoilCoefs( AOA, Re, u%UserProp(i,j), AFInfo, AFI_interp, errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) if (ErrStat >= AbortErrLev) return ! Compute Cx, Cy given Cl, Cd and phi, we honor the useAIDrag and useTIDrag flag because Cx,Cy are only used for the solution of inductions - call Transform_ClCd_to_CxCy( phi, p%useAIDrag, p%useTIDrag, AFI_interp%Cl, AFI_interp%Cd, Cx, Cy ) + if(p%BEM_Mod==BEMMod_2D) then + call Transform_ClCd_to_CxCy( phi, p%useAIDrag, p%useTIDrag, AFI_interp%Cl, AFI_interp%Cd, Cx, Cy ) + else + call Transform_ClCdCm_to_CxCyCzCmxCmyCmz( phi, u%theta(i,j), u%cantAngle(i,j), u%toeAngle(i,j), p%useAIDrag, p%useTIDrag, & + AOA, AFI_interp%Cl, AFI_interp%Cd, AFI_interp%Cm, Cx, Cy, Cz, dumX, dumY, dumZ ) + endif ! Determine axInduction, tanInduction for the current Cl, Cd, phi - call inductionFactors( u%rlocal(i,j), p%chord(i,j), phi, Cx, Cy, p%numBlades, & + if(p%BEM_Mod==BEMMod_2D) then + call inductionFactors0( u%rlocal(i,j), p%chord(i,j), phi, Cx, Cy, p%numBlades, & u%Vx(i,j), u%Vy(i,j), p%useTanInd, p%useHubLoss, p%useTipLoss, p%hubLossConst(i,j), p%tipLossConst(i,j), & ResidualVal, axInduction, tanInduction, IsValidSolution) + else + ! Prandtl's tip and hub loss factor + ! TODO TODO TODO EB Unify with 2D, compute F for both before induction + F = getHubTipLossCorrection(p%BEM_Mod, p%useHubLoss, p%useTipLoss, p%hubLossConst(i,j), p%tipLossConst(i,j), phi, u%cantAngle(i,j) ) + F = max(F,0.0001_ReKi) + call inductionFactors2( p%numBlades, u%rlocal(i,j), p%chord(i,j), phi, Cx, Cy, u%Vx(i,j), u%Vy(i,j), u%drdz(i,j), u%cantAngle(i,j), F, u%CHI0, p%useTanInd, & + ResidualVal, axInduction, tanInduction, p%MomentumCorr, u%xVelCorr(i,j), IsValidSolution, k_out, kp_out ) + + endif end if if (present(a )) a = axInduction if (present(ap)) ap = tanInduction + if (present(k )) k = k_out + if (present(kp)) kp = kp_out + if (present(Cx_out)) Cx_out = Cx + if (present(Cy_out)) Cy_out = Cy end function BEMTU_InductionWithResidual !----------------------------------------------------------------------------------------- @@ -257,7 +441,7 @@ subroutine ApplySkewedWakeCorrection( yawCorrFactor, azimuth, chi0, tipRatio, a, end subroutine ApplySkewedWakeCorrection !----------------------------------------------------------------------------------------- !> This subroutine computes the induction factors (a) and (ap) along with the residual (fzero) -subroutine inductionFactors(r, chord, phi, cn, ct, B, Vx, Vy, wakerotation, useHubLoss, useTipLoss, hubLossConst, tipLossConst, & +subroutine inductionFactors0(r, chord, phi, cn, ct, B, Vx, Vy, wakerotation, useHubLoss, useTipLoss, hubLossConst, tipLossConst, & fzero, a, ap, IsValidSolution) implicit none @@ -312,10 +496,10 @@ subroutine inductionFactors(r, chord, phi, cn, ct, B, Vx, Vy, wakerotation, useH !..................................................... ! Prandtl's tip and hub loss factor: !..................................................... - - F = getHubTipLossCorrection(sphi, useHubLoss, useTipLoss, hubLossConst, tipLossConst) ! Prandtl's tip and hub loss factor + ! TODO TODO TODO EB Put this up like BEM_Mod3d + F = getHubTipLossCorrection(BEMMod_2D, useHubLoss, useTipLoss, hubLossConst, tipLossConst, phi, cantAngle=0.0_ReKi) - + !..................................................... ! compute axial induction factor: !..................................................... @@ -428,8 +612,351 @@ subroutine inductionFactors(r, chord, phi, cn, ct, B, Vx, Vy, wakerotation, useH fzero = sphi*(1-k) - cphi/lambda_r*(1-kp) end if -end subroutine inductionFactors +end subroutine inductionFactors0 !----------------------------------------------------------------------------------------- +!> This subroutine computes the induction factors (a) and (ap) along with the residual (fzero) +subroutine inductionFactors2( B, r, chord, phi, cn, ct, Vx, Vy, drdz,cantAngle, F, CHI0, wakerotation, & + fzero_out, a_out, ap_out, MomentumCorr, xVelCorr, IsValidSolution, k_out, kp_out ) + + implicit none + + ! in + integer, intent(in) :: B !< number of blades [p%numBlades] + real(ReKi), intent(in) :: r !< local radial position [u%rlocal] + real(ReKi), intent(in) :: chord !< chord [p%chord] + real(ReKi), intent(in) :: phi !< angle between the plane of rotation and the direction of the local wind [y%phi]; must be in range [-pi,pi] + real(ReKi), intent(in) :: cn !< normal force coefficient (normal to the plane, not chord) of the jth node in the kth blade; [y%cx] + real(ReKi), intent(in) :: ct !< tangential force coefficient (tangential to the plane, not chord) of the jth node in the kth blade; [y%cy] + real(ReKi), intent(in) :: Vx !< velocity component [u%Vx] + real(ReKi), intent(in) :: Vy !< velocity component [u%Vy] + real(ReKi), intent(in) :: drdz, cantAngle + real(ReKi), intent(in) :: F !< hub/tip loss correction factor + real(ReKi), intent(in) :: CHI0 !< Yaw + logical, intent(in) :: wakerotation !< Include tangential induction in BEMT calculations [flag] [p%useTanInd] + logical, intent(in) :: MomentumCorr !< Include tangential induction in BEMT calculations [flag] [p%useTanInd] + real(ReKi), intent(in) :: xVelCorr + ! out + real(ReKi), intent(out) :: fzero_out !< residual of BEM equations + real(ReKi), intent(out) :: a_out !< axial induction [y%axInduction] + real(ReKi), intent(out) :: ap_out !< tangential induction, i.e., a-prime [y%tanInduction] + logical, intent(out) :: IsValidSolution !< this is set to false if k<=1 in the propeller brake region or k<-1 in the momentum region, indicating an invalid solution + real(ReKi), intent(out) :: k_out + real(ReKi), intent(out) :: kp_out + + ! local variables + ! NOTE!!! Double precision is used here to help the numerics which become + ! poorly behaved in the vicinity of phi = 0.0 + + real(R8Ki) :: sigma_p ! local solidity (B*chord/(TwoPi*r)) + real(R8Ki) :: sphi, cphi ! sin(phi), cos(phi) + real(R8Ki) :: k, kp ! non-dimensional parameters + real(R8Ki) :: VxCorrected, kCorrectionFactor + real(R8Ki) :: effectiveYaw ! + + + real(R8Ki) :: k0 + real(R8Ki) :: H ! scaling factor to gradually phase out tangential induction when axial induction is near 1.0 + real(R8Ki) :: fzero, a, ap ! double precision versions of output variables of similar name + + real(R8Ki), parameter :: InductionLimit = 1000000.0_R8Ki + + IsValidSolution = .true. + + !..................................................... + ! Some special cases have already been taken care of in BEMTU_InductionWithResidual, the only routine that calls this function + !..................................................... + + !..................................................... + ! Temporary variables: + !..................................................... + effectiveYaw = abs( CHI0 ) + if (equalrealnos(cos(effectiveYaw),0.0_R8Ki)) then + effectiveYaw = effectiveYaw + sqrt(epsilon(effectiveYaw)) + endif + !effectiveYaw = min( 40.0_R8Ki*D2R, effectiveYaw ) + sphi = sin(real(phi,R8Ki)) + cphi = cos(real(phi,R8Ki)) + + !..................................................... + ! compute axial induction factor: + !..................................................... + sigma_p = B*chord/(TwoPi_R8*r) ! local solidity + k = sigma_p*cn/(4.0_R8Ki*F*sphi*sphi)*drdz + + ! "corrections" + VxCorrected = Vx*cos(cantAngle)+xVelCorr + kCorrectionFactor = 1.0_R8Ki + xVelCorr/(Vx*cos(real(cantAngle,R8Ki))) + k = k*kCorrectionFactor**2 + + !k = sign( k, real(phi,R8Ki) ) + k0 = a0(effectiveYaw) / (1.0-a0(effectiveYaw)) + if (.not.MomentumCorr) then + if (k <= k0 ) then + if (VxCorrected > 0.0) then + a = k/(k+1.0) + else + a = k/(k-1.0) + end if + H = 1.0_R8Ki + else + call axialInductionFromEmpiricalThrust( effectiveYaw, phi, k, F, a, H, MomentumCorr ) + endif + else + call axialInductionFromGlauertMomentum(effectiveYaw, phi, k, F, a, H, MomentumCorr) + a = sign(a,k) + endif + + + !..................................................... + ! compute tangential induction factor: + !..................................................... + if (wakerotation) then + + ! compute tangential induction factor + if ( EqualRealNos(cphi,0.0_R8Ki) ) then + + ap = -1.0_R8Ki + kp = sign(InductionLimit, ct*sphi)*sign(1.0_R8Ki,real(Vx,R8Ki)) + + else + !H = smoothStep( real(a,ReKi), 0.8, 1.0, 1.0, 0.0 ) + smoothStep( real(a,ReKi), 1.0, 0.0, 1.2, 1.0 ) + !kp = sigma_p*( cl*sphi - H*cd*cphi )/( 4.0*F*sphi*cphi )*kCorrectionFactor + if (MomentumCorr) then + if (equalrealnos(a,1.0_R8Ki)) then + kp = 0.0_R8Ki !H*sigma_p*ct/( 4.0*F*sphi*cphi )*(kCorrectionFactor) + else + kp = H*sigma_p*ct/( 4.0*F*sphi*cphi )*(kCorrectionFactor)/sqrt(1+(tan(effectiveYaw)/(1.0_ReKi-a))**2) + endif + else + kp = H*sigma_p*ct/( 4.0*F*sphi*cphi )*kCorrectionFactor + endif + + if ( VxCorrected < 0.0_ReKi ) then + kp = -kp + endif + + if ( EqualRealNos(kp,1.0_R8Ki) ) then + ap = sign(InductionLimit, 1.0_R8Ki-kp) + else + ap = kp/(1.0_R8Ki-kp) + end if + + endif + + else + + ! we're not computing tangential induction: + ap = 0.0_R8Ki + kp = 0.0_R8Ki + + end if + + !..................................................... + ! error function (residual) + !..................................................... + if ( EqualRealNos(a,1.0_R8Ki)) then + fzero = - cphi/(Vy*(1.0_R8Ki+ap)) + elseif (EqualRealNos(ap,-1.0_R8Ki)) then + fzero = sphi/(1.0_R8Ki-a) + else + if (momentumCorr) then + fzero = sphi/(1.0_R8Ki-a) - VxCorrected/Vy*cphi/(1.0_R8Ki+ap)!sphi*Vy(1.0_R8Ki+ap) - cphi*(1.0_R8Ki-a)*VxCorrected !sphi*Vy*(1.0_R8Ki+ap) - cphi*VxCorrected*(1.0_R8Ki-a)!cphi/(1.0_R8Ki+ap)*(1.0_R8Ki-a)-sphi*Vy/VxCorrected + else + fzero = sphi/(1.0_R8Ki-a) - VxCorrected/Vy*cphi/(1.0_R8Ki+ap) + endif + + endif + + ! Convert from double to ReKi + fzero_out = real( fzero, ReKi ) + a_out = real( a, ReKi ) + ap_out = real( ap, ReKi ) + k_out = real( k, ReKi ) + kp_out = real( kp, ReKi ) + +end subroutine inductionFactors2 + +real(R8Ki) function a0(chi0) + implicit none + real(R8Ki), intent(in) :: chi0 + a0 = 0.5*cos(45.0*D2R)/cos(chi0) + a0 = min( a0, 0.5_R8Ki ) +end function a0 + +!----------------------------------------------------------------------------------------- +subroutine axialInductionFromEmpiricalThrust( chi0, phi, k, F, axInd, H, momentumCorr ) + implicit none + real(R8Ki), intent(in) :: chi0 + real(ReKi), intent(in) :: phi + real(R8Ki), intent(in) :: k + real(ReKi), intent(in) :: F + logical, intent(in) :: momentumCorr + + real(R8Ki), intent(out) :: axInd + real(R8Ki), intent(out) :: H + + real(R8Ki) :: c2, c1, c0 ! Empirical CT = c2*a^2 + c1*a + c0 for a > a0 + real(R8Ki) :: A,y1,y2,y3, Asquare ! axial induction quadratic solve variables + real(R8Ki) :: coeffs(5) + complex(R8Ki) :: roots(4) + real(R8Ki) :: tan_chi0 + ! Get Coefficients for Empirical CT + call getEmpiricalCoefficients( chi0 ,F , c0, c1, c2,momentumCorr ) + + ! Solve for axial induction + A = 4.0*F*k + if (.NOT.momentumCorr) then + y1 = 2.0*A + c1 + y2 = 4.0*A*(c2+c1+c0) + c1*c1 - 4.0*c0*c2 + y3 = 2.0*(A-c2) + if ( EqualRealNos( y3, 0.0_R8Ki ) ) then + axInd = 1.0 - 1.0/(2.0*SQRT(y2)) + else + if (phi>=0.0) then + axInd = ( y1 - SQRT(y2) ) / y3 + else + axInd = ( y1 + SQRT(y2) ) / y3 + end if + end if + + if ((axInd>a0(chi0)).AND.(axInd<=1.0)) then + H = (4.0*axInd*(1.0-axInd)*F)/(c0+c1*axInd+c2*axInd*axInd) + elseif (axInd>1.0) then + H = (-4.0*axInd*(1.0-axInd)*F)/(c0+c1*axInd+c2*axInd*axInd) + else + H = 1.0 + endif + else + + Asquare = A**2 + coeffs(5) = Asquare - c2*c2 + coeffs(4) = -4*Asquare-2*c1*c2 + coeffs(3) = 6*Asquare -2*c0*c2 -c1*c1 + coeffs(2) = -4*Asquare - 2*c0*c1 + coeffs(1) = Asquare -c0*c0 + call QuarticRoots(coeffs,roots) + call sortRoots(roots) + + if (phi >= 0.0) then + if (real(roots(1))<0.0_R8Ki) then + axInd = real(roots(2)) + elseif (real(roots(2))<1.0_R8Ki) then + axInd = real(roots(2)) + else + axInd = real(roots(1)) + endif + else + axInd = real(roots(2)) + endif + + tan_chi0 = min(MaxTanChi0, max(-MaxTanChi0, tan(chi0))) + + if (equalrealnos(axInd,1.0_R8Ki)) then + H = 0 + elseif ((axInd>a0(chi0)).AND.(axInd<=1.0)) then + H = 4.0_R8Ki*axInd*(1.0_R8Ki-axInd)*F*sqrt(1 + (tan_chi0/(1.0_R8Ki-axInd)*F)**2)/sqrt((c0+c1*axInd+c2*axInd*axInd)**2 + (4.0_R8Ki*axInd*tan_chi0)**2) + ! Alternatively following implemention can be used but it keeps H from approaching zero as a -> 1 + !H = (4.0_R8Ki*axInd*sqrt(((1.0_R8Ki-axInd)*F)**2 + tan(chi0)**2))/sqrt((c0+c1*axInd+c2*axInd*axInd)**2 + (4.0_R8Ki*axInd*tan(chi0))**2) + elseif (axInd>1.0) then + H = -4.0_R8Ki*axInd*(1.0_R8Ki-axInd)*F*sqrt(1 + (tan_chi0/(1.0_R8Ki-axInd)*F)**2)/sqrt((c0+c1*axInd+c2*axInd*axInd)**2 + (4.0_R8Ki*axInd*tan_chi0)**2) + ! Alternatively following implemention can be used but it keeps H from approaching zero as a -> 1 + !H = -(4.0_R8Ki*axInd*sqrt(((1.0_R8Ki-axInd)*F)**2 + tan(chi0)**2))/sqrt((c0+c1*axInd+c2*axInd*axInd)**2 + (4.0_R8Ki*axInd*tan(chi0))**2) + else + H = 1.0 + endif + if (k<0.0) then + H = 1.0 + endif + endif + +end subroutine axialInductionFromEmpiricalThrust + +subroutine axialInductionFromGlauertMomentum(chi0, phi, k, F, axInd, H,momentumCorr) + ! axialInductionFromGlauertMomentum calculates axial induction using Glauert Momentum Theory + implicit none + real(R8Ki), intent(in) :: chi0 + real(R8Ki), intent(in) :: k + real(ReKi), intent(in) :: F + real(ReKi), intent(in) :: phi + logical, intent(in) :: momentumCorr + real(R8Ki), intent(out):: axInd + real(R8Ki), intent(out):: H + real(R8Ki) :: c11, c12, coeffs(5), previousRoot + complex(R8Ki) :: roots(4) + real(R8Ki) :: a0_local + real(R8Ki) :: c2, c1, c0 ! Empirical CT = c2*a^2 + c1*a + c0 for a > a0 + real(R8Ki) :: k0 + real(R8Ki) :: tan_chi0 + + ! Get Coefficients for Empirical CT + call getEmpiricalCoefficients( chi0, F, c0, c1, c2,momentumCorr) + + a0_local = a0(chi0) + k0 = a0_local / (1.0-a0_local) + + tan_chi0 = min(MaxTanChi0, max(-MaxTanChi0, tan(chi0))) + if (abs(k) <= k0*sqrt(1+(tan_chi0/(1-a0_local))**2)) then + c11 = tan_chi0**2 + c12 = k**2 + coeffs(5) = 1.0_R8Ki-c12 + coeffs(4) = 4.0_R8Ki*c12-2.0_R8Ki + coeffs(3) = 1.0_R8Ki+c11 -6.0_R8Ki*c12 + coeffs(2) = 4.0_R8Ki*c12 + coeffs(1) = -c12 + + call QuarticRoots(coeffs,roots) + call sortRoots(roots) + if (phi >= 0.0) then + if (real(roots(1))<0.0_R8Ki) then + axInd = real(roots(2)) + else + axInd = real(roots(1))!min(real(roots(1)),real(roots(2))) + endif + else + axInd = min(real(roots(1)),real(roots(2))) + endif + + previousRoot = axInd + H = 1.0_R8Ki + else !if (k > k0) then ! High induction/ empirical correction + call axialInductionFromEmpiricalThrust( chi0, phi, k, F, axInd, H, momentumCorr ) + endif +end subroutine axialInductionFromGlauertMomentum + +subroutine getEmpiricalCoefficients( chi0, F, c0, c1, c2, MomentumCorr ) + real(R8Ki), intent(in) :: chi0 + real(ReKi), intent(in) :: F + logical, intent(in) :: MomentumCorr + real(R8Ki), intent(inout) :: c0, c1, c2 ! Empirical CT = c2*a^2 + c1*a + c0 for a > a0 + real(R8Ki) :: a0_local + real(R8Ki) :: CTata1 + real(R8Ki) :: denom, temp1, temp2 + + ! Empirical CT = 4*a*(1-a)*F = c2*a^2 + c1*a + c0 for a > a0 + ! third Boundary condition (CT@a=1) is based on equations from Bladed. + a0_local = a0(chi0) + denom = (a0_local**2 - 2.0_R8Ki*a0_local + 1.0_R8Ki) + if (MomentumCorr) then + temp2 = (min(MaxTanChi0, max(-MaxTanChi0, tan(chi0))))**2 + temp1 = sqrt((a0_local-1)**2 +temp2) + + CTata1 = sqrt(((-0.64755/(cos(chi0)*cos(chi0)) - 0.8509/cos(chi0) + 3.4984)*F)**2 + 16*temp2) + CTata1 = max( 1.0_R8Ki, CTata1 ) + + c2 = (CTata1 - 4*F/temp1 + 16*F*a0_local/temp1 - 4*F*a0_local*temp1 - 4*temp2*F/temp1 - 20*F*(a0_local**2)/temp1 + 8*F*(a0_local**3)/temp1 + 4*temp2*F*a0_local/temp1 ) /denom + c1 = 2*( 2*F/temp1 - a0_local*CTata1 - 6*F*a0_local/temp1 + 2*temp2*F/temp1 + 2*F*(a0_local**2)/temp1 + 4*F*(a0_local**2)*temp1 + 6*F*(a0_local**3)/temp1 - 4*F*(a0_local**4)/temp1 - 2*temp2*F*(a0_local**2)/temp1 )/denom + c0 = a0_local*( a0_local*CTata1 - 4*F/temp1 + 4*F*temp1 + 16*F*a0_local/temp1 - 8*F*a0_local*temp1 - 4*temp2*F/temp1 - 20*F*(a0_local**2)/temp1 + 8*F*(a0_local**3)/temp1 + 4*temp2*F*a0_local/temp1 )/denom + + else + CTata1 = (-0.64755/(cos(chi0)*cos(chi0)) - 0.8509/cos(chi0) + 3.4984)*F + CTata1 = max( 1.0_R8Ki, CTata1 ) + c2 = (-4.0_R8Ki*F*a0_local**2 + 8.0_R8Ki*F*a0_local - 4.0_R8Ki*F + CTata1)/denom + c1 = 2.0_R8Ki*(2.0_R8Ki*F*a0_local**2 - CTata1*a0_local - 4.0_R8Ki*F*a0_local + 2.0_R8Ki*F)/denom + c0 = CTata1*(a0_local**2)/denom + endif + + +end subroutine getEmpiricalCoefficients subroutine limitInductionFactors(a,ap) real(ReKi), intent(inout) :: a ! axial induction real(ReKi), intent(inout), optional :: ap ! tangential induction @@ -445,18 +972,59 @@ subroutine limitInductionFactors(a,ap) end if end subroutine limitInductionFactors +!----------------------------------------------------------------------------------------- +subroutine sortRoots(a) +! Sort the roots + complex(R8Ki), intent(inout) :: a(4) + real(R8Ki) :: reala(4) + INTEGER :: j, ind(4) + INTEGER,DIMENSION(1):: k + + do j = 1,size(a) + if (equalrealnos(aimag(a(j)),0.0_R8Ki)) then + reala(j) = real(a(j)) + else + reala(j) = 10000_R8Ki + endif + ind(j) = j + enddo + + DO j=1,SIZE(a)-1 + k=(j-1)+MINLOC(reala(j:)) + IF (j /= k(1)) CALL SwapInt(ind(k(1)),ind(j)) + END DO + + a = a(ind) + + +end subroutine sortRoots + +subroutine SwapInt(a,b) + INTEGER,INTENT(IN OUT):: a,b + INTEGER :: t + + t=b + b=a + a=t + RETURN + +end subroutine SwapInt + + !----------------------------------------------------------------------------------------- !> This function computes \f$F\f$, the hub/tip loss correction -real(reKi) function getHubTipLossCorrection(sphi, useHubLoss, useTipLoss, hubLossConst, tipLossConst) result(F) +real(reKi) function getHubTipLossCorrection(BEM_Mod, useHubLoss, useTipLoss, hubLossConst, tipLossConst, phi, cantAngle) result(F) - real(ReKi), intent(in) :: sphi !< sine of local inflow angle, sin(phi) + integer(IntKi), intent(in) :: BEM_Mod !< BEM Model real(ReKi), intent(in) :: hubLossConst !< hub loss constant [p%hubLossConst] real(ReKi), intent(in) :: tipLossConst !< tip loss constant [p%tipLossConst] logical, intent(in) :: useHubLoss !< hub-loss flag [p%useHubLoss] logical, intent(in) :: useTipLoss !< tip-loss flag [p%useTipLoss] - + real(ReKi), intent(in) :: phi !< local inflow angle phi + real(ReKi), intent(in) :: cantAngle !< cant angle real(ReKi) :: factortip, Ftip, factorhub, Fhub + real(ReKi) :: phiN, sphiN !sinBeta !..................................................... ! Prandtl's tip and hub loss factor: @@ -465,23 +1033,79 @@ real(reKi) function getHubTipLossCorrection(sphi, useHubLoss, useTipLoss, hubLos Ftip = 1.0_ReKi ! default tip loss value Fhub = 1.0_ReKi ! default hub loss value - if (.not. EqualRealNos(sphi,0.0_ReKi)) then - if ( useTipLoss ) then - factortip = tipLossConst/abs(sphi) - Ftip = TwoByPi*acos(min(1.0_ReKi,exp(-factortip))) - ! else Ftip = 1.0_ReKi ! TwoByPi*Pi/2 + if (BEM_Mod==BEMMod_2D) then + sphiN = abs(sin(phi)) + + if (.not. EqualRealNos(sphiN,0.0_ReKi)) then + if ( useTipLoss ) then + factortip = tipLossConst/sphiN + Ftip = TwoByPi*acos(min(1.0_ReKi,exp(-factortip))) + ! else Ftip = 1.0_ReKi ! TwoByPi*Pi/2 + end if + + if ( useHubLoss ) then + factorhub = hubLossConst/sphiN + Fhub = TwoByPi*acos(min(1.0_ReKi,exp(-factorhub))) + ! else Ftip = 1.0_ReKi ! TwoByPi*Pi/2 + end if end if + + else + !sinBeta = sin(cantAngle) + !phiN = acos(sqrt(sinBeta**2 + ((cos(cantAngle)**2) * (cos(phi)**2)))) + phiN = getNewPhi(phi,cantAngle) + sphiN = sin(phiN) + + if (.not. EqualRealNos(sphiN,0.0_ReKi)) then + + if ( useTipLoss .AND. (phi > 0.0_ReKi) ) then + factortip = max(-1.0_ReKi, tipLossConst/sphiN) + Ftip = TwoByPi*acos(min(1.0_ReKi,exp(-factortip))) + ! else Ftip = 1.0_ReKi ! TwoByPi*Pi/2 + end if - if ( useHubLoss ) then - factorhub = hubLossConst/abs(sphi) - Fhub = TwoByPi*acos(min(1.0_ReKi,exp(-factorhub))) - ! else Ftip = 1.0_ReKi ! TwoByPi*Pi/2 + if ( useHubLoss .AND. (phi > 0.0_ReKi) ) then + factorhub = max(-1.0_ReKi, hubLossConst/sphiN) + Fhub = TwoByPi*acos(min(1.0_ReKi,exp(-factorhub))) + ! else Ftip = 1.0_ReKi ! TwoByPi*Pi/2 + end if end if - end if + endif ! BEM_Mod F = Ftip * Fhub end function getHubTipLossCorrection !----------------------------------------------------------------------------------------- +function getNewPhi(phi,CantAngle) result(phiN) + real(ReKi), intent(in ) :: phi + real(ReKi), intent(in ) :: cantAngle + real(ReKi) :: phiN + + real(ReKi) :: y + real(ReKi) :: x + + y = sin(phi) + x = cos(phi)*cos(cantAngle) + + if (y==0.0_ReKi .and. x==0.0_ReKi) then + phiN = 0.0_ReKi !atan2 is undefined when y=0 and x=0 + else + phiN = atan2(y, x) + end if + +end function getNewPhi +!---------------------------------------------------------------------------------------------------------------------------------- +FUNCTION GetEulerAnglesFromOrientation(EulerDCM,orientation) RESULT(theta) + LOGICAL , INTENT(IN ) :: EulerDCM + REAL(R8Ki), INTENT(IN ) :: orientation(3,3) + REAL(R8Ki) :: theta(3) + + if (EulerDCM) then + theta = EulerExtract( orientation ) + else + theta = -EulerExtract( transpose(orientation) ) + end if +end function +!----------------------------------------------------------------------------------------- end module BEMTUncoupled diff --git a/modules/aerodyn/src/BEMT_Registry.txt b/modules/aerodyn/src/BEMT_Registry.txt index 5c68c3bca9..cd98adc864 100644 --- a/modules/aerodyn/src/BEMT_Registry.txt +++ b/modules/aerodyn/src/BEMT_Registry.txt @@ -16,10 +16,14 @@ usefrom AirfoilInfo_Registry.txt usefrom UnsteadyAero_Registry.txt usefrom DBEMT_Registry.txt -#param BEMT/BEMT - INTEGER SkewMod_Uncoupled - 1 - "Uncoupled (no correction)" - -#param BEMT/BEMT - INTEGER SkewMod_PittPeters - 2 - "Pitt/Peters" - -#param BEMT/BEMT - INTEGER SkewMod_Coupled - 3 - "Coupled" - +param BEMT/BEMT - INTEGER SkewMod_Orthogonal - 0 - "Inflow orthogonal to rotor [-]" - +param BEMT/BEMT - INTEGER SkewMod_Uncoupled - 1 - "Uncoupled (no correction)" - +param BEMT/BEMT - INTEGER SkewMod_PittPeters - 2 - "Pitt/Peters" - +param BEMT/BEMT - INTEGER SkewMod_Coupled - 3 - "Coupled" - +param BEMT/BEMT - INTEGER SkewMod_PittPeters_Cont - 4 - "Pitt/Peters continuous formulation" - +param BEMT/BEMT - INTEGER BEMMod_2D - 0 - "2D BEM assuming Cx, Cy, phi, L, D are in the same plane" - +param BEMT/BEMT - INTEGER BEMMod_3D - 2 - "3D BEM assuming a momentum balance system, and an airfoil system" - # # @@ -39,6 +43,7 @@ typedef ^ ^ LOGICAL typedef ^ ^ LOGICAL useTanInd - - - "Include tangential induction in BEMT calculations [flag]" - typedef ^ ^ LOGICAL useAIDrag - - - "Include the drag term in the axial-induction calculation? [flag]" - typedef ^ ^ LOGICAL useTIDrag - - - "Include the drag term in the tangential-induction calculation? Ignored if TanInd is False. [flag]" - +typedef ^ ^ LOGICAL MomentumCorr - - - "Momentum Correction {0=Axial Theory, 1 = Glauert Momentum Theory}" - typedef ^ ^ INTEGER numBladeNodes - - - "Number of blade nodes used in the analysis" - typedef ^ ^ INTEGER numReIterations - - - "Number of iterations for finding the Reynolds number" - typedef ^ ^ INTEGER maxIndIterations - - - "Maximum number of iterations of induction factor solve" - @@ -47,7 +52,7 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi zLocal {:}{:} - - "Distance to blade node, measured along the blade" m typedef ^ ^ ReKi zTip {:} - - "Distance to blade tip, measured along the blade" m typedef ^ ^ ReKi rLocal {:}{:} - - "Radial distance to blade node from the center of rotation, measured in the rotor plane, needed for DBEMT" m -typedef ^ ^ ReKi rTipFix {:} - - "Nominally the coned rotor diameter (without prebend)" m +typedef ^ ^ ReKi rTipFix {:} - - "Nominally the coned rotor diameter (without prebend), used to align with Bladed calculations" m typedef ^ ^ INTEGER UAMod - - - "Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema]" - typedef ^ ^ LOGICAL UA_Flag - - - "logical flag indicating whether to use UnsteadyAero" - typedef ^ ^ LOGICAL Flookup - - - "Use table lookup for f' and f'' " - @@ -59,6 +64,7 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER UAOff_outerNode {:} - - "First node on each blade where UA should be turned off based on span location from blade tip (>nNodesPerBlade if always on)" - typedef ^ ^ CHARACTER(1024) RootName - - - "RootName for writing output files" - typedef ^ ^ LOGICAL SumPrint - - - "logical flag indicating whether to use UnsteadyAero" - +typedef ^ ^ IntKi BEM_Mod - - - "BEM Model 0=OpenFAST 2=Envision " - # # # Define outputs from the initialization routine here: @@ -66,11 +72,20 @@ typedef ^ ^ LOGICAL typedef ^ InitOutputType ProgDesc Version - - - "" - # # + +# Define inputs to the Skewed-Wake filter here: +# +typedef ^ BEMT_SkewWake_InputType ReKi v_qsw {3} - - "quasi-steady instantaneous wake velocity (value to be filtered in Skewed Wake model)" m/s +typedef ^ BEMT_SkewWake_InputType ReKi V0 - - - "magnitude of disk-averaged velocity (for input to SkewWake)" m/s +typedef ^ BEMT_SkewWake_InputType ReKi R - - - "rotor radius (for input to SkewWake)" m + + # ..... States .................................................................................................................... # Define continuous (differentiable) states here: # typedef ^ ContinuousStateType UA_ContinuousStateType UA - - - "UA module continuous states" - typedef ^ ContinuousStateType DBEMT_ContinuousStateType DBEMT - - - "DBEMT module continuous states" - +typedef ^ ContinuousStateType R8Ki V_w {3} - - "continuous state for filtering wake velocity" # # # Define discrete (non-differentiable) states here: @@ -89,6 +104,8 @@ typedef ^ OtherStateType UA_OtherSta typedef ^ OtherStateType DBEMT_OtherStateType DBEMT - - - "other states for DBEMT" - typedef ^ ^ LOGICAL ValidPhi {:}{:} - - "set to indicate when there is no valid Phi for this node at this time (temporarially turn off induction when this is false)" - typedef ^ OtherStateType Logical nodesInitialized - - - "the node states have been initialized properly" - +typedef ^ OtherStateType BEMT_ContinuousStateType xdot 4 - - "history states for continuous state integration" - +typedef ^ OtherStateType Integer n - - - "time step # value used for continuous state integrator" - # ..... Misc/Optimization variables................................................................................................. # Define any data that are used only for efficiency purposes (these variables are not associated with time): @@ -100,7 +117,8 @@ typedef ^ MiscVarType UA_MiscVarT typedef ^ MiscVarType DBEMT_MiscVarType DBEMT - - - "misc vars for DBEMT" - typedef ^ MiscVarType UA_OutputType y_UA - - - "outputs from UnsteadyAero" - typedef ^ MiscVarType UA_InputType u_UA {:}{:}{:} - - "inputs to UnsteadyAero at t and t+dt" - -typedef ^ MiscVarType DBEMT_InputType u_DBEMT {:} - - "inputs to DBEMT" - +typedef ^ MiscVarType DBEMT_InputType u_DBEMT {2} - - "inputs to DBEMT at t and t+dt" - +typedef ^ MiscVarType BEMT_SkewWake_InputType u_SkewWake {2} - - "inputs to SkewedWake at t and t+dt" - typedef ^ MiscVarType ReKi TnInd_op {:}{:} - - "tangential induction at the operating point (for linearization with frozen wake assumption)" typedef ^ MiscVarType ReKi AxInd_op {:}{:} - - "axial induction at the operating point (for linearization) with frozen wake assumption" typedef ^ MiscVarType ReKi AxInduction {:}{:} - - "axial induction used for code run-time optimization" - @@ -142,6 +160,11 @@ typedef ^ ^ LOGICAL typedef ^ ^ IntKi DBEMT_Mod - - - "DBEMT Model. 0 = constant tau1, 1 = time dependent tau1" - typedef ^ ^ ReKi yawCorrFactor - - - "constant used in Pitt/Peters skewed wake model (default is 15*pi/32)" - typedef ^ ^ LOGICAL FixedInductions {:}{:} - - "flag to determine if BEM inductions should be fixed and not modified by dbemt or skewed wake" - +typedef ^ ^ LOGICAL MomentumCorr - - - "Momentum Correction {0=Axial Theory, 1 = Glauert Momentum Theory}" - +typedef ^ ^ ReKi rTipFixMax - - - "Nominally the coned rotor diameter (without prebend), used to align with Bladed calculations" m +typedef ^ ^ ReKi IntegrateWeight {:}{:} - - "A weighting factor for calculating rotor-averaged values (e.g., AxInd)" - +typedef ^ ParameterType IntKi lin_nx - 0 - "Number of continuous states for linearization" - +typedef ^ ^ IntKi BEM_Mod - - - "BEM Model 0=OpenFAST 2=Envision " - # # @@ -150,15 +173,23 @@ typedef ^ ^ LOGICAL # typedef ^ InputType ReKi theta {:}{:} - - "Twist angle (includes all sources of twist) [Array of size (NumBlNds,numBlades)]" rad typedef ^ ^ ReKi chi0 - - - "Angle between the vector normal to the rotor plane and the wind vector (e.g., the yaw angle in the case of no tilt)" rad +typedef ^ ^ ReKi psiSkewOffset - - - "Azimuth angle offset (relative to 90 deg) of the most downwind blade when chi0 is non-zero" rad typedef ^ ^ ReKi psi {:} - - "Azimuth angle" rad typedef ^ ^ ReKi omega - - - "Angular velocity of rotor" rad/s typedef ^ ^ ReKi TSR - - - "Tip-speed ratio (to check if BEM should be turned off)" - typedef ^ ^ ReKi Vx {:}{:} - - "Local axial velocity at node" m/s typedef ^ ^ ReKi Vy {:}{:} - - "Local tangential velocity at node" m/s +typedef ^ ^ ReKi Vz {:}{:} - - "Local radial velocity at node" m/s typedef ^ ^ ReKi omega_z {:}{:} - - "rotation of no-sweep-pitch-twist coordinate system around z (for CDBEMT and CUA)" "rad/s" +typedef ^ ^ ReKi xVelCorr {:}{:} - - "projection of velocity when yawed + prebend" m/s typedef ^ ^ ReKi rLocal {:}{:} - - "Radial distance from center-of-rotation to node" m typedef ^ InputType ReKi Un_disk - - - "disk-averaged velocity normal to the rotor disk (for input to DBEMT)" m/s +typedef ^ InputType ReKi V0 {3} - - "disk-averaged velocity (for input to SkewWake)" m/s +typedef ^ InputType R8Ki x_hat_disk {3} - - "Hub Orientation vector: normal to rotor disk" - typedef ^ ^ ReKi UserProp {:}{:} - - "Optional user property for interpolating airfoils (per element per blade)" - +typedef ^ InputType ReKi CantAngle {:}{:} - - "Cant angle [Array of size (NumBlNds,numBlades)]" rad +typedef ^ ^ ReKi drdz {:}{:} - - "dr/dz geometric parameter" - +typedef ^ InputType ReKi toeAngle {:}{:} - - "Toe angle [Array of size (NumBlNds,numBlades)]" rad # # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: @@ -170,6 +201,10 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi AOA {:}{:} - - "angle of attack" rad typedef ^ ^ ReKi Cx {:}{:} - - "normal force coefficient (normal to the plane, not chord) of the jth node in the kth blade" - typedef ^ ^ ReKi Cy {:}{:} - - "tangential force coefficient (tangential to the plane, not chord) of the jth node in the kth blade" - +typedef ^ ^ ReKi Cz {:}{:} - - "axial force coefficient (tangential to the plane, not chord) of the jth node in the kth blade" - +typedef ^ ^ ReKi Cmx {:}{:} - - "pitching moment coefficient (x-component) of the jth node in the kth blade" - +typedef ^ ^ ReKi Cmy {:}{:} - - "pitching moment coefficient (y-component) of the jth node in the kth blade" - +typedef ^ ^ ReKi Cmz {:}{:} - - "pitching moment coefficient (z-component) of the jth node in the kth blade" - typedef ^ ^ ReKi Cm {:}{:} - - "pitching moment coefficient of the jth node in the kth blade" - typedef ^ ^ ReKi Cl {:}{:} - - "lift coefficient" - typedef ^ ^ ReKi Cd {:}{:} - - "drag coefficient" - diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index a9be8c1469..afc972c2b4 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -35,6 +35,13 @@ MODULE BEMT_Types USE DBEMT_Types USE NWTC_Library IMPLICIT NONE + INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_Orthogonal = 0 ! Inflow orthogonal to rotor [-] [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_Uncoupled = 1 ! Uncoupled (no correction) [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_PittPeters = 2 ! Pitt/Peters [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_Coupled = 3 ! Coupled [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: SkewMod_PittPeters_Cont = 4 ! Pitt/Peters continuous formulation [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BEMMod_2D = 0 ! 2D BEM assuming Cx, Cy, phi, L, D are in the same plane [-] + INTEGER(IntKi), PUBLIC, PARAMETER :: BEMMod_3D = 2 ! 3D BEM assuming a momentum balance system, and an airfoil system [-] ! ========= BEMT_InitInputType ======= TYPE, PUBLIC :: BEMT_InitInputType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: chord !< Chord length at node [m] @@ -49,6 +56,7 @@ MODULE BEMT_Types LOGICAL :: useTanInd !< Include tangential induction in BEMT calculations [flag] [-] LOGICAL :: useAIDrag !< Include the drag term in the axial-induction calculation? [flag] [-] LOGICAL :: useTIDrag !< Include the drag term in the tangential-induction calculation? Ignored if TanInd is False. [flag] [-] + LOGICAL :: MomentumCorr !< Momentum Correction {0=Axial Theory, 1 = Glauert Momentum Theory} [-] INTEGER(IntKi) :: numBladeNodes !< Number of blade nodes used in the analysis [-] INTEGER(IntKi) :: numReIterations !< Number of iterations for finding the Reynolds number [-] INTEGER(IntKi) :: maxIndIterations !< Maximum number of iterations of induction factor solve [-] @@ -57,7 +65,7 @@ MODULE BEMT_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: zLocal !< Distance to blade node, measured along the blade [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: zTip !< Distance to blade tip, measured along the blade [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: rLocal !< Radial distance to blade node from the center of rotation, measured in the rotor plane, needed for DBEMT [m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rTipFix !< Nominally the coned rotor diameter (without prebend) [m] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: rTipFix !< Nominally the coned rotor diameter (without prebend), used to align with Bladed calculations [m] INTEGER(IntKi) :: UAMod !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] LOGICAL :: Flookup !< Use table lookup for f' and f'' [-] @@ -69,6 +77,7 @@ MODULE BEMT_Types INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: UAOff_outerNode !< First node on each blade where UA should be turned off based on span location from blade tip (>nNodesPerBlade if always on) [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] LOGICAL :: SumPrint !< logical flag indicating whether to use UnsteadyAero [-] + INTEGER(IntKi) :: BEM_Mod !< BEM Model 0=OpenFAST 2=Envision [-] END TYPE BEMT_InitInputType ! ======================= ! ========= BEMT_InitOutputType ======= @@ -76,10 +85,18 @@ MODULE BEMT_Types TYPE(ProgDesc) :: Version !< [-] END TYPE BEMT_InitOutputType ! ======================= +! ========= BEMT_SkewWake_InputType ======= + TYPE, PUBLIC :: BEMT_SkewWake_InputType + REAL(ReKi) , DIMENSION(1:3) :: v_qsw !< quasi-steady instantaneous wake velocity (value to be filtered in Skewed Wake model) [m/s] + REAL(ReKi) :: V0 !< magnitude of disk-averaged velocity (for input to SkewWake) [m/s] + REAL(ReKi) :: R !< rotor radius (for input to SkewWake) [m] + END TYPE BEMT_SkewWake_InputType +! ======================= ! ========= BEMT_ContinuousStateType ======= TYPE, PUBLIC :: BEMT_ContinuousStateType TYPE(UA_ContinuousStateType) :: UA !< UA module continuous states [-] TYPE(DBEMT_ContinuousStateType) :: DBEMT !< DBEMT module continuous states [-] + REAL(R8Ki) , DIMENSION(1:3) :: V_w !< continuous state for filtering wake velocity [-] END TYPE BEMT_ContinuousStateType ! ======================= ! ========= BEMT_DiscreteStateType ======= @@ -98,6 +115,8 @@ MODULE BEMT_Types TYPE(DBEMT_OtherStateType) :: DBEMT !< other states for DBEMT [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: ValidPhi !< set to indicate when there is no valid Phi for this node at this time (temporarially turn off induction when this is false) [-] LOGICAL :: nodesInitialized !< the node states have been initialized properly [-] + TYPE(BEMT_ContinuousStateType) , DIMENSION(1:4) :: xdot !< history states for continuous state integration [-] + INTEGER(IntKi) :: n !< time step value used for continuous state integrator [-] END TYPE BEMT_OtherStateType ! ======================= ! ========= BEMT_MiscVarType ======= @@ -109,7 +128,8 @@ MODULE BEMT_Types TYPE(DBEMT_MiscVarType) :: DBEMT !< misc vars for DBEMT [-] TYPE(UA_OutputType) :: y_UA !< outputs from UnsteadyAero [-] TYPE(UA_InputType) , DIMENSION(:,:,:), ALLOCATABLE :: u_UA !< inputs to UnsteadyAero at t and t+dt [-] - TYPE(DBEMT_InputType) , DIMENSION(:), ALLOCATABLE :: u_DBEMT !< inputs to DBEMT [-] + TYPE(DBEMT_InputType) , DIMENSION(1:2) :: u_DBEMT !< inputs to DBEMT at t and t+dt [-] + TYPE(BEMT_SkewWake_InputType) , DIMENSION(1:2) :: u_SkewWake !< inputs to SkewedWake at t and t+dt [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TnInd_op !< tangential induction at the operating point (for linearization with frozen wake assumption) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AxInd_op !< axial induction at the operating point (for linearization) with frozen wake assumption [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AxInduction !< axial induction used for code run-time optimization [-] @@ -150,21 +170,34 @@ MODULE BEMT_Types INTEGER(IntKi) :: DBEMT_Mod !< DBEMT Model. 0 = constant tau1, 1 = time dependent tau1 [-] REAL(ReKi) :: yawCorrFactor !< constant used in Pitt/Peters skewed wake model (default is 15*pi/32) [-] LOGICAL , DIMENSION(:,:), ALLOCATABLE :: FixedInductions !< flag to determine if BEM inductions should be fixed and not modified by dbemt or skewed wake [-] + LOGICAL :: MomentumCorr !< Momentum Correction {0=Axial Theory, 1 = Glauert Momentum Theory} [-] + REAL(ReKi) :: rTipFixMax !< Nominally the coned rotor diameter (without prebend), used to align with Bladed calculations [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: IntegrateWeight !< A weighting factor for calculating rotor-averaged values (e.g., AxInd) [-] + INTEGER(IntKi) :: lin_nx = 0 !< Number of continuous states for linearization [-] + INTEGER(IntKi) :: BEM_Mod !< BEM Model 0=OpenFAST 2=Envision [-] END TYPE BEMT_ParameterType ! ======================= ! ========= BEMT_InputType ======= TYPE, PUBLIC :: BEMT_InputType REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: theta !< Twist angle (includes all sources of twist) [Array of size (NumBlNds,numBlades)] [rad] REAL(ReKi) :: chi0 !< Angle between the vector normal to the rotor plane and the wind vector (e.g., the yaw angle in the case of no tilt) [rad] + REAL(ReKi) :: psiSkewOffset !< Azimuth angle offset (relative to 90 deg) of the most downwind blade when chi0 is non-zero [rad] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: psi !< Azimuth angle [rad] REAL(ReKi) :: omega !< Angular velocity of rotor [rad/s] REAL(ReKi) :: TSR !< Tip-speed ratio (to check if BEM should be turned off) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vx !< Local axial velocity at node [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vy !< Local tangential velocity at node [m/s] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vz !< Local radial velocity at node [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: omega_z !< rotation of no-sweep-pitch-twist coordinate system around z (for CDBEMT and CUA) [rad/s] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: xVelCorr !< projection of velocity when yawed + prebend [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: rLocal !< Radial distance from center-of-rotation to node [m] REAL(ReKi) :: Un_disk !< disk-averaged velocity normal to the rotor disk (for input to DBEMT) [m/s] + REAL(ReKi) , DIMENSION(1:3) :: V0 !< disk-averaged velocity (for input to SkewWake) [m/s] + REAL(R8Ki) , DIMENSION(1:3) :: x_hat_disk !< Hub Orientation vector: normal to rotor disk [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: UserProp !< Optional user property for interpolating airfoils (per element per blade) [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CantAngle !< Cant angle [Array of size (NumBlNds,numBlades)] [rad] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: drdz !< dr/dz geometric parameter [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: toeAngle !< Toe angle [Array of size (NumBlNds,numBlades)] [rad] END TYPE BEMT_InputType ! ======================= ! ========= BEMT_OutputType ======= @@ -177,6 +210,10 @@ MODULE BEMT_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AOA !< angle of attack [rad] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Cx !< normal force coefficient (normal to the plane, not chord) of the jth node in the kth blade [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Cy !< tangential force coefficient (tangential to the plane, not chord) of the jth node in the kth blade [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Cz !< axial force coefficient (tangential to the plane, not chord) of the jth node in the kth blade [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Cmx !< pitching moment coefficient (x-component) of the jth node in the kth blade [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Cmy !< pitching moment coefficient (y-component) of the jth node in the kth blade [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Cmz !< pitching moment coefficient (z-component) of the jth node in the kth blade [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Cm !< pitching moment coefficient of the jth node in the kth blade [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Cl !< lift coefficient [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Cd !< drag coefficient [-] @@ -227,6 +264,7 @@ SUBROUTINE BEMT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%useTanInd = SrcInitInputData%useTanInd DstInitInputData%useAIDrag = SrcInitInputData%useAIDrag DstInitInputData%useTIDrag = SrcInitInputData%useTIDrag + DstInitInputData%MomentumCorr = SrcInitInputData%MomentumCorr DstInitInputData%numBladeNodes = SrcInitInputData%numBladeNodes DstInitInputData%numReIterations = SrcInitInputData%numReIterations DstInitInputData%maxIndIterations = SrcInitInputData%maxIndIterations @@ -341,6 +379,7 @@ SUBROUTINE BEMT_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err ENDIF DstInitInputData%RootName = SrcInitInputData%RootName DstInitInputData%SumPrint = SrcInitInputData%SumPrint + DstInitInputData%BEM_Mod = SrcInitInputData%BEM_Mod END SUBROUTINE BEMT_CopyInitInput SUBROUTINE BEMT_DestroyInitInput( InitInputData, ErrStat, ErrMsg, DEALLOCATEpointers ) @@ -444,6 +483,7 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_BufSz = Int_BufSz + 1 ! useTanInd Int_BufSz = Int_BufSz + 1 ! useAIDrag Int_BufSz = Int_BufSz + 1 ! useTIDrag + Int_BufSz = Int_BufSz + 1 ! MomentumCorr Int_BufSz = Int_BufSz + 1 ! numBladeNodes Int_BufSz = Int_BufSz + 1 ! numReIterations Int_BufSz = Int_BufSz + 1 ! maxIndIterations @@ -496,6 +536,7 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM END IF Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName Int_BufSz = Int_BufSz + 1 ! SumPrint + Int_BufSz = Int_BufSz + 1 ! BEM_Mod IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -565,6 +606,8 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = TRANSFER(InData%useTIDrag, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%MomentumCorr, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%numBladeNodes Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%numReIterations @@ -726,6 +769,8 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM END DO ! I IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BEM_Mod + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BEMT_PackInitInput SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -802,6 +847,8 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Int_Xferred = Int_Xferred + 1 OutData%useTIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTIDrag) Int_Xferred = Int_Xferred + 1 + OutData%MomentumCorr = TRANSFER(IntKiBuf(Int_Xferred), OutData%MomentumCorr) + Int_Xferred = Int_Xferred + 1 OutData%numBladeNodes = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%numReIterations = IntKiBuf(Int_Xferred) @@ -987,6 +1034,8 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E END DO ! I OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) Int_Xferred = Int_Xferred + 1 + OutData%BEM_Mod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BEMT_UnPackInitInput SUBROUTINE BEMT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1211,6 +1260,163 @@ SUBROUTINE BEMT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE BEMT_UnPackInitOutput + SUBROUTINE BEMT_CopySkewWake_InputType( SrcSkewWake_InputTypeData, DstSkewWake_InputTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(BEMT_SkewWake_InputType), INTENT(IN) :: SrcSkewWake_InputTypeData + TYPE(BEMT_SkewWake_InputType), INTENT(INOUT) :: DstSkewWake_InputTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopySkewWake_InputType' +! + ErrStat = ErrID_None + ErrMsg = "" + DstSkewWake_InputTypeData%v_qsw = SrcSkewWake_InputTypeData%v_qsw + DstSkewWake_InputTypeData%V0 = SrcSkewWake_InputTypeData%V0 + DstSkewWake_InputTypeData%R = SrcSkewWake_InputTypeData%R + END SUBROUTINE BEMT_CopySkewWake_InputType + + SUBROUTINE BEMT_DestroySkewWake_InputType( SkewWake_InputTypeData, ErrStat, ErrMsg, DEALLOCATEpointers ) + TYPE(BEMT_SkewWake_InputType), INTENT(INOUT) :: SkewWake_InputTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: DEALLOCATEpointers + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + LOGICAL :: DEALLOCATEpointers_local + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_DestroySkewWake_InputType' + + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(DEALLOCATEpointers)) THEN + DEALLOCATEpointers_local = DEALLOCATEpointers + ELSE + DEALLOCATEpointers_local = .true. + END IF + + END SUBROUTINE BEMT_DestroySkewWake_InputType + + SUBROUTINE BEMT_PackSkewWake_InputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(BEMT_SkewWake_InputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_PackSkewWake_InputType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + SIZE(InData%v_qsw) ! v_qsw + Re_BufSz = Re_BufSz + 1 ! V0 + Re_BufSz = Re_BufSz + 1 ! R + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%v_qsw,1), UBOUND(InData%v_qsw,1) + ReKiBuf(Re_Xferred) = InData%v_qsw(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%V0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%R + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE BEMT_PackSkewWake_InputType + + SUBROUTINE BEMT_UnPackSkewWake_InputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(BEMT_SkewWake_InputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackSkewWake_InputType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%v_qsw,1) + i1_u = UBOUND(OutData%v_qsw,1) + DO i1 = LBOUND(OutData%v_qsw,1), UBOUND(OutData%v_qsw,1) + OutData%v_qsw(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%V0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%R = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE BEMT_UnPackSkewWake_InputType + SUBROUTINE BEMT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(BEMT_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(BEMT_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -1219,6 +1425,7 @@ SUBROUTINE BEMT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Err CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_CopyContState' @@ -1231,6 +1438,7 @@ SUBROUTINE BEMT_CopyContState( SrcContStateData, DstContStateData, CtrlCode, Err CALL DBEMT_CopyContState( SrcContStateData%DBEMT, DstContStateData%DBEMT, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + DstContStateData%V_w = SrcContStateData%V_w END SUBROUTINE BEMT_CopyContState SUBROUTINE BEMT_DestroyContState( ContStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) @@ -1330,6 +1538,7 @@ SUBROUTINE BEMT_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Db_BufSz = Db_BufSz + SIZE(InData%V_w) ! V_w IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -1413,6 +1622,10 @@ SUBROUTINE BEMT_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + DO i1 = LBOUND(InData%V_w,1), UBOUND(InData%V_w,1) + DbKiBuf(Db_Xferred) = InData%V_w(i1) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE BEMT_PackContState SUBROUTINE BEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1428,6 +1641,7 @@ SUBROUTINE BEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackContState' @@ -1521,6 +1735,12 @@ SUBROUTINE BEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + i1_l = LBOUND(OutData%V_w,1) + i1_u = UBOUND(OutData%V_w,1) + DO i1 = LBOUND(OutData%V_w,1), UBOUND(OutData%V_w,1) + OutData%V_w(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE BEMT_UnPackContState SUBROUTINE BEMT_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1982,6 +2202,12 @@ SUBROUTINE BEMT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, DstOtherStateData%ValidPhi = SrcOtherStateData%ValidPhi ENDIF DstOtherStateData%nodesInitialized = SrcOtherStateData%nodesInitialized + DO i1 = LBOUND(SrcOtherStateData%xdot,1), UBOUND(SrcOtherStateData%xdot,1) + CALL BEMT_CopyContState( SrcOtherStateData%xdot(i1), DstOtherStateData%xdot(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DstOtherStateData%n = SrcOtherStateData%n END SUBROUTINE BEMT_CopyOtherState SUBROUTINE BEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpointers ) @@ -2012,6 +2238,10 @@ SUBROUTINE BEMT_DestroyOtherState( OtherStateData, ErrStat, ErrMsg, DEALLOCATEpo IF (ALLOCATED(OtherStateData%ValidPhi)) THEN DEALLOCATE(OtherStateData%ValidPhi) ENDIF +DO i1 = LBOUND(OtherStateData%xdot,1), UBOUND(OtherStateData%xdot,1) + CALL BEMT_DestroyContState( OtherStateData%xdot(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO END SUBROUTINE BEMT_DestroyOtherState SUBROUTINE BEMT_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2090,6 +2320,26 @@ SUBROUTINE BEMT_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Int_BufSz = Int_BufSz + SIZE(InData%ValidPhi) ! ValidPhi END IF Int_BufSz = Int_BufSz + 1 ! nodesInitialized + DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) + Int_BufSz = Int_BufSz + 3 ! xdot: size of buffers for each call to pack subtype + CALL BEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xdot + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xdot + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xdot + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xdot + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 1 ! n IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -2195,6 +2445,38 @@ SUBROUTINE BEMT_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err END IF IntKiBuf(Int_Xferred) = TRANSFER(InData%nodesInitialized, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) + CALL BEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + IntKiBuf(Int_Xferred) = InData%n + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BEMT_PackOtherState SUBROUTINE BEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2330,6 +2612,52 @@ SUBROUTINE BEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, END IF OutData%nodesInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%nodesInitialized) Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%xdot,1) + i1_u = UBOUND(OutData%xdot,1) + DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL BEMT_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%xdot(i1), ErrStat2, ErrMsg2 ) ! xdot + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + OutData%n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BEMT_UnPackOtherState SUBROUTINE BEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -2385,22 +2713,16 @@ SUBROUTINE BEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) ENDDO ENDDO ENDIF -IF (ALLOCATED(SrcMiscData%u_DBEMT)) THEN - i1_l = LBOUND(SrcMiscData%u_DBEMT,1) - i1_u = UBOUND(SrcMiscData%u_DBEMT,1) - IF (.NOT. ALLOCATED(DstMiscData%u_DBEMT)) THEN - ALLOCATE(DstMiscData%u_DBEMT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%u_DBEMT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF DO i1 = LBOUND(SrcMiscData%u_DBEMT,1), UBOUND(SrcMiscData%u_DBEMT,1) CALL DBEMT_CopyInput( SrcMiscData%u_DBEMT(i1), DstMiscData%u_DBEMT(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO -ENDIF + DO i1 = LBOUND(SrcMiscData%u_SkewWake,1), UBOUND(SrcMiscData%u_SkewWake,1) + CALL BEMT_Copyskewwake_inputtype( SrcMiscData%u_SkewWake(i1), DstMiscData%u_SkewWake(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO IF (ALLOCATED(SrcMiscData%TnInd_op)) THEN i1_l = LBOUND(SrcMiscData%TnInd_op,1) i1_u = UBOUND(SrcMiscData%TnInd_op,1) @@ -2553,13 +2875,14 @@ SUBROUTINE BEMT_DestroyMisc( MiscData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDDO DEALLOCATE(MiscData%u_UA) ENDIF -IF (ALLOCATED(MiscData%u_DBEMT)) THEN DO i1 = LBOUND(MiscData%u_DBEMT,1), UBOUND(MiscData%u_DBEMT,1) CALL DBEMT_DestroyInput( MiscData%u_DBEMT(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ENDDO - DEALLOCATE(MiscData%u_DBEMT) -ENDIF +DO i1 = LBOUND(MiscData%u_SkewWake,1), UBOUND(MiscData%u_SkewWake,1) + CALL BEMT_Destroyskewwake_inputtype( MiscData%u_SkewWake(i1), ErrStat2, ErrMsg2, DEALLOCATEpointers_local ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO IF (ALLOCATED(MiscData%TnInd_op)) THEN DEALLOCATE(MiscData%TnInd_op) ENDIF @@ -2703,9 +3026,6 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S END DO END DO END IF - Int_BufSz = Int_BufSz + 1 ! u_DBEMT allocated yes/no - IF ( ALLOCATED(InData%u_DBEMT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_DBEMT upper/lower bounds for each dimension DO i1 = LBOUND(InData%u_DBEMT,1), UBOUND(InData%u_DBEMT,1) Int_BufSz = Int_BufSz + 3 ! u_DBEMT: size of buffers for each call to pack subtype CALL DBEMT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_DBEMT(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_DBEMT @@ -2725,7 +3045,25 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S DEALLOCATE(Int_Buf) END IF END DO - END IF + DO i1 = LBOUND(InData%u_SkewWake,1), UBOUND(InData%u_SkewWake,1) + Int_BufSz = Int_BufSz + 3 ! u_SkewWake: size of buffers for each call to pack subtype + CALL BEMT_Packskewwake_inputtype( Re_Buf, Db_Buf, Int_Buf, InData%u_SkewWake(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_SkewWake + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_SkewWake + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_SkewWake + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_SkewWake + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO Int_BufSz = Int_BufSz + 1 ! TnInd_op allocated yes/no IF ( ALLOCATED(InData%TnInd_op) ) THEN Int_BufSz = Int_BufSz + 2*2 ! TnInd_op upper/lower bounds for each dimension @@ -2936,16 +3274,6 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%u_DBEMT) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_DBEMT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_DBEMT,1) - Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%u_DBEMT,1), UBOUND(InData%u_DBEMT,1) CALL DBEMT_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_DBEMT(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_DBEMT CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2976,11 +3304,40 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END IF - IF ( .NOT. ALLOCATED(InData%TnInd_op) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE + DO i1 = LBOUND(InData%u_SkewWake,1), UBOUND(InData%u_SkewWake,1) + CALL BEMT_Packskewwake_inputtype( Re_Buf, Db_Buf, Int_Buf, InData%u_SkewWake(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_SkewWake + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + IF ( .NOT. ALLOCATED(InData%TnInd_op) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 IntKiBuf( Int_Xferred ) = LBOUND(InData%TnInd_op,1) @@ -3359,19 +3716,8 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_DBEMT not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_DBEMT)) DEALLOCATE(OutData%u_DBEMT) - ALLOCATE(OutData%u_DBEMT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_DBEMT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + i1_l = LBOUND(OutData%u_DBEMT,1) + i1_u = UBOUND(OutData%u_DBEMT,1) DO i1 = LBOUND(OutData%u_DBEMT,1), UBOUND(OutData%u_DBEMT,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -3414,7 +3760,50 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - END IF + i1_l = LBOUND(OutData%u_SkewWake,1) + i1_u = UBOUND(OutData%u_SkewWake,1) + DO i1 = LBOUND(OutData%u_SkewWake,1), UBOUND(OutData%u_SkewWake,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL BEMT_Unpackskewwake_inputtype( Re_Buf, Db_Buf, Int_Buf, OutData%u_SkewWake(i1), ErrStat2, ErrMsg2 ) ! u_SkewWake + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TnInd_op not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3722,6 +4111,24 @@ SUBROUTINE BEMT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg END IF DstParamData%FixedInductions = SrcParamData%FixedInductions ENDIF + DstParamData%MomentumCorr = SrcParamData%MomentumCorr + DstParamData%rTipFixMax = SrcParamData%rTipFixMax +IF (ALLOCATED(SrcParamData%IntegrateWeight)) THEN + i1_l = LBOUND(SrcParamData%IntegrateWeight,1) + i1_u = UBOUND(SrcParamData%IntegrateWeight,1) + i2_l = LBOUND(SrcParamData%IntegrateWeight,2) + i2_u = UBOUND(SrcParamData%IntegrateWeight,2) + IF (.NOT. ALLOCATED(DstParamData%IntegrateWeight)) THEN + ALLOCATE(DstParamData%IntegrateWeight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%IntegrateWeight.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%IntegrateWeight = SrcParamData%IntegrateWeight +ENDIF + DstParamData%lin_nx = SrcParamData%lin_nx + DstParamData%BEM_Mod = SrcParamData%BEM_Mod END SUBROUTINE BEMT_CopyParam SUBROUTINE BEMT_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) @@ -3766,6 +4173,9 @@ SUBROUTINE BEMT_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ALLOCATED(ParamData%FixedInductions)) THEN DEALLOCATE(ParamData%FixedInductions) +ENDIF +IF (ALLOCATED(ParamData%IntegrateWeight)) THEN + DEALLOCATE(ParamData%IntegrateWeight) ENDIF END SUBROUTINE BEMT_DestroyParam @@ -3887,6 +4297,15 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 2*2 ! FixedInductions upper/lower bounds for each dimension Int_BufSz = Int_BufSz + SIZE(InData%FixedInductions) ! FixedInductions END IF + Int_BufSz = Int_BufSz + 1 ! MomentumCorr + Re_BufSz = Re_BufSz + 1 ! rTipFixMax + Int_BufSz = Int_BufSz + 1 ! IntegrateWeight allocated yes/no + IF ( ALLOCATED(InData%IntegrateWeight) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! IntegrateWeight upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%IntegrateWeight) ! IntegrateWeight + END IF + Int_BufSz = Int_BufSz + 1 ! lin_nx + Int_BufSz = Int_BufSz + 1 ! BEM_Mod IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -4121,6 +4540,34 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, END DO END DO END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%MomentumCorr, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rTipFixMax + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%IntegrateWeight) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IntegrateWeight,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IntegrateWeight,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IntegrateWeight,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IntegrateWeight,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%IntegrateWeight,2), UBOUND(InData%IntegrateWeight,2) + DO i1 = LBOUND(InData%IntegrateWeight,1), UBOUND(InData%IntegrateWeight,1) + ReKiBuf(Re_Xferred) = InData%IntegrateWeight(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%lin_nx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BEM_Mod + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BEMT_PackParam SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4400,6 +4847,37 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs END DO END DO END IF + OutData%MomentumCorr = TRANSFER(IntKiBuf(Int_Xferred), OutData%MomentumCorr) + Int_Xferred = Int_Xferred + 1 + OutData%rTipFixMax = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IntegrateWeight not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IntegrateWeight)) DEALLOCATE(OutData%IntegrateWeight) + ALLOCATE(OutData%IntegrateWeight(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IntegrateWeight.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%IntegrateWeight,2), UBOUND(OutData%IntegrateWeight,2) + DO i1 = LBOUND(OutData%IntegrateWeight,1), UBOUND(OutData%IntegrateWeight,1) + OutData%IntegrateWeight(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%lin_nx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BEM_Mod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BEMT_UnPackParam SUBROUTINE BEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -4433,6 +4911,7 @@ SUBROUTINE BEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg DstInputData%theta = SrcInputData%theta ENDIF DstInputData%chi0 = SrcInputData%chi0 + DstInputData%psiSkewOffset = SrcInputData%psiSkewOffset IF (ALLOCATED(SrcInputData%psi)) THEN i1_l = LBOUND(SrcInputData%psi,1) i1_u = UBOUND(SrcInputData%psi,1) @@ -4475,6 +4954,20 @@ SUBROUTINE BEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg END IF DstInputData%Vy = SrcInputData%Vy ENDIF +IF (ALLOCATED(SrcInputData%Vz)) THEN + i1_l = LBOUND(SrcInputData%Vz,1) + i1_u = UBOUND(SrcInputData%Vz,1) + i2_l = LBOUND(SrcInputData%Vz,2) + i2_u = UBOUND(SrcInputData%Vz,2) + IF (.NOT. ALLOCATED(DstInputData%Vz)) THEN + ALLOCATE(DstInputData%Vz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputData%Vz = SrcInputData%Vz +ENDIF IF (ALLOCATED(SrcInputData%omega_z)) THEN i1_l = LBOUND(SrcInputData%omega_z,1) i1_u = UBOUND(SrcInputData%omega_z,1) @@ -4489,6 +4982,20 @@ SUBROUTINE BEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg END IF DstInputData%omega_z = SrcInputData%omega_z ENDIF +IF (ALLOCATED(SrcInputData%xVelCorr)) THEN + i1_l = LBOUND(SrcInputData%xVelCorr,1) + i1_u = UBOUND(SrcInputData%xVelCorr,1) + i2_l = LBOUND(SrcInputData%xVelCorr,2) + i2_u = UBOUND(SrcInputData%xVelCorr,2) + IF (.NOT. ALLOCATED(DstInputData%xVelCorr)) THEN + ALLOCATE(DstInputData%xVelCorr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%xVelCorr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputData%xVelCorr = SrcInputData%xVelCorr +ENDIF IF (ALLOCATED(SrcInputData%rLocal)) THEN i1_l = LBOUND(SrcInputData%rLocal,1) i1_u = UBOUND(SrcInputData%rLocal,1) @@ -4504,6 +5011,8 @@ SUBROUTINE BEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg DstInputData%rLocal = SrcInputData%rLocal ENDIF DstInputData%Un_disk = SrcInputData%Un_disk + DstInputData%V0 = SrcInputData%V0 + DstInputData%x_hat_disk = SrcInputData%x_hat_disk IF (ALLOCATED(SrcInputData%UserProp)) THEN i1_l = LBOUND(SrcInputData%UserProp,1) i1_u = UBOUND(SrcInputData%UserProp,1) @@ -4517,6 +5026,48 @@ SUBROUTINE BEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg END IF END IF DstInputData%UserProp = SrcInputData%UserProp +ENDIF +IF (ALLOCATED(SrcInputData%CantAngle)) THEN + i1_l = LBOUND(SrcInputData%CantAngle,1) + i1_u = UBOUND(SrcInputData%CantAngle,1) + i2_l = LBOUND(SrcInputData%CantAngle,2) + i2_u = UBOUND(SrcInputData%CantAngle,2) + IF (.NOT. ALLOCATED(DstInputData%CantAngle)) THEN + ALLOCATE(DstInputData%CantAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%CantAngle.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputData%CantAngle = SrcInputData%CantAngle +ENDIF +IF (ALLOCATED(SrcInputData%drdz)) THEN + i1_l = LBOUND(SrcInputData%drdz,1) + i1_u = UBOUND(SrcInputData%drdz,1) + i2_l = LBOUND(SrcInputData%drdz,2) + i2_u = UBOUND(SrcInputData%drdz,2) + IF (.NOT. ALLOCATED(DstInputData%drdz)) THEN + ALLOCATE(DstInputData%drdz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%drdz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputData%drdz = SrcInputData%drdz +ENDIF +IF (ALLOCATED(SrcInputData%toeAngle)) THEN + i1_l = LBOUND(SrcInputData%toeAngle,1) + i1_u = UBOUND(SrcInputData%toeAngle,1) + i2_l = LBOUND(SrcInputData%toeAngle,2) + i2_u = UBOUND(SrcInputData%toeAngle,2) + IF (.NOT. ALLOCATED(DstInputData%toeAngle)) THEN + ALLOCATE(DstInputData%toeAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%toeAngle.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputData%toeAngle = SrcInputData%toeAngle ENDIF END SUBROUTINE BEMT_CopyInput @@ -4553,14 +5104,29 @@ SUBROUTINE BEMT_DestroyInput( InputData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(InputData%Vy)) THEN DEALLOCATE(InputData%Vy) ENDIF +IF (ALLOCATED(InputData%Vz)) THEN + DEALLOCATE(InputData%Vz) +ENDIF IF (ALLOCATED(InputData%omega_z)) THEN DEALLOCATE(InputData%omega_z) ENDIF +IF (ALLOCATED(InputData%xVelCorr)) THEN + DEALLOCATE(InputData%xVelCorr) +ENDIF IF (ALLOCATED(InputData%rLocal)) THEN DEALLOCATE(InputData%rLocal) ENDIF IF (ALLOCATED(InputData%UserProp)) THEN DEALLOCATE(InputData%UserProp) +ENDIF +IF (ALLOCATED(InputData%CantAngle)) THEN + DEALLOCATE(InputData%CantAngle) +ENDIF +IF (ALLOCATED(InputData%drdz)) THEN + DEALLOCATE(InputData%drdz) +ENDIF +IF (ALLOCATED(InputData%toeAngle)) THEN + DEALLOCATE(InputData%toeAngle) ENDIF END SUBROUTINE BEMT_DestroyInput @@ -4605,6 +5171,7 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Re_BufSz = Re_BufSz + SIZE(InData%theta) ! theta END IF Re_BufSz = Re_BufSz + 1 ! chi0 + Re_BufSz = Re_BufSz + 1 ! psiSkewOffset Int_BufSz = Int_BufSz + 1 ! psi allocated yes/no IF ( ALLOCATED(InData%psi) ) THEN Int_BufSz = Int_BufSz + 2*1 ! psi upper/lower bounds for each dimension @@ -4622,22 +5189,49 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 2*2 ! Vy upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%Vy) ! Vy END IF + Int_BufSz = Int_BufSz + 1 ! Vz allocated yes/no + IF ( ALLOCATED(InData%Vz) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Vz upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vz) ! Vz + END IF Int_BufSz = Int_BufSz + 1 ! omega_z allocated yes/no IF ( ALLOCATED(InData%omega_z) ) THEN Int_BufSz = Int_BufSz + 2*2 ! omega_z upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%omega_z) ! omega_z END IF + Int_BufSz = Int_BufSz + 1 ! xVelCorr allocated yes/no + IF ( ALLOCATED(InData%xVelCorr) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! xVelCorr upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%xVelCorr) ! xVelCorr + END IF Int_BufSz = Int_BufSz + 1 ! rLocal allocated yes/no IF ( ALLOCATED(InData%rLocal) ) THEN Int_BufSz = Int_BufSz + 2*2 ! rLocal upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%rLocal) ! rLocal END IF Re_BufSz = Re_BufSz + 1 ! Un_disk + Re_BufSz = Re_BufSz + SIZE(InData%V0) ! V0 + Db_BufSz = Db_BufSz + SIZE(InData%x_hat_disk) ! x_hat_disk Int_BufSz = Int_BufSz + 1 ! UserProp allocated yes/no IF ( ALLOCATED(InData%UserProp) ) THEN Int_BufSz = Int_BufSz + 2*2 ! UserProp upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%UserProp) ! UserProp END IF + Int_BufSz = Int_BufSz + 1 ! CantAngle allocated yes/no + IF ( ALLOCATED(InData%CantAngle) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! CantAngle upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CantAngle) ! CantAngle + END IF + Int_BufSz = Int_BufSz + 1 ! drdz allocated yes/no + IF ( ALLOCATED(InData%drdz) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! drdz upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%drdz) ! drdz + END IF + Int_BufSz = Int_BufSz + 1 ! toeAngle allocated yes/no + IF ( ALLOCATED(InData%toeAngle) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! toeAngle upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%toeAngle) ! toeAngle + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -4687,6 +5281,8 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, END IF ReKiBuf(Re_Xferred) = InData%chi0 Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%psiSkewOffset + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%psi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4746,6 +5342,26 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, END DO END DO END IF + IF ( .NOT. ALLOCATED(InData%Vz) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vz,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vz,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Vz,2), UBOUND(InData%Vz,2) + DO i1 = LBOUND(InData%Vz,1), UBOUND(InData%Vz,1) + ReKiBuf(Re_Xferred) = InData%Vz(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( .NOT. ALLOCATED(InData%omega_z) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4766,6 +5382,26 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, END DO END DO END IF + IF ( .NOT. ALLOCATED(InData%xVelCorr) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xVelCorr,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xVelCorr,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xVelCorr,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xVelCorr,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%xVelCorr,2), UBOUND(InData%xVelCorr,2) + DO i1 = LBOUND(InData%xVelCorr,1), UBOUND(InData%xVelCorr,1) + ReKiBuf(Re_Xferred) = InData%xVelCorr(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( .NOT. ALLOCATED(InData%rLocal) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4788,6 +5424,14 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, END IF ReKiBuf(Re_Xferred) = InData%Un_disk Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%V0,1), UBOUND(InData%V0,1) + ReKiBuf(Re_Xferred) = InData%V0(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%x_hat_disk,1), UBOUND(InData%x_hat_disk,1) + DbKiBuf(Db_Xferred) = InData%x_hat_disk(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%UserProp) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4808,6 +5452,66 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, END DO END DO END IF + IF ( .NOT. ALLOCATED(InData%CantAngle) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CantAngle,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CantAngle,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CantAngle,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CantAngle,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%CantAngle,2), UBOUND(InData%CantAngle,2) + DO i1 = LBOUND(InData%CantAngle,1), UBOUND(InData%CantAngle,1) + ReKiBuf(Re_Xferred) = InData%CantAngle(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%drdz) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%drdz,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%drdz,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%drdz,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%drdz,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%drdz,2), UBOUND(InData%drdz,2) + DO i1 = LBOUND(InData%drdz,1), UBOUND(InData%drdz,1) + ReKiBuf(Re_Xferred) = InData%drdz(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%toeAngle) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%toeAngle,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toeAngle,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%toeAngle,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toeAngle,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%toeAngle,2), UBOUND(InData%toeAngle,2) + DO i1 = LBOUND(InData%toeAngle,1), UBOUND(InData%toeAngle,1) + ReKiBuf(Re_Xferred) = InData%toeAngle(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF END SUBROUTINE BEMT_PackInput SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4863,6 +5567,8 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs END IF OutData%chi0 = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 + OutData%psiSkewOffset = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! psi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4931,6 +5637,29 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs END DO END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vz not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Vz)) DEALLOCATE(OutData%Vz) + ALLOCATE(OutData%Vz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Vz,2), UBOUND(OutData%Vz,2) + DO i1 = LBOUND(OutData%Vz,1), UBOUND(OutData%Vz,1) + OutData%Vz(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! omega_z not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4954,6 +5683,29 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs END DO END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xVelCorr not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xVelCorr)) DEALLOCATE(OutData%xVelCorr) + ALLOCATE(OutData%xVelCorr(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xVelCorr.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%xVelCorr,2), UBOUND(OutData%xVelCorr,2) + DO i1 = LBOUND(OutData%xVelCorr,1), UBOUND(OutData%xVelCorr,1) + OutData%xVelCorr(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4979,6 +5731,18 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs END IF OutData%Un_disk = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%V0,1) + i1_u = UBOUND(OutData%V0,1) + DO i1 = LBOUND(OutData%V0,1), UBOUND(OutData%V0,1) + OutData%V0(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + i1_l = LBOUND(OutData%x_hat_disk,1) + i1_u = UBOUND(OutData%x_hat_disk,1) + DO i1 = LBOUND(OutData%x_hat_disk,1), UBOUND(OutData%x_hat_disk,1) + OutData%x_hat_disk(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UserProp not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5002,6 +5766,75 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs END DO END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CantAngle not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CantAngle)) DEALLOCATE(OutData%CantAngle) + ALLOCATE(OutData%CantAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CantAngle.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%CantAngle,2), UBOUND(OutData%CantAngle,2) + DO i1 = LBOUND(OutData%CantAngle,1), UBOUND(OutData%CantAngle,1) + OutData%CantAngle(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! drdz not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%drdz)) DEALLOCATE(OutData%drdz) + ALLOCATE(OutData%drdz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%drdz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%drdz,2), UBOUND(OutData%drdz,2) + DO i1 = LBOUND(OutData%drdz,1), UBOUND(OutData%drdz,1) + OutData%drdz(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! toeAngle not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%toeAngle)) DEALLOCATE(OutData%toeAngle) + ALLOCATE(OutData%toeAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%toeAngle.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%toeAngle,2), UBOUND(OutData%toeAngle,2) + DO i1 = LBOUND(OutData%toeAngle,1), UBOUND(OutData%toeAngle,1) + OutData%toeAngle(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF END SUBROUTINE BEMT_UnPackInput SUBROUTINE BEMT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -5132,6 +5965,62 @@ SUBROUTINE BEMT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err END IF DstOutputData%Cy = SrcOutputData%Cy ENDIF +IF (ALLOCATED(SrcOutputData%Cz)) THEN + i1_l = LBOUND(SrcOutputData%Cz,1) + i1_u = UBOUND(SrcOutputData%Cz,1) + i2_l = LBOUND(SrcOutputData%Cz,2) + i2_u = UBOUND(SrcOutputData%Cz,2) + IF (.NOT. ALLOCATED(DstOutputData%Cz)) THEN + ALLOCATE(DstOutputData%Cz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%Cz = SrcOutputData%Cz +ENDIF +IF (ALLOCATED(SrcOutputData%Cmx)) THEN + i1_l = LBOUND(SrcOutputData%Cmx,1) + i1_u = UBOUND(SrcOutputData%Cmx,1) + i2_l = LBOUND(SrcOutputData%Cmx,2) + i2_u = UBOUND(SrcOutputData%Cmx,2) + IF (.NOT. ALLOCATED(DstOutputData%Cmx)) THEN + ALLOCATE(DstOutputData%Cmx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%Cmx = SrcOutputData%Cmx +ENDIF +IF (ALLOCATED(SrcOutputData%Cmy)) THEN + i1_l = LBOUND(SrcOutputData%Cmy,1) + i1_u = UBOUND(SrcOutputData%Cmy,1) + i2_l = LBOUND(SrcOutputData%Cmy,2) + i2_u = UBOUND(SrcOutputData%Cmy,2) + IF (.NOT. ALLOCATED(DstOutputData%Cmy)) THEN + ALLOCATE(DstOutputData%Cmy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmy.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%Cmy = SrcOutputData%Cmy +ENDIF +IF (ALLOCATED(SrcOutputData%Cmz)) THEN + i1_l = LBOUND(SrcOutputData%Cmz,1) + i1_u = UBOUND(SrcOutputData%Cmz,1) + i2_l = LBOUND(SrcOutputData%Cmz,2) + i2_u = UBOUND(SrcOutputData%Cmz,2) + IF (.NOT. ALLOCATED(DstOutputData%Cmz)) THEN + ALLOCATE(DstOutputData%Cmz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cmz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%Cmz = SrcOutputData%Cmz +ENDIF IF (ALLOCATED(SrcOutputData%Cm)) THEN i1_l = LBOUND(SrcOutputData%Cm,1) i1_u = UBOUND(SrcOutputData%Cm,1) @@ -5249,6 +6138,18 @@ SUBROUTINE BEMT_DestroyOutput( OutputData, ErrStat, ErrMsg, DEALLOCATEpointers ) IF (ALLOCATED(OutputData%Cy)) THEN DEALLOCATE(OutputData%Cy) ENDIF +IF (ALLOCATED(OutputData%Cz)) THEN + DEALLOCATE(OutputData%Cz) +ENDIF +IF (ALLOCATED(OutputData%Cmx)) THEN + DEALLOCATE(OutputData%Cmx) +ENDIF +IF (ALLOCATED(OutputData%Cmy)) THEN + DEALLOCATE(OutputData%Cmy) +ENDIF +IF (ALLOCATED(OutputData%Cmz)) THEN + DEALLOCATE(OutputData%Cmz) +ENDIF IF (ALLOCATED(OutputData%Cm)) THEN DEALLOCATE(OutputData%Cm) ENDIF @@ -5341,6 +6242,26 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 2*2 ! Cy upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%Cy) ! Cy END IF + Int_BufSz = Int_BufSz + 1 ! Cz allocated yes/no + IF ( ALLOCATED(InData%Cz) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Cz upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Cz) ! Cz + END IF + Int_BufSz = Int_BufSz + 1 ! Cmx allocated yes/no + IF ( ALLOCATED(InData%Cmx) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Cmx upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Cmx) ! Cmx + END IF + Int_BufSz = Int_BufSz + 1 ! Cmy allocated yes/no + IF ( ALLOCATED(InData%Cmy) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Cmy upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Cmy) ! Cmy + END IF + Int_BufSz = Int_BufSz + 1 ! Cmz allocated yes/no + IF ( ALLOCATED(InData%Cmz) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Cmz upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Cmz) ! Cmz + END IF Int_BufSz = Int_BufSz + 1 ! Cm allocated yes/no IF ( ALLOCATED(InData%Cm) ) THEN Int_BufSz = Int_BufSz + 2*2 ! Cm upper/lower bounds for each dimension @@ -5553,6 +6474,86 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, END DO END DO END IF + IF ( .NOT. ALLOCATED(InData%Cz) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Cz,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cz,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Cz,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cz,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Cz,2), UBOUND(InData%Cz,2) + DO i1 = LBOUND(InData%Cz,1), UBOUND(InData%Cz,1) + ReKiBuf(Re_Xferred) = InData%Cz(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Cmx) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmx,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmx,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmx,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Cmx,2), UBOUND(InData%Cmx,2) + DO i1 = LBOUND(InData%Cmx,1), UBOUND(InData%Cmx,1) + ReKiBuf(Re_Xferred) = InData%Cmx(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Cmy) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmy,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmy,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmy,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmy,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Cmy,2), UBOUND(InData%Cmy,2) + DO i1 = LBOUND(InData%Cmy,1), UBOUND(InData%Cmy,1) + ReKiBuf(Re_Xferred) = InData%Cmy(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Cmz) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmz,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmz,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Cmz,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cmz,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Cmz,2), UBOUND(InData%Cmz,2) + DO i1 = LBOUND(InData%Cmz,1), UBOUND(InData%Cmz,1) + ReKiBuf(Re_Xferred) = InData%Cmz(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( .NOT. ALLOCATED(InData%Cm) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5867,6 +6868,98 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM END DO END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cz not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Cz)) DEALLOCATE(OutData%Cz) + ALLOCATE(OutData%Cz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Cz,2), UBOUND(OutData%Cz,2) + DO i1 = LBOUND(OutData%Cz,1), UBOUND(OutData%Cz,1) + OutData%Cz(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cmx not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Cmx)) DEALLOCATE(OutData%Cmx) + ALLOCATE(OutData%Cmx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Cmx,2), UBOUND(OutData%Cmx,2) + DO i1 = LBOUND(OutData%Cmx,1), UBOUND(OutData%Cmx,1) + OutData%Cmx(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cmy not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Cmy)) DEALLOCATE(OutData%Cmy) + ALLOCATE(OutData%Cmy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmy.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Cmy,2), UBOUND(OutData%Cmy,2) + DO i1 = LBOUND(OutData%Cmy,1), UBOUND(OutData%Cmy,1) + OutData%Cmy(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cmz not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Cmz)) DEALLOCATE(OutData%Cmz) + ALLOCATE(OutData%Cmz(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cmz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Cmz,2), UBOUND(OutData%Cmz,2) + DO i1 = LBOUND(OutData%Cmz,1), UBOUND(OutData%Cmz,1) + OutData%Cmz(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cm not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6091,6 +7184,8 @@ SUBROUTINE BEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg END IF ! check if allocated b = -(u1%chi0 - u2%chi0) u_out%chi0 = u1%chi0 + b * ScaleFactor + b = -(u1%psiSkewOffset - u2%psiSkewOffset) + u_out%psiSkewOffset = u1%psiSkewOffset + b * ScaleFactor IF (ALLOCATED(u_out%psi) .AND. ALLOCATED(u1%psi)) THEN DO i1 = LBOUND(u_out%psi,1),UBOUND(u_out%psi,1) b = -(u1%psi(i1) - u2%psi(i1)) @@ -6117,6 +7212,14 @@ SUBROUTINE BEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg END DO END DO END IF ! check if allocated +IF (ALLOCATED(u_out%Vz) .AND. ALLOCATED(u1%Vz)) THEN + DO i2 = LBOUND(u_out%Vz,2),UBOUND(u_out%Vz,2) + DO i1 = LBOUND(u_out%Vz,1),UBOUND(u_out%Vz,1) + b = -(u1%Vz(i1,i2) - u2%Vz(i1,i2)) + u_out%Vz(i1,i2) = u1%Vz(i1,i2) + b * ScaleFactor + END DO + END DO +END IF ! check if allocated IF (ALLOCATED(u_out%omega_z) .AND. ALLOCATED(u1%omega_z)) THEN DO i2 = LBOUND(u_out%omega_z,2),UBOUND(u_out%omega_z,2) DO i1 = LBOUND(u_out%omega_z,1),UBOUND(u_out%omega_z,1) @@ -6125,6 +7228,14 @@ SUBROUTINE BEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg END DO END DO END IF ! check if allocated +IF (ALLOCATED(u_out%xVelCorr) .AND. ALLOCATED(u1%xVelCorr)) THEN + DO i2 = LBOUND(u_out%xVelCorr,2),UBOUND(u_out%xVelCorr,2) + DO i1 = LBOUND(u_out%xVelCorr,1),UBOUND(u_out%xVelCorr,1) + b = -(u1%xVelCorr(i1,i2) - u2%xVelCorr(i1,i2)) + u_out%xVelCorr(i1,i2) = u1%xVelCorr(i1,i2) + b * ScaleFactor + END DO + END DO +END IF ! check if allocated IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN DO i2 = LBOUND(u_out%rLocal,2),UBOUND(u_out%rLocal,2) DO i1 = LBOUND(u_out%rLocal,1),UBOUND(u_out%rLocal,1) @@ -6135,6 +7246,14 @@ SUBROUTINE BEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg END IF ! check if allocated b = -(u1%Un_disk - u2%Un_disk) u_out%Un_disk = u1%Un_disk + b * ScaleFactor + DO i1 = LBOUND(u_out%V0,1),UBOUND(u_out%V0,1) + b = -(u1%V0(i1) - u2%V0(i1)) + u_out%V0(i1) = u1%V0(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%x_hat_disk,1),UBOUND(u_out%x_hat_disk,1) + b = -(u1%x_hat_disk(i1) - u2%x_hat_disk(i1)) + u_out%x_hat_disk(i1) = u1%x_hat_disk(i1) + b * ScaleFactor + END DO IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) @@ -6142,6 +7261,30 @@ SUBROUTINE BEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b * ScaleFactor END DO END DO +END IF ! check if allocated +IF (ALLOCATED(u_out%CantAngle) .AND. ALLOCATED(u1%CantAngle)) THEN + DO i2 = LBOUND(u_out%CantAngle,2),UBOUND(u_out%CantAngle,2) + DO i1 = LBOUND(u_out%CantAngle,1),UBOUND(u_out%CantAngle,1) + b = -(u1%CantAngle(i1,i2) - u2%CantAngle(i1,i2)) + u_out%CantAngle(i1,i2) = u1%CantAngle(i1,i2) + b * ScaleFactor + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(u_out%drdz) .AND. ALLOCATED(u1%drdz)) THEN + DO i2 = LBOUND(u_out%drdz,2),UBOUND(u_out%drdz,2) + DO i1 = LBOUND(u_out%drdz,1),UBOUND(u_out%drdz,1) + b = -(u1%drdz(i1,i2) - u2%drdz(i1,i2)) + u_out%drdz(i1,i2) = u1%drdz(i1,i2) + b * ScaleFactor + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(u_out%toeAngle) .AND. ALLOCATED(u1%toeAngle)) THEN + DO i2 = LBOUND(u_out%toeAngle,2),UBOUND(u_out%toeAngle,2) + DO i1 = LBOUND(u_out%toeAngle,1),UBOUND(u_out%toeAngle,1) + b = -(u1%toeAngle(i1,i2) - u2%toeAngle(i1,i2)) + u_out%toeAngle(i1,i2) = u1%toeAngle(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated END SUBROUTINE BEMT_Input_ExtrapInterp1 @@ -6214,6 +7357,9 @@ SUBROUTINE BEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er b = (t(3)**2*(u1%chi0 - u2%chi0) + t(2)**2*(-u1%chi0 + u3%chi0))* scaleFactor c = ( (t(2)-t(3))*u1%chi0 + t(3)*u2%chi0 - t(2)*u3%chi0 ) * scaleFactor u_out%chi0 = u1%chi0 + b + c * t_out + b = (t(3)**2*(u1%psiSkewOffset - u2%psiSkewOffset) + t(2)**2*(-u1%psiSkewOffset + u3%psiSkewOffset))* scaleFactor + c = ( (t(2)-t(3))*u1%psiSkewOffset + t(3)*u2%psiSkewOffset - t(2)*u3%psiSkewOffset ) * scaleFactor + u_out%psiSkewOffset = u1%psiSkewOffset + b + c * t_out IF (ALLOCATED(u_out%psi) .AND. ALLOCATED(u1%psi)) THEN DO i1 = LBOUND(u_out%psi,1),UBOUND(u_out%psi,1) b = (t(3)**2*(u1%psi(i1) - u2%psi(i1)) + t(2)**2*(-u1%psi(i1) + u3%psi(i1)))* scaleFactor @@ -6245,6 +7391,15 @@ SUBROUTINE BEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er END DO END DO END IF ! check if allocated +IF (ALLOCATED(u_out%Vz) .AND. ALLOCATED(u1%Vz)) THEN + DO i2 = LBOUND(u_out%Vz,2),UBOUND(u_out%Vz,2) + DO i1 = LBOUND(u_out%Vz,1),UBOUND(u_out%Vz,1) + b = (t(3)**2*(u1%Vz(i1,i2) - u2%Vz(i1,i2)) + t(2)**2*(-u1%Vz(i1,i2) + u3%Vz(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%Vz(i1,i2) + t(3)*u2%Vz(i1,i2) - t(2)*u3%Vz(i1,i2) ) * scaleFactor + u_out%Vz(i1,i2) = u1%Vz(i1,i2) + b + c * t_out + END DO + END DO +END IF ! check if allocated IF (ALLOCATED(u_out%omega_z) .AND. ALLOCATED(u1%omega_z)) THEN DO i2 = LBOUND(u_out%omega_z,2),UBOUND(u_out%omega_z,2) DO i1 = LBOUND(u_out%omega_z,1),UBOUND(u_out%omega_z,1) @@ -6254,6 +7409,15 @@ SUBROUTINE BEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er END DO END DO END IF ! check if allocated +IF (ALLOCATED(u_out%xVelCorr) .AND. ALLOCATED(u1%xVelCorr)) THEN + DO i2 = LBOUND(u_out%xVelCorr,2),UBOUND(u_out%xVelCorr,2) + DO i1 = LBOUND(u_out%xVelCorr,1),UBOUND(u_out%xVelCorr,1) + b = (t(3)**2*(u1%xVelCorr(i1,i2) - u2%xVelCorr(i1,i2)) + t(2)**2*(-u1%xVelCorr(i1,i2) + u3%xVelCorr(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%xVelCorr(i1,i2) + t(3)*u2%xVelCorr(i1,i2) - t(2)*u3%xVelCorr(i1,i2) ) * scaleFactor + u_out%xVelCorr(i1,i2) = u1%xVelCorr(i1,i2) + b + c * t_out + END DO + END DO +END IF ! check if allocated IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN DO i2 = LBOUND(u_out%rLocal,2),UBOUND(u_out%rLocal,2) DO i1 = LBOUND(u_out%rLocal,1),UBOUND(u_out%rLocal,1) @@ -6266,6 +7430,16 @@ SUBROUTINE BEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er b = (t(3)**2*(u1%Un_disk - u2%Un_disk) + t(2)**2*(-u1%Un_disk + u3%Un_disk))* scaleFactor c = ( (t(2)-t(3))*u1%Un_disk + t(3)*u2%Un_disk - t(2)*u3%Un_disk ) * scaleFactor u_out%Un_disk = u1%Un_disk + b + c * t_out + DO i1 = LBOUND(u_out%V0,1),UBOUND(u_out%V0,1) + b = (t(3)**2*(u1%V0(i1) - u2%V0(i1)) + t(2)**2*(-u1%V0(i1) + u3%V0(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%V0(i1) + t(3)*u2%V0(i1) - t(2)*u3%V0(i1) ) * scaleFactor + u_out%V0(i1) = u1%V0(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%x_hat_disk,1),UBOUND(u_out%x_hat_disk,1) + b = (t(3)**2*(u1%x_hat_disk(i1) - u2%x_hat_disk(i1)) + t(2)**2*(-u1%x_hat_disk(i1) + u3%x_hat_disk(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%x_hat_disk(i1) + t(3)*u2%x_hat_disk(i1) - t(2)*u3%x_hat_disk(i1) ) * scaleFactor + u_out%x_hat_disk(i1) = u1%x_hat_disk(i1) + b + c * t_out + END DO IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) @@ -6274,6 +7448,33 @@ SUBROUTINE BEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b + c * t_out END DO END DO +END IF ! check if allocated +IF (ALLOCATED(u_out%CantAngle) .AND. ALLOCATED(u1%CantAngle)) THEN + DO i2 = LBOUND(u_out%CantAngle,2),UBOUND(u_out%CantAngle,2) + DO i1 = LBOUND(u_out%CantAngle,1),UBOUND(u_out%CantAngle,1) + b = (t(3)**2*(u1%CantAngle(i1,i2) - u2%CantAngle(i1,i2)) + t(2)**2*(-u1%CantAngle(i1,i2) + u3%CantAngle(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%CantAngle(i1,i2) + t(3)*u2%CantAngle(i1,i2) - t(2)*u3%CantAngle(i1,i2) ) * scaleFactor + u_out%CantAngle(i1,i2) = u1%CantAngle(i1,i2) + b + c * t_out + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(u_out%drdz) .AND. ALLOCATED(u1%drdz)) THEN + DO i2 = LBOUND(u_out%drdz,2),UBOUND(u_out%drdz,2) + DO i1 = LBOUND(u_out%drdz,1),UBOUND(u_out%drdz,1) + b = (t(3)**2*(u1%drdz(i1,i2) - u2%drdz(i1,i2)) + t(2)**2*(-u1%drdz(i1,i2) + u3%drdz(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%drdz(i1,i2) + t(3)*u2%drdz(i1,i2) - t(2)*u3%drdz(i1,i2) ) * scaleFactor + u_out%drdz(i1,i2) = u1%drdz(i1,i2) + b + c * t_out + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(u_out%toeAngle) .AND. ALLOCATED(u1%toeAngle)) THEN + DO i2 = LBOUND(u_out%toeAngle,2),UBOUND(u_out%toeAngle,2) + DO i1 = LBOUND(u_out%toeAngle,1),UBOUND(u_out%toeAngle,1) + b = (t(3)**2*(u1%toeAngle(i1,i2) - u2%toeAngle(i1,i2)) + t(2)**2*(-u1%toeAngle(i1,i2) + u3%toeAngle(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%toeAngle(i1,i2) + t(3)*u2%toeAngle(i1,i2) - t(2)*u3%toeAngle(i1,i2) ) * scaleFactor + u_out%toeAngle(i1,i2) = u1%toeAngle(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated END SUBROUTINE BEMT_Input_ExtrapInterp2 @@ -6438,6 +7639,38 @@ SUBROUTINE BEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs END DO END DO END IF ! check if allocated +IF (ALLOCATED(y_out%Cz) .AND. ALLOCATED(y1%Cz)) THEN + DO i2 = LBOUND(y_out%Cz,2),UBOUND(y_out%Cz,2) + DO i1 = LBOUND(y_out%Cz,1),UBOUND(y_out%Cz,1) + b = -(y1%Cz(i1,i2) - y2%Cz(i1,i2)) + y_out%Cz(i1,i2) = y1%Cz(i1,i2) + b * ScaleFactor + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%Cmx) .AND. ALLOCATED(y1%Cmx)) THEN + DO i2 = LBOUND(y_out%Cmx,2),UBOUND(y_out%Cmx,2) + DO i1 = LBOUND(y_out%Cmx,1),UBOUND(y_out%Cmx,1) + b = -(y1%Cmx(i1,i2) - y2%Cmx(i1,i2)) + y_out%Cmx(i1,i2) = y1%Cmx(i1,i2) + b * ScaleFactor + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%Cmy) .AND. ALLOCATED(y1%Cmy)) THEN + DO i2 = LBOUND(y_out%Cmy,2),UBOUND(y_out%Cmy,2) + DO i1 = LBOUND(y_out%Cmy,1),UBOUND(y_out%Cmy,1) + b = -(y1%Cmy(i1,i2) - y2%Cmy(i1,i2)) + y_out%Cmy(i1,i2) = y1%Cmy(i1,i2) + b * ScaleFactor + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%Cmz) .AND. ALLOCATED(y1%Cmz)) THEN + DO i2 = LBOUND(y_out%Cmz,2),UBOUND(y_out%Cmz,2) + DO i1 = LBOUND(y_out%Cmz,1),UBOUND(y_out%Cmz,1) + b = -(y1%Cmz(i1,i2) - y2%Cmz(i1,i2)) + y_out%Cmz(i1,i2) = y1%Cmz(i1,i2) + b * ScaleFactor + END DO + END DO +END IF ! check if allocated IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN DO i2 = LBOUND(y_out%Cm,2),UBOUND(y_out%Cm,2) DO i1 = LBOUND(y_out%Cm,1),UBOUND(y_out%Cm,1) @@ -6609,6 +7842,42 @@ SUBROUTINE BEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E END DO END DO END IF ! check if allocated +IF (ALLOCATED(y_out%Cz) .AND. ALLOCATED(y1%Cz)) THEN + DO i2 = LBOUND(y_out%Cz,2),UBOUND(y_out%Cz,2) + DO i1 = LBOUND(y_out%Cz,1),UBOUND(y_out%Cz,1) + b = (t(3)**2*(y1%Cz(i1,i2) - y2%Cz(i1,i2)) + t(2)**2*(-y1%Cz(i1,i2) + y3%Cz(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cz(i1,i2) + t(3)*y2%Cz(i1,i2) - t(2)*y3%Cz(i1,i2) ) * scaleFactor + y_out%Cz(i1,i2) = y1%Cz(i1,i2) + b + c * t_out + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%Cmx) .AND. ALLOCATED(y1%Cmx)) THEN + DO i2 = LBOUND(y_out%Cmx,2),UBOUND(y_out%Cmx,2) + DO i1 = LBOUND(y_out%Cmx,1),UBOUND(y_out%Cmx,1) + b = (t(3)**2*(y1%Cmx(i1,i2) - y2%Cmx(i1,i2)) + t(2)**2*(-y1%Cmx(i1,i2) + y3%Cmx(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cmx(i1,i2) + t(3)*y2%Cmx(i1,i2) - t(2)*y3%Cmx(i1,i2) ) * scaleFactor + y_out%Cmx(i1,i2) = y1%Cmx(i1,i2) + b + c * t_out + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%Cmy) .AND. ALLOCATED(y1%Cmy)) THEN + DO i2 = LBOUND(y_out%Cmy,2),UBOUND(y_out%Cmy,2) + DO i1 = LBOUND(y_out%Cmy,1),UBOUND(y_out%Cmy,1) + b = (t(3)**2*(y1%Cmy(i1,i2) - y2%Cmy(i1,i2)) + t(2)**2*(-y1%Cmy(i1,i2) + y3%Cmy(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cmy(i1,i2) + t(3)*y2%Cmy(i1,i2) - t(2)*y3%Cmy(i1,i2) ) * scaleFactor + y_out%Cmy(i1,i2) = y1%Cmy(i1,i2) + b + c * t_out + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(y_out%Cmz) .AND. ALLOCATED(y1%Cmz)) THEN + DO i2 = LBOUND(y_out%Cmz,2),UBOUND(y_out%Cmz,2) + DO i1 = LBOUND(y_out%Cmz,1),UBOUND(y_out%Cmz,1) + b = (t(3)**2*(y1%Cmz(i1,i2) - y2%Cmz(i1,i2)) + t(2)**2*(-y1%Cmz(i1,i2) + y3%Cmz(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cmz(i1,i2) + t(3)*y2%Cmz(i1,i2) - t(2)*y3%Cmz(i1,i2) ) * scaleFactor + y_out%Cmz(i1,i2) = y1%Cmz(i1,i2) + b + c * t_out + END DO + END DO +END IF ! check if allocated IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN DO i2 = LBOUND(y_out%Cm,2),UBOUND(y_out%Cm,2) DO i1 = LBOUND(y_out%Cm,1),UBOUND(y_out%Cm,1) diff --git a/modules/aerodyn/src/FVW_Subs.f90 b/modules/aerodyn/src/FVW_Subs.f90 index bcf2809c42..f8a6eeaa38 100644 --- a/modules/aerodyn/src/FVW_Subs.f90 +++ b/modules/aerodyn/src/FVW_Subs.f90 @@ -1491,7 +1491,7 @@ end subroutine FakeGroundEffect !! - M_sg : from global to section (this is ill-defined), this coordinate is used to define the "axial" and "tangential" inductions subroutine FVW_AeroOuts( M_sg, M_ag, PitchAndTwist, Vstr_g, Vind_g, Vwnd_g, KinVisc, Chord, & AxInd, TanInd, Vrel_norm, phi, alpha, Re, Urel_s, ErrStat, ErrMsg ) - real(ReKi), intent(in ) :: M_sg(3,3) ! m%WithoutSweepPitchTwist global coord to "section" coord + real(R8Ki), intent(in ) :: M_sg(3,3) ! m%WithoutSweepPitchTwist global coord to "section" coord real(R8Ki), intent(in ) :: M_ag(3,3) ! u%BladeMotion(k)%Orientation(1:3,1:3,j) global coord to airfoil coord real(ReKi), intent(in ) :: PitchAndTwist ! Pitch and twist of section real(ReKi), intent(in ) :: Vstr_g(3) ! Structural velocity global coord diff --git a/modules/nwtc-library/CMakeLists.txt b/modules/nwtc-library/CMakeLists.txt index 6883581a0e..7186913a20 100644 --- a/modules/nwtc-library/CMakeLists.txt +++ b/modules/nwtc-library/CMakeLists.txt @@ -28,6 +28,9 @@ set(NWTCLIBS_SOURCES # RanLux sources src/ranlux/RANLUX.f90 + + # Public Domain Aeronautical Software (PDAS) Polynomial Root Finder + src/Polynomial/quartic.f90 # NetLib sources src/NetLib/fftpack/fftpack4.1.f diff --git a/modules/nwtc-library/src/Polynomial/quartic.f90 b/modules/nwtc-library/src/Polynomial/quartic.f90 new file mode 100644 index 0000000000..176549241f --- /dev/null +++ b/modules/nwtc-library/src/Polynomial/quartic.f90 @@ -0,0 +1,591 @@ +!+ +MODULE PolynomialRoots +! --------------------------------------------------------------------------- +! PURPOSE - Solve for the roots of a polynomial equation with real +! coefficients, up to quartic order. Retrun a code indicating the nature +! of the roots found. + +! AUTHORS - Alfred H. Morris, Naval Surface Weapons Center, Dahlgren,VA +! William L. Davis, Naval Surface Weapons Center, Dahlgren,VA +! Alan Miller, CSIRO Mathematical & Information Sciences +! CLAYTON, VICTORIA, AUSTRALIA 3169 +! http://www.mel.dms.csiro.au/~alan +! Ralph L. Carmichael, Public Domain Aeronautical Software +! http://www.pdas.com +! REVISION HISTORY +! DATE VERS PERSON STATEMENT OF CHANGES +! ?? 1.0 AHM&WLD Original coding +! 27Feb97 1.1 AM Converted to be compatible with ELF90 +! 12Jul98 1.2 RLC Module format; numerous style changes +! 4Jan99 1.3 RLC Made the tests for zero constant term exactly zero + + + IMPLICIT NONE + + INTEGER,PARAMETER,PRIVATE:: SP=KIND(1.0_4), DP=KIND(1.0_8) + REAL(DP),PARAMETER,PRIVATE:: ZERO=0.0D0, FOURTH=0.25D0, HALF=0.5D0 + REAL(DP),PARAMETER,PRIVATE:: ONE=1.0D0, TWO=2.0D0, THREE=3.0D0, FOUR=4.0D0 + COMPLEX(DP),PARAMETER,PRIVATE:: CZERO=(0.D0,0.D0) + + REAL(DP),PARAMETER,PRIVATE:: EPS=EPSILON(ONE) + + CHARACTER(LEN=*),PARAMETER,PUBLIC:: POLYROOTS_VERSION= "1.3 (4 Jan 1999)" + INTEGER,PRIVATE:: outputCode +! =0 degenerate equation +! =1 one real root +! =21 two identical real roots +! =22 two distinct real roots +! =23 two complex roots +! =31 multiple real roots +! =32 one real and two complex roots +! =33 three distinct real roots +! =41 +! =42 two real and two complex roots +! =43 +! =44 four complex roots + + PRIVATE:: CubeRoot + PUBLIC:: LinearRoot + PRIVATE:: OneLargeTwoSmall + PUBLIC:: QuadraticRoots + PUBLIC:: CubicRoots + PUBLIC:: QuarticRoots + PUBLIC:: SolvePolynomial +!---------------------------------------------------------------------------- + + INTERFACE Swap + MODULE PROCEDURE SwapDouble + MODULE PROCEDURE SwapSingle + END INTERFACE + +CONTAINS + +!+ +FUNCTION CubeRoot(x) RESULT(f) +! --------------------------------------------------------------------------- +! PURPOSE - Compute the Cube Root of a REAL(DP) number. If the argument is +! negative, then the cube root is also negative. + + REAL(DP),INTENT(IN) :: x + REAL(DP):: f +!---------------------------------------------------------------------------- + IF (x < ZERO) THEN + f=-EXP(LOG(-x)/THREE) + ELSE IF (x > ZERO) THEN + f=EXP(LOG(x)/THREE) + ELSE + f=ZERO + END IF + RETURN +END Function CubeRoot ! --------------------------------------------------- + +!+ +SUBROUTINE LinearRoot(a, z) +! --------------------------------------------------------------------------- +! PURPOSE - COMPUTES THE ROOTS OF THE REAL POLYNOMIAL +! A(1) + A(2)*Z +! AND STORES THE RESULTS IN Z. It is assumed that a(2) is non-zero. + REAL(DP),INTENT(IN),DIMENSION(:):: a + REAL(DP),INTENT(OUT):: z +!---------------------------------------------------------------------------- + IF (a(2)==0.0) THEN + z=ZERO + ELSE + z=-a(1)/a(2) + END IF + RETURN +END Subroutine LinearRoot ! ----------------------------------------------- + +!+ +SUBROUTINE OneLargeTwoSmall(a1,a2,a4,w, z) +! --------------------------------------------------------------------------- +! PURPOSE - Compute the roots of a cubic when one root, w, is known to be +! much larger in magnitude than the other two + + REAL(DP),INTENT(IN):: a1,a2,a4 + REAL(DP),INTENT(IN):: w + COMPLEX(DP),INTENT(OUT),DIMENSION(:):: z + + + REAL(DP),DIMENSION(3):: aq +!---------------------------------------------------------------------------- + aq(1)=a1 + aq(2)=a2+a1/w + aq(3)=-a4*w + CALL QuadraticRoots(aq, z) + z(3)=CMPLX(w,ZERO,DP) + + IF (AIMAG(z(1)) == ZERO) RETURN + z(3)=z(2) + z(2)=z(1) + z(1)=CMPLX(w,ZERO,DP) + RETURN +END Subroutine OneLargeTwoSmall ! ----------------------------------------- + +!+ +SUBROUTINE QuadraticRoots(a, z) +! --------------------------------------------------------------------------- +! PURPOSE - COMPUTES THE ROOTS OF THE REAL POLYNOMIAL +! A(1) + A(2)*Z + A(3)*Z**2 +! AND STORES THE RESULTS IN Z. IT IS ASSUMED THAT A(3) IS NONZERO. + + REAL(DP),INTENT(IN),DIMENSION(:):: a + COMPLEX(DP),INTENT(OUT),DIMENSION(:):: z + + + REAL(DP):: d, r, w, x, y +!---------------------------------------------------------------------------- + IF(a(1)==0.0) THEN ! EPS is a global module constant (private) + z(1) = CZERO ! one root is obviously zero + z(2) = CMPLX(-a(2)/a(3), ZERO,DP) ! remainder is a linear eq. + outputCode=21 ! two identical real roots + RETURN + END IF + + d = a(2)*a(2) - FOUR*a(1)*a(3) ! the discriminant + IF (ABS(d) <= TWO*eps*a(2)*a(2)) THEN + z(1) = CMPLX(-HALF*a(2)/a(3), ZERO, DP) ! discriminant is tiny + z(2) = z(1) + outputCode=22 ! two distinct real roots + RETURN + END IF + + r = SQRT(ABS(d)) + IF (d < ZERO) THEN + x = -HALF*a(2)/a(3) ! negative discriminant => roots are complex + y = ABS(HALF*r/a(3)) + z(1) = CMPLX(x, y, DP) + z(2) = CMPLX(x,-y, DP) ! its conjugate + outputCode=23 ! COMPLEX ROOTS + RETURN + END IF + + IF (a(2) /= ZERO) THEN ! see Numerical Recipes, sec. 5.5 + w = -(a(2) + SIGN(r,a(2))) + z(1) = CMPLX(TWO*a(1)/w, ZERO, DP) + z(2) = CMPLX(HALF*w/a(3), ZERO, DP) + outputCode=22 ! two real roots + RETURN + END IF + + x = ABS(HALF*r/a(3)) ! a(2)=0 if you get here + z(1) = CMPLX( x, ZERO, DP) + z(2) = CMPLX(-x, ZERO, DP) + outputCode=22 + RETURN +END Subroutine QuadraticRoots ! ------------------------------------------- + +!+ +SUBROUTINE CubicRoots(a, z) +!---------------------------------------------------------------------------- +! PURPOSE - Compute the roots of the real polynomial +! A(1) + A(2)*Z + A(3)*Z**2 + A(4)*Z**3 + REAL(DP),INTENT(IN),DIMENSION(:):: a + COMPLEX(DP),INTENT(OUT),DIMENSION(:):: z + + REAL(DP),PARAMETER:: RT3=1.7320508075689D0 ! (Sqrt(3) + REAL (DP) :: aq(3), arg, c, cf, d, p, p1, q, q1 + REAL(DP):: r, ra, rb, rq, rt + REAL(DP):: r1, s, sf, sq, sum, t, tol, t1, w + REAL(DP):: w1, w2, x, x1, x2, x3, y, y1, y2, y3 + +! NOTE - It is assumed that a(4) is non-zero. No test is made here. +!---------------------------------------------------------------------------- + IF (a(1)==0.0) THEN + z(1) = CZERO ! one root is obviously zero + CALL QuadraticRoots(a(2:4), z(2:3)) ! remaining 2 roots here + RETURN + END IF + + p = a(3)/(THREE*a(4)) + q = a(2)/a(4) + r = a(1)/a(4) + tol = FOUR*EPS + + c = ZERO + t = a(2) - p*a(3) + IF (ABS(t) > tol*ABS(a(2))) c = t/a(4) + + t = TWO*p*p - q + IF (ABS(t) <= tol*ABS(q)) t = ZERO + d = r + p*t + IF (ABS(d) <= tol*ABS(r)) GO TO 110 + +! SET SQ = (A(4)/S)**2 * (C**3/27 + D**2/4) + + s = MAX(ABS(a(1)), ABS(a(2)), ABS(a(3))) + p1 = a(3)/(THREE*s) + q1 = a(2)/s + r1 = a(1)/s + + t1 = q - 2.25D0*p*p + IF (ABS(t1) <= tol*ABS(q)) t1 = ZERO + w = FOURTH*r1*r1 + w1 = HALF*p1*r1*t + w2 = q1*q1*t1/27.0D0 + + IF (w1 >= ZERO) THEN + w = w + w1 + sq = w + w2 + ELSE IF (w2 < ZERO) THEN + sq = w + (w1 + w2) + ELSE + w = w + w2 + sq = w + w1 + END IF + + IF (ABS(sq) <= tol*w) sq = ZERO + rq = ABS(s/a(4))*SQRT(ABS(sq)) + IF (sq >= ZERO) GO TO 40 + +! ALL ROOTS ARE REAL + + arg = ATAN2(rq, -HALF*d) + cf = COS(arg/THREE) + sf = SIN(arg/THREE) + rt = SQRT(-c/THREE) + y1 = TWO*rt*cf + y2 = -rt*(cf + rt3*sf) + y3 = -(d/y1)/y2 + + x1 = y1 - p + x2 = y2 - p + x3 = y3 - p + + IF (ABS(x1) > ABS(x2)) CALL Swap(x1,x2) + IF (ABS(x2) > ABS(x3)) CALL Swap(x2,x3) + IF (ABS(x1) > ABS(x2)) CALL Swap(x1,x2) + + w = x3 + + IF (ABS(x2) < 0.1D0*ABS(x3)) GO TO 70 + IF (ABS(x1) < 0.1D0*ABS(x2)) x1 = - (r/x3)/x2 + z(1) = CMPLX(x1, ZERO,DP) + z(2) = CMPLX(x2, ZERO,DP) + z(3) = CMPLX(x3, ZERO,DP) + RETURN + +! REAL AND COMPLEX ROOTS + +40 ra =CubeRoot(-HALF*d - SIGN(rq,d)) + rb = -c/(THREE*ra) + t = ra + rb + w = -p + x = -p + IF (ABS(t) <= tol*ABS(ra)) GO TO 41 + w = t - p + x = -HALF*t - p + IF (ABS(x) <= tol*ABS(p)) x = ZERO + 41 t = ABS(ra - rb) + y = HALF*rt3*t + + IF (t <= tol*ABS(ra)) GO TO 60 + IF (ABS(x) < ABS(y)) GO TO 50 + s = ABS(x) + t = y/x + GO TO 51 +50 s = ABS(y) + t = x/y +51 IF (s < 0.1D0*ABS(w)) GO TO 70 + w1 = w/s + sum = ONE + t*t + IF (w1*w1 < 0.01D0*sum) w = - ((r/sum)/s)/s + z(1) = CMPLX(w, ZERO,DP) + z(2) = CMPLX(x, y,DP) + z(3) = CMPLX(x,-y,DP) + RETURN + +! AT LEAST TWO ROOTS ARE EQUAL + +60 IF (ABS(x) < ABS(w)) GO TO 61 + IF (ABS(w) < 0.1D0*ABS(x)) w = - (r/x)/x + z(1) = CMPLX(w, ZERO,DP) + z(2) = CMPLX(x, ZERO,DP) + z(3) = z(2) + RETURN + 61 IF (ABS(x) < 0.1D0*ABS(w)) GO TO 70 + z(1) = CMPLX(x, ZERO,DP) + z(2) = z(1) + z(3) = CMPLX(w, ZERO,DP) + RETURN + +! HERE W IS MUCH LARGER IN MAGNITUDE THAN THE OTHER ROOTS. +! AS A RESULT, THE OTHER ROOTS MAY BE EXCEEDINGLY INACCURATE +! BECAUSE OF ROUNDOFF ERROR. TO DEAL WITH THIS, A QUADRATIC +! IS FORMED WHOSE ROOTS ARE THE SAME AS THE SMALLER ROOTS OF +! THE CUBIC. THIS QUADRATIC IS THEN SOLVED. + +! THIS CODE WAS WRITTEN BY WILLIAM L. DAVIS (NSWC). + +70 aq(1) = a(1) + aq(2) = a(2) + a(1)/w + aq(3) = -a(4)*w + CALL QuadraticRoots(aq, z) + z(3) = CMPLX(w, ZERO,DP) + + IF (AIMAG(z(1)) == ZERO) RETURN + z(3) = z(2) + z(2) = z(1) + z(1) = CMPLX(w, ZERO,DP) + RETURN +!----------------------------------------------------------------------- + + +! CASE WHEN D = 0 + +110 z(1) = CMPLX(-p, ZERO,DP) + w = SQRT(ABS(c)) + IF (c < ZERO) GO TO 120 + z(2) = CMPLX(-p, w,DP) + z(3) = CMPLX(-p,-w,DP) + RETURN + +120 IF (p /= ZERO) GO TO 130 + z(2) = CMPLX(w, ZERO,DP) + z(3) = CMPLX(-w, ZERO,DP) + RETURN + +130 x = -(p + SIGN(w,p)) + z(3) = CMPLX(x, ZERO,DP) + t = THREE*a(1)/(a(3)*x) + IF (ABS(p) > ABS(t)) GO TO 131 + z(2) = CMPLX(t, ZERO,DP) + RETURN +131 z(2) = z(1) + z(1) = CMPLX(t, ZERO,DP) + RETURN +END Subroutine CubicRoots ! ----------------------------------------------- + + +!+ +SUBROUTINE QuarticRoots(a,z) +!---------------------------------------------------------------------------- +! PURPOSE - Compute the roots of the real polynomial +! A(1) + A(2)*Z + ... + A(5)*Z**4 + + REAL(DP), INTENT(IN) :: a(:) + COMPLEX(DP), INTENT(OUT) :: z(:) + + COMPLEX(DP) :: w + REAL(DP):: b,b2, c, d, e, h, p, q, r, t + REAL(DP),DIMENSION(4):: temp + REAL(DP):: u, v, v1, v2, x, x1, x2, x3, y + + +! NOTE - It is assumed that a(5) is non-zero. No test is made here + +!---------------------------------------------------------------------------- + + IF (a(1)==0.0) THEN + z(1) = CZERO ! one root is obviously zero + CALL CubicRoots(a(2:), z(2:)) + RETURN + END IF + + + b = a(4)/(FOUR*a(5)) + c = a(3)/a(5) + d = a(2)/a(5) + e = a(1)/a(5) + b2 = b*b + + p = HALF*(c - 6.0D0*b2) + q = d - TWO*b*(c - FOUR*b2) + r = b2*(c - THREE*b2) - b*d + e + +! SOLVE THE RESOLVENT CUBIC EQUATION. THE CUBIC HAS AT LEAST ONE +! NONNEGATIVE REAL ROOT. IF W1, W2, W3 ARE THE ROOTS OF THE CUBIC +! THEN THE ROOTS OF THE ORIGINIAL EQUATION ARE +! Z = -B + CSQRT(W1) + CSQRT(W2) + CSQRT(W3) +! WHERE THE SIGNS OF THE SQUARE ROOTS ARE CHOSEN SO +! THAT CSQRT(W1) * CSQRT(W2) * CSQRT(W3) = -Q/8. + + temp(1) = -q*q/64.0D0 + temp(2) = 0.25D0*(p*p - r) + temp(3) = p + temp(4) = ONE + CALL CubicRoots(temp,z) + IF (AIMAG(z(2)) /= ZERO) GO TO 60 + +! THE RESOLVENT CUBIC HAS ONLY REAL ROOTS +! REORDER THE ROOTS IN INCREASING ORDER + + x1 = DBLE(z(1)) + x2 = DBLE(z(2)) + x3 = DBLE(z(3)) + IF (x1 > x2) CALL Swap(x1,x2) + IF (x2 > x3) CALL Swap(x2,x3) + IF (x1 > x2) CALL Swap(x1,x2) + + u = ZERO + IF (x3 > ZERO) u = SQRT(x3) + IF (x2 <= ZERO) GO TO 41 + IF (x1 >= ZERO) GO TO 30 + IF (ABS(x1) > x2) GO TO 40 + x1 = ZERO + +30 x1 = SQRT(x1) + x2 = SQRT(x2) + IF (q > ZERO) x1 = -x1 + temp(1) = (( x1 + x2) + u) - b + temp(2) = ((-x1 - x2) + u) - b + temp(3) = (( x1 - x2) - u) - b + temp(4) = ((-x1 + x2) - u) - b + CALL SelectSort(temp) + IF (ABS(temp(1)) >= 0.1D0*ABS(temp(4))) GO TO 31 + t = temp(2)*temp(3)*temp(4) + IF (t /= ZERO) temp(1) = e/t +31 z(1) = CMPLX(temp(1), ZERO,DP) + z(2) = CMPLX(temp(2), ZERO,DP) + z(3) = CMPLX(temp(3), ZERO,DP) + z(4) = CMPLX(temp(4), ZERO,DP) + RETURN + +40 v1 = SQRT(ABS(x1)) +v2 = ZERO +GO TO 50 +41 v1 = SQRT(ABS(x1)) +v2 = SQRT(ABS(x2)) +IF (q < ZERO) u = -u + +50 x = -u - b +y = v1 - v2 +z(1) = CMPLX(x, y,DP) +z(2) = CMPLX(x,-y,DP) +x = u - b +y = v1 + v2 +z(3) = CMPLX(x, y,DP) +z(4) = CMPLX(x,-y,DP) +RETURN + +! THE RESOLVENT CUBIC HAS COMPLEX ROOTS + +60 t = DBLE(z(1)) +x = ZERO +IF (t < ZERO) THEN + GO TO 61 +ELSE IF (t == ZERO) THEN + GO TO 70 +ELSE + GO TO 62 +END IF +61 h = ABS(DBLE(z(2))) + ABS(AIMAG(z(2))) +IF (ABS(t) <= h) GO TO 70 +GO TO 80 +62 x = SQRT(t) +IF (q > ZERO) x = -x + +70 w = SQRT(z(2)) + u = TWO*DBLE(w) + v = TWO*ABS(AIMAG(w)) + t = x - b + x1 = t + u + x2 = t - u + IF (ABS(x1) <= ABS(x2)) GO TO 71 + t = x1 + x1 = x2 + x2 = t +71 u = -x - b + h = u*u + v*v + IF (x1*x1 < 0.01D0*MIN(x2*x2,h)) x1 = e/(x2*h) + z(1) = CMPLX(x1, ZERO,DP) + z(2) = CMPLX(x2, ZERO,DP) + z(3) = CMPLX(u, v,DP) + z(4) = CMPLX(u,-v,DP) + RETURN + +80 v = SQRT(ABS(t)) + z(1) = CMPLX(-b, v,DP) + z(2) = CMPLX(-b,-v,DP) + z(3) = z(1) + z(4) = z(2) + RETURN + +END Subroutine QuarticRoots + +!+ +SUBROUTINE SelectSort(a) +! --------------------------------------------------------------------------- +! PURPOSE - Reorder the elements of in increasing order. + REAL(DP),INTENT(IN OUT),DIMENSION(:):: a + + INTEGER:: j + INTEGER,DIMENSION(1):: k +! NOTE - This is a n**2 method. It should only be used for small arrays. <25 +!---------------------------------------------------------------------------- + DO j=1,SIZE(a)-1 + k=MINLOC(a(j:)) + IF (j /= k(1)) CALL Swap(a(k(1)),a(j)) + END DO + RETURN +END Subroutine SelectSort ! ----------------------------------------------- + +!+ +SUBROUTINE SolvePolynomial(quarticCoeff, cubicCoeff, quadraticCoeff, & + linearCoeff, constantCoeff, code, root1,root2,root3,root4) +! --------------------------------------------------------------------------- + REAL(DP),INTENT(IN):: quarticCoeff + REAL(DP),INTENT(IN):: cubicCoeff, quadraticCoeff + REAL(DP),INTENT(IN):: linearCoeff, constantCoeff + INTEGER,INTENT(OUT):: code + COMPLEX(DP),INTENT(OUT):: root1,root2,root3,root4 + REAL(DP),DIMENSION(5):: a + COMPLEX(DP),DIMENSION(5):: z +!---------------------------------------------------------------------------- + a(1)=constantCoeff + a(2)=linearCoeff + a(3)=quadraticCoeff + a(4)=cubicCoeff + a(5)=quarticCoeff + + IF (quarticCoeff /= ZERO) THEN + CALL QuarticRoots(a,z) + ELSE IF (cubicCoeff /= ZERO) THEN + CALL CubicRoots(a,z) + ELSE IF (quadraticCoeff /= ZERO) THEN + CALL QuadraticRoots(a,z) + ELSE IF (linearCoeff /= ZERO) THEN + z(1)=CMPLX(-constantCoeff/linearCoeff, 0, DP) + outputCode=1 + ELSE + outputCode=0 ! { no roots } + END IF + + code=outputCode + IF (outputCode > 0) root1=z(1) + IF (outputCode > 1) root2=z(2) + IF (outputCode > 23) root3=z(3) + IF (outputCode > 99) root4=z(4) + RETURN +END Subroutine SolvePolynomial ! ------------------------------------------ + +!+ +SUBROUTINE SwapDouble(a,b) +! --------------------------------------------------------------------------- +! PURPOSE - Interchange the contents of a and b + REAL(DP),INTENT(IN OUT):: a,b + REAL(DP):: t +!---------------------------------------------------------------------------- + t=b + b=a + a=t + RETURN +END Subroutine SwapDouble ! ----------------------------------------------- + +!+ +SUBROUTINE SwapSingle(a,b) +! --------------------------------------------------------------------------- +! PURPOSE - Interchange the contents of a and b + REAL(SP),INTENT(IN OUT):: a,b + REAL(SP):: t +!---------------------------------------------------------------------------- + t=b + b=a + a=t + RETURN +END Subroutine SwapSingle ! ----------------------------------------------- + + +END Module PolynomialRoots ! ============================================== + + diff --git a/modules/nwtc-library/src/Polynomial/readme.txt b/modules/nwtc-library/src/Polynomial/readme.txt new file mode 100644 index 0000000000..8798b4c115 --- /dev/null +++ b/modules/nwtc-library/src/Polynomial/readme.txt @@ -0,0 +1,63 @@ + + +ROOTS OF QUARTIC/CUBIC/QUADRATIC POLYNOMIALS /quartic/readme.txt + WITH REAL COEFFICIENTS + + +The files for this program are in the directory \quartic on the CD-ROM and in the +archive file quartic.zip that may be downloaded from the PDAS web site. + readme.txt this file of general description + quartic.f90 the complete source codetosh (Intel) + + +The reference documents for this program may be accessed +from the web page http://www.pdas.com/quarticrefs.html. + +2020-03-05 bjj: see http://www.pdas.com/quartic.html and http://www.pdas.com/quarticdownload.html + +To compile this program for your computer, use the command + gfortran quartic.f90 -o quartic.exe +Linux and Macintosh users may prefer to omit the .exe on the file name. + + +Many problems in science and engineering lead to polynomial equations +and the desired physical quantities must be found by solving for the +zeroes of the equation. Most books on Numerical Computing or Engineering +Mathematics show examples of code for making these calculations. +One must be careful with roundoff and overflow when making these +calculations and the textbook examples frequently do not incorporate +these "robustness" features. + +There is a collection of software from the U.S. Naval Surface Weapons +Center that has been widely distributed and checked for accuracy. +Among this collection is a very nice coding of the solution of zeroes +of polynomial equations with real coefficients up to quartic order. +I noted that Alan Miller of CSIRO had updated the code to comply with +modern Fortran, using the Essential Lahey Fortran 90 compiler, which +enforces very strict standards of program structure and syntax. +I have added a simple front-end that allows you to solve quartics as +a stand-alone program. Of course, you may want to extract the subroutine +for inclusion in your own code. + +This program computes the solution to the polynomial equation + a*x**4 + b*x**3 + c*x**2 + d*x + e = 0 +with real coefficients. + +The program asks for the coefficients of each term of the polynomial +to be solved. If you are solving a cubic, answer zero to the question +"What is the coefficient of the quartic term?" + +If you want to take the program apart to use in your own programs, you +can pick up each of the individual subroutines or go for the general +subroutine SolvePolynomial. It should be pretty obvious. If not, send +me mail and I will try to clear it up. + +The routine quartic.f90 has been checked and will compile properly with +either of the free Fortran compilers, gfortran or g95. + +There is a treasure house of wonderful Fortran code at Alan Miller's web site + at http://users.bigpond.net.au/amiller/ +There seems to be a problem with this web site, but there is a mirror site at + http://jblevins.org/mirror/amiller/ +that should work for now. + diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 41559bfcae..4a656370ce 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -498,6 +498,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_AD%rotors(1)%HubOrientation = ED%y%HubPtMotion%RefOrientation(:,:,1) Init%InData_AD%rotors(1)%NacellePosition = ED%y%NacelleMotion%Position(:,1) Init%InData_AD%rotors(1)%NacelleOrientation = ED%y%NacelleMotion%RefOrientation(:,:,1) + Init%InData_AD%rotors(1)%AeroProjMod = APM_BEM_NoSweepPitchTwist do k=1,NumBl Init%InData_AD%rotors(1)%BladeRootPosition(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) diff --git a/reg_tests/manualRegressionTest.py b/reg_tests/manualRegressionTest.py index 5d5a00bc0b..f651c71a25 100644 --- a/reg_tests/manualRegressionTest.py +++ b/reg_tests/manualRegressionTest.py @@ -61,7 +61,7 @@ def strFormat(string): buildDirectory = os.path.join(sourceDirectory, "build", "reg_tests", "modules", moduleName.lower()) caseListFile = os.path.join("r-test", "modules", moduleName.lower(), "CaseList.md") else: - moduleName = Openfast + moduleName = "Openfast" buildDirectory = os.path.join(sourceDirectory, "build", "reg_tests", "glue-codes", "openfast") caseListFile = os.path.join("r-test", "glue-codes", "openfast", "CaseList.md") diff --git a/reg_tests/r-test b/reg_tests/r-test index 3997c2abcf..96a0ea8756 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 3997c2abcfdc7be922ef7d764258c67474169a24 +Subproject commit 96a0ea8756400f3d4c071235846105d8dd5d1395 diff --git a/vs-build/AeroDyn/AeroDyn_Driver.vfproj b/vs-build/AeroDyn/AeroDyn_Driver.vfproj index fae55eb9b0..873521d2a2 100644 --- a/vs-build/AeroDyn/AeroDyn_Driver.vfproj +++ b/vs-build/AeroDyn/AeroDyn_Driver.vfproj @@ -683,6 +683,8 @@ + + diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index 42b0ae5427..7f6a269ff7 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -1771,6 +1771,8 @@ + +