diff --git a/.gitignore b/.gitignore index 7647b77c3..9a325b930 100644 --- a/.gitignore +++ b/.gitignore @@ -40,3 +40,4 @@ vs-build/ .vscode .atom .fortls +tags diff --git a/Makefile b/Makefile index ac4c15c20..fd5eb9c64 100644 --- a/Makefile +++ b/Makefile @@ -21,7 +21,8 @@ else RMDIR=rm -rf endif BUILD_DIR=build$(suffix) -TEST_DIR=../noise-test/ +TEST_DIR=../openfast-noise-test/ +CMAKE=cmake @@ -34,7 +35,7 @@ $(BUILD_DIR): compile: $(BUILD_DIR) @echo "------------------------------------------------------------" - cd $(BUILD_DIR) && cmake $(CMAKE_ARGS) .. && $(MAKE) + cd $(BUILD_DIR) && $(CMAKE) $(CMAKE_ARGS) .. && $(MAKE) clean: cd $(BUILD_DIR) && $(MAKE) clean diff --git a/modules/aerodyn/AeroDynF8/AeroDyn.f90 b/modules/aerodyn/AeroDynF8/AeroDyn.f90 deleted file mode 100644 index 398e63297..000000000 --- a/modules/aerodyn/AeroDynF8/AeroDyn.f90 +++ /dev/null @@ -1,3767 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2015-2016 National Renewable Energy Laboratory -! -! This file is part of AeroDyn. -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -! -!********************************************************************************************************************************** -! File last committed: $Date$ -! (File) Revision #: $Rev$ -! URL: $HeadURL$ -!********************************************************************************************************************************** -!> AeroDyn is a time-domain aerodynamics module for horizontal-axis wind turbines. -module AeroDyn - - use NWTC_Library - use AeroDyn_Types - use AeroDyn_IO - use BEMT - use AirfoilInfo - use NWTC_LAPACK - - - implicit none - - private - - - ! ..... Public Subroutines ................................................................................................... - - public :: AD_Init ! Initialization routine - public :: AD_End ! Ending routine (includes clean up) - public :: AD_UpdateStates ! Loose coupling routine for solving for constraint states, integrating - ! continuous states, and updating discrete states - public :: AD_CalcOutput ! Routine for computing outputs - public :: AD_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual - - - PUBLIC :: AD_JacobianPInput ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - - ! (Xd), and constraint - state(Z) functions all with respect to the inputs(u) - PUBLIC :: AD_JacobianPContState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - - ! (Xd), and constraint - state(Z) functions all with respect to the continuous - ! states(x) - PUBLIC :: AD_JacobianPDiscState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - - ! (Xd), and constraint - state(Z) functions all with respect to the discrete - ! states(xd) - PUBLIC :: AD_JacobianPConstrState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - - ! (Xd), and constraint - state(Z) functions all with respect to the constraint - ! states(z) - PUBLIC :: AD_GetOP !< Routine to pack the operating point values (for linearization) into arrays - - -contains -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine sets the initialization output data structure, which contains data to be returned to the calling program (e.g., -!! FAST or AeroDyn_Driver) -subroutine AD_SetInitOut(p, InputFileData, InitOut, errStat, errMsg) - - type(AD_InitOutputType), intent( out) :: InitOut ! output data - type(AD_InputFile), intent(in ) :: InputFileData ! input file data (for setting airfoil shape outputs) - type(AD_ParameterType), intent(in ) :: p ! Parameters - integer(IntKi), intent( out) :: errStat ! Error status of the operation - character(*), intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None - - - ! Local variables - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'AD_SetInitOut' - - - - integer(IntKi) :: i, j, k, f - integer(IntKi) :: NumCoords -#ifdef DBG_OUTS - integer(IntKi) :: m - character(5) ::chanPrefix -#endif - ! Initialize variables for this routine - - errStat = ErrID_None - errMsg = "" - - InitOut%AirDens = p%AirDens - - call AllocAry( InitOut%WriteOutputHdr, p%numOuts, 'WriteOutputHdr', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - call AllocAry( InitOut%WriteOutputUnt, p%numOuts, 'WriteOutputUnt', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (ErrStat >= AbortErrLev) return - - -#ifdef DBG_OUTS - ! Loop over blades and nodes to populate the output channel names and units - - do k=1,p%numBlades - do j=1, p%NumBlNds - - m = (k-1)*p%NumBlNds*23 + (j-1)*23 - - chanPrefix = "B"//trim(num2lstr(k))//"N"//trim(num2lstr(j)) - InitOut%WriteOutputHdr( m + 1 ) = trim(chanPrefix)//"Twst" - InitOut%WriteOutputUnt( m + 1 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 2 ) = trim(chanPrefix)//"Psi" - InitOut%WriteOutputUnt( m + 2 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 3 ) = trim(chanPrefix)//"Vx" - InitOut%WriteOutputUnt( m + 3 ) = ' (m/s) ' - InitOut%WriteOutputHdr( m + 4 ) = trim(chanPrefix)//"Vy" - InitOut%WriteOutputUnt( m + 4 ) = ' (m/s) ' - InitOut%WriteOutputHdr( m + 5 ) = ' '//trim(chanPrefix)//"AIn" - InitOut%WriteOutputUnt( m + 5 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 6 ) = ' '//trim(chanPrefix)//"ApIn" - InitOut%WriteOutputUnt( m + 6 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 7 ) = trim(chanPrefix)//"Vrel" - InitOut%WriteOutputUnt( m + 7 ) = ' (m/s) ' - InitOut%WriteOutputHdr( m + 8 ) = ' '//trim(chanPrefix)//"Phi" - InitOut%WriteOutputUnt( m + 8 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 9 ) = ' '//trim(chanPrefix)//"AOA" - InitOut%WriteOutputUnt( m + 9 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 10 ) = ' '//trim(chanPrefix)//"Cl" - InitOut%WriteOutputUnt( m + 10 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 11 ) = ' '//trim(chanPrefix)//"Cd" - InitOut%WriteOutputUnt( m + 11 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 12 ) = ' '//trim(chanPrefix)//"Cm" - InitOut%WriteOutputUnt( m + 12 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 13 ) = ' '//trim(chanPrefix)//"Cx" - InitOut%WriteOutputUnt( m + 13 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 14 ) = ' '//trim(chanPrefix)//"Cy" - InitOut%WriteOutputUnt( m + 14 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 15 ) = ' '//trim(chanPrefix)//"Cn" - InitOut%WriteOutputUnt( m + 15 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 16 ) = ' '//trim(chanPrefix)//"Ct" - InitOut%WriteOutputUnt( m + 16 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 17 ) = ' '//trim(chanPrefix)//"Fl" - InitOut%WriteOutputUnt( m + 17 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 18 ) = ' '//trim(chanPrefix)//"Fd" - InitOut%WriteOutputUnt( m + 18 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 19 ) = ' '//trim(chanPrefix)//"M" - InitOut%WriteOutputUnt( m + 19 ) = ' (N/m^2) ' - InitOut%WriteOutputHdr( m + 20 ) = ' '//trim(chanPrefix)//"Fx" - InitOut%WriteOutputUnt( m + 20 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 21 ) = ' '//trim(chanPrefix)//"Fy" - InitOut%WriteOutputUnt( m + 21 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 22 ) = ' '//trim(chanPrefix)//"Fn" - InitOut%WriteOutputUnt( m + 22 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 23 ) = ' '//trim(chanPrefix)//"Ft" - InitOut%WriteOutputUnt( m + 23 ) = ' (N/m) ' - - end do - end do -#else - do i=1,p%NumOuts - InitOut%WriteOutputHdr(i) = p%OutParam(i)%Name - InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units - end do -#endif - - - InitOut%Ver = AD_Ver - -! set visualization data: - ! this check is overly restrictive, but it would be a lot of work to ensure that only the *used* airfoil - ! tables have the same number of coordinates. - if ( allocated(p%AFI%AFInfo) ) then - - if ( p%AFI%AFInfo(1)%NumCoords > 0 ) then - NumCoords = p%AFI%AFInfo(1)%NumCoords - do i=2,size(p%AFI%AFInfo) - if (p%AFI%AFInfo(1)%NumCoords /= NumCoords) then - call SetErrStat( ErrID_Info, 'Airfoil files do not contain the same number of x-y coordinates.', ErrStat, ErrMsg, RoutineName ) - NumCoords = -1 - exit - end if - end do - - if (NumCoords > 0) then - if (NumCoords < 3) then - call SetErrStat( ErrID_Info, 'Airfoil files with NumCoords > 0 must contain at least 2 coordinates.', ErrStat, ErrMsg, RoutineName ) - return - end if - - allocate( InitOut%BladeShape( p%numBlades ), STAT=ErrStat2 ) - if (ErrStat2 /= 0) then - call SetErrStat( ErrID_Info, 'Error allocationg InitOut%AD_BladeShape', ErrStat, ErrMsg, RoutineName ) - return - end if - - do k=1,p%numBlades - call allocAry( InitOut%BladeShape(k)%AirfoilCoords, 2, NumCoords-1, InputFileData%BladeProps(k)%NumBlNds, 'AirfoilCoords', ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return - - do j=1,InputFileData%BladeProps(k)%NumBlNds - f = InputFileData%BladeProps(k)%BlAFID(j) - - do i=1,NumCoords-1 - InitOut%BladeShape(k)%AirfoilCoords(1,i,j) = InputFileData%BladeProps(k)%BlChord(j)*( p%AFI%AFInfo(f)%Y_Coord(i+1) - p%AFI%AFInfo(f)%Y_Coord(1) ) - InitOut%BladeShape(k)%AirfoilCoords(2,i,j) = InputFileData%BladeProps(k)%BlChord(j)*( p%AFI%AFInfo(f)%X_Coord(i+1) - p%AFI%AFInfo(f)%X_Coord(1) ) - end do - end do - - end do - - end if - end if - - end if - - - - - -end subroutine AD_SetInitOut -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is called at the start of the simulation to perform initialization steps. -!! The parameters are set here and not changed during the simulation. -!! The initial states and initial guess for the input are defined. -subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) -!.................................................................................................................................. - - type(AD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine - type(AD_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined - type(AD_ParameterType), intent( out) :: p !< Parameters - type(AD_ContinuousStateType), intent( out) :: x !< Initial continuous states - type(AD_DiscreteStateType), intent( out) :: xd !< Initial discrete states - type(AD_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states - type(AD_OtherStateType), intent( out) :: OtherState !< Initial other states - type(AD_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; - !! only the output mesh is initialized) - type(AD_MiscVarType), intent( out) :: m !< Initial misc/optimization variables - real(DbKi), intent(inout) :: interval !< Coupling interval in seconds: the rate that - !! (1) AD_UpdateStates() is called in loose coupling & - !! (2) AD_UpdateDiscState() is called in tight coupling. - !! Input is the suggested time from the glue code; - !! Output is the actual coupling interval that will be used - !! by the glue code. - type(AD_InitOutputType), intent( out) :: InitOut !< Output for initialization routine - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - - ! Local variables - integer(IntKi) :: i ! loop counter - - integer(IntKi) :: errStat2 ! temporary error status of the operation - character(ErrMsgLen) :: errMsg2 ! temporary error message - - type(AD_InputFile) :: InputFileData ! Data stored in the module's input file - integer(IntKi) :: UnEcho ! Unit number for the echo file - - character(*), parameter :: RoutineName = 'AD_Init' - - - ! Initialize variables for this routine - - errStat = ErrID_None - errMsg = "" - UnEcho = -1 - - ! Initialize the NWTC Subroutine Library - - call NWTC_Init( EchoLibVer=.FALSE. ) - - ! Display the module information - - call DispNVD( AD_Ver ) - - - p%NumBlades = InitInp%NumBlades ! need this before reading the AD input file so that we know how many blade files to read - !bjj: note that we haven't validated p%NumBlades before using it below! - p%RootName = TRIM(InitInp%RootName)//'.AD' - - ! Read the primary AeroDyn input file - call ReadInputFiles( InitInp%InputFile, InputFileData, interval, p%RootName, p%NumBlades, UnEcho, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - - ! Validate the inputs - call ValidateInputData( InitInp, InputFileData, p%NumBlades, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - !............................................................................................ - ! Define parameters - !............................................................................................ - - ! Initialize AFI module (read Airfoil tables) - call Init_AFIparams( InputFileData, p%AFI, UnEcho, p%NumBlades, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - - ! set the rest of the parameters - call SetParameters( InitInp, InputFileData, p, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - !............................................................................................ - ! Define and initialize inputs here - !............................................................................................ - - call Init_u( u, p, InputFileData, InitInp, errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - ! - - !............................................................................................ - ! Initialize the BEMT module (also sets other variables for sub module) - !............................................................................................ - - ! initialize BEMT after setting parameters and inputs because we are going to use the already- - ! calculated node positions from the input meshes - - call Init_BEMTmodule( InputFileData, u, m%BEMT_u(1), p, x%BEMT, xd%BEMT, z%BEMT, & - OtherState%BEMT, m%BEMT_y, m%BEMT, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - call BEMT_CopyInput( m%BEMT_u(1), m%BEMT_u(2), MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - !............................................................................................ - ! Define outputs here - !............................................................................................ - call Init_y(y, u, p, errStat2, errMsg2) ! do this after input meshes have been initialized - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - - !............................................................................................ - ! Initialize states and misc vars - !............................................................................................ - - ! many states are in the BEMT module, which were initialized in BEMT_Init() - - call Init_MiscVars(m, p, u, y, errStat2, errMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - !............................................................................................ - ! Define initialization output here - !............................................................................................ - call AD_SetInitOut(p, InputFileData, InitOut, errStat2, errMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! after setting InitOut variables, we really don't need the airfoil coordinates taking up - ! space in AeroDyn - if ( allocated(p%AFI%AFInfo) ) then - do i=1,size(p%AFI%AFInfo) - if (allocated(p%AFI%AFInfo(i)%X_Coord)) deallocate( p%AFI%AFInfo(i)%X_Coord) - if (allocated(p%AFI%AFInfo(i)%Y_Coord)) deallocate( p%AFI%AFInfo(i)%Y_Coord) - end do - end if - - !............................................................................................ - ! Initialize Jacobian: - !............................................................................................ - if (InitInp%Linearize) then - call Init_Jacobian(InputFileData, p, u, y, m, InitOut, ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if - - !............................................................................................ - ! Print the summary file if requested: - !............................................................................................ - if (InputFileData%SumPrint) then - call AD_PrintSum( InputFileData, p, u, y, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if - - - call Cleanup() - -contains - subroutine Cleanup() - - CALL AD_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2 ) - IF ( UnEcho > 0 ) CLOSE( UnEcho ) - - end subroutine Cleanup - -end subroutine AD_Init -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes (allocates) the misc variables for use during the simulation. -subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) - type(AD_MiscVarType), intent(inout) :: m !< misc/optimization data (not defined in submodules) - type(AD_ParameterType), intent(in ) :: p !< Parameters - type(AD_InputType), intent(inout) :: u !< input for HubMotion mesh (create sibling mesh here) - type(AD_OutputType), intent(in ) :: y !< output (create mapping between output and otherstate mesh here) - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - - ! Local variables - integer(intKi) :: k - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'Init_OtherStates' - - ! Initialize variables for this routine - - errStat = ErrID_None - 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 SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - ! arrays for output -#ifdef DBG_OUTS - allocate( m%AllOuts(0:p%NumOuts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels -#else - allocate( m%AllOuts(0:MaxOutPts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels -#endif - if (ErrStat2 /= 0) then - call SetErrStat( ErrID_Fatal, "Error allocating AllOuts.", errStat, errMsg, RoutineName ) - return - end if - m%AllOuts = 0.0_ReKi - - ! save these tower calculations for output: - call AllocAry( m%W_Twr, p%NumTwrNds, 'm%W_Twr', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( m%X_Twr, p%NumTwrNds, 'm%X_Twr', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( m%Y_Twr, p%NumTwrNds, 'm%Y_Twr', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - ! save blade calculations for output: -if (p%TwrPotent /= TwrPotent_none .or. p%TwrShadow) then - call AllocAry( m%TwrClrnc, p%NumBlNds, p%NumBlades, 'm%TwrClrnc', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) -end if - call AllocAry( m%Curve, p%NumBlNds, p%NumBlades, 'm%Curve', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( m%X, p%NumBlNds, p%NumBlades, 'm%X', ErrStat2, ErrMsg2 ) - 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 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) - if (ErrStat2 /= 0) then - call SetErrStat( ErrID_Fatal, "Error allocating B_L_2_H_P mapping structure.", errStat, errMsg, RoutineName ) - return - end if - - call MeshCopy ( SrcMesh = u%HubMotion & - , DestMesh = m%HubLoad & - , CtrlCode = MESH_SIBLING & - , IOS = COMPONENT_OUTPUT & - , force = .TRUE. & - , moment = .TRUE. & - , ErrStat = ErrStat2 & - , ErrMess = ErrMsg2 ) - - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - - do k=1,p%NumBlades - CALL MeshMapCreate( y%BladeLoad(k), m%HubLoad, m%B_L_2_H_P(k), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':B_L_2_H_P('//TRIM(Num2LStr(K))//')' ) - end do - - if (ErrStat >= AbortErrLev) RETURN - - ! - if (p%NumTwrNds > 0) then - m%W_Twr = 0.0_ReKi - m%X_Twr = 0.0_ReKi - m%Y_Twr = 0.0_ReKi - end if - - - -end subroutine Init_MiscVars -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes AeroDyn meshes and output array variables for use during the simulation. -subroutine Init_y(y, u, p, errStat, errMsg) - type(AD_OutputType), intent( out) :: y !< Module outputs - type(AD_InputType), intent(inout) :: u !< Module inputs -- intent(out) because of mesh sibling copy - type(AD_ParameterType), intent(in ) :: p !< Parameters - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - - ! Local variables - integer(intKi) :: k ! loop counter for blades - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'Init_y' - - ! Initialize variables for this routine - - errStat = ErrID_None - errMsg = "" - - - if (p%TwrAero) then - - call MeshCopy ( SrcMesh = u%TowerMotion & - , DestMesh = y%TowerLoad & - , CtrlCode = MESH_SIBLING & - , IOS = COMPONENT_OUTPUT & - , force = .TRUE. & - , moment = .TRUE. & - , ErrStat = ErrStat2 & - , ErrMess = ErrMsg2 ) - - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - - !y%TowerLoad%force = 0.0_ReKi ! shouldn't have to initialize this - !y%TowerLoad%moment= 0.0_ReKi ! shouldn't have to initialize this - else - y%TowerLoad%nnodes = 0 - end if - - - allocate( y%BladeLoad(p%numBlades), stat=ErrStat2 ) - if (errStat2 /= 0) then - call SetErrStat( ErrID_Fatal, 'Error allocating y%BladeLoad.', ErrStat, ErrMsg, RoutineName ) - return - end if - - - do k = 1, p%numBlades - - call MeshCopy ( SrcMesh = u%BladeMotion(k) & - , DestMesh = y%BladeLoad(k) & - , CtrlCode = MESH_SIBLING & - , IOS = COMPONENT_OUTPUT & - , force = .TRUE. & - , moment = .TRUE. & - , ErrStat = ErrStat2 & - , ErrMess = ErrMsg2 ) - - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - end do - - call AllocAry( y%WriteOutput, p%numOuts, 'WriteOutput', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - - - -end subroutine Init_y -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes AeroDyn meshes and input array variables for use during the simulation. -subroutine Init_u( u, p, InputFileData, InitInp, errStat, errMsg ) -!.................................................................................................................................. - - type(AD_InputType), intent( out) :: u !< Input data - type(AD_ParameterType), intent(in ) :: p !< Parameters - type(AD_InputFile), intent(in ) :: InputFileData !< Data stored in the module's input file - type(AD_InitInputType), intent(in ) :: InitInp !< Input data for AD initialization routine - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - - ! Local variables - real(reKi) :: position(3) ! node reference position - real(reKi) :: positionL(3) ! node local position - real(R8Ki) :: theta(3) ! Euler angles - real(R8Ki) :: orientation(3,3) ! node reference orientation - real(R8Ki) :: orientationL(3,3) ! node local orientation - - integer(intKi) :: j ! counter for nodes - integer(intKi) :: k ! counter for blades - - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'Init_u' - - ! Initialize variables for this routine - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Arrays for InflowWind inputs: - - call AllocAry( u%InflowOnBlade, 3_IntKi, p%NumBlNds, p%numBlades, 'u%InflowOnBlade', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( u%InflowOnTower, 3_IntKi, p%NumTwrNds, 'u%InflowOnTower', ErrStat2, ErrMsg2 ) ! could be size zero - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (errStat >= AbortErrLev) return - - u%InflowOnBlade = 0.0_ReKi - - ! Meshes for motion inputs (ElastoDyn and/or BeamDyn) - !................ - ! tower - !................ - if (p%NumTwrNds > 0) then - - u%InflowOnTower = 0.0_ReKi - - call MeshCreate ( BlankMesh = u%TowerMotion & - ,IOS = COMPONENT_INPUT & - ,Nnodes = p%NumTwrNds & - ,ErrStat = ErrStat2 & - ,ErrMess = ErrMsg2 & - ,Orientation = .true. & - ,TranslationDisp = .true. & - ,TranslationVel = .true. & - ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (errStat >= AbortErrLev) return - - ! set node initial position/orientation - position = 0.0_ReKi - do j=1,p%NumTwrNds - position(3) = InputFileData%TwrElev(j) - - call MeshPositionNode(u%TowerMotion, j, position, errStat2, errMsg2) ! orientation is identity by default - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - end do !j - - ! create line2 elements - do j=1,p%NumTwrNds-1 - call MeshConstructElement( u%TowerMotion, ELEMENT_LINE2, errStat2, errMsg2, p1=j, p2=j+1 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - end do !j - - call MeshCommit(u%TowerMotion, errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (errStat >= AbortErrLev) return - - - u%TowerMotion%Orientation = u%TowerMotion%RefOrientation - u%TowerMotion%TranslationDisp = 0.0_R8Ki - u%TowerMotion%TranslationVel = 0.0_ReKi - - end if ! we compute tower loads - - !................ - ! hub - !................ - - call MeshCreate ( BlankMesh = u%HubMotion & - ,IOS = COMPONENT_INPUT & - ,Nnodes = 1 & - ,ErrStat = ErrStat2 & - ,ErrMess = ErrMsg2 & - ,Orientation = .true. & - ,TranslationDisp = .true. & - ,RotationVel = .true. & - ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (errStat >= AbortErrLev) return - - call MeshPositionNode(u%HubMotion, 1, InitInp%HubPosition, errStat2, errMsg2, InitInp%HubOrientation) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - call MeshConstructElement( u%HubMotion, ELEMENT_POINT, errStat2, errMsg2, p1=1 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - call MeshCommit(u%HubMotion, errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (errStat >= AbortErrLev) return - - - u%HubMotion%Orientation = u%HubMotion%RefOrientation - u%HubMotion%TranslationDisp = 0.0_R8Ki - u%HubMotion%RotationVel = 0.0_ReKi - - - !................ - ! blade roots - !................ - - allocate( u%BladeRootMotion(p%NumBlades), STAT = ErrStat2 ) - if (ErrStat2 /= 0) then - call SetErrStat( ErrID_Fatal, 'Error allocating u%BladeRootMotion array.', ErrStat, ErrMsg, RoutineName ) - return - end if - - do k=1,p%NumBlades - call MeshCreate ( BlankMesh = u%BladeRootMotion(k) & - ,IOS = COMPONENT_INPUT & - ,Nnodes = 1 & - ,ErrStat = ErrStat2 & - ,ErrMess = ErrMsg2 & - ,Orientation = .true. & - ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (errStat >= AbortErrLev) return - - call MeshPositionNode(u%BladeRootMotion(k), 1, InitInp%BladeRootPosition(:,k), errStat2, errMsg2, InitInp%BladeRootOrientation(:,:,k)) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - call MeshConstructElement( u%BladeRootMotion(k), ELEMENT_POINT, errStat2, errMsg2, p1=1 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - call MeshCommit(u%BladeRootMotion(k), errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (errStat >= AbortErrLev) return - - - u%BladeRootMotion(k)%Orientation = u%BladeRootMotion(k)%RefOrientation - - end do !k=numBlades - - - !................ - ! blades - !................ - - allocate( u%BladeMotion(p%NumBlades), STAT = ErrStat2 ) - if (ErrStat2 /= 0) then - call SetErrStat( ErrID_Fatal, 'Error allocating u%BladeMotion array.', ErrStat, ErrMsg, RoutineName ) - return - end if - - do k=1,p%NumBlades - call MeshCreate ( BlankMesh = u%BladeMotion(k) & - ,IOS = COMPONENT_INPUT & - ,Nnodes = InputFileData%BladeProps(k)%NumBlNds & - ,ErrStat = ErrStat2 & - ,ErrMess = ErrMsg2 & - ,Orientation = .true. & - ,TranslationDisp = .true. & - ,TranslationVel = .true. & - ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (errStat >= AbortErrLev) return - - - do j=1,InputFileData%BladeProps(k)%NumBlNds - - ! reference position of the jth node in the kth blade, relative to the root in the local blade coordinate system: - positionL(1) = InputFileData%BladeProps(k)%BlCrvAC(j) - positionL(2) = InputFileData%BladeProps(k)%BlSwpAC(j) - positionL(3) = InputFileData%BladeProps(k)%BlSpn( j) - - ! reference position of the jth node in the kth blade: - position = u%BladeRootMotion(k)%Position(:,1) + matmul(positionL,u%BladeRootMotion(k)%RefOrientation(:,:,1)) ! note that because positionL is a 1-D array, we're doing the transpose of matmul(transpose(u%BladeRootMotion(k)%RefOrientation),positionL) - - - ! reference orientation of the jth node in the kth blade, relative to the root in the local blade coordinate system: - theta(1) = 0.0_R8Ki - theta(2) = InputFileData%BladeProps(k)%BlCrvAng(j) - theta(3) = -InputFileData%BladeProps(k)%BlTwist( j) - orientationL = EulerConstruct( theta ) - - ! reference orientation of the jth node in the kth blade - orientation = matmul( orientationL, u%BladeRootMotion(k)%RefOrientation(:,:,1) ) - - - call MeshPositionNode(u%BladeMotion(k), j, position, errStat2, errMsg2, orientation) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - end do ! j=blade nodes - - ! create line2 elements - do j=1,InputFileData%BladeProps(k)%NumBlNds-1 - call MeshConstructElement( u%BladeMotion(k), ELEMENT_LINE2, errStat2, errMsg2, p1=j, p2=j+1 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - end do !j - - call MeshCommit(u%BladeMotion(k), errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (errStat >= AbortErrLev) return - - - u%BladeMotion(k)%Orientation = u%BladeMotion(k)%RefOrientation - u%BladeMotion(k)%TranslationDisp = 0.0_R8Ki - u%BladeMotion(k)%TranslationVel = 0.0_ReKi - - end do !k=numBlades - - -end subroutine Init_u -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets AeroDyn parameters for use during the simulation; these variables are not changed after AD_Init. -subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) - TYPE(AD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine, out is needed because of copy below - TYPE(AD_InputFile), INTENT(INout) :: InputFileData !< Data stored in the module's input file -- intent(out) only for move_alloc statements - TYPE(AD_ParameterType), INTENT(INOUT) :: p !< Parameters - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - ! Local variables - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - !INTEGER(IntKi) :: i, j - character(*), parameter :: RoutineName = 'SetParameters' - - ! Initialize variables for this routine - - ErrStat = ErrID_None - ErrMsg = "" - - p%DT = InputFileData%DTAero - p%WakeMod = InputFileData%WakeMod - p%TwrPotent = InputFileData%TwrPotent - p%TwrShadow = InputFileData%TwrShadow - p%TwrAero = InputFileData%TwrAero - - if (InitInp%Linearize) then - p%FrozenWake = InputFileData%FrozenWake - else - p%FrozenWake = .FALSE. - end if - - - ! p%numBlades = InitInp%numBlades ! this was set earlier because it was necessary - p%NumBlNds = InputFileData%BladeProps(1)%NumBlNds - if (p%TwrPotent == TwrPotent_none .and. .not. p%TwrShadow .and. .not. p%TwrAero) then - p%NumTwrNds = 0 - else - p%NumTwrNds = InputFileData%NumTwrNds - - call move_alloc( InputFileData%TwrDiam, p%TwrDiam ) - call move_alloc( InputFileData%TwrCd, p%TwrCd ) - end if - - p%AirDens = InputFileData%AirDens - p%KinVisc = InputFileData%KinVisc - p%SpdSound = InputFileData%SpdSound - - !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() - - !p%RootName = TRIM(InitInp%RootName)//'.AD' ! set earlier to it could be used - -#ifdef DBG_OUTS - p%NBlOuts = 23 - p%numOuts = p%NumBlNds*p%NumBlades*p%NBlOuts - p%NTwOuts = 0 - -#else - p%numOuts = InputFileData%NumOuts - p%NBlOuts = InputFileData%NBlOuts - p%BlOutNd = InputFileData%BlOutNd - - if (p%NumTwrNds > 0) then - p%NTwOuts = InputFileData%NTwOuts - p%TwOutNd = InputFileData%TwOutNd - else - p%NTwOuts = 0 - end if - - call SetOutParam(InputFileData%OutList, p, ErrStat2, ErrMsg2 ) ! requires: p%NumOuts, p%numBlades, p%NumBlNds, p%NumTwrNds; sets: p%OutParam. - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return - -#endif - -end subroutine SetParameters -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is called at the end of the simulation. -subroutine AD_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(AD_InputType), INTENT(INOUT) :: u !< System inputs - TYPE(AD_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(AD_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states - TYPE(AD_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states - TYPE(AD_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states - TYPE(AD_OtherStateType), INTENT(INOUT) :: OtherState !< Other states - TYPE(AD_OutputType), INTENT(INOUT) :: y !< System outputs - TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Place any last minute operations or calculations here: - - - ! Close files here: - - - - ! Destroy the input data: - - CALL AD_DestroyInput( u, ErrStat, ErrMsg ) - - - ! Destroy the parameter data: - - CALL AD_DestroyParam( p, ErrStat, ErrMsg ) - - - ! Destroy the state data: - - CALL AD_DestroyContState( x, ErrStat, ErrMsg ) - CALL AD_DestroyDiscState( xd, ErrStat, ErrMsg ) - CALL AD_DestroyConstrState( z, ErrStat, ErrMsg ) - CALL AD_DestroyOtherState( OtherState, ErrStat, ErrMsg ) - CALL AD_DestroyMisc( m, ErrStat, ErrMsg ) - - ! Destroy the output data: - - CALL AD_DestroyOutput( y, ErrStat, ErrMsg ) - - - - -END SUBROUTINE AD_End -!---------------------------------------------------------------------------------------------------------------------------------- -!> Loose coupling routine for solving for constraint states, integrating continuous states, and updating discrete and other states. -!! Continuous, constraint, discrete, and other states are updated for t + Interval -subroutine AD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errStat, errMsg ) -!.................................................................................................................................. - - real(DbKi), intent(in ) :: t !< Current simulation time in seconds - integer(IntKi), intent(in ) :: n !< Current simulation time step n = 0,1,... - type(AD_InputType), intent(inout) :: u(:) !< Inputs at utimes (out only for mesh record-keeping in ExtrapInterp routine) - real(DbKi), intent(in ) :: utimes(:) !< Times associated with u(:), in seconds - type(AD_ParameterType), intent(in ) :: p !< Parameters - type(AD_ContinuousStateType), intent(inout) :: x !< Input: Continuous states at t; - !! Output: Continuous states at t + Interval - type(AD_DiscreteStateType), intent(inout) :: xd !< Input: Discrete states at t; - !! Output: Discrete states at t + Interval - type(AD_ConstraintStateType), intent(inout) :: z !< Input: Constraint states at t; - !! Output: Constraint states at t+dt - type(AD_OtherStateType), intent(inout) :: OtherState !< Input: Other states at t; - !! Output: Other states at t+dt - type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - type(AD_InputType) :: uInterp ! Interpolated/Extrapolated input - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'AD_UpdateStates' - - ErrStat = ErrID_None - ErrMsg = "" - - - call AD_CopyInput( u(1), uInterp, MESH_NEWCOPY, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - ! set values of m%BEMT_u(2) from inputs interpolated at t+dt: - call AD_Input_ExtrapInterp(u,utimes,uInterp,t+p%DT, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call SetInputs(p, uInterp, m, 2, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! set values of m%BEMT_u(1) from inputs (uInterp) interpolated at t: - ! 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) - - call SetInputs(p, uInterp, m, 1, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - ! Call into the BEMT update states NOTE: This is a non-standard framework interface!!!!! GJH - call BEMT_UpdateStates(t, n, m%BEMT_u(1), m%BEMT_u(2), p%BEMT, x%BEMT, xd%BEMT, z%BEMT, OtherState%BEMT, p%AFI%AFInfo, m%BEMT, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - call Cleanup() - -contains - subroutine Cleanup() - call AD_DestroyInput( uInterp, errStat2, errMsg2) - end subroutine Cleanup -end subroutine AD_UpdateStates -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine for computing outputs, used in both loose and tight coupling. -!! This subroutine is used to compute the output channels (motions and loads) and place them in the WriteOutput() array. -!! The descriptions of the output channels are not given here. Please see the included OutListParameters.xlsx sheet for -!! for a complete description of each output parameter. -subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -! NOTE: no matter how many channels are selected for output, all of the outputs are calcalated -! All of the calculated output channels are placed into the m%AllOuts(:), while the channels selected for outputs are -! placed in the y%WriteOutput(:) array. -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at Time t - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(AD_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- - !! nectivity information does not have to be recalculated) - type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - integer(intKi) :: i - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CalcOutput' - - - ErrStat = ErrID_None - ErrMsg = "" - - - call SetInputs(p, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! Call the BEMT module CalcOutput. Notice that the BEMT outputs are purposely attached to AeroDyn's MiscVar structure to - ! avoid issues with the coupling code - - call BEMT_CalcOutput(t, m%BEMT_u(indx), p%BEMT, x%BEMT, xd%BEMT, z%BEMT, OtherState%BEMT, p%AFI%AFInfo, m%BEMT_y, m%BEMT, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call SetOutputsFromBEMT(p, m, y ) - - if ( p%TwrAero ) then - call ADTwr_CalcOutput(p, u, m, y, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end if - - !------------------------------------------------------- - ! get values to output to file: - !------------------------------------------------------- - if (p%NumOuts > 0) then -#ifdef DBG_OUTS - call Calc_WriteDbgOutput( p, u, m, y, ErrStat2, ErrMsg2 ) -#else - call Calc_WriteOutput( p, u, m, y, indx, ErrStat2, ErrMsg2 ) -#endif - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - !............................................................................................................................... - ! Place the selected output channels into the WriteOutput(:) array with the proper sign: - !............................................................................................................................... - - do i = 1,p%NumOuts ! Loop through all selected output channels -#ifdef DBG_OUTS - y%WriteOutput(i) = m%AllOuts( i ) -#else - y%WriteOutput(i) = p%OutParam(i)%SignM * m%AllOuts( p%OutParam(i)%Indx ) -#endif - - end do ! i - All selected output channels - - end if - - - -end subroutine AD_CalcOutput -!---------------------------------------------------------------------------------------------------------------------------------- -!> Tight coupling routine for solving for the residual of the constraint state equations -subroutine AD_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_residual, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time - TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time (possibly a guess) - TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time - TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - TYPE(AD_ConstraintStateType), INTENT(INOUT) :: Z_residual !< Residual of the constraint state equations using - !! the input values described above - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - - ! Local variables - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CalcConstrStateResidual' - - - - ErrStat = ErrID_None - ErrMsg = "" - - if (.not. allocated(Z_residual%BEMT%phi)) then ! BEMT_CalcConstrStateResidual expects memory to be allocated, so let's make sure it is - call AD_CopyConstrState( z, Z_residual, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end if - - - call SetInputs(p, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - call BEMT_CalcConstrStateResidual( Time, m%BEMT_u(indx), p%BEMT, x%BEMT, xd%BEMT, z%BEMT, OtherState%BEMT, m%BEMT, & - Z_residual%BEMT, p%AFI%AFInfo, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - -end subroutine AD_CalcConstrStateResidual -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine converts the AeroDyn inputs into values that can be used for its submodules. It calculates the disturbed inflow -!! on the blade if tower shadow or tower influence are enabled, then uses these values to set m%BEMT_u(indx). -subroutine SetInputs(p, u, m, indx, errStat, errMsg) - type(AD_ParameterType), intent(in ) :: p !< AD parameters - type(AD_InputType), intent(in ) :: u !< AD Inputs at Time - type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables - integer, intent(in ) :: indx !< index into m%BEMT_u(indx) array; 1=t and 2=t+dt (but not checked here) - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SetInputs' - - - ErrStat = ErrID_None - ErrMsg = "" - - if (p%TwrPotent /= TwrPotent_none .or. p%TwrShadow) then - call TwrInfl( p, u, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - else - m%DisturbedInflow = u%InflowOnBlade - end if - - ! This needs to extract the inputs from the AD data types (mesh) and massage them for the BEMT module - call SetInputsForBEMT(p, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - -end subroutine SetInputs -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine sets m%BEMT_u(indx). -subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) - - type(AD_ParameterType), intent(in ) :: p !< AD parameters - type(AD_InputType), intent(in ) :: u !< AD Inputs at Time - type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables - integer, intent(in ) :: indx !< index into m%BEMT_u array; must be 1 or 2 (but not checked here) - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - real(ReKi) :: x_hat(3) - real(ReKi) :: y_hat(3) - real(ReKi) :: z_hat(3) - real(ReKi) :: x_hat_disk(3) - real(ReKi) :: y_hat_disk(3) - real(ReKi) :: z_hat_disk(3) - real(ReKi) :: tmp(3) - real(R8Ki) :: theta(3) - real(R8Ki) :: orientation(3,3) - real(R8Ki) :: orientation_nopitch(3,3) - real(ReKi) :: tmp_sz, tmp_sz_y - - integer(intKi) :: j ! loop counter for nodes - integer(intKi) :: k ! loop counter for blades - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SetInputsForBEMT' - - - ErrStat = ErrID_None - ErrMsg = "" - - - ! 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 - end do - end do - m%V_diskAvg = m%V_diskAvg / real( p%NumBlades * p%NumBlNds, ReKi ) - - ! orientation vectors: - x_hat_disk = u%HubMotion%Orientation(1,:,1) !actually also x_hat_hub - - m%V_dot_x = dot_product( m%V_diskAvg, x_hat_disk ) - tmp = m%V_dot_x * x_hat_disk - m%V_diskAvg - tmp_sz = TwoNorm(tmp) - if ( EqualRealNos( tmp_sz, 0.0_ReKi ) ) then - y_hat_disk = u%HubMotion%Orientation(2,:,1) - z_hat_disk = u%HubMotion%Orientation(3,:,1) - else - y_hat_disk = tmp / tmp_sz - z_hat_disk = cross_product( m%V_diskAvg, x_hat_disk ) / tmp_sz - end if - - ! "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 - 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 = max( -1.0_ReKi, tmp_sz_y ) - - m%BEMT_u(indx)%chi0 = acos( tmp_sz_y ) - - end if - - ! "Azimuth angle" rad - do k=1,p%NumBlades - z_hat = u%BladeRootMotion(k)%Orientation(3,:,1) - tmp_sz_y = -1.0*dot_product(z_hat,y_hat_disk) - tmp_sz = dot_product(z_hat,z_hat_disk) - if ( EqualRealNos(tmp_sz_y,0.0_ReKi) .and. EqualRealNos(tmp_sz,0.0_ReKi) ) then - m%BEMT_u(indx)%psi(k) = 0.0_ReKi - else - m%BEMT_u(indx)%psi(k) = atan2( tmp_sz_y, tmp_sz ) - end if - end do - - ! 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 - 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)) ) - 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) -#ifndef DBG_OUTS - m%AllOuts( BPitch( k) ) = -theta(3)*R2D ! save this value of pitch for potential output -#endif - theta(3) = 0.0_ReKi - orientation = EulerConstruct( theta ) - orientation_nopitch = matmul( orientation, u%HubMotion%Orientation(:,:,1) ) ! withoutPitch_theta_Root(k) - - do j=1,p%NumBlNds - - ! form coordinate system equivalent to u%BladeMotion(k)%Orientation(:,:,j) but without live sweep (due to in-plane - ! deflection), blade-pitch and twist (aerodynamic + elastic) angles: - - ! orientation = matmul( u%BladeMotion(k)%Orientation(:,:,j), transpose(orientation_nopitch) ) - call LAPACK_gemm( 'n', 't', 1.0_R8Ki, u%BladeMotion(k)%Orientation(:,:,j), orientation_nopitch, 0.0_R8Ki, orientation, errStat2, errMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - theta = EulerExtract( orientation ) !root(k)WithoutPitch_theta(j)_blade(k) - - m%BEMT_u(indx)%theta(j,k) = -theta(3) ! local pitch + twist (aerodyanmic + elastic) angle of the jth node in the kth blade - - - theta(1) = 0.0_ReKi - theta(3) = 0.0_ReKi - m%Curve(j,k) = theta(2) ! save value for possible output later - m%WithoutSweepPitchTwist(:,:,j,k) = matmul( EulerConstruct( theta ), orientation_nopitch ) ! WithoutSweepPitch+Twist_theta(j)_Blade(k) - - 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 - - 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 - -end subroutine SetInputsForBEMT -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine converts outputs from BEMT (stored in m%BEMT_y) into values on the AeroDyn BladeLoad output mesh. -subroutine SetOutputsFromBEMT(p, m, y ) - - type(AD_ParameterType), intent(in ) :: p !< AD parameters - type(AD_OutputType), intent(inout) :: y !< AD outputs - type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables - !type(BEMT_OutputType), intent(in ) :: BEMT_y ! BEMT outputs - !real(ReKi), intent(in ) :: WithoutSweepPitchTwist(:,:,:,:) ! modified orientation matrix - - 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 - - - - force(3) = 0.0_ReKi - moment(1:2) = 0.0_ReKi - do k=1,p%NumBlades - do j=1,p%NumBlNds - - q = 0.5 * p%airDens * m%BEMT_y%Vrel(j,k)**2 ! dynamic pressure of the jth node in the kth blade - 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 - - ! 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) - - ! 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 - - end do !j=nodes - end do !k=blades - - -end subroutine SetOutputsFromBEMT - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine validates the inputs from the AeroDyn input files. -SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) -!.................................................................................................................................. - - ! Passed variables: - - type(AD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine - type(AD_InputFile), intent(in) :: InputFileData !< All the data in the AeroDyn input file - integer(IntKi), intent(in) :: NumBl !< Number of blades - integer(IntKi), intent(out) :: ErrStat !< Error status - character(*), intent(out) :: ErrMsg !< Error message - - - ! local variables - integer(IntKi) :: k ! Blade number - integer(IntKi) :: j ! node number - character(*), parameter :: RoutineName = 'ValidateInputData' - - ErrStat = ErrID_None - ErrMsg = "" - - - if (NumBl > MaxBl .or. NumBl < 1) call SetErrStat( ErrID_Fatal, 'Number of blades must be between 1 and '//trim(num2lstr(MaxBl))//'.', ErrSTat, ErrMsg, RoutineName ) - if (InputFileData%DTAero <= 0.0) call SetErrStat ( ErrID_Fatal, 'DTAero must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%WakeMod /= WakeMod_None .and. InputFileData%WakeMod /= WakeMod_BEMT) call SetErrStat ( ErrID_Fatal, & - 'WakeMod must '//trim(num2lstr(WakeMod_None))//' (none) or '//trim(num2lstr(WakeMod_BEMT))//' (BEMT).', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%AFAeroMod /= AFAeroMod_Steady .and. InputFileData%AFAeroMod /= AFAeroMod_BL_unsteady) then - call SetErrStat ( ErrID_Fatal, 'AFAeroMod must be '//trim(num2lstr(AFAeroMod_Steady))//' (steady) or '//& - trim(num2lstr(AFAeroMod_BL_unsteady))//' (Beddoes-Leishman unsteady).', ErrStat, ErrMsg, RoutineName ) - end if - if (InputFileData%TwrPotent /= TwrPotent_none .and. InputFileData%TwrPotent /= TwrPotent_baseline .and. InputFileData%TwrPotent /= TwrPotent_Bak) then - call SetErrStat ( ErrID_Fatal, 'TwrPotent must be 0 (none), 1 (baseline potential flow), or 2 (potential flow with Bak correction).', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%AirDens <= 0.0) call SetErrStat ( ErrID_Fatal, 'The air density (AirDens) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%KinVisc <= 0.0) call SetErrStat ( ErrID_Fatal, 'The kinesmatic viscosity (KinVisc) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%SpdSound <= 0.0) call SetErrStat ( ErrID_Fatal, 'The speed of sound (SpdSound) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - - - ! BEMT inputs - ! bjj: these checks should probably go into BEMT where they are used... - if (InputFileData%WakeMod == WakeMod_BEMT) then - if ( InputFileData%MaxIter < 1 ) call SetErrStat( ErrID_Fatal, 'MaxIter must be greater than 0.', ErrStat, ErrMsg, RoutineName ) - - if ( InputFileData%IndToler < 0.0 .or. EqualRealNos(InputFileData%IndToler, 0.0_ReKi) ) & - call SetErrStat( ErrID_Fatal, 'IndToler must be greater than 0.', ErrStat, ErrMsg, RoutineName ) - - if ( InputFileData%SkewMod /= SkewMod_Uncoupled .and. InputFileData%SkewMod /= SkewMod_PittPeters) & ! .and. InputFileData%SkewMod /= SkewMod_Coupled ) - call SetErrStat( ErrID_Fatal, 'SkewMod must be 1, or 2. Option 3 will be implemented in a future version.', ErrStat, ErrMsg, RoutineName ) - - end if !BEMT checks - - ! UA inputs - if (InputFileData%AFAeroMod == AFAeroMod_BL_unsteady ) then - if (InputFileData%UAMod < 2 .or. InputFileData%UAMod > 3 ) call SetErrStat( ErrID_Fatal, & - "In this version, UAMod must be 2 (Gonzalez's variant) or 3 (Minemma/Pierce variant).", ErrStat, ErrMsg, RoutineName ) ! NOTE: for later- 1 (baseline/original) - - if (.not. InputFileData%FLookUp ) call SetErrStat( ErrID_Fatal, 'FLookUp must be TRUE for this version.', ErrStat, ErrMsg, RoutineName ) - end if - - - ! validate the AFI input data because it doesn't appear to be done in AFI - if (InputFileData%NumAFfiles < 1) call SetErrStat( ErrID_Fatal, 'The number of unique airfoil tables (NumAFfiles) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%InCol_Alfa < 0) call SetErrStat( ErrID_Fatal, 'InCol_Alfa must not be a negative number.', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%InCol_Cl < 0) call SetErrStat( ErrID_Fatal, 'InCol_Cl must not be a negative number.', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%InCol_Cd < 0) call SetErrStat( ErrID_Fatal, 'InCol_Cd must not be a negative number.', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%InCol_Cm < 0) call SetErrStat( ErrID_Fatal, 'InCol_Cm must not be a negative number.', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%InCol_Cpmin < 0) call SetErrStat( ErrID_Fatal, 'InCol_Cpmin must not be a negative number.', ErrStat, ErrMsg, RoutineName ) - - ! ............................. - ! check blade mesh data: - ! ............................. - if ( InputFileData%BladeProps(1)%NumBlNds < 2 ) call SetErrStat( ErrID_Fatal, 'There must be at least two nodes per blade.',ErrStat, ErrMsg, RoutineName ) - do k=2,NumBl - if ( InputFileData%BladeProps(k)%NumBlNds /= InputFileData%BladeProps(k-1)%NumBlNds ) then - call SetErrStat( ErrID_Fatal, 'All blade property files must have the same number of blade nodes.', ErrStat, ErrMsg, RoutineName ) - exit ! exit do loop - end if - end do - - ! Check the list of airfoil tables for blades to make sure they are all within limits. - do k=1,NumBl - do j=1,InputFileData%BladeProps(k)%NumBlNds - if ( ( InputFileData%BladeProps(k)%BlAFID(j) < 1 ) .OR. ( InputFileData%BladeProps(k)%BlAFID(j) > InputFileData%NumAFfiles ) ) then - call SetErrStat( ErrID_Fatal, 'Blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j))//' must be a number between 1 and NumAFfiles (' & - //TRIM(Num2LStr(InputFileData%NumAFfiles))//').', ErrStat, ErrMsg, RoutineName ) - end if - end do ! j=nodes - end do ! k=blades - - ! Check that the blade chord is > 0. - do k=1,NumBl - do j=1,InputFileData%BladeProps(k)%NumBlNds - if ( InputFileData%BladeProps(k)%BlChord(j) <= 0.0_ReKi ) then - call SetErrStat( ErrID_Fatal, 'The chord for blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j)) & - //' must be greater than 0.', ErrStat, ErrMsg, RoutineName ) - endif - end do ! j=nodes - end do ! k=blades - - do k=1,NumBl - if ( .not. EqualRealNos(InputFileData%BladeProps(k)%BlSpn(1), 0.0_ReKi) ) call SetErrStat( ErrID_Fatal, 'Blade '//trim(Num2LStr(k))//' span location must start at 0.0 m', ErrStat, ErrMsg, RoutineName) - do j=2,InputFileData%BladeProps(k)%NumBlNds - if ( InputFileData%BladeProps(k)%BlSpn(j) <= InputFileData%BladeProps(k)%BlSpn(j-1) ) then - call SetErrStat( ErrID_Fatal, 'Blade '//trim(Num2LStr(k))//' nodes must be entered in increasing elevation.', ErrStat, ErrMsg, RoutineName ) - exit - end if - end do ! j=nodes - end do ! k=blades - - ! ............................. - ! check tower mesh data: - ! ............................. - if (InputFileData%TwrPotent /= TwrPotent_none .or. InputFileData%TwrShadow .or. InputFileData%TwrAero ) then - - if (InputFileData%NumTwrNds < 2) call SetErrStat( ErrID_Fatal, 'There must be at least two nodes on the tower.',ErrStat, ErrMsg, RoutineName ) - - ! Check that the tower diameter is > 0. - do j=1,InputFileData%NumTwrNds - if ( InputFileData%TwrDiam(j) <= 0.0_ReKi ) then - call SetErrStat( ErrID_Fatal, 'The diameter for tower node '//trim(Num2LStr(j))//' must be greater than 0.' & - , ErrStat, ErrMsg, RoutineName ) - end if - end do ! j=nodes - - ! check that the elevation is increasing: - do j=2,InputFileData%NumTwrNds - if ( InputFileData%TwrElev(j) <= InputFileData%TwrElev(j-1) ) then - call SetErrStat( ErrID_Fatal, 'The tower nodes must be entered in increasing elevation.', ErrStat, ErrMsg, RoutineName ) - exit - end if - end do ! j=nodes - - end if - - ! ............................. - ! check outputs: - ! ............................. - - if ( ( InputFileData%NTwOuts < 0_IntKi ) .OR. ( InputFileData%NTwOuts > 9_IntKi ) ) then - call SetErrStat( ErrID_Fatal, 'NTwOuts must be between 0 and 9 (inclusive).', ErrStat, ErrMsg, RoutineName ) - else - ! Check to see if all TwOutNd(:) analysis points are existing analysis points: - - do j=1,InputFileData%NTwOuts - if ( InputFileData%TwOutNd(j) < 1_IntKi .OR. InputFileData%TwOutNd(j) > InputFileData%NumTwrNds ) then - call SetErrStat( ErrID_Fatal, ' All TwOutNd values must be between 1 and '//& - trim( Num2LStr( InputFileData%NumTwrNds ) )//' (inclusive).', ErrStat, ErrMsg, RoutineName ) - exit ! stop checking this loop - end if - end do - - end if - - - if ( ( InputFileData%NBlOuts < 0_IntKi ) .OR. ( InputFileData%NBlOuts > 9_IntKi ) ) then - call SetErrStat( ErrID_Fatal, 'NBlOuts must be between 0 and 9 (inclusive).', ErrStat, ErrMsg, RoutineName ) - else - - ! Check to see if all BlOutNd(:) analysis points are existing analysis points: - - do j=1,InputFileData%NBlOuts - if ( InputFileData%BlOutNd(j) < 1_IntKi .OR. InputFileData%BlOutNd(j) > InputFileData%BladeProps(1)%NumBlNds ) then - call SetErrStat( ErrID_Fatal, ' All BlOutNd values must be between 1 and '//& - trim( Num2LStr( InputFileData%BladeProps(1)%NumBlNds ) )//' (inclusive).', ErrStat, ErrMsg, RoutineName ) - exit ! stop checking this loop - end if - end do - - end if - - !.................. - ! check for linearization - !.................. - if (InitInp%Linearize) then - if (InputFileData%AFAeroMod /= AFAeroMod_Steady) then - call SetErrStat( ErrID_Fatal, 'Steady blade airfoil aerodynamics must be used for linearization. Set AFAeroMod=1.', ErrStat, ErrMsg, RoutineName ) - end if - end if - - -END SUBROUTINE ValidateInputData -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine sets up the data structures and initializes AirfoilInfo to get the necessary AFI parameters. It then verifies -!! that the UA parameters are included in the AFI tables if UA is being used. -SUBROUTINE Init_AFIparams( InputFileData, p_AFI, UnEc, NumBl, ErrStat, ErrMsg ) - - - ! Passed variables - type(AD_InputFile), intent(inout) :: InputFileData !< All the data in the AeroDyn input file (intent(out) only because of the call to MOVE_ALLOC) - type(AFI_ParameterType), intent( out) :: p_AFI !< parameters returned from the AFI (airfoil info) module - integer(IntKi), intent(in ) :: UnEc !< I/O unit for echo file. If > 0, file is open for writing. - integer(IntKi), intent(in ) :: NumBl !< number of blades (for performing check on valid airfoil data read in) - integer(IntKi), intent( out) :: ErrStat !< Error status - character(*), intent( out) :: ErrMsg !< Error message - - ! local variables - type(AFI_InitInputType) :: AFI_InitInputs ! initialization data for the AFI routines - - integer(IntKi) :: j ! loop counter for nodes - integer(IntKi) :: k ! loop counter for blades - integer(IntKi) :: File ! loop counter for airfoil files - integer(IntKi) :: Table ! loop counter for airfoil tables in a file - logical, allocatable :: fileUsed(:) - - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'Init_AFIparams' - - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Setup Airfoil InitInput data structure: - AFI_InitInputs%NumAFfiles = InputFileData%NumAFfiles - call MOVE_ALLOC( InputFileData%AFNames, AFI_InitInputs%FileNames ) ! move from AFNames to FileNames - AFI_InitInputs%InCol_Alfa = InputFileData%InCol_Alfa - AFI_InitInputs%InCol_Cl = InputFileData%InCol_Cl - AFI_InitInputs%InCol_Cd = InputFileData%InCol_Cd - AFI_InitInputs%InCol_Cm = InputFileData%InCol_Cm - AFI_InitInputs%InCol_Cpmin = InputFileData%InCol_Cpmin - - ! Call AFI_Init to read in and process the airfoil files. - ! This includes creating the spline coefficients to be used for interpolation. - - call AFI_Init ( AFI_InitInputs, p_AFI, ErrStat2, ErrMsg2, UnEc ) - call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - call MOVE_ALLOC( AFI_InitInputs%FileNames, InputFileData%AFNames ) ! move from FileNames back to AFNames - call AFI_DestroyInitInput( AFI_InitInputs, ErrStat2, ErrMsg2 ) - - if (ErrStat >= AbortErrLev) return - - - ! check that we read the correct airfoil parameters for UA: - if ( InputFileData%AFAeroMod == AFAeroMod_BL_unsteady ) then - - - ! determine which airfoil files will be used - call AllocAry( fileUsed, InputFileData%NumAFfiles, 'fileUsed', errStat2, errMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (errStat >= AbortErrLev) return - fileUsed = .false. - - do k=1,NumBl - do j=1,InputFileData%BladeProps(k)%NumBlNds - fileUsed ( InputFileData%BladeProps(k)%BlAFID(j) ) = .true. - end do ! j=nodes - end do ! k=blades - - ! make sure all files in use have UA input parameters: - do File = 1,InputFileData%NumAFfiles - - if (fileUsed(File)) then - do Table=1,p_AFI%AFInfo(File)%NumTabs - if ( .not. p_AFI%AFInfo(File)%Table(Table)%InclUAdata ) then - call SetErrStat( ErrID_Fatal, 'Airfoil file '//trim(InputFileData%AFNames(File))//', table #'// & - trim(num2lstr(Table))//' does not contain parameters for UA data.', ErrStat, ErrMsg, RoutineName ) - end if - end do - end if - - end do - - if ( allocated(fileUsed) ) deallocate(fileUsed) - - end if - - -END SUBROUTINE Init_AFIparams -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the BEMT module from within AeroDyn. -SUBROUTINE Init_BEMTmodule( InputFileData, u_AD, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - type(AD_InputFile), intent(in ) :: InputFileData !< All the data in the AeroDyn input file - type(AD_InputType), intent(in ) :: u_AD !< AD inputs - used for input mesh node positions - type(BEMT_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined - type(AD_ParameterType), intent(inout) :: p !< Parameters ! intent out b/c we set the BEMT parameters here - type(BEMT_ContinuousStateType), intent( out) :: x !< Initial continuous states - type(BEMT_DiscreteStateType), intent( out) :: xd !< Initial discrete states - type(BEMT_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states - type(BEMT_OtherStateType), intent( out) :: OtherState !< Initial other states - type(BEMT_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; - !! only the output mesh is initialized) - type(BEMT_MiscVarType), intent( out) :: m !< Initial misc/optimization variables - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - - ! Local variables - real(DbKi) :: Interval ! Coupling interval in seconds: the rate that - ! (1) BEMT_UpdateStates() is called in loose coupling & - ! (2) BEMT_UpdateDiscState() is called in tight coupling. - ! Input is the suggested time from the glue code; - ! Output is the actual coupling interval that will be used - ! by the glue code. - type(BEMT_InitInputType) :: InitInp ! Input data for initialization routine - type(BEMT_InitOutputType) :: InitOut ! Output for initialization routine - - integer(intKi) :: j ! node index - integer(intKi) :: k ! blade index - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'Init_BEMTmodule' - - ! note here that each blade is required to have the same number of nodes - - ErrStat = ErrID_None - ErrMsg = "" - - - ! set initialization data here: - Interval = p%DT - InitInp%numBlades = p%NumBlades - - InitInp%airDens = InputFileData%AirDens - InitInp%kinVisc = InputFileData%KinVisc - InitInp%skewWakeMod = InputFileData%SkewMod - InitInp%aTol = InputFileData%IndToler - InitInp%useTipLoss = InputFileData%TipLoss - InitInp%useHubLoss = InputFileData%HubLoss - InitInp%useInduction = InputFileData%WakeMod == WakeMod_BEMT - InitInp%useTanInd = InputFileData%TanInd - InitInp%useAIDrag = InputFileData%AIDrag - InitInp%useTIDrag = InputFileData%TIDrag - InitInp%numBladeNodes = p%NumBlNds - InitInp%numReIterations = 1 ! This is currently not available in the input file and is only for testing - InitInp%maxIndIterations = InputFileData%MaxIter - - call AllocAry(InitInp%chord, InitInp%numBladeNodes,InitInp%numBlades,'chord', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(InitInp%AFindx,InitInp%numBladeNodes,InitInp%numBlades,'AFindx',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(InitInp%zHub, InitInp%numBlades,'zHub', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(InitInp%zLocal,InitInp%numBladeNodes,InitInp%numBlades,'zLocal',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(InitInp%zTip, InitInp%numBlades,'zTip', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - if ( ErrStat >= AbortErrLev ) then - call Cleanup() - return - end if - - - do k=1,p%numBlades - - InitInp%zHub(k) = TwoNorm( u_AD%BladeRootMotion(k)%Position(:,1) - u_AD%HubMotion%Position(:,1) ) - if (EqualRealNos(InitInp%zHub(k),0.0_ReKi) ) & - call SetErrStat( ErrID_Fatal, "zHub for blade "//trim(num2lstr(k))//" is zero.", ErrStat, ErrMsg, RoutineName) - - InitInp%zLocal(1,k) = InitInp%zHub(k) + TwoNorm( u_AD%BladeMotion(k)%Position(:,1) - u_AD%BladeRootMotion(k)%Position(:,1) ) - do j=2,p%NumBlNds - InitInp%zLocal(j,k) = InitInp%zLocal(j-1,k) + TwoNorm( u_AD%BladeMotion(k)%Position(:,j) - u_AD%BladeMotion(k)%Position(:,j-1) ) - end do !j=nodes - - InitInp%zTip(k) = InitInp%zLocal(p%NumBlNds,k) - - end do !k=blades - - - do k=1,p%numBlades - do j=1,p%NumBlNds - InitInp%chord (j,k) = InputFileData%BladeProps(k)%BlChord(j) - InitInp%AFindx(j,k) = InputFileData%BladeProps(k)%BlAFID(j) - end do - end do - - InitInp%UA_Flag = InputFileData%AFAeroMod == AFAeroMod_BL_unsteady - InitInp%UAMod = InputFileData%UAMod - InitInp%Flookup = InputFileData%Flookup - InitInp%a_s = InputFileData%SpdSound - - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if - - - call BEMT_Init(InitInp, u, p%BEMT, x, xd, z, OtherState, p%AFI%AFInfo, y, m, Interval, InitOut, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - - if (.not. equalRealNos(Interval, p%DT) ) & - call SetErrStat( ErrID_Fatal, "DTAero was changed in Init_BEMTmodule(); this is not allowed.", ErrStat2, ErrMsg2, RoutineName) - - !m%UseFrozenWake = .FALSE. !BJJ: set this in BEMT - - call Cleanup() - return - -contains - subroutine Cleanup() - call BEMT_DestroyInitInput( InitInp, ErrStat2, ErrMsg2 ) - call BEMT_DestroyInitOutput( InitOut, ErrStat2, ErrMsg2 ) - end subroutine Cleanup - -END SUBROUTINE Init_BEMTmodule -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine calculates the tower loads for the AeroDyn TowerLoad output mesh. -SUBROUTINE ADTwr_CalcOutput(p, u, m, y, ErrStat, ErrMsg ) - - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at Time t - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - TYPE(AD_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- - !! 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 - - - INTEGER(IntKi) :: j - real(ReKi) :: q - real(ReKi) :: V_rel(3) ! relative wind speed on a tower node - real(ReKi) :: VL(2) ! relative local x- and y-components of the wind speed on a tower node - real(ReKi) :: tmp(3) - - !integer(intKi) :: ErrStat2 - !character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'ADTwr_CalcOutput' - - - ErrStat = ErrID_None - ErrMsg = "" - - - do j=1,p%NumTwrNds - - V_rel = u%InflowOnTower(:,j) - u%TowerMotion%TranslationDisp(:,j) ! relative wind speed at tower node - - tmp = u%TowerMotion%Orientation(1,:,j) - VL(1) = dot_product( V_Rel, tmp ) ! relative local x-component of wind speed of the jth node in the tower - tmp = u%TowerMotion%Orientation(2,:,j) - VL(2) = dot_product( V_Rel, tmp ) ! relative local y-component of wind speed of the jth node in the tower - - m%W_Twr(j) = TwoNorm( VL ) ! relative wind speed normal to the tower at node j - q = 0.5 * p%TwrCd(j) * p%AirDens * p%TwrDiam(j) * m%W_Twr(j) - - ! force per unit length of the jth node in the tower - tmp(1) = q * VL(1) - tmp(2) = q * VL(2) - tmp(3) = 0.0_ReKi - - y%TowerLoad%force(:,j) = matmul( tmp, u%TowerMotion%Orientation(:,:,j) ) ! note that I'm calculating the transpose here, which is okay because we have 1-d arrays - m%X_Twr(j) = tmp(1) - m%Y_Twr(j) = tmp(2) - - - ! moment per unit length of the jth node in the tower - y%TowerLoad%moment(:,j) = 0.0_ReKi - - end do - - -END SUBROUTINE ADTwr_CalcOutput -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine checks for invalid inputs to the tower influence models. -SUBROUTINE CheckTwrInfl(u, ErrStat, ErrMsg ) - - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at Time t - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - real(reKi) :: ElemSize - real(reKi) :: tmp(3) - integer(intKi) :: j - character(*), parameter :: RoutineName = 'CheckTwrInfl' - - - ErrStat = ErrID_None - ErrMsg = "" - - !! the tower-influence models (tower potential flow and tower shadow) are valid only for small tower deflections; - !! so, first throw an error to avoid a division-by-zero error if any line2 elements on the tower mesh are colocated. - - do j = 2,u%TowerMotion%Nnodes - tmp = u%TowerMotion%Position(:,j ) + u%TowerMotion%TranslationDisp(:,j ) & - - u%TowerMotion%Position(:,j-1) - u%TowerMotion%TranslationDisp(:,j-1) - - ElemSize = TwoNorm(tmp) - if ( EqualRealNos(ElemSize,0.0_ReKi) ) then - call SetErrStat(ErrID_Fatal, "Division by zero:Elements "//trim(num2lstr(j))//' and '//trim(num2lstr(j-1))//' are colocated.', ErrStat, ErrMsg, RoutineName ) - exit - end if - end do - - -END SUBROUTINE CheckTwrInfl -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine calculates m%DisturbedInflow, the influence of tower shadow and/or potential flow on the inflow velocities -SUBROUTINE TwrInfl( p, u, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at Time t - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - real(ReKi) :: xbar ! local x^ component of r_TowerBlade (distance from tower to blade) normalized by tower radius - real(ReKi) :: ybar ! local y^ component of r_TowerBlade (distance from tower to blade) normalized by tower radius - real(ReKi) :: zbar ! local z^ component of r_TowerBlade (distance from tower to blade) normalized by tower radius - real(ReKi) :: theta_tower_trans(3,3) ! transpose of local tower orientation expressed as a DCM - real(ReKi) :: TwrCd ! local tower drag coefficient - real(ReKi) :: W_tower ! local relative wind speed normal to the tower - - real(ReKi) :: BladeNodePosition(3) ! local blade node position - - - real(ReKi) :: u_TwrShadow ! axial velocity deficit fraction from tower shadow - real(ReKi) :: u_TwrPotent ! axial velocity deficit fraction from tower potential flow - real(ReKi) :: v_TwrPotent ! transverse velocity deficit fraction from tower potential flow - - real(ReKi) :: denom ! denominator - real(ReKi) :: v(3) ! temp vector - - integer(IntKi) :: j, k ! loop counters for elements, blades - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'TwrInfl' - - - ErrStat = ErrID_None - ErrMsg = "" - - - ! these models are valid for only small tower deflections; check for potential division-by-zero errors: - call CheckTwrInfl( u, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return - - do k = 1, p%NumBlades - do j = 1, u%BladeMotion(k)%NNodes - - ! for each line2-element node of the blade mesh, a nearest-neighbor line2 element or node of the tower - ! mesh is found in the deflected configuration, returning theta_tower, W_tower, xbar, ybar, zbar, and TowerCd: - - BladeNodePosition = u%BladeMotion(k)%Position(:,j) + u%BladeMotion(k)%TranslationDisp(:,j) - - call getLocalTowerProps(p, u, BladeNodePosition, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, m%TwrClrnc(j,k), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return - - - ! calculate tower influence: - if ( abs(zbar) < 1.0_ReKi .and. p%TwrPotent /= TwrPotent_none ) then - if ( p%TwrPotent == TwrPotent_baseline ) then - - denom = (xbar**2 + ybar**2)**2 - - u_TwrPotent = ( -1.0*xbar**2 + ybar**2 ) / denom - v_TwrPotent = ( -2.0*xbar * ybar ) / denom - - elseif (p%TwrPotent == TwrPotent_Bak) then - - xbar = xbar + 0.1 - - denom = (xbar**2 + ybar**2)**2 - u_TwrPotent = ( -1.0*xbar**2 + ybar**2 ) / denom - v_TwrPotent = ( -2.0*xbar * ybar ) / denom - - denom = TwoPi*(xbar**2 + ybar**2) - u_TwrPotent = u_TwrPotent + TwrCd*xbar / denom - v_TwrPotent = v_TwrPotent + TwrCd*ybar / denom - - end if - else - u_TwrPotent = 0.0_ReKi - v_TwrPotent = 0.0_ReKi - end if - - if ( p%TwrShadow .and. xbar > 0.0_ReKi .and. abs(zbar) < 1.0_ReKi) then - denom = sqrt( sqrt( xbar**2 + ybar**2 ) ) - if ( abs(ybar) < denom ) then - u_TwrShadow = -TwrCd / denom * cos( PiBy2*ybar / denom )**2 - else - u_TwrShadow = 0.0_ReKi - end if - else - u_TwrShadow = 0.0_ReKi - end if - - v(1) = (u_TwrPotent + u_TwrShadow)*W_tower - v(2) = v_TwrPotent*W_tower - v(3) = 0.0_ReKi - - m%DisturbedInflow(:,j,k) = u%InflowOnBlade(:,j,k) + matmul( theta_tower_trans, v ) - - end do !j=NumBlNds - end do ! NumBlades - - -END SUBROUTINE TwrInfl -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine returns the tower constants necessary to compute the tower influence. -!! if u%TowerMotion does not have any nodes there will be serious problems. I assume that has been checked earlier. -SUBROUTINE getLocalTowerProps(p, u, BladeNodePosition, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrClrnc, ErrStat, ErrMsg) -!.................................................................................................................................. - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at Time t - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - REAL(ReKi) ,INTENT(IN ) :: BladeNodePosition(3) !< local blade node position - REAL(ReKi) ,INTENT( OUT) :: theta_tower_trans(3,3) !< transpose of local tower orientation expressed as a DCM - REAL(ReKi) ,INTENT( OUT) :: W_tower !< local relative wind speed normal to the tower - REAL(ReKi) ,INTENT( OUT) :: xbar !< local x^ component of r_TowerBlade normalized by tower radius - REAL(ReKi) ,INTENT( OUT) :: ybar !< local y^ component of r_TowerBlade normalized by tower radius - REAL(ReKi) ,INTENT( OUT) :: zbar !< local z^ component of r_TowerBlade normalized by tower radius - REAL(ReKi) ,INTENT( OUT) :: TwrCd !< local tower drag coefficient - REAL(ReKi) ,INTENT( OUT) :: TwrClrnc !< tower clearance for potential output - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - real(ReKi) :: r_TowerBlade(3) ! distance vector from tower to blade - real(ReKi) :: TwrDiam ! local tower diameter - logical :: found - character(*), parameter :: RoutineName = 'getLocalTowerProps' - - - ErrStat = ErrID_None - ErrMsg = "" - - ! .............................................. - ! option 1: nearest line2 element - ! .............................................. - call TwrInfl_NearestLine2Element(p, u, BladeNodePosition, r_TowerBlade, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrDiam, found) - - if ( .not. found) then - ! .............................................. - ! option 2: nearest node - ! .............................................. - call TwrInfl_NearestPoint(p, u, BladeNodePosition, r_TowerBlade, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrDiam) - - end if - - TwrClrnc = TwoNorm(r_TowerBlade) - 0.5_ReKi*TwrDiam - if ( TwrClrnc <= 0.0_ReKi ) then - call SetErrStat(ErrID_Severe, "Tower strike.", ErrStat, ErrMsg, RoutineName) - end if - - -END SUBROUTINE getLocalTowerProps -!---------------------------------------------------------------------------------------------------------------------------------- -!> Option 1: Find the nearest-neighbor line2 element of the tower mesh for which the blade line2-element node projects orthogonally onto -!! the tower line2-element domain (following an approach similar to the line2_to_line2 mapping search for motion and scalar quantities). -!! That is, for each node of the blade mesh, an orthogonal projection is made onto all possible Line2 elements of the tower mesh and -!! the line2 element of the tower mesh that is the minimum distance away is found. -!! Adapted from modmesh_mapping::createmapping_projecttoline2() -SUBROUTINE TwrInfl_NearestLine2Element(p, u, BladeNodePosition, r_TowerBlade, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrDiam, found) -!.................................................................................................................................. - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at Time t - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - REAL(ReKi) ,INTENT(IN ) :: BladeNodePosition(3) !< local blade node position - REAL(ReKi) ,INTENT( OUT) :: r_TowerBlade(3) !< distance vector from tower to blade - REAL(ReKi) ,INTENT( OUT) :: theta_tower_trans(3,3) !< transpose of local tower orientation expressed as a DCM - REAL(ReKi) ,INTENT( OUT) :: W_tower !< local relative wind speed normal to the tower - REAL(ReKi) ,INTENT( OUT) :: xbar !< local x^ component of r_TowerBlade normalized by tower radius - REAL(ReKi) ,INTENT( OUT) :: ybar !< local y^ component of r_TowerBlade normalized by tower radius - REAL(ReKi) ,INTENT( OUT) :: zbar !< local z^ component of r_TowerBlade normalized by tower radius - REAL(ReKi) ,INTENT( OUT) :: TwrCd !< local tower drag coefficient - REAL(ReKi) ,INTENT( OUT) :: TwrDiam !< local tower diameter - logical ,INTENT( OUT) :: found !< whether a mapping was found with this option - - ! local variables - REAL(ReKi) :: denom - REAL(ReKi) :: dist - REAL(ReKi) :: min_dist - REAL(ReKi) :: elem_position, elem_position2 - REAL(SiKi) :: elem_position_SiKi - - REAL(ReKi) :: p1(3), p2(3) ! position vectors for nodes on tower line 2 element - - REAL(ReKi) :: V_rel_tower(3) - - REAL(ReKi) :: n1_n2_vector(3) ! vector going from node 1 to node 2 in Line2 element - REAL(ReKi) :: n1_Point_vector(3) ! vector going from node 1 in Line 2 element to Destination Point - REAL(ReKi) :: tmp(3) ! temporary vector for cross product calculation - - INTEGER(IntKi) :: jElem ! do-loop counter for elements on tower mesh - - INTEGER(IntKi) :: n1, n2 ! nodes associated with an element - - LOGICAL :: on_element - - - found = .false. - min_dist = HUGE(min_dist) - - do jElem = 1, u%TowerMotion%ElemTable(ELEMENT_LINE2)%nelem ! number of elements on TowerMesh - ! grab node numbers associated with the jElem_th element - n1 = u%TowerMotion%ElemTable(ELEMENT_LINE2)%Elements(jElem)%ElemNodes(1) - n2 = u%TowerMotion%ElemTable(ELEMENT_LINE2)%Elements(jElem)%ElemNodes(2) - - p1 = u%TowerMotion%Position(:,n1) + u%TowerMotion%TranslationDisp(:,n1) - p2 = u%TowerMotion%Position(:,n2) + u%TowerMotion%TranslationDisp(:,n2) - - ! Calculate vectors used in projection operation - n1_n2_vector = p2 - p1 - n1_Point_vector = BladeNodePosition - p1 - - denom = DOT_PRODUCT( n1_n2_vector, n1_n2_vector ) ! we've already checked that these aren't zero - - ! project point onto line defined by n1 and n2 - - elem_position = DOT_PRODUCT(n1_n2_vector,n1_Point_vector) / denom - - ! note: i forumlated it this way because Fortran doesn't necessarially do shortcutting and I don't want to call EqualRealNos if we don't need it: - if ( elem_position .ge. 0.0_ReKi .and. elem_position .le. 1.0_ReKi ) then !we're ON the element (between the two nodes) - on_element = .true. - else - elem_position_SiKi = REAL( elem_position, SiKi ) - if (EqualRealNos( elem_position_SiKi, 1.0_SiKi )) then !we're ON the element (at a node) - on_element = .true. - elem_position = 1.0_ReKi - elseif (EqualRealNos( elem_position_SiKi, 0.0_SiKi )) then !we're ON the element (at a node) - on_element = .true. - elem_position = 0.0_ReKi - else !we're not on the element - on_element = .false. - end if - - end if - - if (on_element) then - - ! calculate distance between point and line (note: this is actually the distance squared); - ! will only store information once we have determined the closest element - elem_position2 = 1.0_ReKi - elem_position - - r_TowerBlade = BladeNodePosition - elem_position2*p1 - elem_position*p2 - dist = dot_product( r_TowerBlade, r_TowerBlade ) - - if (dist .lt. min_dist) then - found = .true. - min_dist = dist - - V_rel_tower = ( u%InflowOnTower(:,n1) - u%TowerMotion%TranslationVel(:,n1) ) * elem_position2 & - + ( u%InflowOnTower(:,n2) - u%TowerMotion%TranslationVel(:,n2) ) * elem_position - - TwrDiam = elem_position2*p%TwrDiam(n1) + elem_position*p%TwrDiam(n2) - TwrCd = elem_position2*p%TwrCd( n1) + elem_position*p%TwrCd( n2) - - - ! z_hat - theta_tower_trans(:,3) = n1_n2_vector / sqrt( denom ) ! = n1_n2_vector / twoNorm( n1_n2_vector ) - - tmp = V_rel_tower - dot_product(V_rel_tower,theta_tower_trans(:,3)) * theta_tower_trans(:,3) - denom = TwoNorm( tmp ) - if (.not. EqualRealNos( denom, 0.0_ReKi ) ) then - ! x_hat - theta_tower_trans(:,1) = tmp / denom - - ! y_hat - tmp = cross_product( theta_tower_trans(:,3), V_rel_tower ) - theta_tower_trans(:,2) = tmp / denom - - W_tower = dot_product( V_rel_tower,theta_tower_trans(:,1) ) - xbar = 2.0/TwrDiam * dot_product( r_TowerBlade, theta_tower_trans(:,1) ) - ybar = 2.0/TwrDiam * dot_product( r_TowerBlade, theta_tower_trans(:,2) ) - zbar = 0.0_ReKi - - else - ! there is no tower influence because dot_product(V_rel_tower,x_hat) = 0 - ! thus, we don't need to set the other values (except we don't want the sum of xbar^2 and ybar^2 to be 0) - theta_tower_trans = 0.0_ReKi - W_tower = 0.0_ReKi - xbar = 1.0_ReKi - ybar = 0.0_ReKi - zbar = 0.0_ReKi - end if - - - end if !the point is closest to this line2 element - - end if - - end do !jElem - -END SUBROUTINE TwrInfl_NearestLine2Element -!---------------------------------------------------------------------------------------------------------------------------------- -!> Option 2: used when the blade node does not orthogonally intersect a tower element. -!! Find the nearest-neighbor node in the tower Line2-element domain (following an approach similar to the point_to_point mapping -!! search for motion and scalar quantities). That is, for each node of the blade mesh, the node of the tower mesh that is the minimum -!! distance away is found. -SUBROUTINE TwrInfl_NearestPoint(p, u, BladeNodePosition, r_TowerBlade, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrDiam) -!.................................................................................................................................. - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at Time t - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - REAL(ReKi) ,INTENT(IN ) :: BladeNodePosition(3) !< local blade node position - REAL(ReKi) ,INTENT( OUT) :: r_TowerBlade(3) !< distance vector from tower to blade - REAL(ReKi) ,INTENT( OUT) :: theta_tower_trans(3,3) !< transpose of local tower orientation expressed as a DCM - REAL(ReKi) ,INTENT( OUT) :: W_tower !< local relative wind speed normal to the tower - REAL(ReKi) ,INTENT( OUT) :: xbar !< local x^ component of r_TowerBlade normalized by tower radius - REAL(ReKi) ,INTENT( OUT) :: ybar !< local y^ component of r_TowerBlade normalized by tower radius - REAL(ReKi) ,INTENT( OUT) :: zbar !< local z^ component of r_TowerBlade normalized by tower radius - REAL(ReKi) ,INTENT( OUT) :: TwrCd !< local tower drag coefficient - REAL(ReKi) ,INTENT( OUT) :: TwrDiam !< local tower diameter - - ! local variables - REAL(ReKi) :: denom - REAL(ReKi) :: dist - REAL(ReKi) :: min_dist - REAL(ReKi) :: cosTaper - - REAL(ReKi) :: p1(3) ! position vectors for nodes on tower - REAL(ReKi) :: V_rel_tower(3) - - REAL(ReKi) :: tmp(3) ! temporary vector for cross product calculation - - INTEGER(IntKi) :: n1 ! node - INTEGER(IntKi) :: node_with_min_distance - - - - !................. - ! find the closest node - !................. - - min_dist = HUGE(min_dist) - node_with_min_distance = 0 - - do n1 = 1, u%TowerMotion%NNodes ! number of nodes on TowerMesh - - p1 = u%TowerMotion%Position(:,n1) + u%TowerMotion%TranslationDisp(:,n1) - - ! calculate distance between points (note: this is actually the distance squared); - ! will only store information once we have determined the closest node - r_TowerBlade = BladeNodePosition - p1 - dist = dot_product( r_TowerBlade, r_TowerBlade ) - - if (dist .lt. min_dist) then - min_dist = dist - node_with_min_distance = n1 - - end if !the point is (so far) closest to this blade node - - end do !n1 - - !................. - ! calculate the values to be returned: - !.................. - if (node_with_min_distance == 0) then - node_with_min_distance = 1 - if (NWTC_VerboseLevel == NWTC_Verbose) call WrScr( 'AD:TwrInfl_NearestPoint:Error finding minimum distance. Positions may be invalid.' ) - end if - - n1 = node_with_min_distance - - r_TowerBlade = BladeNodePosition - u%TowerMotion%Position(:,n1) - u%TowerMotion%TranslationDisp(:,n1) - V_rel_tower = u%InflowOnTower(:,n1) - u%TowerMotion%TranslationVel(:,n1) - TwrDiam = p%TwrDiam(n1) - TwrCd = p%TwrCd( n1) - - ! z_hat - theta_tower_trans(:,3) = u%TowerMotion%Orientation(3,:,n1) - - tmp = V_rel_tower - dot_product(V_rel_tower,theta_tower_trans(:,3)) * theta_tower_trans(:,3) - denom = TwoNorm( tmp ) - - if (.not. EqualRealNos( denom, 0.0_ReKi ) ) then - - ! x_hat - theta_tower_trans(:,1) = tmp / denom - - ! y_hat - tmp = cross_product( theta_tower_trans(:,3), V_rel_tower ) - theta_tower_trans(:,2) = tmp / denom - - W_tower = dot_product( V_rel_tower,theta_tower_trans(:,1) ) - - if ( n1 == 1 .or. n1 == u%TowerMotion%NNodes) then - ! option 2b - zbar = 2.0/TwrDiam * dot_product( r_TowerBlade, theta_tower_trans(:,3) ) - if (abs(zbar) < 1) then - cosTaper = cos( PiBy2*zbar ) - xbar = 2.0/TwrDiam * dot_product( r_TowerBlade, theta_tower_trans(:,1) ) / cosTaper - ybar = 2.0/TwrDiam * dot_product( r_TowerBlade, theta_tower_trans(:,2) ) / cosTaper - else ! we check that zbar < 1 before using xbar and ybar later, but I'm going to set them here anyway: - xbar = 1.0_ReKi - ybar = 0.0_ReKi - end if - else - ! option 2a - xbar = 2.0/TwrDiam * dot_product( r_TowerBlade, theta_tower_trans(:,1) ) - ybar = 2.0/TwrDiam * dot_product( r_TowerBlade, theta_tower_trans(:,2) ) - zbar = 0.0_ReKi - end if - - else - - ! there is no tower influence because W_tower = dot_product(V_rel_tower,x_hat) = 0 - ! thus, we don't need to set the other values (except we don't want the sum of xbar^2 and ybar^2 to be 0) - W_tower = 0.0_ReKi - theta_tower_trans = 0.0_ReKi - xbar = 1.0_ReKi - ybar = 0.0_ReKi - zbar = 0.0_ReKi - - end if - -END SUBROUTINE TwrInfl_NearestPoint -!---------------------------------------------------------------------------------------------------------------------------------- - -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -! ###### The following four routines are Jacobian routines for linearization capabilities ####### -! If the module does not implement them, set ErrStat = ErrID_Fatal in AD_Init() when InitInp%Linearize is .true. -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. -SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(AD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(AD_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); - !! Output fields are not used by this routine, but type is - !! available here so that mesh parameter information (i.e., - !! connectivity) does not have to be recalculated for dYdu. - TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect - !! to the inputs (u) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with - !! respect to the inputs (u) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with - !! respect to the inputs (u) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with - !! respect to the inputs (u) [intent in to avoid deallocation] - ! local variables - TYPE(AD_OutputType) :: y_p - TYPE(AD_OutputType) :: y_m - TYPE(AD_ConstraintStateType) :: z_p - TYPE(AD_ConstraintStateType) :: z_m - TYPE(AD_InputType) :: u_perturb - REAL(ReKi) :: delta_p, delta_m ! delta change in input - INTEGER(IntKi) :: i, j, k, n - logical :: ValidInput - - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - integer, parameter :: op_indx = 2 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt or the input at OP - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_JacobianPInput' - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - - ! get OP values here: - !call AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) - call SetInputsForBEMT(p, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call BEMT_CopyInput( m%BEMT_u(indx), m%BEMT_u(op_indx), MESH_UPDATECOPY, ErrStat2, ErrMsg2) ! copy the BEMT OP inputs to a temporary location that won't be overwritten - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - if ( p%FrozenWake ) then - ! compare arguments with call to BEMT_CalcOutput - call computeFrozenWake(m%BEMT_u(op_indx), p%BEMT, m%BEMT_y, m%BEMT ) - m%BEMT%UseFrozenWake = .true. - end if - - - ! make a copy of the inputs to perturb - call AD_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - IF ( PRESENT( dYdu ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - - ! allocate dYdu - if (.not. allocated(dYdu) ) then - call AllocAry(dYdu,p%Jac_ny, size(p%Jac_u_indx,1),'dYdu', ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - end if - - - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call AD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta_p u - call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_u( p, i, 1, u_perturb, delta_p ) - - ! we need to see if these perturbed inputs put us in different solution regions: - call SetInputsForBEMT(p, u_perturb, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ValidInput = CheckBEMTInputPerturbations( p, m ) - - ! if so, we do a 1-sided difference: - if (.not. ValidInput) then - call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - delta_p = 0 - end if - - - ! compute y at u_op + delta_p u - call AD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get u_op - delta_m u - call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_u( p, i, -1, u_perturb, delta_m ) - - ! we need to see if these perturbed inputs put us in different solution regions: - call SetInputsForBEMT(p, u_perturb, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ValidInput = CheckBEMTInputPerturbations( p, m ) - - ! if so, we do a 1-sided difference: - if (.not. ValidInput) then - call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - delta_m = 0 - if (EqualRealNos(delta_p, 0.0_ReKi)) then - call SetErrStat(ErrID_Fatal,'Both sides of central difference equation change solution region. '// & - 'dYdu cannot be calculated for column '//trim(num2lstr(i))//'.',ErrStat,ErrMsg,RoutineName) - return - end if - end if - - - ! compute y at u_op - delta_m u - call AD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get central difference: - call Compute_dY( p, y_p, y_m, delta_p, delta_m, dYdu(:,i) ) - - end do - - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call AD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - - END IF - - IF ( PRESENT( dXdu ) ) THEN - if (allocated(dXdu)) deallocate(dXdu) - END IF - - IF ( PRESENT( dXddu ) ) THEN - if (allocated(dXddu)) deallocate(dXddu) - END IF - - IF ( PRESENT( dZdu ) ) THEN - - call CheckLinearizationInput(p%BEMT, m%BEMT_u(op_indx), z%BEMT, m%BEMT, ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the inputs (u) here: - - ! allocate dZdu - if (.not. allocated(dZdu)) then - call AllocAry(dZdu,size(z%BEMT%phi), size(p%Jac_u_indx,1),'dZdu', ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - end if - - - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta_p u - call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_u( p, i, 1, u_perturb, delta_p ) - - ! we need to see if these perturbed inputs put us in different solution regions: - call SetInputsForBEMT(p, u_perturb, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ValidInput = CheckBEMTInputPerturbations( p, m ) - - ! if so, we do a 1-sided difference: - if (.not. ValidInput) then - call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - delta_p = 0 - end if - - - ! compute z_p at u_op + delta_p u - call AD_CalcConstrStateResidual( t, u_perturb, p, x, xd, z, OtherState, m, z_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get u_op - delta_m u - call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call Perturb_u( p, i, -1, u_perturb, delta_m ) - - ! we need to see if these perturbed inputs put us in different solution regions: - call SetInputsForBEMT(p, u_perturb, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ValidInput = CheckBEMTInputPerturbations( p, m ) - - ! if so, we do a 1-sided difference: - if (.not. ValidInput) then - call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - delta_m = 0 - if (EqualRealNos(delta_p, 0.0_ReKi)) then - call SetErrStat(ErrID_Fatal,'Both sides of central difference equation change solution region. '// & - 'dYdu cannot be calculated for column '//trim(num2lstr(i))//'.',ErrStat,ErrMsg,RoutineName) - return - end if - end if - - - ! compute z_m at u_op - delta_m u - call AD_CalcConstrStateResidual( t, u_perturb, p, x, xd, z, OtherState, m, z_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get central difference: - - ! we may have had an error allocating memory, so we'll check - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - do k=1,p%NumBlades ! size(z%BEMT%Phi,2) - do j=1,p%NumBlNds ! size(z%BEMT%Phi,1) - n = (k-1)*p%NumBlNds + j - dZdu(n,i) = z_p%BEMT%Phi(j,k) - z_m%BEMT%Phi(j,k) - end do - end do - - dZdu(:,i) = dZdu(:,i) / (delta_p + delta_m) - - end do - - call AD_DestroyConstrState( z_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyConstrState( z_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - END IF -contains - subroutine cleanup() - m%BEMT%UseFrozenWake = .false. - - call AD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call AD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call AD_DestroyConstrState( z_p, ErrStat2, ErrMsg2 ) - call AD_DestroyConstrState( z_m, ErrStat2, ErrMsg2 ) - call AD_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - -END SUBROUTINE AD_JacobianPInput -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and DZ/dx are returned. -SUBROUTINE AD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(AD_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); - !! Output fields are not used by this routine, but type is - !! available here so that mesh parameter information (i.e., - !! connectivity) does not have to be recalculated for dYdx. - TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions - !! (Y) with respect to the continuous - !! states (x) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state - !! functions (X) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state - !! functions (Xd) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state - !! functions (Z) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - - - IF ( PRESENT( dYdx ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: - - ! allocate and set dYdx - - END IF - - IF ( PRESENT( dXdx ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - - ! allocate and set dXdx - - END IF - - IF ( PRESENT( dXddx ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the continuous states (x) here: - - ! allocate and set dXddx - - END IF - - IF ( PRESENT( dZdx ) ) THEN - - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the continuous states (x) here: - - ! allocate and set dZdx - - END IF - - -END SUBROUTINE AD_JacobianPContState -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and DZ/dxd are returned. -SUBROUTINE AD_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(AD_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); - !! Output fields are not used by this routine, but type is - !! available here so that mesh parameter information (i.e., - !! connectivity) does not have to be recalculated for dYdxd. - TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdxd(:,:) !< Partial derivatives of output functions - !! (Y) with respect to the discrete - !! states (xd) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdxd(:,:) !< Partial derivatives of continuous state - !! functions (X) with respect to the - !! discrete states (xd) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddxd(:,:)!< Partial derivatives of discrete state - !! functions (Xd) with respect to the - !! discrete states (xd) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdxd(:,:) !< Partial derivatives of constraint state - !! functions (Z) with respect to the - !! discrete states (xd) [intent in to avoid deallocation] - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - - IF ( PRESENT( dYdxd ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd) here: - - ! allocate and set dYdxd - - END IF - - IF ( PRESENT( dXdxd ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd) here: - - ! allocate and set dXdxd - - END IF - - IF ( PRESENT( dXddxd ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd) here: - - ! allocate and set dXddxd - - END IF - - IF ( PRESENT( dZdxd ) ) THEN - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd) here: - - ! allocate and set dZdxd - - END IF - - -END SUBROUTINE AD_JacobianPDiscState -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and DZ/dz are returned. -SUBROUTINE AD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(AD_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); - !! Output fields are not used by this routine, but type is - !! available here so that mesh parameter information (i.e., - !! connectivity) does not have to be recalculated for dYdz. - TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdz(:,:) !< Partial derivatives of output - !! functions (Y) with respect to the - !! constraint states (z) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdz(:,:) !< Partial derivatives of continuous - !! state functions (X) with respect to - !! the constraint states (z) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddz(:,:) !< Partial derivatives of discrete state - !! functions (Xd) with respect to the - !! constraint states (z) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdz(:,:) !< Partial derivatives of constraint - !! state functions (Z) with respect to - !! the constraint states (z) [intent in to avoid deallocation] - - ! local variables - TYPE(AD_OutputType) :: y_p - TYPE(AD_OutputType) :: y_m - TYPE(AD_ConstraintStateType) :: Z_p - TYPE(AD_ConstraintStateType) :: Z_m - TYPE(AD_ConstraintStateType) :: z_perturb - REAL(ReKi) :: delta_p, delta_m ! delta change in state - INTEGER(IntKi) :: i, j, k, n, k2, j2 - - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - integer, parameter :: op_indx = 2 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt or the input at OP - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_JacobianPConstrState' - - - ! local variables - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - -!bjj: how do I figure out if F is 0??? In that case, need to se dY/dz = 0 and dZ/dz = 1 {and need to ask jmj if this is the whole matrix or just a row/column where it applies} - - ! get OP values here: - !call AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) ! (bjj: is this necessary? if not, still need to get BEMT inputs) - call SetInputsForBEMT(p, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call BEMT_CopyInput( m%BEMT_u(indx), m%BEMT_u(op_indx), MESH_UPDATECOPY, ErrStat2, ErrMsg2) ! copy the BEMT OP inputs to a temporary location that won't be overwritten - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - if ( p%FrozenWake ) then - ! compare arguments with call to BEMT_CalcOutput - call computeFrozenWake(m%BEMT_u(op_indx), p%BEMT, m%BEMT_y, m%BEMT ) - m%BEMT%UseFrozenWake = .true. - end if - - - ! make a copy of the constraint states to perturb - call AD_CopyConstrState( z, z_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - IF ( PRESENT( dYdz ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here: - - ! allocate and set dYdz - if (.not. allocated(dYdz) ) then - call AllocAry(dYdz,p%Jac_ny, size(z%BEMT%phi),'dYdz', ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - end if - - - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call AD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - do k=1,p%NumBlades ! size(z%BEMT%Phi,2) - do j=1,p%NumBlNds ! size(z%BEMT%Phi,1) - i = (k-1)*p%NumBlNds + j - - ! need a check if F = 0 for this case: - - if ( ( p%BEMT%UseTipLoss .and. EqualRealNos(p%BEMT%tipLossConst(j,k),0.0_ReKi) ) .or. & - ( p%BEMT%useHubLoss .and. EqualRealNos(p%BEMT%hubLossConst(j,k),0.0_ReKi) ) ) then - ! F is zero, we we need to skip this perturbation - dYdz(:,i) = 0.0_ReKi - else - - call Get_phi_perturbations(p%BEMT, m%BEMT, z%BEMT%phi(j,k), delta_p, delta_m) - - ! get z_op + delta_p z - z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) + delta_p - - ! compute y at z_op + delta_p z - call AD_CalcOutput( t, u, p, x, xd, z_perturb, OtherState, y_p, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get z_op - delta_m z - z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) - delta_m - - ! compute y at z_op - delta_m z - call AD_CalcOutput( t, u, p, x, xd, z_perturb, OtherState, y_m, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get central difference: - call Compute_dY( p, y_p, y_m, delta_p, delta_m, dYdz(:,i) ) - - - ! put z_perturb back (for next iteration): - z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) - end if - - end do - end do - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call AD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - - END IF - - IF ( PRESENT( dXdz ) ) THEN - if (allocated(dXdz)) deallocate(dXdz) - END IF - - IF ( PRESENT( dXddz ) ) THEN - if (allocated(dXddz)) deallocate(dXddz) - END IF - - IF ( PRESENT(dZdz) ) THEN - - call CheckLinearizationInput(p%BEMT, m%BEMT_u(op_indx), z%BEMT, m%BEMT, ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here: - - ! allocate and set dZdz - if (.not. allocated(dZdz)) then - call AllocAry(dZdz,size(z%BEMT%phi), size(z%BEMT%phi),'dZdz', ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - end if - - - call AD_CopyConstrState( z, z_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - - do k=1,p%NumBlades ! size(z%BEMT%Phi,2) - do j=1,p%NumBlNds ! size(z%BEMT%Phi,1) - i = (k-1)*p%NumBlNds + j - - if ( ( p%BEMT%UseTipLoss .and. EqualRealNos(p%BEMT%tipLossConst(j,k),0.0_ReKi) ) .or. & - ( p%BEMT%useHubLoss .and. EqualRealNos(p%BEMT%hubLossConst(j,k),0.0_ReKi) ) ) then - ! F is zero, we we need to skip this perturbation - dZdz(:,i) = 0.0_ReKi - dZdz(i,i) = 1.0_ReKi - else - - call Get_phi_perturbations(p%BEMT, m%BEMT, z%BEMT%phi(j,k), delta_p, delta_m) - - ! get z_op + delta_p z - z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) + delta_p - - ! compute z_p at z_op + delta_p z - call AD_CalcConstrStateResidual( t, u, p, x, xd, z_perturb, OtherState, m, z_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get z_op - delta_m z - z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) - delta_m - - ! compute z_m at u_op - delta_m u - call AD_CalcConstrStateResidual( t, u, p, x, xd, z_perturb, OtherState, m, z_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - ! get central difference: - - do k2=1,p%NumBlades ! size(z%BEMT%Phi,2) - do j2=1,p%NumBlNds ! size(z%BEMT%Phi,1) - n = (k2-1)*p%NumBlNds + j2 - dZdz(n,i) = z_p%BEMT%Phi(j2,k2) - z_m%BEMT%Phi(j2,k2) - end do - end do - - dZdz(:,i) = dZdz(:,i) / (delta_p + delta_m) - - ! put z_perturb back (for next iteration): - z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) - - end if - - end do - end do - - call AD_DestroyConstrState( z_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyConstrState( z_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - END IF - - -contains - subroutine cleanup() - call AD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call AD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call AD_DestroyConstrState( z_p, ErrStat2, ErrMsg2 ) - call AD_DestroyConstrState( z_m, ErrStat2, ErrMsg2 ) - call AD_DestroyConstrState( z_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - -END SUBROUTINE AD_JacobianPConstrState -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE AD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(AD_OutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - - INTEGER(IntKi) :: index, i, j, k - INTEGER(IntKi) :: nu - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_GetOP' - LOGICAL :: FieldMask(FIELDMASK_SIZE) - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - IF ( PRESENT( u_op ) ) THEN - - nu = size(p%Jac_u_indx,1) + u%TowerMotion%NNodes * 6 & ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - + u%hubMotion%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - do i=1,p%NumBlades - nu = nu + u%BladeMotion(i)%NNodes * 6 & ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - + u%BladeRootMotion(i)%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - end do - - if (.not. allocated(u_op)) then - call AllocAry(u_op, nu, 'u_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if - - - index = 1 - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - call PackMotionMesh(u%TowerMotion, u_op, index, FieldMask=FieldMask) - - FieldMask(MASKID_TRANSLATIONVel) = .false. - FieldMask(MASKID_RotationVel) = .true. - call PackMotionMesh(u%HubMotion, u_op, index, FieldMask=FieldMask) - - FieldMask = .false. - FieldMask(MASKID_Orientation) = .true. - do k = 1,p%NumBlades - call PackMotionMesh(u%BladeRootMotion(k), u_op, index, FieldMask=FieldMask) - end do - - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - do k=1,p%NumBlades - call PackMotionMesh(u%BladeMotion(k), u_op, index, FieldMask=FieldMask) - end do - - do k=1,p%NumBlades - do i=1,p%NumBlNds - do j=1,3 - u_op(index) = u%InflowOnBlade(j,i,k) - index = index + 1 - end do - end do - end do - - do i=1,p%NumTwrNds - do j=1,3 - u_op(index) = u%InflowOnTower(j,i) - index = index + 1 - end do - end do - - END IF - - IF ( PRESENT( y_op ) ) THEN - - if (.not. allocated(y_op)) then - call AllocAry(y_op, p%Jac_ny, 'y_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if - - - - index = 1 - call PackLoadMesh(y%TowerLoad, y_op, index) - do k=1,p%NumBlades - call PackLoadMesh(y%BladeLoad(k), y_op, index) - end do - - index = index - 1 - do i=1,p%NumOuts - y_op(i+index) = y%WriteOutput(i) - end do - - - END IF - - IF ( PRESENT( x_op ) ) THEN - - END IF - - IF ( PRESENT( dx_op ) ) THEN - - END IF - - IF ( PRESENT( xd_op ) ) THEN - - END IF - - IF ( PRESENT( z_op ) ) THEN - - if (.not. allocated(z_op)) then - call AllocAry(z_op, p%NumBlades*p%NumBlNds, 'z_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if - - - index = 1 - do k=1,p%NumBlades ! size(z%BEMT%Phi,2) - do i=1,p%NumBlNds ! size(z%BEMT%Phi,1) - z_op(index) = z%BEMT%phi(i,k) - index = index + 1 - end do - end do - - END IF - -END SUBROUTINE AD_GetOP -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) - - TYPE(AD_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(AD_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(AD_InitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - - 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, j, k, indx_next, indx_last - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian_y' - logical, allocatable :: AllOut(:) - - - ErrStat = ErrID_None - ErrMsg = "" - - - ! determine how many outputs there are in the Jacobians - p%Jac_ny = y%TowerLoad%NNodes * 6 & ! 3 forces + 3 moments at each node - + p%NumOuts ! WriteOutput values - - do k=1,p%NumBlades - p%Jac_ny = p%Jac_ny + y%BladeLoad(k)%NNodes * 6 ! 3 forces + 3 moments at each node - end do - - - ! get the names of the linearized outputs: - call AllocAry(InitOut%LinNames_y, p%Jac_ny,'',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(InitOut%RotFrame_y, p%Jac_ny,'',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return - - - InitOut%RotFrame_y = .false. ! default all to false, then set the true ones below - indx_next = 1 - call PackLoadMesh_Names(y%TowerLoad, 'Tower', InitOut%LinNames_y, indx_next) - - indx_last = indx_next - do k=1,p%NumBlades - call PackLoadMesh_Names(y%BladeLoad(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_y, indx_next) - end do - InitOut%RotFrame_y(indx_last:indx_next-1) = .true. - - do i=1,p%NumOuts - InitOut%LinNames_y(i+indx_next-1) = trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units - end do - - ! check for all the WriteOutput values that are functions of blade number: - allocate( AllOut(0:MaxOutPts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels - if (ErrStat2 /=0 ) then - call SetErrStat(ErrID_Info, 'error allocating temporary space for AllOut',ErrStat,ErrMsg,RoutineName) - return; - end if - - AllOut = .false. - do k=1,3 - AllOut( BAzimuth(k)) = .true. - AllOut( BPitch (k)) = .true. - do j=1,9 - AllOut(BNVUndx(j,k)) = .true. - AllOut(BNVUndy(j,k)) = .true. - AllOut(BNVUndz(j,k)) = .true. - AllOut(BNVDisx(j,k)) = .true. - AllOut(BNVDisy(j,k)) = .true. - AllOut(BNVDisz(j,k)) = .true. - AllOut(BNSTVx (j,k)) = .true. - AllOut(BNSTVy (j,k)) = .true. - AllOut(BNSTVz (j,k)) = .true. - AllOut(BNVRel (j,k)) = .true. - AllOut(BNDynP (j,k)) = .true. - AllOut(BNRe (j,k)) = .true. - AllOut(BNM (j,k)) = .true. - AllOut(BNVIndx(j,k)) = .true. - AllOut(BNVIndy(j,k)) = .true. - AllOut(BNAxInd(j,k)) = .true. - AllOut(BNTnInd(j,k)) = .true. - AllOut(BNAlpha(j,k)) = .true. - AllOut(BNTheta(j,k)) = .true. - AllOut(BNPhi (j,k)) = .true. - AllOut(BNCurve(j,k)) = .true. - AllOut(BNCl (j,k)) = .true. - AllOut(BNCd (j,k)) = .true. - AllOut(BNCm (j,k)) = .true. - AllOut(BNCx (j,k)) = .true. - AllOut(BNCy (j,k)) = .true. - AllOut(BNCn (j,k)) = .true. - AllOut(BNCt (j,k)) = .true. - AllOut(BNFl (j,k)) = .true. - AllOut(BNFd (j,k)) = .true. - AllOut(BNMm (j,k)) = .true. - AllOut(BNFx (j,k)) = .true. - AllOut(BNFy (j,k)) = .true. - AllOut(BNFn (j,k)) = .true. - AllOut(BNFt (j,k)) = .true. - AllOut(BNClrnc(j,k)) = .true. - end do - end do - - - do i=1,p%NumOuts - InitOut%RotFrame_y(i+indx_next-1) = AllOut( p%OutParam(i)%Indx ) - end do - - deallocate(AllOut) - -END SUBROUTINE Init_Jacobian_y -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. -!! Do not change the order of this packing without changing subroutine elastodyn::create_ed_uvector ! -SUBROUTINE Init_Jacobian( InputFileData, p, u, y, m, InitOut, ErrStat, ErrMsg) - - type(AD_InputFile) , intent(in ) :: InputFileData !< input file data (for default blade perturbation) - TYPE(AD_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(AD_InputType) , INTENT(IN ) :: u !< inputs - TYPE(AD_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(AD_MiscVarType) , INTENT(IN ) :: m !< miscellaneous variable - TYPE(AD_InitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian' - - ! local variables: - INTEGER(IntKi) :: i, j, k, index, index_last, nu, i_meshField - REAL(ReKi) :: perturb, perturb_t, perturb_b(MaxBl) - LOGICAL :: FieldMask(FIELDMASK_SIZE) - CHARACTER(1), PARAMETER :: UVW(3) = (/'U','V','W'/) - - - - ErrStat = ErrID_None - ErrMsg = "" - - call Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) - - ! these matrices will be needed for linearization with frozen wake feature - if (p%FrozenWake) then - call AllocAry(m%BEMT%AxInd_op,p%NumBlNds,p%numBlades,'m%BEMT%AxInd_op', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(m%BEMT%TnInd_op,p%NumBlNds,p%numBlades,'m%BEMT%TnInd_op', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - end if - - - - ! determine how many inputs there are in the Jacobians - nu = u%TowerMotion%NNodes * 9 & ! 3 Translation Displacements + 3 orientations + 3 Translation velocities at each node - + u%hubMotion%NNodes * 9 & ! 3 Translation Displacements + 3 orientations + 3 Rotation velocities at each node - + size( u%InflowOnBlade) & - + size( u%InflowOnTower) - - do i=1,p%NumBlades - nu = nu + u%BladeMotion(i)%NNodes * 9 & ! 3 Translation Displacements + 3 orientations + 3 Translation velocities at each node - + u%BladeRootMotion(i)%NNodes * 3 ! 3 orientations at each node - end do - - ! all other inputs ignored - - - !............................ - ! fill matrix to store index to help us figure out what the ith value of the u vector really means - ! (see aerodyn::perturb_u ... these MUST match ) - ! column 1 indicates module's mesh and field - ! column 2 indicates the first index (x-y-z component) of the field - ! column 3 is the node - !............................ - - call allocAry( p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - !............... - ! AD input mappings stored in p%Jac_u_indx: - !............... - index = 1 - !Module/Mesh/Field: u%TowerMotion%TranslationDisp = 1; - !Module/Mesh/Field: u%TowerMotion%Orientation = 2; - !Module/Mesh/Field: u%TowerMotion%TranslationVel = 3; - do i_meshField = 1,3 - do i=1,u%TowerMotion%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - !Module/Mesh/Field: u%HubMotion%TranslationDisp = 4; - !Module/Mesh/Field: u%HubMotion%Orientation = 5; - !Module/Mesh/Field: u%HubMotion%RotationVel = 6; - do i_meshField = 4,6 - do i=1,u%HubMotion%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - !bjj: if MaxBl (max blades) changes, we need to modify this - !Module/Mesh/Field: u%BladeRootMotion(1)%Orientation = 7; - !Module/Mesh/Field: u%BladeRootMotion(2)%Orientation = 8; - !Module/Mesh/Field: u%BladeRootMotion(3)%Orientation = 9; - do k=1,p%NumBlades - do i_meshField = 6,6 - do i=1,u%BladeRootMotion(k)%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField + k - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - - end do !i_meshField - end do !k - - !bjj: if MaxBl (max blades) changes, we need to modify this - !Module/Mesh/Field: u%BladeMotion(1)%TranslationDisp = 10; - !Module/Mesh/Field: u%BladeMotion(1)%Orientation = 11; - !Module/Mesh/Field: u%BladeMotion(1)%TranslationVel = 12; - !Module/Mesh/Field: u%BladeMotion(2)%TranslationDisp = 13; - !Module/Mesh/Field: u%BladeMotion(2)%Orientation = 14; - !Module/Mesh/Field: u%BladeMotion(2)%TranslationVel = 15; - !Module/Mesh/Field: u%BladeMotion(3)%TranslationDisp = 16; - !Module/Mesh/Field: u%BladeMotion(3)%Orientation = 17; - !Module/Mesh/Field: u%BladeMotion(3)%TranslationVel = 18; - do k=1,p%NumBlades - do i_meshField = 1,3 - do i=1,u%BladeMotion(k)%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = 9 + i_meshField + (k-1)*3 - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - - end do !i_meshField - end do !k - - !Module/Mesh/Field: u%InflowOnBlade(:,:,1) = 19; - !Module/Mesh/Field: u%InflowOnBlade(:,:,2) = 20; - !Module/Mesh/Field: u%InflowOnBlade(:,:,3) = 21; - do k=1,size(u%InflowOnBlade,3) ! p%NumBlades - do i=1,size(u%InflowOnBlade,2) ! numNodes - do j=1,3 - p%Jac_u_indx(index,1) = 18 + k - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do !k - - !Module/Mesh/Field: u%InflowOnTower(:,:) = 22; - do i=1,size(u%InflowOnTower,2) ! numNodes - do j=1,3 - p%Jac_u_indx(index,1) = 22 - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - - - !...................................... - ! default perturbations, p%du: - !...................................... - call allocAry( p%du, 22, 'p%du', ErrStat2, ErrMsg2) ! 22 = number of unique values in p%Jac_u_indx(:,1) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - perturb = 2*D2R - - do k=1,p%NumBlades - perturb_b(k) = 0.2_ReKi*D2R * InputFileData%BladeProps(k)%BlSpn( InputFileData%BladeProps(k)%NumBlNds ) - end do - - if ( u%TowerMotion%NNodes > 0) then - perturb_t = 0.2_ReKi*D2R * u%TowerMotion%Position( 3, u%TowerMotion%NNodes ) - else - perturb_t = 0.0_ReKi - end if - - p%du(1) = perturb_t ! u%TowerMotion%TranslationDisp = 1 - p%du(2) = perturb ! u%TowerMotion%Orientation = 2 - p%du(3) = perturb_t ! u%TowerMotion%TranslationVel = 3 - p%du(4) = perturb_b(1) ! u%HubMotion%TranslationDisp = 4 - p%du(5) = perturb ! u%HubMotion%Orientation = 5 - p%du(6) = perturb ! u%HubMotion%RotationVel = 6 - do i_meshField = 7,9 - p%du(i_meshField) = perturb ! u%BladeRootMotion(k)%Orientation = 6+k, for k in [1, 3] - end do - do k=1,p%NumBlades - p%du(10 + (k-1)*3) = perturb_b(k) ! u%BladeMotion(k)%TranslationDisp = 10 + (k-1)*3 - p%du(11 + (k-1)*3) = perturb ! u%BladeMotion(k)%Orientation = 11 + (k-1)*3 - p%du(12 + (k-1)*3) = perturb_b(k) ! u%BladeMotion(k)%TranslationVel = 12 + (k-1)*3 - end do - do k=1,p%NumBlades - p%du(18 + k) = perturb_b(k) ! u%InflowOnBlade(:,:,k) = 18 + k - end do - p%du(22) = perturb_t ! u%InflowOnTower(:,:) = 22 - - - !..................... - ! get names of linearized inputs - !..................... - call AllocAry(InitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%RotFrame_u, nu, 'RotFrame_u', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - InitOut%RotFrame_u = .false. - - index = 1 - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - call PackMotionMesh_Names(u%TowerMotion, 'Tower', InitOut%LinNames_u, index, FieldMask=FieldMask) - - FieldMask(MASKID_TRANSLATIONVel) = .false. - FieldMask(MASKID_RotationVel) = .true. - call PackMotionMesh_Names(u%HubMotion, 'Hub', InitOut%LinNames_u, index, FieldMask=FieldMask) - - index_last = index - FieldMask = .false. - FieldMask(MASKID_Orientation) = .true. - do k = 1,p%NumBlades - call PackMotionMesh_Names(u%BladeRootMotion(k), 'Blade root '//trim(num2lstr(k)), InitOut%LinNames_u, index, FieldMask=FieldMask) - end do - - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - do k=1,p%NumBlades - call PackMotionMesh_Names(u%BladeMotion(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_u, index, FieldMask=FieldMask) - end do - - do k=1,p%NumBlades - do i=1,p%NumBlNds - do j=1,3 - InitOut%LinNames_u(index) = UVW(j)//'-component inflow on blade '//trim(num2lstr(k))//', node '//trim(num2lstr(i))//', m/s' - index = index + 1 - end do - end do - end do - InitOut%RotFrame_u(index_last:index-1) = .true. - - do i=1,p%NumTwrNds - do j=1,3 - InitOut%LinNames_u(index) = UVW(j)//'-component inflow on tower node '//trim(num2lstr(i))//', m/s' - index = index + 1 - end do - end do - - - - !..................... - ! get names of linearized constraint states (though i don't think we really need them) - !..................... - call AllocAry(InitOut%LinNames_z, p%NumBlades*p%NumBlNds, 'LinNames_z', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%RotFrame_z, p%NumBlades*p%NumBlNds, 'RotFrame_z', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - InitOut%RotFrame_z = .true. - - index = 1 - do k=1,p%NumBlades ! size(z%BEMT%Phi,2) - do i=1,p%NumBlNds ! size(z%BEMT%Phi,1) - InitOut%LinNames_z(index) = 'phi at blade '//trim(num2lstr(k))//', node '//trim(num2lstr(i))//', rad' - index = index + 1 - end do - end do - -END SUBROUTINE Init_Jacobian -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine aerodyn::init_jacobian is consistant with this routine! -SUBROUTINE Perturb_u( p, n, perturb_sign, u, du ) - - TYPE(AD_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(AD_InputType) , INTENT(INOUT) :: u !< perturbed ED inputs - REAL( ReKi ) , INTENT( OUT) :: du !< amount that specific input was perturbed - - - ! local variables - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - INTEGER :: fieldIndx - INTEGER :: node - REAL(R8Ki) :: orientation(3,3) - REAL(R8Ki) :: angles(3) - - fieldIndx = p%Jac_u_indx(n,2) - node = p%Jac_u_indx(n,3) - - du = p%du( p%Jac_u_indx(n,1) ) - - ! determine which mesh we're trying to perturb and perturb the input: - SELECT CASE( p%Jac_u_indx(n,1) ) - - CASE ( 1) !Module/Mesh/Field: u%TowerMotion%TranslationDisp = 1; - u%TowerMotion%TranslationDisp( fieldIndx,node) = u%TowerMotion%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE ( 2) !Module/Mesh/Field: u%TowerMotion%Orientation = 2; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%TowerMotion%Orientation(:,:,node) = matmul(u%TowerMotion%Orientation(:,:,node), orientation) - CASE ( 3) !Module/Mesh/Field: u%TowerMotion%TranslationVel = 3; - u%TowerMotion%TranslationVel( fieldIndx,node) = u%TowerMotion%TranslationVel( fieldIndx,node) + du * perturb_sign - - CASE ( 4) !Module/Mesh/Field: u%HubMotion%TranslationDisp = 4; - u%HubMotion%TranslationDisp(fieldIndx,node) = u%HubMotion%TranslationDisp(fieldIndx,node) + du * perturb_sign - CASE ( 5) !Module/Mesh/Field: u%HubMotion%Orientation = 5; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%HubMotion%Orientation(:,:,node) = matmul(u%HubMotion%Orientation(:,:,node), orientation) - CASE ( 6) !Module/Mesh/Field: u%HubMotion%RotationVel = 6; - u%HubMotion%RotationVel(fieldIndx,node) = u%HubMotion%RotationVel(fieldIndx,node) + du * perturb_sign - - CASE ( 7) !Module/Mesh/Field: u%BladeRootMotion(1)%Orientation = 7; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%BladeRootMotion(1)%Orientation(:,:,node) = matmul(u%BladeRootMotion(1)%Orientation(:,:,node), orientation) - CASE ( 8) !Module/Mesh/Field: u%BladeRootMotion(2)%Orientation = 8; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%BladeRootMotion(2)%Orientation(:,:,node) = matmul(u%BladeRootMotion(2)%Orientation(:,:,node), orientation) - CASE ( 9) !Module/Mesh/Field: u%BladeRootMotion(3)%Orientation = 9; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%BladeRootMotion(3)%Orientation(:,:,node) = matmul(u%BladeRootMotion(3)%Orientation(:,:,node), orientation) - - CASE (10) !Module/Mesh/Field: u%BladeMotion(1)%TranslationDisp = 10; - u%BladeMotion(1)%TranslationDisp(fieldIndx,node) = u%BladeMotion(1)%TranslationDisp(fieldIndx,node) + du * perturb_sign - CASE (11) !Module/Mesh/Field: u%BladeMotion(1)%Orientation = 11; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%BladeMotion(1)%Orientation(:,:,node) = matmul(u%BladeMotion(1)%Orientation(:,:,node), orientation) - CASE (12) !Module/Mesh/Field: u%BladeMotion(1)%TranslationVel = 12; - u%BladeMotion(1)%TranslationVel(fieldIndx,node) = u%BladeMotion(1)%TranslationVel(fieldIndx,node) + du * perturb_sign - - CASE (13) !Module/Mesh/Field: u%BladeMotion(2)%TranslationDisp = 13; - u%BladeMotion(2)%TranslationDisp( fieldIndx,node) = u%BladeMotion(2)%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE (14) !Module/Mesh/Field: u%BladeMotion(2)%Orientation = 14; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%BladeMotion(2)%Orientation(:,:,node) = matmul(u%BladeMotion(2)%Orientation(:,:,node), orientation) - CASE (15) !Module/Mesh/Field: u%BladeMotion(2)%TranslationVel = 15; - u%BladeMotion(2)%TranslationVel(fieldIndx,node) = u%BladeMotion(2)%TranslationVel(fieldIndx,node) + du * perturb_sign - - CASE (16) !Module/Mesh/Field: u%BladeMotion(3)%TranslationDisp = 16; - u%BladeMotion(3)%TranslationDisp( fieldIndx,node) = u%BladeMotion(3)%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE (17) !Module/Mesh/Field: u%BladeMotion(3)%Orientation = 17; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%BladeMotion(3)%Orientation(:,:,node) = matmul(u%BladeMotion(3)%Orientation(:,:,node), orientation) - CASE (18) !Module/Mesh/Field: u%BladeMotion(3)%TranslationVel = 18; - u%BladeMotion(3)%TranslationVel(fieldIndx,node) = u%BladeMotion(3)%TranslationVel(fieldIndx,node) + du * perturb_sign - - CASE (19) !Module/Mesh/Field: u%InflowOnBlade(:,:,1) = 19; - u%InflowOnBlade(fieldIndx,node,1) = u%InflowOnBlade(fieldIndx,node,1) + du * perturb_sign - CASE (20) !Module/Mesh/Field: u%InflowOnBlade(:,:,2) = 20; - u%InflowOnBlade(fieldIndx,node,2) = u%InflowOnBlade(fieldIndx,node,2) + du * perturb_sign - CASE (21) !Module/Mesh/Field: u%InflowOnBlade(:,:,3) = 21; - u%InflowOnBlade(fieldIndx,node,3) = u%InflowOnBlade(fieldIndx,node,3) + du * perturb_sign - - CASE (22) !Module/Mesh/Field: u%InflowOnTower(:,:) = 22; - u%InflowOnTower(fieldIndx,node) = u%InflowOnTower(fieldIndx,node) + du * perturb_sign - - END SELECT - -END SUBROUTINE Perturb_u -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine elastodyn::ed_init_jacobian is consistant with this routine! -SUBROUTINE Compute_dY(p, y_p, y_m, delta_p, delta_m, dY) - - TYPE(AD_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(AD_OutputType) , INTENT(IN ) :: y_p !< AD outputs at \f$ u + \Delta_p u \f$ or \f$ z + \Delta_p z \f$ (p=plus) - TYPE(AD_OutputType) , INTENT(IN ) :: y_m !< AD outputs at \f$ u - \Delta_m u \f$ or \f$ z - \Delta_m z \f$ (m=minus) - REAL(ReKi) , INTENT(IN ) :: delta_p !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p z \f$ - REAL(ReKi) , INTENT(IN ) :: delta_m !< difference in inputs or states \f$ delta_m = \Delta_m u \f$ or \f$ delta_m = \Delta_m z \f$ - REAL(ReKi) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdz: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial z_i} = \frac{y_p - y_m}{2 \, \Delta z}\f$ - - ! local variables: - INTEGER(IntKi) :: k ! loop over blades - INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - - - - indx_first = 1 - call PackLoadMesh_dY(y_p%TowerLoad, y_m%TowerLoad, dY, indx_first) - do k=1,p%NumBlades - call PackLoadMesh_dY(y_p%BladeLoad(k), y_m%BladeLoad(k), dY, indx_first) - end do - - - !indx_last = indx_first + p%NumOuts - 1 - !if (p%NumOuts > 0) dY(indx_first:) = y_p%WriteOutput - y_m%WriteOutput - do k=1,p%NumOuts - dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) - end do - - - dY = dY / (delta_p + delta_m) - -END SUBROUTINE Compute_dY -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine computes the differences of two meshes and packs that value into appropriate locations in the dY array. -!! Do not change this packing without making sure subroutines elastodyn::ed_init_jacobian and elastodyn::compute_dt are consistant with this routine! -SUBROUTINE PackLoadMesh_dY(M_p, M_m, dY, indx_first) - - TYPE(MeshType) , INTENT(IN ) :: M_p !< AD outputs on given mesh at \f$ u + \Delta u \f$ (p=plus) - TYPE(MeshType) , INTENT(IN ) :: M_m !< AD outputs on given mesh at \f$ u - \Delta u \f$ (m=minus) - REAL(ReKi) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdz \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ - INTEGER(IntKi) , INTENT(INOUT) :: indx_first !< index into dY array; gives location of next array position to fill - - ! local variables: - INTEGER(IntKi) :: i, indx_last - - - do i=1,M_p%NNodes - indx_last = indx_first + 2 - dY(indx_first:indx_last) = M_p%Force(:,i) - M_m%Force(:,i) - indx_first = indx_last + 1 - end do - - do i=1,M_p%NNodes - indx_last = indx_first + 2 - dY(indx_first:indx_last) = M_p%Moment(:,i) - M_m%Moment(:,i) - indx_first = indx_last + 1 - end do - -END SUBROUTINE PackLoadMesh_dY -!---------------------------------------------------------------------------------------------------------------------------------- -FUNCTION CheckBEMTInputPerturbations( p, m ) RESULT(ValidPerturb) - - type(AD_ParameterType), intent(in ) :: p !< AD parameters - type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables - logical :: ValidPerturb !< if .true., the perturbation is valid; if false, invalid (and thus don't use it) - - integer :: j,k - - integer, parameter :: indx = 1 ! index of perturbed input - integer, parameter :: indx_op = 2 ! index of operating point - - ValidPerturb = .true. - - if ( p%BEMT%UseInduction ) then - if (p%FrozenWake ) then - - do k=1,p%NumBlades - do j=1,p%NumBlNds - - ! don't allow the input perturbations to change Vx or Vy so that Vx+AxInd_op=0 and Vy+TnInd_op=0 to - ! avoid ill-conditioning in CalcConstrStateResidual: - if ( EqualRealNos( m%BEMT_u(indx)%Vx(j,k), -m%BEMT%AxInd_op(j,k) ) .and. & - EqualRealNos( m%BEMT_u(indx)%Vy(j,k), -m%BEMT%TnInd_op(j,k) ) ) then - ValidPerturb = .false. - return - end if - - ! don't allow the input perturbations to change Vx or Vy so that Vx=0 or Vy=0 to - ! avoid division-by-zero errors in CalcOutput: - if ( EqualRealNos( m%BEMT_u(indx)%Vx(j,k), 0.0_ReKi ) .or. & - EqualRealNos( m%BEMT_u(indx)%Vy(j,k), 0.0_ReKi ) ) then - ValidPerturb = .false. - return - end if - - end do !j=nodes - end do !k=blades - - else ! not FrozenWake - - do k=1,p%NumBlades - do j=1,p%NumBlNds - - ! don't allow the input perturbations to change Vx or Vy far enough to switch sign (or go to zero) - ! so as to change solution regions. - if ( m%BEMT_u(indx)%Vx(j,k) * m%BEMT_u(indx_op)%Vx(j,k) <= 0.0_ReKi ) then - ValidPerturb = .false. - return - elseif (m%BEMT_u(indx)%Vy(j,k) * m%BEMT_u(indx_op)%Vy(j,k) <= 0.0_ReKi ) then - ValidPerturb = .false. - return - end if - - end do !j=nodes - end do !k=blades - - end if - - else ! not UseInduction - - do k=1,p%NumBlades - do j=1,p%NumBlNds - - ! don't allow the input perturbations to change Vx or Vy so that Vx=0 or Vy=0: - if ( EqualRealNos( m%BEMT_u(indx)%Vx(j,k), 0.0_ReKi ) .or. & - EqualRealNos( m%BEMT_u(indx)%Vy(j,k), 0.0_ReKi ) ) then - ValidPerturb = .false. - return - end if - - end do !j=nodes - end do !k=blades - - end if - -END FUNCTION CheckBEMTInputPerturbations -!---------------------------------------------------------------------------------------------------------------------------------- -END MODULE AeroDyn diff --git a/modules/aerodyn/AeroDynF8/AeroDyn_IO.f90 b/modules/aerodyn/AeroDynF8/AeroDyn_IO.f90 deleted file mode 100644 index b0e9a8564..000000000 --- a/modules/aerodyn/AeroDynF8/AeroDyn_IO.f90 +++ /dev/null @@ -1,3300 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2015-2016 National Renewable Energy Laboratory -! -! This file is part of AeroDyn. -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -! -!********************************************************************************************************************************** -! File last committed: $Date$ -! (File) Revision #: $Rev$ -! URL: $HeadURL$ -!********************************************************************************************************************************** -MODULE AeroDyn_IO - - use NWTC_Library - use AeroDyn_Types - use BEMTUncoupled, only : SkewMod_Uncoupled, SkewMod_PittPeters - - - implicit none - - type(ProgDesc), parameter :: AD_Ver = ProgDesc( 'AeroDyn', 'v15.03.00', '27-Jul-2016' ) - character(*), parameter :: AD_Nickname = 'AD' - -! =================================================================================================== -! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" -! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these -! lines should be modified in the Matlab script and/or Excel worksheet as necessary. -! =================================================================================================== -! This code was generated by Write_ChckOutLst.m at 11-Mar-2016 14:45:58. - - - ! Parameters related to output length (number of characters allowed in the output data headers): - - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 - - - ! Indices for computing output channels: - ! NOTES: - ! (1) These parameters are in the order stored in "OutListParameters.xlsx" - ! (2) Array AllOuts() must be dimensioned to the value of the largest output parameter - - ! Time: - - INTEGER(IntKi), PARAMETER :: Time = 0 - - - ! Tower: - - INTEGER(IntKi), PARAMETER :: TwN1VUndx = 1 - INTEGER(IntKi), PARAMETER :: TwN1VUndy = 2 - INTEGER(IntKi), PARAMETER :: TwN1VUndz = 3 - INTEGER(IntKi), PARAMETER :: TwN2VUndx = 4 - INTEGER(IntKi), PARAMETER :: TwN2VUndy = 5 - INTEGER(IntKi), PARAMETER :: TwN2VUndz = 6 - INTEGER(IntKi), PARAMETER :: TwN3VUndx = 7 - INTEGER(IntKi), PARAMETER :: TwN3VUndy = 8 - INTEGER(IntKi), PARAMETER :: TwN3VUndz = 9 - INTEGER(IntKi), PARAMETER :: TwN4VUndx = 10 - INTEGER(IntKi), PARAMETER :: TwN4VUndy = 11 - INTEGER(IntKi), PARAMETER :: TwN4VUndz = 12 - INTEGER(IntKi), PARAMETER :: TwN5VUndx = 13 - INTEGER(IntKi), PARAMETER :: TwN5VUndy = 14 - INTEGER(IntKi), PARAMETER :: TwN5VUndz = 15 - INTEGER(IntKi), PARAMETER :: TwN6VUndx = 16 - INTEGER(IntKi), PARAMETER :: TwN6VUndy = 17 - INTEGER(IntKi), PARAMETER :: TwN6VUndz = 18 - INTEGER(IntKi), PARAMETER :: TwN7VUndx = 19 - INTEGER(IntKi), PARAMETER :: TwN7VUndy = 20 - INTEGER(IntKi), PARAMETER :: TwN7VUndz = 21 - INTEGER(IntKi), PARAMETER :: TwN8VUndx = 22 - INTEGER(IntKi), PARAMETER :: TwN8VUndy = 23 - INTEGER(IntKi), PARAMETER :: TwN8VUndz = 24 - INTEGER(IntKi), PARAMETER :: TwN9VUndx = 25 - INTEGER(IntKi), PARAMETER :: TwN9VUndy = 26 - INTEGER(IntKi), PARAMETER :: TwN9VUndz = 27 - INTEGER(IntKi), PARAMETER :: TwN1STVx = 28 - INTEGER(IntKi), PARAMETER :: TwN1STVy = 29 - INTEGER(IntKi), PARAMETER :: TwN1STVz = 30 - INTEGER(IntKi), PARAMETER :: TwN2STVx = 31 - INTEGER(IntKi), PARAMETER :: TwN2STVy = 32 - INTEGER(IntKi), PARAMETER :: TwN2STVz = 33 - INTEGER(IntKi), PARAMETER :: TwN3STVx = 34 - INTEGER(IntKi), PARAMETER :: TwN3STVy = 35 - INTEGER(IntKi), PARAMETER :: TwN3STVz = 36 - INTEGER(IntKi), PARAMETER :: TwN4STVx = 37 - INTEGER(IntKi), PARAMETER :: TwN4STVy = 38 - INTEGER(IntKi), PARAMETER :: TwN4STVz = 39 - INTEGER(IntKi), PARAMETER :: TwN5STVx = 40 - INTEGER(IntKi), PARAMETER :: TwN5STVy = 41 - INTEGER(IntKi), PARAMETER :: TwN5STVz = 42 - INTEGER(IntKi), PARAMETER :: TwN6STVx = 43 - INTEGER(IntKi), PARAMETER :: TwN6STVy = 44 - INTEGER(IntKi), PARAMETER :: TwN6STVz = 45 - INTEGER(IntKi), PARAMETER :: TwN7STVx = 46 - INTEGER(IntKi), PARAMETER :: TwN7STVy = 47 - INTEGER(IntKi), PARAMETER :: TwN7STVz = 48 - INTEGER(IntKi), PARAMETER :: TwN8STVx = 49 - INTEGER(IntKi), PARAMETER :: TwN8STVy = 50 - INTEGER(IntKi), PARAMETER :: TwN8STVz = 51 - INTEGER(IntKi), PARAMETER :: TwN9STVx = 52 - INTEGER(IntKi), PARAMETER :: TwN9STVy = 53 - INTEGER(IntKi), PARAMETER :: TwN9STVz = 54 - INTEGER(IntKi), PARAMETER :: TwN1Vrel = 55 - INTEGER(IntKi), PARAMETER :: TwN2Vrel = 56 - INTEGER(IntKi), PARAMETER :: TwN3Vrel = 57 - INTEGER(IntKi), PARAMETER :: TwN4Vrel = 58 - INTEGER(IntKi), PARAMETER :: TwN5Vrel = 59 - INTEGER(IntKi), PARAMETER :: TwN6Vrel = 60 - INTEGER(IntKi), PARAMETER :: TwN7Vrel = 61 - INTEGER(IntKi), PARAMETER :: TwN8Vrel = 62 - INTEGER(IntKi), PARAMETER :: TwN9Vrel = 63 - INTEGER(IntKi), PARAMETER :: TwN1DynP = 64 - INTEGER(IntKi), PARAMETER :: TwN2DynP = 65 - INTEGER(IntKi), PARAMETER :: TwN3DynP = 66 - INTEGER(IntKi), PARAMETER :: TwN4DynP = 67 - INTEGER(IntKi), PARAMETER :: TwN5DynP = 68 - INTEGER(IntKi), PARAMETER :: TwN6DynP = 69 - INTEGER(IntKi), PARAMETER :: TwN7DynP = 70 - INTEGER(IntKi), PARAMETER :: TwN8DynP = 71 - INTEGER(IntKi), PARAMETER :: TwN9DynP = 72 - INTEGER(IntKi), PARAMETER :: TwN1Re = 73 - INTEGER(IntKi), PARAMETER :: TwN2Re = 74 - INTEGER(IntKi), PARAMETER :: TwN3Re = 75 - INTEGER(IntKi), PARAMETER :: TwN4Re = 76 - INTEGER(IntKi), PARAMETER :: TwN5Re = 77 - INTEGER(IntKi), PARAMETER :: TwN6Re = 78 - INTEGER(IntKi), PARAMETER :: TwN7Re = 79 - INTEGER(IntKi), PARAMETER :: TwN8Re = 80 - INTEGER(IntKi), PARAMETER :: TwN9Re = 81 - INTEGER(IntKi), PARAMETER :: TwN1M = 82 - INTEGER(IntKi), PARAMETER :: TwN2M = 83 - INTEGER(IntKi), PARAMETER :: TwN3M = 84 - INTEGER(IntKi), PARAMETER :: TwN4M = 85 - INTEGER(IntKi), PARAMETER :: TwN5M = 86 - INTEGER(IntKi), PARAMETER :: TwN6M = 87 - INTEGER(IntKi), PARAMETER :: TwN7M = 88 - INTEGER(IntKi), PARAMETER :: TwN8M = 89 - INTEGER(IntKi), PARAMETER :: TwN9M = 90 - INTEGER(IntKi), PARAMETER :: TwN1Fdx = 91 - INTEGER(IntKi), PARAMETER :: TwN2Fdx = 92 - INTEGER(IntKi), PARAMETER :: TwN3Fdx = 93 - INTEGER(IntKi), PARAMETER :: TwN4Fdx = 94 - INTEGER(IntKi), PARAMETER :: TwN5Fdx = 95 - INTEGER(IntKi), PARAMETER :: TwN6Fdx = 96 - INTEGER(IntKi), PARAMETER :: TwN7Fdx = 97 - INTEGER(IntKi), PARAMETER :: TwN8Fdx = 98 - INTEGER(IntKi), PARAMETER :: TwN9Fdx = 99 - INTEGER(IntKi), PARAMETER :: TwN1Fdy = 100 - INTEGER(IntKi), PARAMETER :: TwN2Fdy = 101 - INTEGER(IntKi), PARAMETER :: TwN3Fdy = 102 - INTEGER(IntKi), PARAMETER :: TwN4Fdy = 103 - INTEGER(IntKi), PARAMETER :: TwN5Fdy = 104 - INTEGER(IntKi), PARAMETER :: TwN6Fdy = 105 - INTEGER(IntKi), PARAMETER :: TwN7Fdy = 106 - INTEGER(IntKi), PARAMETER :: TwN8Fdy = 107 - INTEGER(IntKi), PARAMETER :: TwN9Fdy = 108 - - - ! Blade: - - INTEGER(IntKi), PARAMETER :: B1Azimuth = 109 - INTEGER(IntKi), PARAMETER :: B2Azimuth = 110 - INTEGER(IntKi), PARAMETER :: B3Azimuth = 111 - INTEGER(IntKi), PARAMETER :: B1Pitch = 112 - INTEGER(IntKi), PARAMETER :: B2Pitch = 113 - INTEGER(IntKi), PARAMETER :: B3Pitch = 114 - INTEGER(IntKi), PARAMETER :: B1N1VUndx = 115 - INTEGER(IntKi), PARAMETER :: B1N2VUndx = 116 - INTEGER(IntKi), PARAMETER :: B1N3VUndx = 117 - INTEGER(IntKi), PARAMETER :: B1N4VUndx = 118 - INTEGER(IntKi), PARAMETER :: B1N5VUndx = 119 - INTEGER(IntKi), PARAMETER :: B1N6VUndx = 120 - INTEGER(IntKi), PARAMETER :: B1N7VUndx = 121 - INTEGER(IntKi), PARAMETER :: B1N8VUndx = 122 - INTEGER(IntKi), PARAMETER :: B1N9VUndx = 123 - INTEGER(IntKi), PARAMETER :: B1N1VUndy = 124 - INTEGER(IntKi), PARAMETER :: B1N2VUndy = 125 - INTEGER(IntKi), PARAMETER :: B1N3VUndy = 126 - INTEGER(IntKi), PARAMETER :: B1N4VUndy = 127 - INTEGER(IntKi), PARAMETER :: B1N5VUndy = 128 - INTEGER(IntKi), PARAMETER :: B1N6VUndy = 129 - INTEGER(IntKi), PARAMETER :: B1N7VUndy = 130 - INTEGER(IntKi), PARAMETER :: B1N8VUndy = 131 - INTEGER(IntKi), PARAMETER :: B1N9VUndy = 132 - INTEGER(IntKi), PARAMETER :: B1N1VUndz = 133 - INTEGER(IntKi), PARAMETER :: B1N2VUndz = 134 - INTEGER(IntKi), PARAMETER :: B1N3VUndz = 135 - INTEGER(IntKi), PARAMETER :: B1N4VUndz = 136 - INTEGER(IntKi), PARAMETER :: B1N5VUndz = 137 - INTEGER(IntKi), PARAMETER :: B1N6VUndz = 138 - INTEGER(IntKi), PARAMETER :: B1N7VUndz = 139 - INTEGER(IntKi), PARAMETER :: B1N8VUndz = 140 - INTEGER(IntKi), PARAMETER :: B1N9VUndz = 141 - INTEGER(IntKi), PARAMETER :: B2N1VUndx = 142 - INTEGER(IntKi), PARAMETER :: B2N2VUndx = 143 - INTEGER(IntKi), PARAMETER :: B2N3VUndx = 144 - INTEGER(IntKi), PARAMETER :: B2N4VUndx = 145 - INTEGER(IntKi), PARAMETER :: B2N5VUndx = 146 - INTEGER(IntKi), PARAMETER :: B2N6VUndx = 147 - INTEGER(IntKi), PARAMETER :: B2N7VUndx = 148 - INTEGER(IntKi), PARAMETER :: B2N8VUndx = 149 - INTEGER(IntKi), PARAMETER :: B2N9VUndx = 150 - INTEGER(IntKi), PARAMETER :: B2N1VUndy = 151 - INTEGER(IntKi), PARAMETER :: B2N2VUndy = 152 - INTEGER(IntKi), PARAMETER :: B2N3VUndy = 153 - INTEGER(IntKi), PARAMETER :: B2N4VUndy = 154 - INTEGER(IntKi), PARAMETER :: B2N5VUndy = 155 - INTEGER(IntKi), PARAMETER :: B2N6VUndy = 156 - INTEGER(IntKi), PARAMETER :: B2N7VUndy = 157 - INTEGER(IntKi), PARAMETER :: B2N8VUndy = 158 - INTEGER(IntKi), PARAMETER :: B2N9VUndy = 159 - INTEGER(IntKi), PARAMETER :: B2N1VUndz = 160 - INTEGER(IntKi), PARAMETER :: B2N2VUndz = 161 - INTEGER(IntKi), PARAMETER :: B2N3VUndz = 162 - INTEGER(IntKi), PARAMETER :: B2N4VUndz = 163 - INTEGER(IntKi), PARAMETER :: B2N5VUndz = 164 - INTEGER(IntKi), PARAMETER :: B2N6VUndz = 165 - INTEGER(IntKi), PARAMETER :: B2N7VUndz = 166 - INTEGER(IntKi), PARAMETER :: B2N8VUndz = 167 - INTEGER(IntKi), PARAMETER :: B2N9VUndz = 168 - INTEGER(IntKi), PARAMETER :: B3N1VUndx = 169 - INTEGER(IntKi), PARAMETER :: B3N2VUndx = 170 - INTEGER(IntKi), PARAMETER :: B3N3VUndx = 171 - INTEGER(IntKi), PARAMETER :: B3N4VUndx = 172 - INTEGER(IntKi), PARAMETER :: B3N5VUndx = 173 - INTEGER(IntKi), PARAMETER :: B3N6VUndx = 174 - INTEGER(IntKi), PARAMETER :: B3N7VUndx = 175 - INTEGER(IntKi), PARAMETER :: B3N8VUndx = 176 - INTEGER(IntKi), PARAMETER :: B3N9VUndx = 177 - INTEGER(IntKi), PARAMETER :: B3N1VUndy = 178 - INTEGER(IntKi), PARAMETER :: B3N2VUndy = 179 - INTEGER(IntKi), PARAMETER :: B3N3VUndy = 180 - INTEGER(IntKi), PARAMETER :: B3N4VUndy = 181 - INTEGER(IntKi), PARAMETER :: B3N5VUndy = 182 - INTEGER(IntKi), PARAMETER :: B3N6VUndy = 183 - INTEGER(IntKi), PARAMETER :: B3N7VUndy = 184 - INTEGER(IntKi), PARAMETER :: B3N8VUndy = 185 - INTEGER(IntKi), PARAMETER :: B3N9VUndy = 186 - INTEGER(IntKi), PARAMETER :: B3N1VUndz = 187 - INTEGER(IntKi), PARAMETER :: B3N2VUndz = 188 - INTEGER(IntKi), PARAMETER :: B3N3VUndz = 189 - INTEGER(IntKi), PARAMETER :: B3N4VUndz = 190 - INTEGER(IntKi), PARAMETER :: B3N5VUndz = 191 - INTEGER(IntKi), PARAMETER :: B3N6VUndz = 192 - INTEGER(IntKi), PARAMETER :: B3N7VUndz = 193 - INTEGER(IntKi), PARAMETER :: B3N8VUndz = 194 - INTEGER(IntKi), PARAMETER :: B3N9VUndz = 195 - INTEGER(IntKi), PARAMETER :: B1N1VDisx = 196 - INTEGER(IntKi), PARAMETER :: B1N2VDisx = 197 - INTEGER(IntKi), PARAMETER :: B1N3VDisx = 198 - INTEGER(IntKi), PARAMETER :: B1N4VDisx = 199 - INTEGER(IntKi), PARAMETER :: B1N5VDisx = 200 - INTEGER(IntKi), PARAMETER :: B1N6VDisx = 201 - INTEGER(IntKi), PARAMETER :: B1N7VDisx = 202 - INTEGER(IntKi), PARAMETER :: B1N8VDisx = 203 - INTEGER(IntKi), PARAMETER :: B1N9VDisx = 204 - INTEGER(IntKi), PARAMETER :: B1N1VDisy = 205 - INTEGER(IntKi), PARAMETER :: B1N2VDisy = 206 - INTEGER(IntKi), PARAMETER :: B1N3VDisy = 207 - INTEGER(IntKi), PARAMETER :: B1N4VDisy = 208 - INTEGER(IntKi), PARAMETER :: B1N5VDisy = 209 - INTEGER(IntKi), PARAMETER :: B1N6VDisy = 210 - INTEGER(IntKi), PARAMETER :: B1N7VDisy = 211 - INTEGER(IntKi), PARAMETER :: B1N8VDisy = 212 - INTEGER(IntKi), PARAMETER :: B1N9VDisy = 213 - INTEGER(IntKi), PARAMETER :: B1N1VDisz = 214 - INTEGER(IntKi), PARAMETER :: B1N2VDisz = 215 - INTEGER(IntKi), PARAMETER :: B1N3VDisz = 216 - INTEGER(IntKi), PARAMETER :: B1N4VDisz = 217 - INTEGER(IntKi), PARAMETER :: B1N5VDisz = 218 - INTEGER(IntKi), PARAMETER :: B1N6VDisz = 219 - INTEGER(IntKi), PARAMETER :: B1N7VDisz = 220 - INTEGER(IntKi), PARAMETER :: B1N8VDisz = 221 - INTEGER(IntKi), PARAMETER :: B1N9VDisz = 222 - INTEGER(IntKi), PARAMETER :: B2N1VDisx = 223 - INTEGER(IntKi), PARAMETER :: B2N2VDisx = 224 - INTEGER(IntKi), PARAMETER :: B2N3VDisx = 225 - INTEGER(IntKi), PARAMETER :: B2N4VDisx = 226 - INTEGER(IntKi), PARAMETER :: B2N5VDisx = 227 - INTEGER(IntKi), PARAMETER :: B2N6VDisx = 228 - INTEGER(IntKi), PARAMETER :: B2N7VDisx = 229 - INTEGER(IntKi), PARAMETER :: B2N8VDisx = 230 - INTEGER(IntKi), PARAMETER :: B2N9VDisx = 231 - INTEGER(IntKi), PARAMETER :: B2N1VDisy = 232 - INTEGER(IntKi), PARAMETER :: B2N2VDisy = 233 - INTEGER(IntKi), PARAMETER :: B2N3VDisy = 234 - INTEGER(IntKi), PARAMETER :: B2N4VDisy = 235 - INTEGER(IntKi), PARAMETER :: B2N5VDisy = 236 - INTEGER(IntKi), PARAMETER :: B2N6VDisy = 237 - INTEGER(IntKi), PARAMETER :: B2N7VDisy = 238 - INTEGER(IntKi), PARAMETER :: B2N8VDisy = 239 - INTEGER(IntKi), PARAMETER :: B2N9VDisy = 240 - INTEGER(IntKi), PARAMETER :: B2N1VDisz = 241 - INTEGER(IntKi), PARAMETER :: B2N2VDisz = 242 - INTEGER(IntKi), PARAMETER :: B2N3VDisz = 243 - INTEGER(IntKi), PARAMETER :: B2N4VDisz = 244 - INTEGER(IntKi), PARAMETER :: B2N5VDisz = 245 - INTEGER(IntKi), PARAMETER :: B2N6VDisz = 246 - INTEGER(IntKi), PARAMETER :: B2N7VDisz = 247 - INTEGER(IntKi), PARAMETER :: B2N8VDisz = 248 - INTEGER(IntKi), PARAMETER :: B2N9VDisz = 249 - INTEGER(IntKi), PARAMETER :: B3N1VDisx = 250 - INTEGER(IntKi), PARAMETER :: B3N2VDisx = 251 - INTEGER(IntKi), PARAMETER :: B3N3VDisx = 252 - INTEGER(IntKi), PARAMETER :: B3N4VDisx = 253 - INTEGER(IntKi), PARAMETER :: B3N5VDisx = 254 - INTEGER(IntKi), PARAMETER :: B3N6VDisx = 255 - INTEGER(IntKi), PARAMETER :: B3N7VDisx = 256 - INTEGER(IntKi), PARAMETER :: B3N8VDisx = 257 - INTEGER(IntKi), PARAMETER :: B3N9VDisx = 258 - INTEGER(IntKi), PARAMETER :: B3N1VDisy = 259 - INTEGER(IntKi), PARAMETER :: B3N2VDisy = 260 - INTEGER(IntKi), PARAMETER :: B3N3VDisy = 261 - INTEGER(IntKi), PARAMETER :: B3N4VDisy = 262 - INTEGER(IntKi), PARAMETER :: B3N5VDisy = 263 - INTEGER(IntKi), PARAMETER :: B3N6VDisy = 264 - INTEGER(IntKi), PARAMETER :: B3N7VDisy = 265 - INTEGER(IntKi), PARAMETER :: B3N8VDisy = 266 - INTEGER(IntKi), PARAMETER :: B3N9VDisy = 267 - INTEGER(IntKi), PARAMETER :: B3N1VDisz = 268 - INTEGER(IntKi), PARAMETER :: B3N2VDisz = 269 - INTEGER(IntKi), PARAMETER :: B3N3VDisz = 270 - INTEGER(IntKi), PARAMETER :: B3N4VDisz = 271 - INTEGER(IntKi), PARAMETER :: B3N5VDisz = 272 - INTEGER(IntKi), PARAMETER :: B3N6VDisz = 273 - INTEGER(IntKi), PARAMETER :: B3N7VDisz = 274 - INTEGER(IntKi), PARAMETER :: B3N8VDisz = 275 - INTEGER(IntKi), PARAMETER :: B3N9VDisz = 276 - INTEGER(IntKi), PARAMETER :: B1N1STVx = 277 - INTEGER(IntKi), PARAMETER :: B1N2STVx = 278 - INTEGER(IntKi), PARAMETER :: B1N3STVx = 279 - INTEGER(IntKi), PARAMETER :: B1N4STVx = 280 - INTEGER(IntKi), PARAMETER :: B1N5STVx = 281 - INTEGER(IntKi), PARAMETER :: B1N6STVx = 282 - INTEGER(IntKi), PARAMETER :: B1N7STVx = 283 - INTEGER(IntKi), PARAMETER :: B1N8STVx = 284 - INTEGER(IntKi), PARAMETER :: B1N9STVx = 285 - INTEGER(IntKi), PARAMETER :: B1N1STVy = 286 - INTEGER(IntKi), PARAMETER :: B1N2STVy = 287 - INTEGER(IntKi), PARAMETER :: B1N3STVy = 288 - INTEGER(IntKi), PARAMETER :: B1N4STVy = 289 - INTEGER(IntKi), PARAMETER :: B1N5STVy = 290 - INTEGER(IntKi), PARAMETER :: B1N6STVy = 291 - INTEGER(IntKi), PARAMETER :: B1N7STVy = 292 - INTEGER(IntKi), PARAMETER :: B1N8STVy = 293 - INTEGER(IntKi), PARAMETER :: B1N9STVy = 294 - INTEGER(IntKi), PARAMETER :: B1N1STVz = 295 - INTEGER(IntKi), PARAMETER :: B1N2STVz = 296 - INTEGER(IntKi), PARAMETER :: B1N3STVz = 297 - INTEGER(IntKi), PARAMETER :: B1N4STVz = 298 - INTEGER(IntKi), PARAMETER :: B1N5STVz = 299 - INTEGER(IntKi), PARAMETER :: B1N6STVz = 300 - INTEGER(IntKi), PARAMETER :: B1N7STVz = 301 - INTEGER(IntKi), PARAMETER :: B1N8STVz = 302 - INTEGER(IntKi), PARAMETER :: B1N9STVz = 303 - INTEGER(IntKi), PARAMETER :: B2N1STVx = 304 - INTEGER(IntKi), PARAMETER :: B2N2STVx = 305 - INTEGER(IntKi), PARAMETER :: B2N3STVx = 306 - INTEGER(IntKi), PARAMETER :: B2N4STVx = 307 - INTEGER(IntKi), PARAMETER :: B2N5STVx = 308 - INTEGER(IntKi), PARAMETER :: B2N6STVx = 309 - INTEGER(IntKi), PARAMETER :: B2N7STVx = 310 - INTEGER(IntKi), PARAMETER :: B2N8STVx = 311 - INTEGER(IntKi), PARAMETER :: B2N9STVx = 312 - INTEGER(IntKi), PARAMETER :: B2N1STVy = 313 - INTEGER(IntKi), PARAMETER :: B2N2STVy = 314 - INTEGER(IntKi), PARAMETER :: B2N3STVy = 315 - INTEGER(IntKi), PARAMETER :: B2N4STVy = 316 - INTEGER(IntKi), PARAMETER :: B2N5STVy = 317 - INTEGER(IntKi), PARAMETER :: B2N6STVy = 318 - INTEGER(IntKi), PARAMETER :: B2N7STVy = 319 - INTEGER(IntKi), PARAMETER :: B2N8STVy = 320 - INTEGER(IntKi), PARAMETER :: B2N9STVy = 321 - INTEGER(IntKi), PARAMETER :: B2N1STVz = 322 - INTEGER(IntKi), PARAMETER :: B2N2STVz = 323 - INTEGER(IntKi), PARAMETER :: B2N3STVz = 324 - INTEGER(IntKi), PARAMETER :: B2N4STVz = 325 - INTEGER(IntKi), PARAMETER :: B2N5STVz = 326 - INTEGER(IntKi), PARAMETER :: B2N6STVz = 327 - INTEGER(IntKi), PARAMETER :: B2N7STVz = 328 - INTEGER(IntKi), PARAMETER :: B2N8STVz = 329 - INTEGER(IntKi), PARAMETER :: B2N9STVz = 330 - INTEGER(IntKi), PARAMETER :: B3N1STVx = 331 - INTEGER(IntKi), PARAMETER :: B3N2STVx = 332 - INTEGER(IntKi), PARAMETER :: B3N3STVx = 333 - INTEGER(IntKi), PARAMETER :: B3N4STVx = 334 - INTEGER(IntKi), PARAMETER :: B3N5STVx = 335 - INTEGER(IntKi), PARAMETER :: B3N6STVx = 336 - INTEGER(IntKi), PARAMETER :: B3N7STVx = 337 - INTEGER(IntKi), PARAMETER :: B3N8STVx = 338 - INTEGER(IntKi), PARAMETER :: B3N9STVx = 339 - INTEGER(IntKi), PARAMETER :: B3N1STVy = 340 - INTEGER(IntKi), PARAMETER :: B3N2STVy = 341 - INTEGER(IntKi), PARAMETER :: B3N3STVy = 342 - INTEGER(IntKi), PARAMETER :: B3N4STVy = 343 - INTEGER(IntKi), PARAMETER :: B3N5STVy = 344 - INTEGER(IntKi), PARAMETER :: B3N6STVy = 345 - INTEGER(IntKi), PARAMETER :: B3N7STVy = 346 - INTEGER(IntKi), PARAMETER :: B3N8STVy = 347 - INTEGER(IntKi), PARAMETER :: B3N9STVy = 348 - INTEGER(IntKi), PARAMETER :: B3N1STVz = 349 - INTEGER(IntKi), PARAMETER :: B3N2STVz = 350 - INTEGER(IntKi), PARAMETER :: B3N3STVz = 351 - INTEGER(IntKi), PARAMETER :: B3N4STVz = 352 - INTEGER(IntKi), PARAMETER :: B3N5STVz = 353 - INTEGER(IntKi), PARAMETER :: B3N6STVz = 354 - INTEGER(IntKi), PARAMETER :: B3N7STVz = 355 - INTEGER(IntKi), PARAMETER :: B3N8STVz = 356 - INTEGER(IntKi), PARAMETER :: B3N9STVz = 357 - INTEGER(IntKi), PARAMETER :: B1N1VRel = 358 - INTEGER(IntKi), PARAMETER :: B1N2VRel = 359 - INTEGER(IntKi), PARAMETER :: B1N3VRel = 360 - INTEGER(IntKi), PARAMETER :: B1N4VRel = 361 - INTEGER(IntKi), PARAMETER :: B1N5VRel = 362 - INTEGER(IntKi), PARAMETER :: B1N6VRel = 363 - INTEGER(IntKi), PARAMETER :: B1N7VRel = 364 - INTEGER(IntKi), PARAMETER :: B1N8VRel = 365 - INTEGER(IntKi), PARAMETER :: B1N9VRel = 366 - INTEGER(IntKi), PARAMETER :: B2N1VRel = 367 - INTEGER(IntKi), PARAMETER :: B2N2VRel = 368 - INTEGER(IntKi), PARAMETER :: B2N3VRel = 369 - INTEGER(IntKi), PARAMETER :: B2N4VRel = 370 - INTEGER(IntKi), PARAMETER :: B2N5VRel = 371 - INTEGER(IntKi), PARAMETER :: B2N6VRel = 372 - INTEGER(IntKi), PARAMETER :: B2N7VRel = 373 - INTEGER(IntKi), PARAMETER :: B2N8VRel = 374 - INTEGER(IntKi), PARAMETER :: B2N9VRel = 375 - INTEGER(IntKi), PARAMETER :: B3N1VRel = 376 - INTEGER(IntKi), PARAMETER :: B3N2VRel = 377 - INTEGER(IntKi), PARAMETER :: B3N3VRel = 378 - INTEGER(IntKi), PARAMETER :: B3N4VRel = 379 - INTEGER(IntKi), PARAMETER :: B3N5VRel = 380 - INTEGER(IntKi), PARAMETER :: B3N6VRel = 381 - INTEGER(IntKi), PARAMETER :: B3N7VRel = 382 - INTEGER(IntKi), PARAMETER :: B3N8VRel = 383 - INTEGER(IntKi), PARAMETER :: B3N9VRel = 384 - INTEGER(IntKi), PARAMETER :: B1N1DynP = 385 - INTEGER(IntKi), PARAMETER :: B1N2DynP = 386 - INTEGER(IntKi), PARAMETER :: B1N3DynP = 387 - INTEGER(IntKi), PARAMETER :: B1N4DynP = 388 - INTEGER(IntKi), PARAMETER :: B1N5DynP = 389 - INTEGER(IntKi), PARAMETER :: B1N6DynP = 390 - INTEGER(IntKi), PARAMETER :: B1N7DynP = 391 - INTEGER(IntKi), PARAMETER :: B1N8DynP = 392 - INTEGER(IntKi), PARAMETER :: B1N9DynP = 393 - INTEGER(IntKi), PARAMETER :: B2N1DynP = 394 - INTEGER(IntKi), PARAMETER :: B2N2DynP = 395 - INTEGER(IntKi), PARAMETER :: B2N3DynP = 396 - INTEGER(IntKi), PARAMETER :: B2N4DynP = 397 - INTEGER(IntKi), PARAMETER :: B2N5DynP = 398 - INTEGER(IntKi), PARAMETER :: B2N6DynP = 399 - INTEGER(IntKi), PARAMETER :: B2N7DynP = 400 - INTEGER(IntKi), PARAMETER :: B2N8DynP = 401 - INTEGER(IntKi), PARAMETER :: B2N9DynP = 402 - INTEGER(IntKi), PARAMETER :: B3N1DynP = 403 - INTEGER(IntKi), PARAMETER :: B3N2DynP = 404 - INTEGER(IntKi), PARAMETER :: B3N3DynP = 405 - INTEGER(IntKi), PARAMETER :: B3N4DynP = 406 - INTEGER(IntKi), PARAMETER :: B3N5DynP = 407 - INTEGER(IntKi), PARAMETER :: B3N6DynP = 408 - INTEGER(IntKi), PARAMETER :: B3N7DynP = 409 - INTEGER(IntKi), PARAMETER :: B3N8DynP = 410 - INTEGER(IntKi), PARAMETER :: B3N9DynP = 411 - INTEGER(IntKi), PARAMETER :: B1N1Re = 412 - INTEGER(IntKi), PARAMETER :: B1N2Re = 413 - INTEGER(IntKi), PARAMETER :: B1N3Re = 414 - INTEGER(IntKi), PARAMETER :: B1N4Re = 415 - INTEGER(IntKi), PARAMETER :: B1N5Re = 416 - INTEGER(IntKi), PARAMETER :: B1N6Re = 417 - INTEGER(IntKi), PARAMETER :: B1N7Re = 418 - INTEGER(IntKi), PARAMETER :: B1N8Re = 419 - INTEGER(IntKi), PARAMETER :: B1N9Re = 420 - INTEGER(IntKi), PARAMETER :: B2N1Re = 421 - INTEGER(IntKi), PARAMETER :: B2N2Re = 422 - INTEGER(IntKi), PARAMETER :: B2N3Re = 423 - INTEGER(IntKi), PARAMETER :: B2N4Re = 424 - INTEGER(IntKi), PARAMETER :: B2N5Re = 425 - INTEGER(IntKi), PARAMETER :: B2N6Re = 426 - INTEGER(IntKi), PARAMETER :: B2N7Re = 427 - INTEGER(IntKi), PARAMETER :: B2N8Re = 428 - INTEGER(IntKi), PARAMETER :: B2N9Re = 429 - INTEGER(IntKi), PARAMETER :: B3N1Re = 430 - INTEGER(IntKi), PARAMETER :: B3N2Re = 431 - INTEGER(IntKi), PARAMETER :: B3N3Re = 432 - INTEGER(IntKi), PARAMETER :: B3N4Re = 433 - INTEGER(IntKi), PARAMETER :: B3N5Re = 434 - INTEGER(IntKi), PARAMETER :: B3N6Re = 435 - INTEGER(IntKi), PARAMETER :: B3N7Re = 436 - INTEGER(IntKi), PARAMETER :: B3N8Re = 437 - INTEGER(IntKi), PARAMETER :: B3N9Re = 438 - INTEGER(IntKi), PARAMETER :: B1N1M = 439 - INTEGER(IntKi), PARAMETER :: B1N2M = 440 - INTEGER(IntKi), PARAMETER :: B1N3M = 441 - INTEGER(IntKi), PARAMETER :: B1N4M = 442 - INTEGER(IntKi), PARAMETER :: B1N5M = 443 - INTEGER(IntKi), PARAMETER :: B1N6M = 444 - INTEGER(IntKi), PARAMETER :: B1N7M = 445 - INTEGER(IntKi), PARAMETER :: B1N8M = 446 - INTEGER(IntKi), PARAMETER :: B1N9M = 447 - INTEGER(IntKi), PARAMETER :: B2N1M = 448 - INTEGER(IntKi), PARAMETER :: B2N2M = 449 - INTEGER(IntKi), PARAMETER :: B2N3M = 450 - INTEGER(IntKi), PARAMETER :: B2N4M = 451 - INTEGER(IntKi), PARAMETER :: B2N5M = 452 - INTEGER(IntKi), PARAMETER :: B2N6M = 453 - INTEGER(IntKi), PARAMETER :: B2N7M = 454 - INTEGER(IntKi), PARAMETER :: B2N8M = 455 - INTEGER(IntKi), PARAMETER :: B2N9M = 456 - INTEGER(IntKi), PARAMETER :: B3N1M = 457 - INTEGER(IntKi), PARAMETER :: B3N2M = 458 - INTEGER(IntKi), PARAMETER :: B3N3M = 459 - INTEGER(IntKi), PARAMETER :: B3N4M = 460 - INTEGER(IntKi), PARAMETER :: B3N5M = 461 - INTEGER(IntKi), PARAMETER :: B3N6M = 462 - INTEGER(IntKi), PARAMETER :: B3N7M = 463 - INTEGER(IntKi), PARAMETER :: B3N8M = 464 - INTEGER(IntKi), PARAMETER :: B3N9M = 465 - INTEGER(IntKi), PARAMETER :: B1N1Vindx = 466 - INTEGER(IntKi), PARAMETER :: B1N2Vindx = 467 - INTEGER(IntKi), PARAMETER :: B1N3Vindx = 468 - INTEGER(IntKi), PARAMETER :: B1N4Vindx = 469 - INTEGER(IntKi), PARAMETER :: B1N5Vindx = 470 - INTEGER(IntKi), PARAMETER :: B1N6Vindx = 471 - INTEGER(IntKi), PARAMETER :: B1N7Vindx = 472 - INTEGER(IntKi), PARAMETER :: B1N8Vindx = 473 - INTEGER(IntKi), PARAMETER :: B1N9Vindx = 474 - INTEGER(IntKi), PARAMETER :: B2N1Vindx = 475 - INTEGER(IntKi), PARAMETER :: B2N2Vindx = 476 - INTEGER(IntKi), PARAMETER :: B2N3Vindx = 477 - INTEGER(IntKi), PARAMETER :: B2N4Vindx = 478 - INTEGER(IntKi), PARAMETER :: B2N5Vindx = 479 - INTEGER(IntKi), PARAMETER :: B2N6Vindx = 480 - INTEGER(IntKi), PARAMETER :: B2N7Vindx = 481 - INTEGER(IntKi), PARAMETER :: B2N8Vindx = 482 - INTEGER(IntKi), PARAMETER :: B2N9Vindx = 483 - INTEGER(IntKi), PARAMETER :: B3N1Vindx = 484 - INTEGER(IntKi), PARAMETER :: B3N2Vindx = 485 - INTEGER(IntKi), PARAMETER :: B3N3Vindx = 486 - INTEGER(IntKi), PARAMETER :: B3N4Vindx = 487 - INTEGER(IntKi), PARAMETER :: B3N5Vindx = 488 - INTEGER(IntKi), PARAMETER :: B3N6Vindx = 489 - INTEGER(IntKi), PARAMETER :: B3N7Vindx = 490 - INTEGER(IntKi), PARAMETER :: B3N8Vindx = 491 - INTEGER(IntKi), PARAMETER :: B3N9Vindx = 492 - INTEGER(IntKi), PARAMETER :: B1N1Vindy = 493 - INTEGER(IntKi), PARAMETER :: B1N2Vindy = 494 - INTEGER(IntKi), PARAMETER :: B1N3Vindy = 495 - INTEGER(IntKi), PARAMETER :: B1N4Vindy = 496 - INTEGER(IntKi), PARAMETER :: B1N5Vindy = 497 - INTEGER(IntKi), PARAMETER :: B1N6Vindy = 498 - INTEGER(IntKi), PARAMETER :: B1N7Vindy = 499 - INTEGER(IntKi), PARAMETER :: B1N8Vindy = 500 - INTEGER(IntKi), PARAMETER :: B1N9Vindy = 501 - INTEGER(IntKi), PARAMETER :: B2N1Vindy = 502 - INTEGER(IntKi), PARAMETER :: B2N2Vindy = 503 - INTEGER(IntKi), PARAMETER :: B2N3Vindy = 504 - INTEGER(IntKi), PARAMETER :: B2N4Vindy = 505 - INTEGER(IntKi), PARAMETER :: B2N5Vindy = 506 - INTEGER(IntKi), PARAMETER :: B2N6Vindy = 507 - INTEGER(IntKi), PARAMETER :: B2N7Vindy = 508 - INTEGER(IntKi), PARAMETER :: B2N8Vindy = 509 - INTEGER(IntKi), PARAMETER :: B2N9Vindy = 510 - INTEGER(IntKi), PARAMETER :: B3N1Vindy = 511 - INTEGER(IntKi), PARAMETER :: B3N2Vindy = 512 - INTEGER(IntKi), PARAMETER :: B3N3Vindy = 513 - INTEGER(IntKi), PARAMETER :: B3N4Vindy = 514 - INTEGER(IntKi), PARAMETER :: B3N5Vindy = 515 - INTEGER(IntKi), PARAMETER :: B3N6Vindy = 516 - INTEGER(IntKi), PARAMETER :: B3N7Vindy = 517 - INTEGER(IntKi), PARAMETER :: B3N8Vindy = 518 - INTEGER(IntKi), PARAMETER :: B3N9Vindy = 519 - INTEGER(IntKi), PARAMETER :: B1N1AxInd = 520 - INTEGER(IntKi), PARAMETER :: B1N2AxInd = 521 - INTEGER(IntKi), PARAMETER :: B1N3AxInd = 522 - INTEGER(IntKi), PARAMETER :: B1N4AxInd = 523 - INTEGER(IntKi), PARAMETER :: B1N5AxInd = 524 - INTEGER(IntKi), PARAMETER :: B1N6AxInd = 525 - INTEGER(IntKi), PARAMETER :: B1N7AxInd = 526 - INTEGER(IntKi), PARAMETER :: B1N8AxInd = 527 - INTEGER(IntKi), PARAMETER :: B1N9AxInd = 528 - INTEGER(IntKi), PARAMETER :: B2N1AxInd = 529 - INTEGER(IntKi), PARAMETER :: B2N2AxInd = 530 - INTEGER(IntKi), PARAMETER :: B2N3AxInd = 531 - INTEGER(IntKi), PARAMETER :: B2N4AxInd = 532 - INTEGER(IntKi), PARAMETER :: B2N5AxInd = 533 - INTEGER(IntKi), PARAMETER :: B2N6AxInd = 534 - INTEGER(IntKi), PARAMETER :: B2N7AxInd = 535 - INTEGER(IntKi), PARAMETER :: B2N8AxInd = 536 - INTEGER(IntKi), PARAMETER :: B2N9AxInd = 537 - INTEGER(IntKi), PARAMETER :: B3N1AxInd = 538 - INTEGER(IntKi), PARAMETER :: B3N2AxInd = 539 - INTEGER(IntKi), PARAMETER :: B3N3AxInd = 540 - INTEGER(IntKi), PARAMETER :: B3N4AxInd = 541 - INTEGER(IntKi), PARAMETER :: B3N5AxInd = 542 - INTEGER(IntKi), PARAMETER :: B3N6AxInd = 543 - INTEGER(IntKi), PARAMETER :: B3N7AxInd = 544 - INTEGER(IntKi), PARAMETER :: B3N8AxInd = 545 - INTEGER(IntKi), PARAMETER :: B3N9AxInd = 546 - INTEGER(IntKi), PARAMETER :: B1N1TnInd = 547 - INTEGER(IntKi), PARAMETER :: B1N2TnInd = 548 - INTEGER(IntKi), PARAMETER :: B1N3TnInd = 549 - INTEGER(IntKi), PARAMETER :: B1N4TnInd = 550 - INTEGER(IntKi), PARAMETER :: B1N5TnInd = 551 - INTEGER(IntKi), PARAMETER :: B1N6TnInd = 552 - INTEGER(IntKi), PARAMETER :: B1N7TnInd = 553 - INTEGER(IntKi), PARAMETER :: B1N8TnInd = 554 - INTEGER(IntKi), PARAMETER :: B1N9TnInd = 555 - INTEGER(IntKi), PARAMETER :: B2N1TnInd = 556 - INTEGER(IntKi), PARAMETER :: B2N2TnInd = 557 - INTEGER(IntKi), PARAMETER :: B2N3TnInd = 558 - INTEGER(IntKi), PARAMETER :: B2N4TnInd = 559 - INTEGER(IntKi), PARAMETER :: B2N5TnInd = 560 - INTEGER(IntKi), PARAMETER :: B2N6TnInd = 561 - INTEGER(IntKi), PARAMETER :: B2N7TnInd = 562 - INTEGER(IntKi), PARAMETER :: B2N8TnInd = 563 - INTEGER(IntKi), PARAMETER :: B2N9TnInd = 564 - INTEGER(IntKi), PARAMETER :: B3N1TnInd = 565 - INTEGER(IntKi), PARAMETER :: B3N2TnInd = 566 - INTEGER(IntKi), PARAMETER :: B3N3TnInd = 567 - INTEGER(IntKi), PARAMETER :: B3N4TnInd = 568 - INTEGER(IntKi), PARAMETER :: B3N5TnInd = 569 - INTEGER(IntKi), PARAMETER :: B3N6TnInd = 570 - INTEGER(IntKi), PARAMETER :: B3N7TnInd = 571 - INTEGER(IntKi), PARAMETER :: B3N8TnInd = 572 - INTEGER(IntKi), PARAMETER :: B3N9TnInd = 573 - INTEGER(IntKi), PARAMETER :: B1N1Alpha = 574 - INTEGER(IntKi), PARAMETER :: B1N2Alpha = 575 - INTEGER(IntKi), PARAMETER :: B1N3Alpha = 576 - INTEGER(IntKi), PARAMETER :: B1N4Alpha = 577 - INTEGER(IntKi), PARAMETER :: B1N5Alpha = 578 - INTEGER(IntKi), PARAMETER :: B1N6Alpha = 579 - INTEGER(IntKi), PARAMETER :: B1N7Alpha = 580 - INTEGER(IntKi), PARAMETER :: B1N8Alpha = 581 - INTEGER(IntKi), PARAMETER :: B1N9Alpha = 582 - INTEGER(IntKi), PARAMETER :: B2N1Alpha = 583 - INTEGER(IntKi), PARAMETER :: B2N2Alpha = 584 - INTEGER(IntKi), PARAMETER :: B2N3Alpha = 585 - INTEGER(IntKi), PARAMETER :: B2N4Alpha = 586 - INTEGER(IntKi), PARAMETER :: B2N5Alpha = 587 - INTEGER(IntKi), PARAMETER :: B2N6Alpha = 588 - INTEGER(IntKi), PARAMETER :: B2N7Alpha = 589 - INTEGER(IntKi), PARAMETER :: B2N8Alpha = 590 - INTEGER(IntKi), PARAMETER :: B2N9Alpha = 591 - INTEGER(IntKi), PARAMETER :: B3N1Alpha = 592 - INTEGER(IntKi), PARAMETER :: B3N2Alpha = 593 - INTEGER(IntKi), PARAMETER :: B3N3Alpha = 594 - INTEGER(IntKi), PARAMETER :: B3N4Alpha = 595 - INTEGER(IntKi), PARAMETER :: B3N5Alpha = 596 - INTEGER(IntKi), PARAMETER :: B3N6Alpha = 597 - INTEGER(IntKi), PARAMETER :: B3N7Alpha = 598 - INTEGER(IntKi), PARAMETER :: B3N8Alpha = 599 - INTEGER(IntKi), PARAMETER :: B3N9Alpha = 600 - INTEGER(IntKi), PARAMETER :: B1N1Theta = 601 - INTEGER(IntKi), PARAMETER :: B1N2Theta = 602 - INTEGER(IntKi), PARAMETER :: B1N3Theta = 603 - INTEGER(IntKi), PARAMETER :: B1N4Theta = 604 - INTEGER(IntKi), PARAMETER :: B1N5Theta = 605 - INTEGER(IntKi), PARAMETER :: B1N6Theta = 606 - INTEGER(IntKi), PARAMETER :: B1N7Theta = 607 - INTEGER(IntKi), PARAMETER :: B1N8Theta = 608 - INTEGER(IntKi), PARAMETER :: B1N9Theta = 609 - INTEGER(IntKi), PARAMETER :: B2N1Theta = 610 - INTEGER(IntKi), PARAMETER :: B2N2Theta = 611 - INTEGER(IntKi), PARAMETER :: B2N3Theta = 612 - INTEGER(IntKi), PARAMETER :: B2N4Theta = 613 - INTEGER(IntKi), PARAMETER :: B2N5Theta = 614 - INTEGER(IntKi), PARAMETER :: B2N6Theta = 615 - INTEGER(IntKi), PARAMETER :: B2N7Theta = 616 - INTEGER(IntKi), PARAMETER :: B2N8Theta = 617 - INTEGER(IntKi), PARAMETER :: B2N9Theta = 618 - INTEGER(IntKi), PARAMETER :: B3N1Theta = 619 - INTEGER(IntKi), PARAMETER :: B3N2Theta = 620 - INTEGER(IntKi), PARAMETER :: B3N3Theta = 621 - INTEGER(IntKi), PARAMETER :: B3N4Theta = 622 - INTEGER(IntKi), PARAMETER :: B3N5Theta = 623 - INTEGER(IntKi), PARAMETER :: B3N6Theta = 624 - INTEGER(IntKi), PARAMETER :: B3N7Theta = 625 - INTEGER(IntKi), PARAMETER :: B3N8Theta = 626 - INTEGER(IntKi), PARAMETER :: B3N9Theta = 627 - INTEGER(IntKi), PARAMETER :: B1N1Phi = 628 - INTEGER(IntKi), PARAMETER :: B1N2Phi = 629 - INTEGER(IntKi), PARAMETER :: B1N3Phi = 630 - INTEGER(IntKi), PARAMETER :: B1N4Phi = 631 - INTEGER(IntKi), PARAMETER :: B1N5Phi = 632 - INTEGER(IntKi), PARAMETER :: B1N6Phi = 633 - INTEGER(IntKi), PARAMETER :: B1N7Phi = 634 - INTEGER(IntKi), PARAMETER :: B1N8Phi = 635 - INTEGER(IntKi), PARAMETER :: B1N9Phi = 636 - INTEGER(IntKi), PARAMETER :: B2N1Phi = 637 - INTEGER(IntKi), PARAMETER :: B2N2Phi = 638 - INTEGER(IntKi), PARAMETER :: B2N3Phi = 639 - INTEGER(IntKi), PARAMETER :: B2N4Phi = 640 - INTEGER(IntKi), PARAMETER :: B2N5Phi = 641 - INTEGER(IntKi), PARAMETER :: B2N6Phi = 642 - INTEGER(IntKi), PARAMETER :: B2N7Phi = 643 - INTEGER(IntKi), PARAMETER :: B2N8Phi = 644 - INTEGER(IntKi), PARAMETER :: B2N9Phi = 645 - INTEGER(IntKi), PARAMETER :: B3N1Phi = 646 - INTEGER(IntKi), PARAMETER :: B3N2Phi = 647 - INTEGER(IntKi), PARAMETER :: B3N3Phi = 648 - INTEGER(IntKi), PARAMETER :: B3N4Phi = 649 - INTEGER(IntKi), PARAMETER :: B3N5Phi = 650 - INTEGER(IntKi), PARAMETER :: B3N6Phi = 651 - INTEGER(IntKi), PARAMETER :: B3N7Phi = 652 - INTEGER(IntKi), PARAMETER :: B3N8Phi = 653 - INTEGER(IntKi), PARAMETER :: B3N9Phi = 654 - INTEGER(IntKi), PARAMETER :: B1N1Curve = 655 - INTEGER(IntKi), PARAMETER :: B1N2Curve = 656 - INTEGER(IntKi), PARAMETER :: B1N3Curve = 657 - INTEGER(IntKi), PARAMETER :: B1N4Curve = 658 - INTEGER(IntKi), PARAMETER :: B1N5Curve = 659 - INTEGER(IntKi), PARAMETER :: B1N6Curve = 660 - INTEGER(IntKi), PARAMETER :: B1N7Curve = 661 - INTEGER(IntKi), PARAMETER :: B1N8Curve = 662 - INTEGER(IntKi), PARAMETER :: B1N9Curve = 663 - INTEGER(IntKi), PARAMETER :: B2N1Curve = 664 - INTEGER(IntKi), PARAMETER :: B2N2Curve = 665 - INTEGER(IntKi), PARAMETER :: B2N3Curve = 666 - INTEGER(IntKi), PARAMETER :: B2N4Curve = 667 - INTEGER(IntKi), PARAMETER :: B2N5Curve = 668 - INTEGER(IntKi), PARAMETER :: B2N6Curve = 669 - INTEGER(IntKi), PARAMETER :: B2N7Curve = 670 - INTEGER(IntKi), PARAMETER :: B2N8Curve = 671 - INTEGER(IntKi), PARAMETER :: B2N9Curve = 672 - INTEGER(IntKi), PARAMETER :: B3N1Curve = 673 - INTEGER(IntKi), PARAMETER :: B3N2Curve = 674 - INTEGER(IntKi), PARAMETER :: B3N3Curve = 675 - INTEGER(IntKi), PARAMETER :: B3N4Curve = 676 - INTEGER(IntKi), PARAMETER :: B3N5Curve = 677 - INTEGER(IntKi), PARAMETER :: B3N6Curve = 678 - INTEGER(IntKi), PARAMETER :: B3N7Curve = 679 - INTEGER(IntKi), PARAMETER :: B3N8Curve = 680 - INTEGER(IntKi), PARAMETER :: B3N9Curve = 681 - INTEGER(IntKi), PARAMETER :: B1N1Cl = 682 - INTEGER(IntKi), PARAMETER :: B1N2Cl = 683 - INTEGER(IntKi), PARAMETER :: B1N3Cl = 684 - INTEGER(IntKi), PARAMETER :: B1N4Cl = 685 - INTEGER(IntKi), PARAMETER :: B1N5Cl = 686 - INTEGER(IntKi), PARAMETER :: B1N6Cl = 687 - INTEGER(IntKi), PARAMETER :: B1N7Cl = 688 - INTEGER(IntKi), PARAMETER :: B1N8Cl = 689 - INTEGER(IntKi), PARAMETER :: B1N9Cl = 690 - INTEGER(IntKi), PARAMETER :: B2N1Cl = 691 - INTEGER(IntKi), PARAMETER :: B2N2Cl = 692 - INTEGER(IntKi), PARAMETER :: B2N3Cl = 693 - INTEGER(IntKi), PARAMETER :: B2N4Cl = 694 - INTEGER(IntKi), PARAMETER :: B2N5Cl = 695 - INTEGER(IntKi), PARAMETER :: B2N6Cl = 696 - INTEGER(IntKi), PARAMETER :: B2N7Cl = 697 - INTEGER(IntKi), PARAMETER :: B2N8Cl = 698 - INTEGER(IntKi), PARAMETER :: B2N9Cl = 699 - INTEGER(IntKi), PARAMETER :: B3N1Cl = 700 - INTEGER(IntKi), PARAMETER :: B3N2Cl = 701 - INTEGER(IntKi), PARAMETER :: B3N3Cl = 702 - INTEGER(IntKi), PARAMETER :: B3N4Cl = 703 - INTEGER(IntKi), PARAMETER :: B3N5Cl = 704 - INTEGER(IntKi), PARAMETER :: B3N6Cl = 705 - INTEGER(IntKi), PARAMETER :: B3N7Cl = 706 - INTEGER(IntKi), PARAMETER :: B3N8Cl = 707 - INTEGER(IntKi), PARAMETER :: B3N9Cl = 708 - INTEGER(IntKi), PARAMETER :: B1N1Cd = 709 - INTEGER(IntKi), PARAMETER :: B1N2Cd = 710 - INTEGER(IntKi), PARAMETER :: B1N3Cd = 711 - INTEGER(IntKi), PARAMETER :: B1N4Cd = 712 - INTEGER(IntKi), PARAMETER :: B1N5Cd = 713 - INTEGER(IntKi), PARAMETER :: B1N6Cd = 714 - INTEGER(IntKi), PARAMETER :: B1N7Cd = 715 - INTEGER(IntKi), PARAMETER :: B1N8Cd = 716 - INTEGER(IntKi), PARAMETER :: B1N9Cd = 717 - INTEGER(IntKi), PARAMETER :: B2N1Cd = 718 - INTEGER(IntKi), PARAMETER :: B2N2Cd = 719 - INTEGER(IntKi), PARAMETER :: B2N3Cd = 720 - INTEGER(IntKi), PARAMETER :: B2N4Cd = 721 - INTEGER(IntKi), PARAMETER :: B2N5Cd = 722 - INTEGER(IntKi), PARAMETER :: B2N6Cd = 723 - INTEGER(IntKi), PARAMETER :: B2N7Cd = 724 - INTEGER(IntKi), PARAMETER :: B2N8Cd = 725 - INTEGER(IntKi), PARAMETER :: B2N9Cd = 726 - INTEGER(IntKi), PARAMETER :: B3N1Cd = 727 - INTEGER(IntKi), PARAMETER :: B3N2Cd = 728 - INTEGER(IntKi), PARAMETER :: B3N3Cd = 729 - INTEGER(IntKi), PARAMETER :: B3N4Cd = 730 - INTEGER(IntKi), PARAMETER :: B3N5Cd = 731 - INTEGER(IntKi), PARAMETER :: B3N6Cd = 732 - INTEGER(IntKi), PARAMETER :: B3N7Cd = 733 - INTEGER(IntKi), PARAMETER :: B3N8Cd = 734 - INTEGER(IntKi), PARAMETER :: B3N9Cd = 735 - INTEGER(IntKi), PARAMETER :: B1N1Cm = 736 - INTEGER(IntKi), PARAMETER :: B1N2Cm = 737 - INTEGER(IntKi), PARAMETER :: B1N3Cm = 738 - INTEGER(IntKi), PARAMETER :: B1N4Cm = 739 - INTEGER(IntKi), PARAMETER :: B1N5Cm = 740 - INTEGER(IntKi), PARAMETER :: B1N6Cm = 741 - INTEGER(IntKi), PARAMETER :: B1N7Cm = 742 - INTEGER(IntKi), PARAMETER :: B1N8Cm = 743 - INTEGER(IntKi), PARAMETER :: B1N9Cm = 744 - INTEGER(IntKi), PARAMETER :: B2N1Cm = 745 - INTEGER(IntKi), PARAMETER :: B2N2Cm = 746 - INTEGER(IntKi), PARAMETER :: B2N3Cm = 747 - INTEGER(IntKi), PARAMETER :: B2N4Cm = 748 - INTEGER(IntKi), PARAMETER :: B2N5Cm = 749 - INTEGER(IntKi), PARAMETER :: B2N6Cm = 750 - INTEGER(IntKi), PARAMETER :: B2N7Cm = 751 - INTEGER(IntKi), PARAMETER :: B2N8Cm = 752 - INTEGER(IntKi), PARAMETER :: B2N9Cm = 753 - INTEGER(IntKi), PARAMETER :: B3N1Cm = 754 - INTEGER(IntKi), PARAMETER :: B3N2Cm = 755 - INTEGER(IntKi), PARAMETER :: B3N3Cm = 756 - INTEGER(IntKi), PARAMETER :: B3N4Cm = 757 - INTEGER(IntKi), PARAMETER :: B3N5Cm = 758 - INTEGER(IntKi), PARAMETER :: B3N6Cm = 759 - INTEGER(IntKi), PARAMETER :: B3N7Cm = 760 - INTEGER(IntKi), PARAMETER :: B3N8Cm = 761 - INTEGER(IntKi), PARAMETER :: B3N9Cm = 762 - INTEGER(IntKi), PARAMETER :: B1N1Cx = 763 - INTEGER(IntKi), PARAMETER :: B1N2Cx = 764 - INTEGER(IntKi), PARAMETER :: B1N3Cx = 765 - INTEGER(IntKi), PARAMETER :: B1N4Cx = 766 - INTEGER(IntKi), PARAMETER :: B1N5Cx = 767 - INTEGER(IntKi), PARAMETER :: B1N6Cx = 768 - INTEGER(IntKi), PARAMETER :: B1N7Cx = 769 - INTEGER(IntKi), PARAMETER :: B1N8Cx = 770 - INTEGER(IntKi), PARAMETER :: B1N9Cx = 771 - INTEGER(IntKi), PARAMETER :: B2N1Cx = 772 - INTEGER(IntKi), PARAMETER :: B2N2Cx = 773 - INTEGER(IntKi), PARAMETER :: B2N3Cx = 774 - INTEGER(IntKi), PARAMETER :: B2N4Cx = 775 - INTEGER(IntKi), PARAMETER :: B2N5Cx = 776 - INTEGER(IntKi), PARAMETER :: B2N6Cx = 777 - INTEGER(IntKi), PARAMETER :: B2N7Cx = 778 - INTEGER(IntKi), PARAMETER :: B2N8Cx = 779 - INTEGER(IntKi), PARAMETER :: B2N9Cx = 780 - INTEGER(IntKi), PARAMETER :: B3N1Cx = 781 - INTEGER(IntKi), PARAMETER :: B3N2Cx = 782 - INTEGER(IntKi), PARAMETER :: B3N3Cx = 783 - INTEGER(IntKi), PARAMETER :: B3N4Cx = 784 - INTEGER(IntKi), PARAMETER :: B3N5Cx = 785 - INTEGER(IntKi), PARAMETER :: B3N6Cx = 786 - INTEGER(IntKi), PARAMETER :: B3N7Cx = 787 - INTEGER(IntKi), PARAMETER :: B3N8Cx = 788 - INTEGER(IntKi), PARAMETER :: B3N9Cx = 789 - INTEGER(IntKi), PARAMETER :: B1N1Cy = 790 - INTEGER(IntKi), PARAMETER :: B1N2Cy = 791 - INTEGER(IntKi), PARAMETER :: B1N3Cy = 792 - INTEGER(IntKi), PARAMETER :: B1N4Cy = 793 - INTEGER(IntKi), PARAMETER :: B1N5Cy = 794 - INTEGER(IntKi), PARAMETER :: B1N6Cy = 795 - INTEGER(IntKi), PARAMETER :: B1N7Cy = 796 - INTEGER(IntKi), PARAMETER :: B1N8Cy = 797 - INTEGER(IntKi), PARAMETER :: B1N9Cy = 798 - INTEGER(IntKi), PARAMETER :: B2N1Cy = 799 - INTEGER(IntKi), PARAMETER :: B2N2Cy = 800 - INTEGER(IntKi), PARAMETER :: B2N3Cy = 801 - INTEGER(IntKi), PARAMETER :: B2N4Cy = 802 - INTEGER(IntKi), PARAMETER :: B2N5Cy = 803 - INTEGER(IntKi), PARAMETER :: B2N6Cy = 804 - INTEGER(IntKi), PARAMETER :: B2N7Cy = 805 - INTEGER(IntKi), PARAMETER :: B2N8Cy = 806 - INTEGER(IntKi), PARAMETER :: B2N9Cy = 807 - INTEGER(IntKi), PARAMETER :: B3N1Cy = 808 - INTEGER(IntKi), PARAMETER :: B3N2Cy = 809 - INTEGER(IntKi), PARAMETER :: B3N3Cy = 810 - INTEGER(IntKi), PARAMETER :: B3N4Cy = 811 - INTEGER(IntKi), PARAMETER :: B3N5Cy = 812 - INTEGER(IntKi), PARAMETER :: B3N6Cy = 813 - INTEGER(IntKi), PARAMETER :: B3N7Cy = 814 - INTEGER(IntKi), PARAMETER :: B3N8Cy = 815 - INTEGER(IntKi), PARAMETER :: B3N9Cy = 816 - INTEGER(IntKi), PARAMETER :: B1N1Cn = 817 - INTEGER(IntKi), PARAMETER :: B1N2Cn = 818 - INTEGER(IntKi), PARAMETER :: B1N3Cn = 819 - INTEGER(IntKi), PARAMETER :: B1N4Cn = 820 - INTEGER(IntKi), PARAMETER :: B1N5Cn = 821 - INTEGER(IntKi), PARAMETER :: B1N6Cn = 822 - INTEGER(IntKi), PARAMETER :: B1N7Cn = 823 - INTEGER(IntKi), PARAMETER :: B1N8Cn = 824 - INTEGER(IntKi), PARAMETER :: B1N9Cn = 825 - INTEGER(IntKi), PARAMETER :: B2N1Cn = 826 - INTEGER(IntKi), PARAMETER :: B2N2Cn = 827 - INTEGER(IntKi), PARAMETER :: B2N3Cn = 828 - INTEGER(IntKi), PARAMETER :: B2N4Cn = 829 - INTEGER(IntKi), PARAMETER :: B2N5Cn = 830 - INTEGER(IntKi), PARAMETER :: B2N6Cn = 831 - INTEGER(IntKi), PARAMETER :: B2N7Cn = 832 - INTEGER(IntKi), PARAMETER :: B2N8Cn = 833 - INTEGER(IntKi), PARAMETER :: B2N9Cn = 834 - INTEGER(IntKi), PARAMETER :: B3N1Cn = 835 - INTEGER(IntKi), PARAMETER :: B3N2Cn = 836 - INTEGER(IntKi), PARAMETER :: B3N3Cn = 837 - INTEGER(IntKi), PARAMETER :: B3N4Cn = 838 - INTEGER(IntKi), PARAMETER :: B3N5Cn = 839 - INTEGER(IntKi), PARAMETER :: B3N6Cn = 840 - INTEGER(IntKi), PARAMETER :: B3N7Cn = 841 - INTEGER(IntKi), PARAMETER :: B3N8Cn = 842 - INTEGER(IntKi), PARAMETER :: B3N9Cn = 843 - INTEGER(IntKi), PARAMETER :: B1N1Ct = 844 - INTEGER(IntKi), PARAMETER :: B1N2Ct = 845 - INTEGER(IntKi), PARAMETER :: B1N3Ct = 846 - INTEGER(IntKi), PARAMETER :: B1N4Ct = 847 - INTEGER(IntKi), PARAMETER :: B1N5Ct = 848 - INTEGER(IntKi), PARAMETER :: B1N6Ct = 849 - INTEGER(IntKi), PARAMETER :: B1N7Ct = 850 - INTEGER(IntKi), PARAMETER :: B1N8Ct = 851 - INTEGER(IntKi), PARAMETER :: B1N9Ct = 852 - INTEGER(IntKi), PARAMETER :: B2N1Ct = 853 - INTEGER(IntKi), PARAMETER :: B2N2Ct = 854 - INTEGER(IntKi), PARAMETER :: B2N3Ct = 855 - INTEGER(IntKi), PARAMETER :: B2N4Ct = 856 - INTEGER(IntKi), PARAMETER :: B2N5Ct = 857 - INTEGER(IntKi), PARAMETER :: B2N6Ct = 858 - INTEGER(IntKi), PARAMETER :: B2N7Ct = 859 - INTEGER(IntKi), PARAMETER :: B2N8Ct = 860 - INTEGER(IntKi), PARAMETER :: B2N9Ct = 861 - INTEGER(IntKi), PARAMETER :: B3N1Ct = 862 - INTEGER(IntKi), PARAMETER :: B3N2Ct = 863 - INTEGER(IntKi), PARAMETER :: B3N3Ct = 864 - INTEGER(IntKi), PARAMETER :: B3N4Ct = 865 - INTEGER(IntKi), PARAMETER :: B3N5Ct = 866 - INTEGER(IntKi), PARAMETER :: B3N6Ct = 867 - INTEGER(IntKi), PARAMETER :: B3N7Ct = 868 - INTEGER(IntKi), PARAMETER :: B3N8Ct = 869 - INTEGER(IntKi), PARAMETER :: B3N9Ct = 870 - INTEGER(IntKi), PARAMETER :: B1N1Fl = 871 - INTEGER(IntKi), PARAMETER :: B1N2Fl = 872 - INTEGER(IntKi), PARAMETER :: B1N3Fl = 873 - INTEGER(IntKi), PARAMETER :: B1N4Fl = 874 - INTEGER(IntKi), PARAMETER :: B1N5Fl = 875 - INTEGER(IntKi), PARAMETER :: B1N6Fl = 876 - INTEGER(IntKi), PARAMETER :: B1N7Fl = 877 - INTEGER(IntKi), PARAMETER :: B1N8Fl = 878 - INTEGER(IntKi), PARAMETER :: B1N9Fl = 879 - INTEGER(IntKi), PARAMETER :: B2N1Fl = 880 - INTEGER(IntKi), PARAMETER :: B2N2Fl = 881 - INTEGER(IntKi), PARAMETER :: B2N3Fl = 882 - INTEGER(IntKi), PARAMETER :: B2N4Fl = 883 - INTEGER(IntKi), PARAMETER :: B2N5Fl = 884 - INTEGER(IntKi), PARAMETER :: B2N6Fl = 885 - INTEGER(IntKi), PARAMETER :: B2N7Fl = 886 - INTEGER(IntKi), PARAMETER :: B2N8Fl = 887 - INTEGER(IntKi), PARAMETER :: B2N9Fl = 888 - INTEGER(IntKi), PARAMETER :: B3N1Fl = 889 - INTEGER(IntKi), PARAMETER :: B3N2Fl = 890 - INTEGER(IntKi), PARAMETER :: B3N3Fl = 891 - INTEGER(IntKi), PARAMETER :: B3N4Fl = 892 - INTEGER(IntKi), PARAMETER :: B3N5Fl = 893 - INTEGER(IntKi), PARAMETER :: B3N6Fl = 894 - INTEGER(IntKi), PARAMETER :: B3N7Fl = 895 - INTEGER(IntKi), PARAMETER :: B3N8Fl = 896 - INTEGER(IntKi), PARAMETER :: B3N9Fl = 897 - INTEGER(IntKi), PARAMETER :: B1N1Fd = 898 - INTEGER(IntKi), PARAMETER :: B1N2Fd = 899 - INTEGER(IntKi), PARAMETER :: B1N3Fd = 900 - INTEGER(IntKi), PARAMETER :: B1N4Fd = 901 - INTEGER(IntKi), PARAMETER :: B1N5Fd = 902 - INTEGER(IntKi), PARAMETER :: B1N6Fd = 903 - INTEGER(IntKi), PARAMETER :: B1N7Fd = 904 - INTEGER(IntKi), PARAMETER :: B1N8Fd = 905 - INTEGER(IntKi), PARAMETER :: B1N9Fd = 906 - INTEGER(IntKi), PARAMETER :: B2N1Fd = 907 - INTEGER(IntKi), PARAMETER :: B2N2Fd = 908 - INTEGER(IntKi), PARAMETER :: B2N3Fd = 909 - INTEGER(IntKi), PARAMETER :: B2N4Fd = 910 - INTEGER(IntKi), PARAMETER :: B2N5Fd = 911 - INTEGER(IntKi), PARAMETER :: B2N6Fd = 912 - INTEGER(IntKi), PARAMETER :: B2N7Fd = 913 - INTEGER(IntKi), PARAMETER :: B2N8Fd = 914 - INTEGER(IntKi), PARAMETER :: B2N9Fd = 915 - INTEGER(IntKi), PARAMETER :: B3N1Fd = 916 - INTEGER(IntKi), PARAMETER :: B3N2Fd = 917 - INTEGER(IntKi), PARAMETER :: B3N3Fd = 918 - INTEGER(IntKi), PARAMETER :: B3N4Fd = 919 - INTEGER(IntKi), PARAMETER :: B3N5Fd = 920 - INTEGER(IntKi), PARAMETER :: B3N6Fd = 921 - INTEGER(IntKi), PARAMETER :: B3N7Fd = 922 - INTEGER(IntKi), PARAMETER :: B3N8Fd = 923 - INTEGER(IntKi), PARAMETER :: B3N9Fd = 924 - INTEGER(IntKi), PARAMETER :: B1N1Mm = 925 - INTEGER(IntKi), PARAMETER :: B1N2Mm = 926 - INTEGER(IntKi), PARAMETER :: B1N3Mm = 927 - INTEGER(IntKi), PARAMETER :: B1N4Mm = 928 - INTEGER(IntKi), PARAMETER :: B1N5Mm = 929 - INTEGER(IntKi), PARAMETER :: B1N6Mm = 930 - INTEGER(IntKi), PARAMETER :: B1N7Mm = 931 - INTEGER(IntKi), PARAMETER :: B1N8Mm = 932 - INTEGER(IntKi), PARAMETER :: B1N9Mm = 933 - INTEGER(IntKi), PARAMETER :: B2N1Mm = 934 - INTEGER(IntKi), PARAMETER :: B2N2Mm = 935 - INTEGER(IntKi), PARAMETER :: B2N3Mm = 936 - INTEGER(IntKi), PARAMETER :: B2N4Mm = 937 - INTEGER(IntKi), PARAMETER :: B2N5Mm = 938 - INTEGER(IntKi), PARAMETER :: B2N6Mm = 939 - INTEGER(IntKi), PARAMETER :: B2N7Mm = 940 - INTEGER(IntKi), PARAMETER :: B2N8Mm = 941 - INTEGER(IntKi), PARAMETER :: B2N9Mm = 942 - INTEGER(IntKi), PARAMETER :: B3N1Mm = 943 - INTEGER(IntKi), PARAMETER :: B3N2Mm = 944 - INTEGER(IntKi), PARAMETER :: B3N3Mm = 945 - INTEGER(IntKi), PARAMETER :: B3N4Mm = 946 - INTEGER(IntKi), PARAMETER :: B3N5Mm = 947 - INTEGER(IntKi), PARAMETER :: B3N6Mm = 948 - INTEGER(IntKi), PARAMETER :: B3N7Mm = 949 - INTEGER(IntKi), PARAMETER :: B3N8Mm = 950 - INTEGER(IntKi), PARAMETER :: B3N9Mm = 951 - INTEGER(IntKi), PARAMETER :: B1N1Fx = 952 - INTEGER(IntKi), PARAMETER :: B1N2Fx = 953 - INTEGER(IntKi), PARAMETER :: B1N3Fx = 954 - INTEGER(IntKi), PARAMETER :: B1N4Fx = 955 - INTEGER(IntKi), PARAMETER :: B1N5Fx = 956 - INTEGER(IntKi), PARAMETER :: B1N6Fx = 957 - INTEGER(IntKi), PARAMETER :: B1N7Fx = 958 - INTEGER(IntKi), PARAMETER :: B1N8Fx = 959 - INTEGER(IntKi), PARAMETER :: B1N9Fx = 960 - INTEGER(IntKi), PARAMETER :: B2N1Fx = 961 - INTEGER(IntKi), PARAMETER :: B2N2Fx = 962 - INTEGER(IntKi), PARAMETER :: B2N3Fx = 963 - INTEGER(IntKi), PARAMETER :: B2N4Fx = 964 - INTEGER(IntKi), PARAMETER :: B2N5Fx = 965 - INTEGER(IntKi), PARAMETER :: B2N6Fx = 966 - INTEGER(IntKi), PARAMETER :: B2N7Fx = 967 - INTEGER(IntKi), PARAMETER :: B2N8Fx = 968 - INTEGER(IntKi), PARAMETER :: B2N9Fx = 969 - INTEGER(IntKi), PARAMETER :: B3N1Fx = 970 - INTEGER(IntKi), PARAMETER :: B3N2Fx = 971 - INTEGER(IntKi), PARAMETER :: B3N3Fx = 972 - INTEGER(IntKi), PARAMETER :: B3N4Fx = 973 - INTEGER(IntKi), PARAMETER :: B3N5Fx = 974 - INTEGER(IntKi), PARAMETER :: B3N6Fx = 975 - INTEGER(IntKi), PARAMETER :: B3N7Fx = 976 - INTEGER(IntKi), PARAMETER :: B3N8Fx = 977 - INTEGER(IntKi), PARAMETER :: B3N9Fx = 978 - INTEGER(IntKi), PARAMETER :: B1N1Fy = 979 - INTEGER(IntKi), PARAMETER :: B1N2Fy = 980 - INTEGER(IntKi), PARAMETER :: B1N3Fy = 981 - INTEGER(IntKi), PARAMETER :: B1N4Fy = 982 - INTEGER(IntKi), PARAMETER :: B1N5Fy = 983 - INTEGER(IntKi), PARAMETER :: B1N6Fy = 984 - INTEGER(IntKi), PARAMETER :: B1N7Fy = 985 - INTEGER(IntKi), PARAMETER :: B1N8Fy = 986 - INTEGER(IntKi), PARAMETER :: B1N9Fy = 987 - INTEGER(IntKi), PARAMETER :: B2N1Fy = 988 - INTEGER(IntKi), PARAMETER :: B2N2Fy = 989 - INTEGER(IntKi), PARAMETER :: B2N3Fy = 990 - INTEGER(IntKi), PARAMETER :: B2N4Fy = 991 - INTEGER(IntKi), PARAMETER :: B2N5Fy = 992 - INTEGER(IntKi), PARAMETER :: B2N6Fy = 993 - INTEGER(IntKi), PARAMETER :: B2N7Fy = 994 - INTEGER(IntKi), PARAMETER :: B2N8Fy = 995 - INTEGER(IntKi), PARAMETER :: B2N9Fy = 996 - INTEGER(IntKi), PARAMETER :: B3N1Fy = 997 - INTEGER(IntKi), PARAMETER :: B3N2Fy = 998 - INTEGER(IntKi), PARAMETER :: B3N3Fy = 999 - INTEGER(IntKi), PARAMETER :: B3N4Fy = 1000 - INTEGER(IntKi), PARAMETER :: B3N5Fy = 1001 - INTEGER(IntKi), PARAMETER :: B3N6Fy = 1002 - INTEGER(IntKi), PARAMETER :: B3N7Fy = 1003 - INTEGER(IntKi), PARAMETER :: B3N8Fy = 1004 - INTEGER(IntKi), PARAMETER :: B3N9Fy = 1005 - INTEGER(IntKi), PARAMETER :: B1N1Fn = 1006 - INTEGER(IntKi), PARAMETER :: B1N2Fn = 1007 - INTEGER(IntKi), PARAMETER :: B1N3Fn = 1008 - INTEGER(IntKi), PARAMETER :: B1N4Fn = 1009 - INTEGER(IntKi), PARAMETER :: B1N5Fn = 1010 - INTEGER(IntKi), PARAMETER :: B1N6Fn = 1011 - INTEGER(IntKi), PARAMETER :: B1N7Fn = 1012 - INTEGER(IntKi), PARAMETER :: B1N8Fn = 1013 - INTEGER(IntKi), PARAMETER :: B1N9Fn = 1014 - INTEGER(IntKi), PARAMETER :: B2N1Fn = 1015 - INTEGER(IntKi), PARAMETER :: B2N2Fn = 1016 - INTEGER(IntKi), PARAMETER :: B2N3Fn = 1017 - INTEGER(IntKi), PARAMETER :: B2N4Fn = 1018 - INTEGER(IntKi), PARAMETER :: B2N5Fn = 1019 - INTEGER(IntKi), PARAMETER :: B2N6Fn = 1020 - INTEGER(IntKi), PARAMETER :: B2N7Fn = 1021 - INTEGER(IntKi), PARAMETER :: B2N8Fn = 1022 - INTEGER(IntKi), PARAMETER :: B2N9Fn = 1023 - INTEGER(IntKi), PARAMETER :: B3N1Fn = 1024 - INTEGER(IntKi), PARAMETER :: B3N2Fn = 1025 - INTEGER(IntKi), PARAMETER :: B3N3Fn = 1026 - INTEGER(IntKi), PARAMETER :: B3N4Fn = 1027 - INTEGER(IntKi), PARAMETER :: B3N5Fn = 1028 - INTEGER(IntKi), PARAMETER :: B3N6Fn = 1029 - INTEGER(IntKi), PARAMETER :: B3N7Fn = 1030 - INTEGER(IntKi), PARAMETER :: B3N8Fn = 1031 - INTEGER(IntKi), PARAMETER :: B3N9Fn = 1032 - INTEGER(IntKi), PARAMETER :: B1N1Ft = 1033 - INTEGER(IntKi), PARAMETER :: B1N2Ft = 1034 - INTEGER(IntKi), PARAMETER :: B1N3Ft = 1035 - INTEGER(IntKi), PARAMETER :: B1N4Ft = 1036 - INTEGER(IntKi), PARAMETER :: B1N5Ft = 1037 - INTEGER(IntKi), PARAMETER :: B1N6Ft = 1038 - INTEGER(IntKi), PARAMETER :: B1N7Ft = 1039 - INTEGER(IntKi), PARAMETER :: B1N8Ft = 1040 - INTEGER(IntKi), PARAMETER :: B1N9Ft = 1041 - INTEGER(IntKi), PARAMETER :: B2N1Ft = 1042 - INTEGER(IntKi), PARAMETER :: B2N2Ft = 1043 - INTEGER(IntKi), PARAMETER :: B2N3Ft = 1044 - INTEGER(IntKi), PARAMETER :: B2N4Ft = 1045 - INTEGER(IntKi), PARAMETER :: B2N5Ft = 1046 - INTEGER(IntKi), PARAMETER :: B2N6Ft = 1047 - INTEGER(IntKi), PARAMETER :: B2N7Ft = 1048 - INTEGER(IntKi), PARAMETER :: B2N8Ft = 1049 - INTEGER(IntKi), PARAMETER :: B2N9Ft = 1050 - INTEGER(IntKi), PARAMETER :: B3N1Ft = 1051 - INTEGER(IntKi), PARAMETER :: B3N2Ft = 1052 - INTEGER(IntKi), PARAMETER :: B3N3Ft = 1053 - INTEGER(IntKi), PARAMETER :: B3N4Ft = 1054 - INTEGER(IntKi), PARAMETER :: B3N5Ft = 1055 - INTEGER(IntKi), PARAMETER :: B3N6Ft = 1056 - INTEGER(IntKi), PARAMETER :: B3N7Ft = 1057 - INTEGER(IntKi), PARAMETER :: B3N8Ft = 1058 - INTEGER(IntKi), PARAMETER :: B3N9Ft = 1059 - INTEGER(IntKi), PARAMETER :: B1N1Clrnc = 1060 - INTEGER(IntKi), PARAMETER :: B1N2Clrnc = 1061 - INTEGER(IntKi), PARAMETER :: B1N3Clrnc = 1062 - INTEGER(IntKi), PARAMETER :: B1N4Clrnc = 1063 - INTEGER(IntKi), PARAMETER :: B1N5Clrnc = 1064 - INTEGER(IntKi), PARAMETER :: B1N6Clrnc = 1065 - INTEGER(IntKi), PARAMETER :: B1N7Clrnc = 1066 - INTEGER(IntKi), PARAMETER :: B1N8Clrnc = 1067 - INTEGER(IntKi), PARAMETER :: B1N9Clrnc = 1068 - INTEGER(IntKi), PARAMETER :: B2N1Clrnc = 1069 - INTEGER(IntKi), PARAMETER :: B2N2Clrnc = 1070 - INTEGER(IntKi), PARAMETER :: B2N3Clrnc = 1071 - INTEGER(IntKi), PARAMETER :: B2N4Clrnc = 1072 - INTEGER(IntKi), PARAMETER :: B2N5Clrnc = 1073 - INTEGER(IntKi), PARAMETER :: B2N6Clrnc = 1074 - INTEGER(IntKi), PARAMETER :: B2N7Clrnc = 1075 - INTEGER(IntKi), PARAMETER :: B2N8Clrnc = 1076 - INTEGER(IntKi), PARAMETER :: B2N9Clrnc = 1077 - INTEGER(IntKi), PARAMETER :: B3N1Clrnc = 1078 - INTEGER(IntKi), PARAMETER :: B3N2Clrnc = 1079 - INTEGER(IntKi), PARAMETER :: B3N3Clrnc = 1080 - INTEGER(IntKi), PARAMETER :: B3N4Clrnc = 1081 - INTEGER(IntKi), PARAMETER :: B3N5Clrnc = 1082 - INTEGER(IntKi), PARAMETER :: B3N6Clrnc = 1083 - INTEGER(IntKi), PARAMETER :: B3N7Clrnc = 1084 - INTEGER(IntKi), PARAMETER :: B3N8Clrnc = 1085 - INTEGER(IntKi), PARAMETER :: B3N9Clrnc = 1086 - - - ! Rotor: - - INTEGER(IntKi), PARAMETER :: RtSpeed = 1087 - INTEGER(IntKi), PARAMETER :: RtTSR = 1088 - INTEGER(IntKi), PARAMETER :: RtVAvgxh = 1089 - INTEGER(IntKi), PARAMETER :: RtVAvgyh = 1090 - INTEGER(IntKi), PARAMETER :: RtVAvgzh = 1091 - INTEGER(IntKi), PARAMETER :: RtSkew = 1092 - INTEGER(IntKi), PARAMETER :: RtAeroFxh = 1093 - INTEGER(IntKi), PARAMETER :: RtAeroFyh = 1094 - INTEGER(IntKi), PARAMETER :: RtAeroFzh = 1095 - INTEGER(IntKi), PARAMETER :: RtAeroMxh = 1096 - INTEGER(IntKi), PARAMETER :: RtAeroMyh = 1097 - INTEGER(IntKi), PARAMETER :: RtAeroMzh = 1098 - INTEGER(IntKi), PARAMETER :: RtAeroPwr = 1099 - INTEGER(IntKi), PARAMETER :: RtArea = 1100 - INTEGER(IntKi), PARAMETER :: RtAeroCp = 1101 - INTEGER(IntKi), PARAMETER :: RtAeroCq = 1102 - INTEGER(IntKi), PARAMETER :: RtAeroCt = 1103 - - - ! The maximum number of output channels which can be output by the code. - INTEGER(IntKi), PARAMETER :: MaxOutPts = 1103 - -!End of code generated by Matlab script -! =================================================================================================== - - INTEGER, PARAMETER :: TwNVUnd(3, 9) = RESHAPE( (/ & ! Undisturbed wind velocity - TwN1VUndx,TwN1VUndy,TwN1VUndz, & - TwN2VUndx,TwN2VUndy,TwN2VUndz, & - TwN3VUndx,TwN3VUndy,TwN3VUndz, & - TwN4VUndx,TwN4VUndy,TwN4VUndz, & - TwN5VUndx,TwN5VUndy,TwN5VUndz, & - TwN6VUndx,TwN6VUndy,TwN6VUndz, & - TwN7VUndx,TwN7VUndy,TwN7VUndz, & - TwN8VUndx,TwN8VUndy,TwN8VUndz, & - TwN9VUndx,TwN9VUndy,TwN9VUndz & - /), (/3, 9/) ) - INTEGER, PARAMETER :: TwNSTV(3, 9) = RESHAPE( (/ & ! Structural translational velocity - TwN1STVx,TwN1STVy,TwN1STVz, & - TwN2STVx,TwN2STVy,TwN2STVz, & - TwN3STVx,TwN3STVy,TwN3STVz, & - TwN4STVx,TwN4STVy,TwN4STVz, & - TwN5STVx,TwN5STVy,TwN5STVz, & - TwN6STVx,TwN6STVy,TwN6STVz, & - TwN7STVx,TwN7STVy,TwN7STVz, & - TwN8STVx,TwN8STVy,TwN8STVz, & - TwN9STVx,TwN9STVy,TwN9STVz & - /), (/3, 9/) ) - INTEGER, PARAMETER :: TwNVRel(9) = (/TwN1VRel,TwN2VRel,TwN3VRel,TwN4VRel,TwN5VRel,TwN6VRel,TwN7VRel,TwN8VRel,TwN9VRel/) ! relative wind speed - INTEGER, PARAMETER :: TwNDynP(9) = (/TwN1DynP,TwN2DynP,TwN3DynP,TwN4DynP,TwN5DynP,TwN6DynP,TwN7DynP,TwN8DynP,TwN9DynP/) ! dynamic pressure - INTEGER, PARAMETER :: TwNRe(9) = (/TwN1Re,TwN2Re,TwN3Re,TwN4Re,TwN5Re,TwN6Re,TwN7Re,TwN8Re,TwN9Re/) ! Reynolds number - INTEGER, PARAMETER :: TwNM(9) = (/TwN1M,TwN2M,TwN3M,TwN4M,TwN5M,TwN6M,TwN7M,TwN8M,TwN9M/) ! Mach number - INTEGER, PARAMETER :: TwNFdx(9) = (/TwN1Fdx,TwN2Fdx,TwN3Fdx,TwN4Fdx,TwN5Fdx,TwN6Fdx,TwN7Fdx,TwN8Fdx,TwN9Fdx/) ! x-component drag force per unit length - INTEGER, PARAMETER :: TwNFdy(9) = (/TwN1Fdy,TwN2Fdy,TwN3Fdy,TwN4Fdy,TwN5Fdy,TwN6Fdy,TwN7Fdy,TwN8Fdy,TwN9Fdy/) ! y-component drag force per unit length - INTEGER, PARAMETER :: BAzimuth(3) = (/B1Azimuth,B2Azimuth,B3Azimuth/) ! azimuth angle - INTEGER, PARAMETER :: BPitch(3) = (/B1Pitch, B2Pitch, B3Pitch/) ! pitch - - INTEGER, PARAMETER :: BNVUndx(9, 3) = RESHAPE( (/ & ! undisturbed wind velocity (x component) - B1N1VUndx,B1N2VUndx,B1N3VUndx,B1N4VUndx,B1N5VUndx,B1N6VUndx,B1N7VUndx,B1N8VUndx,B1N9VUndx, & - B2N1VUndx,B2N2VUndx,B2N3VUndx,B2N4VUndx,B2N5VUndx,B2N6VUndx,B2N7VUndx,B2N8VUndx,B2N9VUndx, & - B3N1VUndx,B3N2VUndx,B3N3VUndx,B3N4VUndx,B3N5VUndx,B3N6VUndx,B3N7VUndx,B3N8VUndx,B3N9VUndx & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNVUndy(9, 3) = RESHAPE( (/ & ! undisturbed wind velocity (y component) - B1N1VUndy,B1N2VUndy,B1N3VUndy,B1N4VUndy,B1N5VUndy,B1N6VUndy,B1N7VUndy,B1N8VUndy,B1N9VUndy, & - B2N1VUndy,B2N2VUndy,B2N3VUndy,B2N4VUndy,B2N5VUndy,B2N6VUndy,B2N7VUndy,B2N8VUndy,B2N9VUndy, & - B3N1VUndy,B3N2VUndy,B3N3VUndy,B3N4VUndy,B3N5VUndy,B3N6VUndy,B3N7VUndy,B3N8VUndy,B3N9VUndy & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNVUndz(9, 3) = RESHAPE( (/ & ! undisturbed wind velocity (z component) - B1N1VUndz,B1N2VUndz,B1N3VUndz,B1N4VUndz,B1N5VUndz,B1N6VUndz,B1N7VUndz,B1N8VUndz,B1N9VUndz, & - B2N1VUndz,B2N2VUndz,B2N3VUndz,B2N4VUndz,B2N5VUndz,B2N6VUndz,B2N7VUndz,B2N8VUndz,B2N9VUndz, & - B3N1VUndz,B3N2VUndz,B3N3VUndz,B3N4VUndz,B3N5VUndz,B3N6VUndz,B3N7VUndz,B3N8VUndz,B3N9VUndz & - /), (/9, 3/) ) - - INTEGER, PARAMETER :: BNVDisx(9, 3) = RESHAPE( (/ & ! disturbed wind velocity (x component) - B1N1VDisx,B1N2VDisx,B1N3VDisx,B1N4VDisx,B1N5VDisx,B1N6VDisx,B1N7VDisx,B1N8VDisx,B1N9VDisx, & - B2N1VDisx,B2N2VDisx,B2N3VDisx,B2N4VDisx,B2N5VDisx,B2N6VDisx,B2N7VDisx,B2N8VDisx,B2N9VDisx, & - B3N1VDisx,B3N2VDisx,B3N3VDisx,B3N4VDisx,B3N5VDisx,B3N6VDisx,B3N7VDisx,B3N8VDisx,B3N9VDisx & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNVDisy(9, 3) = RESHAPE( (/ & ! disturbed wind velocity (y component) - B1N1VDisy,B1N2VDisy,B1N3VDisy,B1N4VDisy,B1N5VDisy,B1N6VDisy,B1N7VDisy,B1N8VDisy,B1N9VDisy, & - B2N1VDisy,B2N2VDisy,B2N3VDisy,B2N4VDisy,B2N5VDisy,B2N6VDisy,B2N7VDisy,B2N8VDisy,B2N9VDisy, & - B3N1VDisy,B3N2VDisy,B3N3VDisy,B3N4VDisy,B3N5VDisy,B3N6VDisy,B3N7VDisy,B3N8VDisy,B3N9VDisy & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNVDisz(9, 3) = RESHAPE( (/ & ! disturbed wind velocity (z component) - B1N1VDisz,B1N2VDisz,B1N3VDisz,B1N4VDisz,B1N5VDisz,B1N6VDisz,B1N7VDisz,B1N8VDisz,B1N9VDisz, & - B2N1VDisz,B2N2VDisz,B2N3VDisz,B2N4VDisz,B2N5VDisz,B2N6VDisz,B2N7VDisz,B2N8VDisz,B2N9VDisz, & - B3N1VDisz,B3N2VDisz,B3N3VDisz,B3N4VDisz,B3N5VDisz,B3N6VDisz,B3N7VDisz,B3N8VDisz,B3N9VDisz & - /), (/9, 3/) ) - - INTEGER, PARAMETER :: BNSTVx(9, 3) = RESHAPE( (/ & ! structural translational velocity (x component) - B1N1STVx,B1N2STVx,B1N3STVx,B1N4STVx,B1N5STVx,B1N6STVx,B1N7STVx,B1N8STVx,B1N9STVx, & - B2N1STVx,B2N2STVx,B2N3STVx,B2N4STVx,B2N5STVx,B2N6STVx,B2N7STVx,B2N8STVx,B2N9STVx, & - B3N1STVx,B3N2STVx,B3N3STVx,B3N4STVx,B3N5STVx,B3N6STVx,B3N7STVx,B3N8STVx,B3N9STVx & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNSTVy(9, 3) = RESHAPE( (/ & ! structural translational velocity (y component) - B1N1STVy,B1N2STVy,B1N3STVy,B1N4STVy,B1N5STVy,B1N6STVy,B1N7STVy,B1N8STVy,B1N9STVy, & - B2N1STVy,B2N2STVy,B2N3STVy,B2N4STVy,B2N5STVy,B2N6STVy,B2N7STVy,B2N8STVy,B2N9STVy, & - B3N1STVy,B3N2STVy,B3N3STVy,B3N4STVy,B3N5STVy,B3N6STVy,B3N7STVy,B3N8STVy,B3N9STVy & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNSTVz(9, 3) = RESHAPE( (/ & ! structural translational velocity (z component) - B1N1STVz,B1N2STVz,B1N3STVz,B1N4STVz,B1N5STVz,B1N6STVz,B1N7STVz,B1N8STVz,B1N9STVz, & - B2N1STVz,B2N2STVz,B2N3STVz,B2N4STVz,B2N5STVz,B2N6STVz,B2N7STVz,B2N8STVz,B2N9STVz, & - B3N1STVz,B3N2STVz,B3N3STVz,B3N4STVz,B3N5STVz,B3N6STVz,B3N7STVz,B3N8STVz,B3N9STVz & - /), (/9, 3/) ) - - INTEGER, PARAMETER :: BNVRel(9, 3) = RESHAPE( (/ & ! relative wind speed - B1N1VRel,B1N2VRel,B1N3VRel,B1N4VRel,B1N5VRel,B1N6VRel,B1N7VRel,B1N8VRel,B1N9VRel, & - B2N1VRel,B2N2VRel,B2N3VRel,B2N4VRel,B2N5VRel,B2N6VRel,B2N7VRel,B2N8VRel,B2N9VRel, & - B3N1VRel,B3N2VRel,B3N3VRel,B3N4VRel,B3N5VRel,B3N6VRel,B3N7VRel,B3N8VRel,B3N9VRel & - /), (/9, 3/) ) - - INTEGER, PARAMETER :: BNDynP(9, 3) = RESHAPE( (/ & ! dynamic pressure - B1N1DynP,B1N2DynP,B1N3DynP,B1N4DynP,B1N5DynP,B1N6DynP,B1N7DynP,B1N8DynP,B1N9DynP, & - B2N1DynP,B2N2DynP,B2N3DynP,B2N4DynP,B2N5DynP,B2N6DynP,B2N7DynP,B2N8DynP,B2N9DynP, & - B3N1DynP,B3N2DynP,B3N3DynP,B3N4DynP,B3N5DynP,B3N6DynP,B3N7DynP,B3N8DynP,B3N9DynP & - /), (/9, 3/) ) - - INTEGER, PARAMETER :: BNRe(9, 3) = RESHAPE( (/ & ! Reynolds number - B1N1Re,B1N2Re,B1N3Re,B1N4Re,B1N5Re,B1N6Re,B1N7Re,B1N8Re,B1N9Re, & - B2N1Re,B2N2Re,B2N3Re,B2N4Re,B2N5Re,B2N6Re,B2N7Re,B2N8Re,B2N9Re, & - B3N1Re,B3N2Re,B3N3Re,B3N4Re,B3N5Re,B3N6Re,B3N7Re,B3N8Re,B3N9Re & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNM(9, 3) = RESHAPE( (/ & ! Mach number - B1N1M,B1N2M,B1N3M,B1N4M,B1N5M,B1N6M,B1N7M,B1N8M,B1N9M, & - B2N1M,B2N2M,B2N3M,B2N4M,B2N5M,B2N6M,B2N7M,B2N8M,B2N9M, & - B3N1M,B3N2M,B3N3M,B3N4M,B3N5M,B3N6M,B3N7M,B3N8M,B3N9M & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNVIndx(9, 3) = RESHAPE( (/ & ! axial induced wind velocity - B1N1VIndx,B1N2VIndx,B1N3VIndx,B1N4VIndx,B1N5VIndx,B1N6VIndx,B1N7VIndx,B1N8VIndx,B1N9VIndx, & - B2N1VIndx,B2N2VIndx,B2N3VIndx,B2N4VIndx,B2N5VIndx,B2N6VIndx,B2N7VIndx,B2N8VIndx,B2N9VIndx, & - B3N1VIndx,B3N2VIndx,B3N3VIndx,B3N4VIndx,B3N5VIndx,B3N6VIndx,B3N7VIndx,B3N8VIndx,B3N9VIndx & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNVIndy(9, 3) = RESHAPE( (/ & ! tangential induced wind velocity - B1N1VIndy,B1N2VIndy,B1N3VIndy,B1N4VIndy,B1N5VIndy,B1N6VIndy,B1N7VIndy,B1N8VIndy,B1N9VIndy, & - B2N1VIndy,B2N2VIndy,B2N3VIndy,B2N4VIndy,B2N5VIndy,B2N6VIndy,B2N7VIndy,B2N8VIndy,B2N9VIndy, & - B3N1VIndy,B3N2VIndy,B3N3VIndy,B3N4VIndy,B3N5VIndy,B3N6VIndy,B3N7VIndy,B3N8VIndy,B3N9VIndy & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNAxInd(9, 3) = RESHAPE( (/ & ! axial induction factor - B1N1AxInd,B1N2AxInd,B1N3AxInd,B1N4AxInd,B1N5AxInd,B1N6AxInd,B1N7AxInd,B1N8AxInd,B1N9AxInd, & - B2N1AxInd,B2N2AxInd,B2N3AxInd,B2N4AxInd,B2N5AxInd,B2N6AxInd,B2N7AxInd,B2N8AxInd,B2N9AxInd, & - B3N1AxInd,B3N2AxInd,B3N3AxInd,B3N4AxInd,B3N5AxInd,B3N6AxInd,B3N7AxInd,B3N8AxInd,B3N9AxInd & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNTnInd(9, 3) = RESHAPE( (/ & ! tangential induction factor - B1N1TnInd,B1N2TnInd,B1N3TnInd,B1N4TnInd,B1N5TnInd,B1N6TnInd,B1N7TnInd,B1N8TnInd,B1N9TnInd, & - B2N1TnInd,B2N2TnInd,B2N3TnInd,B2N4TnInd,B2N5TnInd,B2N6TnInd,B2N7TnInd,B2N8TnInd,B2N9TnInd, & - B3N1TnInd,B3N2TnInd,B3N3TnInd,B3N4TnInd,B3N5TnInd,B3N6TnInd,B3N7TnInd,B3N8TnInd,B3N9TnInd & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNAlpha(9, 3) = RESHAPE( (/ & ! angle of attach - B1N1Alpha,B1N2Alpha,B1N3Alpha,B1N4Alpha,B1N5Alpha,B1N6Alpha,B1N7Alpha,B1N8Alpha,B1N9Alpha, & - B2N1Alpha,B2N2Alpha,B2N3Alpha,B2N4Alpha,B2N5Alpha,B2N6Alpha,B2N7Alpha,B2N8Alpha,B2N9Alpha, & - B3N1Alpha,B3N2Alpha,B3N3Alpha,B3N4Alpha,B3N5Alpha,B3N6Alpha,B3N7Alpha,B3N8Alpha,B3N9Alpha & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNTheta(9, 3) = RESHAPE( (/ & ! pitch+twist angle - B1N1Theta,B1N2Theta,B1N3Theta,B1N4Theta,B1N5Theta,B1N6Theta,B1N7Theta,B1N8Theta,B1N9Theta, & - B2N1Theta,B2N2Theta,B2N3Theta,B2N4Theta,B2N5Theta,B2N6Theta,B2N7Theta,B2N8Theta,B2N9Theta, & - B3N1Theta,B3N2Theta,B3N3Theta,B3N4Theta,B3N5Theta,B3N6Theta,B3N7Theta,B3N8Theta,B3N9Theta & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNPhi(9, 3) = RESHAPE( (/ & ! inflow angle - B1N1Phi,B1N2Phi,B1N3Phi,B1N4Phi,B1N5Phi,B1N6Phi,B1N7Phi,B1N8Phi,B1N9Phi, & - B2N1Phi,B2N2Phi,B2N3Phi,B2N4Phi,B2N5Phi,B2N6Phi,B2N7Phi,B2N8Phi,B2N9Phi, & - B3N1Phi,B3N2Phi,B3N3Phi,B3N4Phi,B3N5Phi,B3N6Phi,B3N7Phi,B3N8Phi,B3N9Phi & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNCurve(9, 3) = RESHAPE( (/ & ! curvature angle - B1N1Curve,B1N2Curve,B1N3Curve,B1N4Curve,B1N5Curve,B1N6Curve,B1N7Curve,B1N8Curve,B1N9Curve, & - B2N1Curve,B2N2Curve,B2N3Curve,B2N4Curve,B2N5Curve,B2N6Curve,B2N7Curve,B2N8Curve,B2N9Curve, & - B3N1Curve,B3N2Curve,B3N3Curve,B3N4Curve,B3N5Curve,B3N6Curve,B3N7Curve,B3N8Curve,B3N9Curve & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNCl(9, 3) = RESHAPE( (/ & ! lift force coefficient - B1N1Cl,B1N2Cl,B1N3Cl,B1N4Cl,B1N5Cl,B1N6Cl,B1N7Cl,B1N8Cl,B1N9Cl, & - B2N1Cl,B2N2Cl,B2N3Cl,B2N4Cl,B2N5Cl,B2N6Cl,B2N7Cl,B2N8Cl,B2N9Cl, & - B3N1Cl,B3N2Cl,B3N3Cl,B3N4Cl,B3N5Cl,B3N6Cl,B3N7Cl,B3N8Cl,B3N9Cl & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNCd(9, 3) = RESHAPE( (/ & ! drag force coefficient - B1N1Cd,B1N2Cd,B1N3Cd,B1N4Cd,B1N5Cd,B1N6Cd,B1N7Cd,B1N8Cd,B1N9Cd, & - B2N1Cd,B2N2Cd,B2N3Cd,B2N4Cd,B2N5Cd,B2N6Cd,B2N7Cd,B2N8Cd,B2N9Cd, & - B3N1Cd,B3N2Cd,B3N3Cd,B3N4Cd,B3N5Cd,B3N6Cd,B3N7Cd,B3N8Cd,B3N9Cd & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNCm(9, 3) = RESHAPE( (/ & ! pitching moment coefficient - B1N1Cm,B1N2Cm,B1N3Cm,B1N4Cm,B1N5Cm,B1N6Cm,B1N7Cm,B1N8Cm,B1N9Cm, & - B2N1Cm,B2N2Cm,B2N3Cm,B2N4Cm,B2N5Cm,B2N6Cm,B2N7Cm,B2N8Cm,B2N9Cm, & - B3N1Cm,B3N2Cm,B3N3Cm,B3N4Cm,B3N5Cm,B3N6Cm,B3N7Cm,B3N8Cm,B3N9Cm & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNCx(9, 3) = RESHAPE( (/ & ! normal force (to plane) coefficient - B1N1Cx,B1N2Cx,B1N3Cx,B1N4Cx,B1N5Cx,B1N6Cx,B1N7Cx,B1N8Cx,B1N9Cx, & - B2N1Cx,B2N2Cx,B2N3Cx,B2N4Cx,B2N5Cx,B2N6Cx,B2N7Cx,B2N8Cx,B2N9Cx, & - B3N1Cx,B3N2Cx,B3N3Cx,B3N4Cx,B3N5Cx,B3N6Cx,B3N7Cx,B3N8Cx,B3N9Cx & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNCy(9, 3) = RESHAPE( (/ & ! tangential force (to plane) coefficient - B1N1Cy,B1N2Cy,B1N3Cy,B1N4Cy,B1N5Cy,B1N6Cy,B1N7Cy,B1N8Cy,B1N9Cy, & - B2N1Cy,B2N2Cy,B2N3Cy,B2N4Cy,B2N5Cy,B2N6Cy,B2N7Cy,B2N8Cy,B2N9Cy, & - B3N1Cy,B3N2Cy,B3N3Cy,B3N4Cy,B3N5Cy,B3N6Cy,B3N7Cy,B3N8Cy,B3N9Cy & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNCn(9, 3) = RESHAPE( (/ & ! normal force (to chord) coefficient - B1N1Cn,B1N2Cn,B1N3Cn,B1N4Cn,B1N5Cn,B1N6Cn,B1N7Cn,B1N8Cn,B1N9Cn, & - B2N1Cn,B2N2Cn,B2N3Cn,B2N4Cn,B2N5Cn,B2N6Cn,B2N7Cn,B2N8Cn,B2N9Cn, & - B3N1Cn,B3N2Cn,B3N3Cn,B3N4Cn,B3N5Cn,B3N6Cn,B3N7Cn,B3N8Cn,B3N9Cn & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNCt(9, 3) = RESHAPE( (/ & ! tangential force (to chord) coefficient - B1N1Ct,B1N2Ct,B1N3Ct,B1N4Ct,B1N5Ct,B1N6Ct,B1N7Ct,B1N8Ct,B1N9Ct, & - B2N1Ct,B2N2Ct,B2N3Ct,B2N4Ct,B2N5Ct,B2N6Ct,B2N7Ct,B2N8Ct,B2N9Ct, & - B3N1Ct,B3N2Ct,B3N3Ct,B3N4Ct,B3N5Ct,B3N6Ct,B3N7Ct,B3N8Ct,B3N9Ct & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNFl(9, 3) = RESHAPE( (/ & ! lift force per unit length - B1N1Fl,B1N2Fl,B1N3Fl,B1N4Fl,B1N5Fl,B1N6Fl,B1N7Fl,B1N8Fl,B1N9Fl, & - B2N1Fl,B2N2Fl,B2N3Fl,B2N4Fl,B2N5Fl,B2N6Fl,B2N7Fl,B2N8Fl,B2N9Fl, & - B3N1Fl,B3N2Fl,B3N3Fl,B3N4Fl,B3N5Fl,B3N6Fl,B3N7Fl,B3N8Fl,B3N9Fl & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNFd(9, 3) = RESHAPE( (/ & ! drag force per unit length - B1N1Fd,B1N2Fd,B1N3Fd,B1N4Fd,B1N5Fd,B1N6Fd,B1N7Fd,B1N8Fd,B1N9Fd, & - B2N1Fd,B2N2Fd,B2N3Fd,B2N4Fd,B2N5Fd,B2N6Fd,B2N7Fd,B2N8Fd,B2N9Fd, & - B3N1Fd,B3N2Fd,B3N3Fd,B3N4Fd,B3N5Fd,B3N6Fd,B3N7Fd,B3N8Fd,B3N9Fd & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNMm(9, 3) = RESHAPE( (/ & ! pitching moment per unit length - B1N1Mm,B1N2Mm,B1N3Mm,B1N4Mm,B1N5Mm,B1N6Mm,B1N7Mm,B1N8Mm,B1N9Mm, & - B2N1Mm,B2N2Mm,B2N3Mm,B2N4Mm,B2N5Mm,B2N6Mm,B2N7Mm,B2N8Mm,B2N9Mm, & - B3N1Mm,B3N2Mm,B3N3Mm,B3N4Mm,B3N5Mm,B3N6Mm,B3N7Mm,B3N8Mm,B3N9Mm & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNFx(9, 3) = RESHAPE( (/ & ! normal force (to plane) per unit length - B1N1Fx,B1N2Fx,B1N3Fx,B1N4Fx,B1N5Fx,B1N6Fx,B1N7Fx,B1N8Fx,B1N9Fx, & - B2N1Fx,B2N2Fx,B2N3Fx,B2N4Fx,B2N5Fx,B2N6Fx,B2N7Fx,B2N8Fx,B2N9Fx, & - B3N1Fx,B3N2Fx,B3N3Fx,B3N4Fx,B3N5Fx,B3N6Fx,B3N7Fx,B3N8Fx,B3N9Fx & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNFy(9, 3) = RESHAPE( (/ & ! tangential force (to plane) per unit length - B1N1Fy,B1N2Fy,B1N3Fy,B1N4Fy,B1N5Fy,B1N6Fy,B1N7Fy,B1N8Fy,B1N9Fy, & - B2N1Fy,B2N2Fy,B2N3Fy,B2N4Fy,B2N5Fy,B2N6Fy,B2N7Fy,B2N8Fy,B2N9Fy, & - B3N1Fy,B3N2Fy,B3N3Fy,B3N4Fy,B3N5Fy,B3N6Fy,B3N7Fy,B3N8Fy,B3N9Fy & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNFn(9, 3) = RESHAPE( (/ & ! normal force (to chord) per unit length - B1N1Fn,B1N2Fn,B1N3Fn,B1N4Fn,B1N5Fn,B1N6Fn,B1N7Fn,B1N8Fn,B1N9Fn, & - B2N1Fn,B2N2Fn,B2N3Fn,B2N4Fn,B2N5Fn,B2N6Fn,B2N7Fn,B2N8Fn,B2N9Fn, & - B3N1Fn,B3N2Fn,B3N3Fn,B3N4Fn,B3N5Fn,B3N6Fn,B3N7Fn,B3N8Fn,B3N9Fn & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNFt(9, 3) = RESHAPE( (/ & ! tangential force (to chord) per unit length - B1N1Ft,B1N2Ft,B1N3Ft,B1N4Ft,B1N5Ft,B1N6Ft,B1N7Ft,B1N8Ft,B1N9Ft, & - B2N1Ft,B2N2Ft,B2N3Ft,B2N4Ft,B2N5Ft,B2N6Ft,B2N7Ft,B2N8Ft,B2N9Ft, & - B3N1Ft,B3N2Ft,B3N3Ft,B3N4Ft,B3N5Ft,B3N6Ft,B3N7Ft,B3N8Ft,B3N9Ft & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNClrnc(9, 3) = RESHAPE( (/ & ! tower clearance - B1N1Clrnc,B1N2Clrnc,B1N3Clrnc,B1N4Clrnc,B1N5Clrnc,B1N6Clrnc,B1N7Clrnc,B1N8Clrnc,B1N9Clrnc, & - B2N1Clrnc,B2N2Clrnc,B2N3Clrnc,B2N4Clrnc,B2N5Clrnc,B2N6Clrnc,B2N7Clrnc,B2N8Clrnc,B2N9Clrnc, & - B3N1Clrnc,B3N2Clrnc,B3N3Clrnc,B3N4Clrnc,B3N5Clrnc,B3N6Clrnc,B3N7Clrnc,B3N8Clrnc,B3N9Clrnc & - /), (/9, 3/) ) - - - INTEGER(IntKi), PARAMETER :: MaxBl = 3 ! Maximum number of blades allowed in simulation - - ! model identifiers - integer(intKi), parameter :: ModelUnknown = -1 - - integer(intKi), parameter :: WakeMod_none = 0 - integer(intKi), parameter :: WakeMod_BEMT = 1 - - integer(intKi), parameter :: AFAeroMod_steady = 1 ! steady model - integer(intKi), parameter :: AFAeroMod_BL_unsteady = 2 ! Beddoes-Leishman unsteady model - - integer(intKi), parameter :: TwrPotent_none = 0 ! none - integer(intKi), parameter :: TwrPotent_baseline = 1 ! baseline potential flow - integer(intKi), parameter :: TwrPotent_Bak = 2 ! potential flow with Bak correction - -contains - - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Calc_WriteDbgOutput( p, u, m, y, ErrStat, ErrMsg ) - - TYPE(AD_ParameterType), INTENT(IN ) :: p ! The module parameters - TYPE(AD_InputType), INTENT(IN ) :: u ! inputs - TYPE(AD_MiscVarType), INTENT(INOUT) :: m ! misc variables - TYPE(AD_OutputType), INTENT(IN ) :: y ! outputs - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code - CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred - - ! local variables - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteOutput' - !INTEGER(intKi) :: ErrStat2 - !CHARACTER(ErrMsgLen) :: ErrMsg2 - - INTEGER(IntKi) :: j,k,i - REAL(ReKi) :: ct, st ! cosine, sine of theta - REAL(ReKi) :: cp, sp ! cosine, sine of phi - - - - ! start routine: - ErrStat = ErrID_None - ErrMsg = "" - - - - ! blade outputs - do k=1,p%numBlades - - ! m%AllOuts( BPitch( k) ) = calculated in SetInputsForBEMT - - do j=1,p%NumBlNds - - i = (k-1)*p%NumBlNds*23 + (j-1)*23 + 1 - - m%AllOuts( i ) = m%BEMT_u(indx)%theta(j,k)*R2D - m%AllOuts( i+1 ) = m%BEMT_u(indx)%psi(k)*R2D - m%AllOuts( i+2 ) = -m%BEMT_u(indx)%Vx(j,k) - m%AllOuts( i+3 ) = m%BEMT_u(indx)%Vy(j,k) - - m%AllOuts( i+4 ) = m%BEMT_y%axInduction(j,k) - m%AllOuts( i+5 ) = m%BEMT_y%tanInduction(j,k) - m%AllOuts( i+6 ) = m%BEMT_y%Vrel(j,k) - m%AllOuts( i+7 ) = m%BEMT_y%phi(j,k)*R2D - m%AllOuts( i+8 ) = (m%BEMT_y%phi(j,k) - m%BEMT_u(indx)%theta(j,k))*R2D - - - m%AllOuts( i+9 ) = m%BEMT_y%Cl(j,k) - m%AllOuts( i+10 ) = m%BEMT_y%Cd(j,k) - m%AllOuts( i+11 ) = m%BEMT_y%Cm(j,k) - m%AllOuts( i+12 ) = m%BEMT_y%Cx(j,k) - m%AllOuts( i+13 ) = m%BEMT_y%Cy(j,k) - - ct=cos(m%BEMT_u(indx)%theta(j,k)) - st=sin(m%BEMT_u(indx)%theta(j,k)) - m%AllOuts( i+14 ) = m%BEMT_y%Cx(j,k)*ct + m%BEMT_y%Cy(j,k)*st - m%AllOuts( i+15 ) = -m%BEMT_y%Cx(j,k)*st + m%BEMT_y%Cy(j,k)*ct - - cp=cos(m%BEMT_y%phi(j,k)) - sp=sin(m%BEMT_y%phi(j,k)) - m%AllOuts( i+16 ) = m%X(j,k)*cp - m%Y(j,k)*sp - m%AllOuts( i+17 ) = m%X(j,k)*sp + m%Y(j,k)*cp - m%AllOuts( i+18 ) = m%M(j,k) - m%AllOuts( i+19 ) = m%X(j,k) - m%AllOuts( i+20 ) = -m%Y(j,k) - m%AllOuts( i+21 ) = m%X(j,k)*ct - m%Y(j,k)*st - m%AllOuts( i+22 ) = -m%X(j,k)*st - m%Y(j,k)*ct - - end do ! nodes - end do ! blades - -END SUBROUTINE Calc_WriteDbgOutput - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Calc_WriteOutput( p, u, m, y, indx, ErrStat, ErrMsg ) - - TYPE(AD_ParameterType), INTENT(IN ) :: p ! The module parameters - TYPE(AD_InputType), INTENT(IN ) :: u ! inputs - TYPE(AD_MiscVarType), INTENT(INOUT) :: m ! misc variables - TYPE(AD_OutputType), INTENT(IN ) :: y ! outputs - integer, intent(in ) :: indx ! index into m%BEMT_u(indx) array; 1=t and 2=t+dt (but not checked here) - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code - CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred - - ! local variables - CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteOutput' - INTEGER(intKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - - INTEGER(IntKi) :: j,k,beta - REAL(ReKi) :: tmp(3) - REAL(ReKi) :: force(3) - REAL(ReKi) :: moment(3) - REAL(ReKi) :: denom, rmax - REAL(ReKi) :: ct, st ! cosine, sine of theta - REAL(ReKi) :: cp, sp ! cosine, sine of phi - - - - ! start routine: - ErrStat = ErrID_None - ErrMsg = "" - - ! tower outputs - do beta=1,p%NTwOuts - j = p%TwOutNd(beta) - - tmp = matmul( u%TowerMotion%Orientation(:,:,j) , u%InflowOnTower(:,j) ) - m%AllOuts( TwNVUnd(:,beta) ) = tmp - - tmp = matmul( u%TowerMotion%Orientation(:,:,j) , u%TowerMotion%TranslationVel(:,j) ) - m%AllOuts( TwNSTV(:,beta) ) = tmp - - m%AllOuts( TwNVrel(beta) ) = m%W_Twr(j) ! relative velocity - m%AllOuts( TwNDynP(beta) ) = 0.5 * p%AirDens * m%W_Twr(j)**2 ! dynamic pressure - m%AllOuts( TwNRe( beta) ) = p%TwrDiam(j) * m%W_Twr(j) / p%KinVisc / 1.0E6 ! reynolds number (in millions) - m%AllOuts( TwNM( beta) ) = m%W_Twr(j) / p%SpdSound ! Mach number - m%AllOuts( TwNFdx( beta) ) = m%X_Twr(j) - m%AllOuts( TwNFdy( beta) ) = m%Y_Twr(j) - - end do ! out nodes - - ! blade outputs - do k=1,p%numBlades - m%AllOuts( BAzimuth(k) ) = m%BEMT_u(indx)%psi(k)*R2D - ! m%AllOuts( BPitch( k) ) = calculated in SetInputsForBEMT - - do beta=1,p%NBlOuts - - j=p%BlOutNd(beta) - - - tmp = matmul( m%WithoutSweepPitchTwist(:,:,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) ) - 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) ) - m%AllOuts( BNSTVx( beta,k) ) = tmp(1) - m%AllOuts( BNSTVy( beta,k) ) = tmp(2) - m%AllOuts( BNSTVz( beta,k) ) = tmp(3) - - m%AllOuts( BNVrel( beta,k) ) = m%BEMT_y%Vrel(j,k) - m%AllOuts( BNDynP( beta,k) ) = 0.5 * p%airDens * m%BEMT_y%Vrel(j,k)**2 - m%AllOuts( BNRe( beta,k) ) = p%BEMT%chord(j,k) * m%BEMT_y%Vrel(j,k) / p%KinVisc / 1.0E6 - m%AllOuts( BNM( beta,k) ) = m%BEMT_y%Vrel(j,k) / p%SpdSound - - m%AllOuts( BNVIndx(beta,k) ) = - m%BEMT_u(indx)%Vx(j,k) * m%BEMT_y%axInduction( j,k) - m%AllOuts( BNVIndy(beta,k) ) = m%BEMT_u(indx)%Vy(j,k) * m%BEMT_y%tanInduction(j,k) - - m%AllOuts( BNAxInd(beta,k) ) = m%BEMT_y%axInduction(j,k) - m%AllOuts( BNTnInd(beta,k) ) = m%BEMT_y%tanInduction(j,k) - - m%AllOuts( BNAlpha(beta,k) ) = (m%BEMT_y%phi(j,k) - m%BEMT_u(indx)%theta(j,k))*R2D - m%AllOuts( BNTheta(beta,k) ) = m%BEMT_u(indx)%theta(j,k)*R2D - m%AllOuts( BNPhi( beta,k) ) = m%BEMT_y%phi(j,k)*R2D - m%AllOuts( BNCurve(beta,k) ) = m%Curve(j,k)*R2D - - !m%AllOuts( BNCl( beta,k) ) = m%BEMT_y%Cl(j,k) - !m%AllOuts( BNCd( beta,k) ) = m%BEMT_y%Cd(j,k) - cp=cos(m%BEMT_y%phi(j,k)) - sp=sin(m%BEMT_y%phi(j,k)) - m%AllOuts( BNCl( beta,k) ) = m%BEMT_y%Cx(j,k)*cp + m%BEMT_y%Cy(j,k)*sp - m%AllOuts( BNCd( beta,k) ) = m%BEMT_y%Cx(j,k)*sp - m%BEMT_y%Cy(j,k)*cp - m%AllOuts( BNCm( beta,k) ) = m%BEMT_y%Cm(j,k) - m%AllOuts( BNCx( beta,k) ) = m%BEMT_y%Cx(j,k) - m%AllOuts( BNCy( beta,k) ) = m%BEMT_y%Cy(j,k) - - ct=cos(m%BEMT_u(indx)%theta(j,k)) - st=sin(m%BEMT_u(indx)%theta(j,k)) - m%AllOuts( BNCn( beta,k) ) = m%BEMT_y%Cx(j,k)*ct + m%BEMT_y%Cy(j,k)*st - m%AllOuts( BNCt( beta,k) ) =-m%BEMT_y%Cx(j,k)*st + m%BEMT_y%Cy(j,k)*ct - - m%AllOuts( BNFl( beta,k) ) = m%X(j,k)*cp - m%Y(j,k)*sp - m%AllOuts( BNFd( beta,k) ) = m%X(j,k)*sp + m%Y(j,k)*cp - m%AllOuts( BNMm( beta,k) ) = m%M(j,k) - m%AllOuts( BNFx( beta,k) ) = m%X(j,k) - m%AllOuts( BNFy( beta,k) ) = -m%Y(j,k) - m%AllOuts( BNFn( beta,k) ) = m%X(j,k)*ct - m%Y(j,k)*st - m%AllOuts( BNFt( beta,k) ) = -m%X(j,k)*st - m%Y(j,k)*ct - - end do ! nodes - end do ! blades - - ! blade node tower clearance (requires tower influence calculation): - if (p%TwrPotent /= TwrPotent_none .or. p%TwrShadow) then - do k=1,p%numBlades - do beta=1,p%NBlOuts - j=p%BlOutNd(beta) - m%AllOuts( BNClrnc( beta,k) ) = m%TwrClrnc(j,k) - end do - end do - end if - - ! rotor outputs: - rmax = 0.0_ReKi - do k=1,p%NumBlades - do j=1,p%NumBlNds - rmax = max(rmax, m%BEMT_u(indx)%rLocal(j,k) ) - end do !j=nodes - end do !k=blades - - m%AllOuts( RtSpeed ) = m%BEMT_u(indx)%omega*RPS2RPM - m%AllOuts( RtArea ) = pi*rmax**2 - - tmp = matmul( u%HubMotion%Orientation(:,:,1), m%V_DiskAvg ) - m%AllOuts( RtVAvgxh ) = tmp(1) - m%AllOuts( RtVAvgyh ) = tmp(2) - m%AllOuts( RtVAvgzh ) = tmp(3) - - m%AllOuts( RtSkew ) = m%BEMT_u(indx)%chi0*R2D - - ! integrate force/moments over blades by performing mesh transfer to hub point: - force = 0.0_ReKi - moment = 0.0_ReKi - do k=1,p%NumBlades - call Transfer_Line2_to_Point( y%BladeLoad(k), m%HubLoad, m%B_L_2_H_P(k), ErrStat2, ErrMsg2, u%BladeMotion(k), u%HubMotion ) - force = force + m%HubLoad%force( :,1) - moment = moment + m%HubLoad%moment(:,1) - end do - tmp = matmul( u%HubMotion%Orientation(:,:,1), force ) - m%AllOuts( RtAeroFxh ) = tmp(1) - m%AllOuts( RtAeroFyh ) = tmp(2) - m%AllOuts( RtAeroFzh ) = tmp(3) - - tmp = matmul( u%HubMotion%Orientation(:,:,1), moment ) - m%AllOuts( RtAeroMxh ) = tmp(1) - m%AllOuts( RtAeroMyh ) = tmp(2) - m%AllOuts( RtAeroMzh ) = tmp(3) - - m%AllOuts( RtAeroPwr ) = m%BEMT_u(indx)%omega * m%AllOuts( RtAeroMxh ) - - - if ( EqualRealNos( m%V_dot_x, 0.0_ReKi ) ) then - m%AllOuts( RtTSR ) = 0.0_ReKi - m%AllOuts( RtAeroCp ) = 0.0_ReKi - m%AllOuts( RtAeroCq ) = 0.0_ReKi - m%AllOuts( RtAeroCt ) = 0.0_ReKi - else - denom = 0.5*p%AirDens*m%AllOuts( RtArea )*m%V_dot_x**2 - m%AllOuts( RtTSR ) = m%BEMT_u(indx)%omega * rmax / m%V_dot_x - - m%AllOuts( RtAeroCp ) = m%AllOuts( RtAeroPwr ) / (denom * m%V_dot_x) - m%AllOuts( RtAeroCq ) = m%AllOuts( RtAeroMxh ) / (denom * rmax) - m%AllOuts( RtAeroCt ) = m%AllOuts( RtAeroFxh ) / denom - end if - - -END SUBROUTINE Calc_WriteOutput -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadInputFiles( InputFileName, InputFileData, Default_DT, OutFileRoot, NumBlades, 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. -!.................................................................................................................................. - - ! Passed variables - REAL(DbKi), INTENT(IN) :: Default_DT ! The default DT (from glue code) - - CHARACTER(*), INTENT(IN) :: InputFileName ! Name of the input file - CHARACTER(*), INTENT(IN) :: OutFileRoot ! The rootname of all the output files written by this routine. - - TYPE(AD_InputFile), INTENT(OUT) :: InputFileData ! Data stored in the module's input file - INTEGER(IntKi), INTENT(OUT) :: UnEcho ! Unit number for the echo file - - INTEGER(IntKi), INTENT(IN) :: NumBlades ! Number of blades for this model - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! The error status code - CHARACTER(*), INTENT(OUT) :: ErrMsg ! The error message, if an error occurred - - ! local variables - - INTEGER(IntKi) :: I - INTEGER(IntKi) :: ErrStat2 ! The error status code - CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred - - CHARACTER(1024) :: ADBlFile(MaxBl) ! File that contains the blade information (specified in the primary input file) - CHARACTER(*), PARAMETER :: RoutineName = 'ReadInputFiles' - - - ! initialize values: - - ErrStat = ErrID_None - ErrMsg = '' - UnEcho = -1 - InputFileData%DTAero = Default_DT ! the glue code's suggested DT for the module (may be overwritten in ReadPrimaryFile()) - - ! get the primary/platform input-file data - ! sets UnEcho, ADBlFile - - CALL ReadPrimaryFile( InputFileName, InputFileData, ADBlFile, OutFileRoot, UnEcho, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - ! get the blade input-file data - - ALLOCATE( InputFileData%BladeProps( NumBlades ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating memory for BladeProps.", ErrStat, ErrMsg, RoutineName) - CALL Cleanup() - RETURN - END IF - - DO I=1,NumBlades - CALL ReadBladeInputs ( ADBlFile(I), InputFileData%BladeProps(I), UnEcho, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName//TRIM(':Blade')//TRIM(Num2LStr(I))) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - END DO - - - - CALL Cleanup ( ) - - -CONTAINS - !............................................................................................................................... - SUBROUTINE Cleanup() - ! This subroutine cleans up before exiting this subroutine - !............................................................................................................................... - - ! IF ( UnEcho > 0 ) CLOSE( UnEcho ) - - END SUBROUTINE Cleanup - -END SUBROUTINE ReadInputFiles -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnEc, ErrStat, ErrMsg ) -! This routine reads in the primary AeroDyn input file and places the values it reads in the InputFileData structure. -! It opens and prints to an echo file if requested. -!.................................................................................................................................. - - - implicit none - - ! Passed variables - integer(IntKi), intent(out) :: UnEc ! I/O unit for echo file. If > 0, file is open for writing. - integer(IntKi), intent(out) :: ErrStat ! Error status - - character(*), intent(out) :: ADBlFile(MaxBl) ! name of the files containing blade inputs - character(*), intent(in) :: InputFile ! Name of the file containing the primary input data - character(*), intent(out) :: ErrMsg ! Error message - character(*), intent(in) :: OutFileRoot ! The rootname of the echo file, possibly opened in this routine - - type(AD_InputFile), intent(inout) :: InputFileData ! All the data in the AeroDyn input file - - ! Local variables: - real(ReKi) :: TmpAry(3) ! array to help read tower properties table - integer(IntKi) :: I ! loop counter - integer(IntKi) :: UnIn ! Unit number for reading file - - integer(IntKi) :: ErrStat2, IOS ! Temporary Error status - logical :: Echo ! Determines if an echo file should be written - character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message - character(1024) :: PriPath ! Path name of the primary file - character(1024) :: FTitle ! "File Title": the 2nd line of the input file, which contains a description of its contents - character(200) :: Line ! Temporary storage of a line from the input file (to compare with "default") - character(*), parameter :: RoutineName = 'ReadPrimaryFile' - - - ! Initialize some variables: - ErrStat = ErrID_None - ErrMsg = "" - - UnEc = -1 - Echo = .FALSE. - CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - - CALL AllocAry( InputFileData%OutList, MaxOutPts, "Outlist", ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Get an available unit number for the file. - - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Open the Primary input file. - - CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - - ! Read the lines up/including to the "Echo" simulation control variable - ! If echo is FALSE, don't write these lines to the echo file. - ! If Echo is TRUE, rewind and write on the second try. - - I = 1 !set the number of times we've read the file - DO - !----------- HEADER ------------------------------------------------------------- - - CALL ReadCom( UnIn, InputFile, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ReadStr( UnIn, InputFile, FTitle, 'FTitle', 'File Header: File Description (line 2)', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - !----------- GENERAL OPTIONS ---------------------------------------------------- - - CALL ReadCom( UnIn, InputFile, 'Section Header: General Options', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Echo - Echo input to ".AD.ech". - - CALL ReadVar( UnIn, InputFile, Echo, 'Echo', 'Echo flag', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - IF (.NOT. Echo .OR. I > 1) EXIT !exit this loop - - ! Otherwise, open the echo file, then rewind the input file and echo everything we've read - - I = I + 1 ! make sure we do this only once (increment counter that says how many times we've read this file) - - CALL OpenEcho ( UnEc, TRIM(OutFileRoot)//'.ech', ErrStat2, ErrMsg2, AD_Ver ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - IF ( UnEc > 0 ) WRITE (UnEc,'(/,A,/)') 'Data from '//TRIM(AD_Ver%Name)//' primary input file "'//TRIM( InputFile )//'":' - - REWIND( UnIn, IOSTAT=ErrStat2 ) - IF (ErrStat2 /= 0_IntKi ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error rewinding file "'//TRIM(InputFile)//'".', ErrStat, ErrMsg, RoutineName ) - CALL Cleanup() - RETURN - END IF - - END DO - - IF (NWTC_VerboseLevel == NWTC_Verbose) THEN - CALL WrScr( ' Heading of the '//TRIM(AD_Ver%Name)//' input file: ' ) - CALL WrScr( ' '//TRIM( FTitle ) ) - END IF - - - ! DTAero - Time interval for aerodynamic calculations {or default} (s): - Line = "" - CALL ReadVar( UnIn, InputFile, Line, "DTAero", "Time interval for aerodynamic calculations {or default} (s)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL Conv2UC( Line ) - IF ( INDEX(Line, "DEFAULT" ) /= 1 ) THEN ! If it's not "default", read this variable; otherwise use the value already stored in InputFileData%DTAero - READ( Line, *, IOSTAT=IOS) InputFileData%DTAero - CALL CheckIOS ( IOS, InputFile, 'DTAero', NumType, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - ! WakeMod - Type of wake/induction model {0=none, 1=BEMT} (-): - CALL ReadVar( UnIn, InputFile, InputFileData%WakeMod, "WakeMod", "Type of wake/induction model {0=none, 1=BEMT} (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! AFAeroMod - Type of airfoil aerodynamics model {1=steady model, 2=Beddoes-Leishman unsteady model} (-): - CALL ReadVar( UnIn, InputFile, InputFileData%AFAeroMod, "AFAeroMod", "Type of airfoil aerodynamics model {1=steady model, 2=Beddoes-Leishman unsteady model} (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! TwrPotent - Type tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} (switch) : - CALL ReadVar( UnIn, InputFile, InputFileData%TwrPotent, "TwrPotent", "Type tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! TwrShadow - Calculate tower influence on wind based on downstream tower shadow? (flag) : - CALL ReadVar( UnIn, InputFile, InputFileData%TwrShadow, "TwrShadow", "Calculate tower influence on wind based on downstream tower shadow? (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! TwrAero - Calculate tower aerodynamic loads? (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%TwrAero, "TwrAero", "Calculate tower aerodynamic loads? (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! FrozenWake - Assume frozen wake during linearization? (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%FrozenWake, "FrozenWake", "Assume frozen wake during linearization? (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !----------- ENVIRONMENTAL CONDITIONS ------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Environmental Conditions', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! AirDens - Air density (kg/m^3): - CALL ReadVar( UnIn, InputFile, InputFileData%AirDens, "AirDens", "Air density (kg/m^3)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! KinVisc - Kinematic air viscosity (m^2/s): - CALL ReadVar( UnIn, InputFile, InputFileData%KinVisc, "KinVisc", "Kinematic air viscosity (m^2/s)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! SpdSound - Speed of sound (m/s): - CALL ReadVar( UnIn, InputFile, InputFileData%SpdSound, "SpdSound", "Speed of sound (m/s)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !----------- BLADE-ELEMENT/MOMENTUM THEORY OPTIONS ------------------------------ - CALL ReadCom( UnIn, InputFile, 'Section Header: Blade-Element/Momentum Theory Options', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! SkewMod - Type of skewed-wake correction model {1=uncoupled, 2=Pitt/Peters, 3=coupled} [used only when WakeMod=1] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%SkewMod, "SkewMod", "Type of skewed-wake correction model {1=uncoupled, 2=Pitt/Peters, 3=coupled} [used only when WakeMod=1] (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! TipLoss - Use the Prandtl tip-loss model? [used only when WakeMod=1] (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%TipLoss, "TipLoss", "Use the Prandtl tip-loss model? [used only when WakeMod=1] (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! HubLoss - Use the Prandtl hub-loss model? [used only when WakeMod=1] (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%HubLoss, "HubLoss", "Use the Prandtl hub-loss model? [used only when WakeMod=1] (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! TanInd - Include tangential induction in BEMT calculations? [used only when WakeMod=1] (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%TanInd, "TanInd", "Include tangential induction in BEMT calculations? [used only when WakeMod=1] (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! AIDrag - Include the drag term in the axial-induction calculation? [used only when WakeMod=1] (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%AIDrag, "AIDrag", "Include the drag term in the axial-induction calculation? [used only when WakeMod=1] (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! TIDrag - Include the drag term in the tangential-induction calculation? [used only when WakeMod=1 and TanInd=TRUE] (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%TIDrag, "TIDrag", "Include the drag term in the tangential-induction calculation? [used only when WakeMod=1 and TanInd=TRUE] (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! IndToler - Convergence tolerance for BEM induction factors (or "default"] [used only when WakeMod=1] (-): - Line = "" - CALL ReadVar( UnIn, InputFile, Line, "IndToler", "Convergence tolerance for BEM induction factors [used only when WakeMod=1] (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL Conv2UC( Line ) - IF ( INDEX(Line, "DEFAULT" ) /= 1 ) THEN ! If it's not "default", read this variable; otherwise set the value based on ReKi precision - READ( Line, *, IOSTAT=IOS) InputFileData%IndToler - CALL CheckIOS ( IOS, InputFile, 'IndToler', NumType, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - else - if (ReKi==SiKi) then - InputFileData%IndToler = 5E-5 - else - InputFileData%IndToler = 5D-10 - end if - END IF - - - - ! MaxIter - Maximum number of iteration steps [used only when WakeMod=1] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%MaxIter, "MaxIter", "Maximum number of iteration steps [used only when WakeMod=1] (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !----------- BEDDOES-LEISHMAN UNSTEADY AIRFOIL AERODYNAMICS OPTIONS ------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Beddoes-Leishman Unsteady Airfoil Aerodynamics Options', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! UAMod - Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez’s variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAreoMod=2] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%UAMod, "UAMod", "Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez’s variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAreoMod=2] (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! FLookup - Flag to indicate whether a lookup for f’ will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAreoMod=2] (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%FLookup, "FLookup", "Flag to indicate whether a lookup for f’ will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAreoMod=2] (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! UACutout - Angle-of-attach beyond which unsteady aerodynamics are disabled (deg) -! CALL ReadVar( UnIn, InputFile, InputFileData%UACutout, "FLookup", "Angle-of-attach beyond which unsteady aerodynamics are disabled (deg)", ErrStat2, ErrMsg2, UnEc) -! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !----------- AIRFOIL INFORMATION ------------------------------------------------ - CALL ReadCom( UnIn, InputFile, 'Section Header: Airfoil Information', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - ! InCol_Alfa - The column in the airfoil tables that contains the angle of attack (-): - CALL ReadVar( UnIn, InputFile, InputFileData%InCol_Alfa, "InCol_Alfa", "The column in the airfoil tables that contains the angle of attack (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! InCol_Cl - The column in the airfoil tables that contains the lift coefficient (-): - CALL ReadVar( UnIn, InputFile, InputFileData%InCol_Cl, "InCol_Cl", "The column in the airfoil tables that contains the lift coefficient (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! InCol_Cd - The column in the airfoil tables that contains the drag coefficient (-): - CALL ReadVar( UnIn, InputFile, InputFileData%InCol_Cd, "InCol_Cd", "The column in the airfoil tables that contains the drag coefficient (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! InCol_Cm - The column in the airfoil tables that contains the pitching-moment coefficient; use zero if there is no Cm column (-): - CALL ReadVar( UnIn, InputFile, InputFileData%InCol_Cm, "InCol_Cm", "The column in the airfoil tables that contains the pitching-moment coefficient; use zero if there is no Cm column (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! InCol_Cpmin - The column in the airfoil tables that contains the drag coefficient; use zero if there is no Cpmin column (-): - CALL ReadVar( UnIn, InputFile, InputFileData%InCol_Cpmin, "InCol_Cpmin", "The column in the airfoil tables that contains the drag coefficient; use zero if there is no Cpmin column (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! NumAFfiles - Number of airfoil files used (-): - CALL ReadVar( UnIn, InputFile, InputFileData%NumAFfiles, "NumAFfiles", "Number of airfoil files used (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! Allocate space to hold AFNames - ALLOCATE( InputFileData%AFNames(InputFileData%NumAFfiles), STAT=ErrStat2) - IF (ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, "Error allocating AFNames.", ErrStat, ErrMsg, RoutineName) - CALL Cleanup() - RETURN - END IF - - ! AFNames - Airfoil file names (NumAFfiles lines) (quoted strings): - DO I = 1,InputFileData%NumAFfiles - CALL ReadVar ( UnIn, InputFile, InputFileData%AFNames(I), 'AFNames('//TRIM(Num2Lstr(I))//')', 'Airfoil '//TRIM(Num2Lstr(I))//' file name', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( PathIsRelative( InputFileData%AFNames(I) ) ) InputFileData%AFNames(I) = TRIM(PriPath)//TRIM(InputFileData%AFNames(I)) - END DO - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !----------- ROTOR/BLADE PROPERTIES -------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Rotor/Blade Properties', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! UseBlCm - Include aerodynamic pitching moment in calculations? (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%UseBlCm, "UseBlCm", "Include aerodynamic pitching moment in calculations? (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! ! NumBlNds - Number of blade nodes used in the analysis (-): - !CALL ReadVar( UnIn, InputFile, InputFileData%NumBlNds, "NumBlNds", "Number of blade nodes used in the analysis (-)", ErrStat2, ErrMsg2, UnEc) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! IF ( ErrStat >= AbortErrLev ) RETURN - - ! ADBlFile - Names of files containing distributed aerodynamic properties for each blade (see AD_BladeInputFile type): - DO I = 1,MaxBl - CALL ReadVar ( UnIn, InputFile, ADBlFile(I), 'ADBlFile('//TRIM(Num2Lstr(I))//')', 'Name of file containing distributed aerodynamic properties for blade '//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( PathIsRelative( ADBlFile(I) ) ) ADBlFile(I) = TRIM(PriPath)//TRIM(ADBlFile(I)) - END DO - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !----------- TOWER INFLUENCE AND AERODYNAMICS ---------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Tower Influence and Aerodynamics', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! NumTwrNds - Number of tower nodes used in the analysis (-): - CALL ReadVar( UnIn, InputFile, InputFileData%NumTwrNds, "NumTwrNds", "Number of tower nodes used in the analysis (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - - !....... tower properties ................... - CALL ReadCom( UnIn, InputFile, 'Section Header: Tower Property Channels', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ReadCom( UnIn, InputFile, 'Section Header: Tower Property Units', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! allocate space for tower inputs: - CALL AllocAry( InputFileData%TwrElev, InputFileData%NumTwrNds, 'TwrElev', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( InputFileData%TwrDiam, InputFileData%NumTwrNds, 'TwrDiam', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( InputFileData%TwrCd, InputFileData%NumTwrNds, 'TwrCd', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Return on error if we didn't allocate space for the next inputs - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - DO I=1,InputFileData%NumTwrNds - call ReadAry ( UnIn, InputFile, TmpAry, 3, 'TwrNds', 'Properties for tower node ' & - //trim( Int2LStr( I ) )//'.', errStat2, errMsg2, UnEc ) - call setErrStat( errStat2, ErrMsg2 , errStat, ErrMsg , RoutineName ) - - InputFileData%TwrElev(I) = TmpAry( 1) - InputFileData%TwrDiam(I) = TmpAry( 2) - InputFileData%TwrCd(I) = TmpAry( 3) - END DO - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !----------- OUTPUTS ----------------------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Outputs', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! SumPrint - Generate a summary file listing input options and interpolated properties to .AD.sum? (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%SumPrint, "SumPrint", "Generate a summary file listing input options and interpolated properties to .AD.sum? (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! NBlOuts - Number of blade node outputs [0 - 9] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%NBlOuts, "NBlOuts", "Number of blade node outputs [0 - 9] (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - IF ( InputFileData%NBlOuts > SIZE(InputFileData%BlOutNd) ) THEN - CALL SetErrStat( ErrID_Warn, ' Warning: number of blade output nodes exceeds '//& - TRIM(Num2LStr(SIZE(InputFileData%BlOutNd))) //'.', ErrStat, ErrMsg, RoutineName ) - InputFileData%NBlOuts = SIZE(InputFileData%BlOutNd) - END IF - - ! BlOutNd - Blade nodes whose values will be output (-): - CALL ReadAry( UnIn, InputFile, InputFileData%BlOutNd, InputFileData%NBlOuts, "BlOutNd", "Blade nodes whose values will be output (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! NTwOuts - Number of tower node outputs [0 - 9] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%NTwOuts, "NTwOuts", "Number of tower node outputs [0 - 9] (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - IF ( InputFileData%NTwOuts > SIZE(InputFileData%TwOutNd) ) THEN - CALL SetErrStat( ErrID_Warn, ' Warning: number of tower output nodes exceeds '//& - TRIM(Num2LStr(SIZE(InputFileData%TwOutNd))) //'.', ErrStat, ErrMsg, RoutineName ) - InputFileData%NTwOuts = SIZE(InputFileData%TwOutNd) - END IF - - ! TwOutNd - Tower nodes whose values will be output (-): - CALL ReadAry( UnIn, InputFile, InputFileData%TwOutNd, InputFileData%NTwOuts, "TwOutNd", "Tower nodes whose values will be output (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !----------- OUTLIST ----------------------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! OutList - List of user-requested output channels (-): - CALL ReadOutputList ( UnIn, InputFile, InputFileData%OutList, InputFileData%NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - !---------------------- END OF FILE ----------------------------------------- - - CALL Cleanup( ) - RETURN - - -CONTAINS - !............................................................................................................................... - SUBROUTINE Cleanup() - ! This subroutine cleans up any local variables and closes input files - !............................................................................................................................... - - IF (UnIn > 0) CLOSE ( UnIn ) - - END SUBROUTINE Cleanup - !............................................................................................................................... -END SUBROUTINE ReadPrimaryFile -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, UnEc, ErrStat, ErrMsg ) -! This routine reads a blade input file. -!.................................................................................................................................. - - - ! Passed variables: - - 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) :: UnEc ! I/O unit for echo file. If present and > 0, write to UnEc - - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Error status - CHARACTER(*), INTENT(OUT) :: ErrMsg ! Error message - - - ! Local variables: - - INTEGER(IntKi) :: I ! A generic DO index. - INTEGER( IntKi ) :: UnIn ! Unit number for reading file - INTEGER(IntKi) :: ErrStat2 , IOS ! Temporary Error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Err msg - CHARACTER(*), PARAMETER :: RoutineName = 'ReadBladeInputs' - - ErrStat = ErrID_None - ErrMsg = "" - UnIn = -1 - - ! Allocate space for these variables - - - - - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - ! Open the input file for blade K. - - CALL OpenFInpFile ( UnIn, ADBlFile, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) RETURN - - - ! -------------- HEADER ------------------------------------------------------- - - ! Skip the header. - - CALL ReadCom ( UnIn, ADBlFile, 'unused blade file header line 1', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL ReadCom ( UnIn, ADBlFile, 'unused blade file header line 2', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! -------------- Blade properties table ------------------------------------------ - CALL ReadCom ( UnIn, ADBlFile, 'Section header: Blade Properties', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! NumBlNds - Number of blade nodes used in the analysis (-): - CALL ReadVar( UnIn, ADBlFile, BladeKInputFileData%NumBlNds, "NumBlNds", "Number of blade nodes used in the analysis (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - CALL ReadCom ( UnIn, ADBlFile, 'Table header: names', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL ReadCom ( UnIn, ADBlFile, 'Table header: units', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - IF ( ErrStat>= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - ! allocate space for blade inputs: - CALL AllocAry( BladeKInputFileData%BlSpn, BladeKInputFileData%NumBlNds, 'BlSpn', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( BladeKInputFileData%BlCrvAC, BladeKInputFileData%NumBlNds, 'BlCrvAC', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( BladeKInputFileData%BlSwpAC, BladeKInputFileData%NumBlNds, 'BlSwpAC', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( BladeKInputFileData%BlCrvAng,BladeKInputFileData%NumBlNds, 'BlCrvAng',ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( BladeKInputFileData%BlTwist, BladeKInputFileData%NumBlNds, 'BlTwist', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( BladeKInputFileData%BlChord, BladeKInputFileData%NumBlNds, 'BlChord', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( BladeKInputFileData%BlAFID, BladeKInputFileData%NumBlNds, 'BlAFID', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Return on error if we didn't allocate space for the next inputs - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - DO I=1,BladeKInputFileData%NumBlNds - READ( UnIn, *, IOStat=IOS ) BladeKInputFileData%BlSpn(I), BladeKInputFileData%BlCrvAC(I), BladeKInputFileData%BlSwpAC(I), & - BladeKInputFileData%BlCrvAng(I), BladeKInputFileData%BlTwist(I), BladeKInputFileData%BlChord(I), & - BladeKInputFileData%BlAFID(I) - CALL CheckIOS( IOS, ADBlFile, 'Blade properties row '//TRIM(Num2LStr(I)), NumType, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! Return on error if we couldn't read this line - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - IF (UnEc > 0) THEN - WRITE( UnEc, "(6(F9.4,1x),I9)", IOStat=IOS) BladeKInputFileData%BlSpn(I), BladeKInputFileData%BlCrvAC(I), BladeKInputFileData%BlSwpAC(I), & - BladeKInputFileData%BlCrvAng(I), BladeKInputFileData%BlTwist(I), BladeKInputFileData%BlChord(I), & - BladeKInputFileData%BlAFID(I) - END IF - END DO - BladeKInputFileData%BlCrvAng = BladeKInputFileData%BlCrvAng*D2R - BladeKInputFileData%BlTwist = BladeKInputFileData%BlTwist*D2R - - ! -------------- END OF FILE -------------------------------------------- - - CALL Cleanup() - RETURN - - -CONTAINS - !............................................................................................................................... - SUBROUTINE Cleanup() - ! This subroutine cleans up local variables and closes files - !............................................................................................................................... - - IF (UnIn > 0) CLOSE(UnIn) - - END SUBROUTINE Cleanup - -END SUBROUTINE ReadBladeInputs -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE AD_PrintSum( InputFileData, p, u, y, ErrStat, ErrMsg ) -! This routine generates the summary file, which contains a summary of input file options. - - ! passed variables - TYPE(AD_InputFile), INTENT(IN) :: InputFileData ! Input-file data - TYPE(AD_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD_InputType), INTENT(IN) :: u ! inputs - TYPE(AD_OutputType), INTENT(IN) :: y ! outputs - INTEGER(IntKi), INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMsg - - - ! Local variables. - - INTEGER(IntKi) :: I ! Index for the nodes. - INTEGER(IntKi) :: UnSu ! I/O unit number for the summary output file - - CHARACTER(*), PARAMETER :: FmtDat = '(A,T35,1(:,F13.3))' ! Format for outputting mass and modal data. - CHARACTER(*), PARAMETER :: FmtDatT = '(A,T35,1(:,F13.8))' ! Format for outputting time steps. - - CHARACTER(30) :: OutPFmt ! Format to print list of selected output channels to summary file - CHARACTER(100) :: Msg ! temporary string for writing appropriate text to summary file - - ! Open the summary file and give it a heading. - - CALL GetNewUnit( UnSu, ErrStat, ErrMsg ) - CALL OpenFOutFile ( UnSu, TRIM( p%RootName )//'.sum', ErrStat, ErrMsg ) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! Heading: - WRITE (UnSu,'(/,A)') 'This summary information was generated by '//TRIM( GetNVD(AD_Ver) )// & - ' on '//CurDate()//' at '//CurTime()//'.' - - WRITE (UnSu,'(/,A)') '====== General Options ============================================================================' - ! WakeMod - select case (p%WakeMod) - case (WakeMod_BEMT) - Msg = 'Blade-Element/Momentum Theory' - case (WakeMod_None) - Msg = 'steady' - case default - Msg = 'unknown' - end select - WRITE (UnSu,Ec_IntFrmt) p%WakeMod, 'WakeMod', 'Type of wake/induction model: '//TRIM(Msg) - - - ! AFAeroMod - select case (InputFileData%AFAeroMod) - case (AFAeroMod_BL_unsteady) - Msg = 'Beddoes-Leishman unsteady model' - case (AFAeroMod_steady) - Msg = 'steady' - case default - Msg = 'unknown' - end select - WRITE (UnSu,Ec_IntFrmt) InputFileData%AFAeroMod, 'AFAeroMod', 'Type of blade airfoil aerodynamics model: '//TRIM(Msg) - - - ! TwrPotent - select case (p%TwrPotent) - case (TwrPotent_baseline) - Msg = 'baseline potential flow' - case (TwrPotent_Bak) - Msg = 'potential flow with Bak correction' - case (TwrPotent_none) - Msg = 'none' - case default - Msg = 'unknown' - end select - WRITE (UnSu,Ec_IntFrmt) p%TwrPotent, 'TwrPotent', 'Type tower influence on wind based on potential flow around the tower: '//TRIM(Msg) - - - ! TwrShadow - if (p%TwrShadow) then - Msg = 'Yes' - else - Msg = 'No' - end if - WRITE (UnSu,Ec_LgFrmt) p%TwrShadow, 'TwrShadow', 'Calculate tower influence on wind based on downstream tower shadow? '//TRIM(Msg) - - - ! TwrAero - if (p%TwrAero) then - Msg = 'Yes' - else - Msg = 'No' - end if - WRITE (UnSu,Ec_LgFrmt) p%TwrAero, 'TwrAero', 'Calculate tower aerodynamic loads? '//TRIM(Msg) - - - if (p%WakeMod==WakeMod_BEMT) then - WRITE (UnSu,'(A)') '====== Blade-Element/Momentum Theory Options ======================================================' - - ! SkewMod - select case (InputFileData%SkewMod) - case (SkewMod_Uncoupled) - Msg = 'uncoupled' - case (SkewMod_PittPeters) - Msg = 'Pitt/Peters' - case default - Msg = 'unknown' - end select - WRITE (UnSu,Ec_IntFrmt) InputFileData%SkewMod, 'SkewMod', 'Type of skewed-wake correction model: '//TRIM(Msg) - - - ! TipLoss - if (InputFileData%TipLoss) then - Msg = 'Yes' - else - Msg = 'No' - end if - WRITE (UnSu,Ec_LgFrmt) InputFileData%TipLoss, 'TipLoss', "Use the Prandtl tip-loss model? "//TRIM(Msg) - - - ! HubLoss - if (InputFileData%HubLoss) then - Msg = 'Yes' - else - Msg = 'No' - end if - WRITE (UnSu,Ec_LgFrmt) InputFileData%HubLoss, 'HubLoss', "Use the Prandtl hub-loss model? "//TRIM(Msg) - - - ! TanInd - if (InputFileData%TanInd) then - Msg = 'Yes' - else - Msg = 'No' - end if - WRITE (UnSu,Ec_LgFrmt) InputFileData%TanInd, 'TanInd', "Include tangential induction in BEMT calculations? "//TRIM(Msg) - - - ! AIDrag - if (InputFileData%AIDrag) then - Msg = 'Yes' - else - Msg = 'No' - end if - WRITE (UnSu,Ec_LgFrmt) InputFileData%AIDrag, 'AIDrag', "Include the drag term in the axial-induction calculation? "//TRIM(Msg) - - ! TIDrag - if (InputFileData%TIDrag .and. InputFileData%TanInd) then - Msg = 'Yes' - else - Msg = 'No' - end if - WRITE (UnSu,Ec_LgFrmt) InputFileData%AIDrag, 'AIDrag', "Include the drag term in the tangential-induction calculation? "//TRIM(Msg) - - ! IndToler - WRITE (UnSu,Ec_ReFrmt) InputFileData%IndToler, 'IndToler', "Convergence tolerance for BEM induction factors (radians)" - - ! MaxIter - - end if - - if (InputFileData%AFAeroMod==AFAeroMod_BL_unsteady) then - WRITE (UnSu,'(A)') '====== Beddoes-Leishman Unsteady Airfoil Aerodynamics Options =====================================' - - ! UAMod - select case (InputFileData%UAMod) - case (1) - Msg = 'baseline model (original)' - case (2) - Msg = 'Gonzalez’s variant (changes in Cn, Cc, and Cm)' - case (3) - Msg = 'Minemma/Pierce variant (changes in Cc and Cm)' - !case (4) - ! Msg = 'DYSTOOL' - case default - Msg = 'unknown' - end select - WRITE (UnSu,Ec_IntFrmt) InputFileData%UAMod, 'UAMod', 'Unsteady Aero Model: '//TRIM(Msg) - - - ! FLookup - if (InputFileData%FLookup) then - Msg = 'Yes' - else - Msg = 'No, use best-fit exponential equations instead' - end if - WRITE (UnSu,Ec_LgFrmt) InputFileData%FLookup, 'FLookup', "Use a lookup for f'? "//TRIM(Msg) - - end if - - WRITE (UnSu,'(A)') '====== Outputs ====================================================================================' - - OutPFmt = '( 49X, I11, 2X, I13 )' - - WRITE(UnSu,Ec_IntFrmt) p%NBlOuts,'NBlOuts','Number of blade nodes selected for output' - if (p%NBlOuts > 0) then - WRITE(UnSu,Ec_IntFrmt) p%NumBlNds,'NumBlNds','Number of blade nodes in the analysis' - - WRITE (UnSu,"(15x,A)") 'Blade nodes selected for output: Output node Analysis node' - WRITE (UnSu,"(15x,A)") ' ----------- -------------' - DO I = 1,p%NBlOuts - WRITE (UnSu,OutPFmt) I, p%BlOutNd(I) - END DO - end if - - WRITE(UnSu,Ec_IntFrmt) p%NTwOuts,'NTwOuts','Number of tower nodes selected for output' - if (p%NTwOuts > 0) then - WRITE(UnSu,Ec_IntFrmt) p%NumTwrNds,'NumTwrNds','Number of tower nodes in the analysis' - WRITE (UnSu,"(15x,A)") 'Tower nodes selected for output: Output node Analysis node' - WRITE (UnSu,"(15x,A)") ' ----------- -------------' - DO I = 1,p%NTwOuts - WRITE (UnSu,OutPFmt) I, p%TwOutNd(I) - END DO - end if - - -#ifndef DBG_OUTS -! p%OutParam isn't allocated when DBG_OUTS is defined - - OutPFmt = '( 15x, I4, 2X, A '//TRIM(Num2LStr(ChanLen))//',1 X, A'//TRIM(Num2LStr(ChanLen))//' )' - WRITE (UnSu,'(15x,A)') 'Requested Output Channels:' - WRITE (UnSu,'(15x,A)') 'Col Parameter Units' - WRITE (UnSu,'(15x,A)') '---- --------- -----' - - DO I = 0,p%NumOuts - WRITE (UnSu,OutPFmt) I, p%OutParam(I)%Name, p%OutParam(I)%Units - END DO -#endif - - CLOSE(UnSu) - -RETURN -END SUBROUTINE AD_PrintSum -!---------------------------------------------------------------------------------------------------------------------------------- - - - -!********************************************************************************************************************************** -! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" -! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these -! lines should be modified in the Matlab script and/or Excel worksheet as necessary. -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine checks to see if any requested output channel names (stored in the OutList(:)) are invalid. It returns a -!! warning if any of the channels are not available outputs from the module. -!! It assigns the settings for OutParam(:) (i.e, the index, name, and units of the output channels, WriteOutput(:)). -!! the sign is set to 0 if the channel is invalid. -!! It sets assumes the value p%NumOuts has been set before this routine has been called, and it sets the values of p%OutParam here. -!! -!! This routine was generated by Write_ChckOutLst.m using the parameters listed in OutListParameters.xlsx at 11-Mar-2016 14:45:58. -SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) -!.................................................................................................................................. - - IMPLICIT NONE - - ! Passed variables - - CHARACTER(ChanLen), INTENT(IN) :: OutList(:) !< The list out user-requested outputs - TYPE(AD_ParameterType), INTENT(INOUT) :: p !< The module parameters - INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status code - CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if an error occurred - - ! Local variables - - INTEGER :: ErrStat2 ! temporary (local) error status - INTEGER :: I ! Generic loop-counting index - INTEGER :: INDX ! Index for valid arrays - - LOGICAL :: CheckOutListAgain ! Flag used to determine if output parameter starting with "M" is valid (or the negative of another parameter) - LOGICAL :: InvalidOutput(0:MaxOutPts) ! This array determines if the output channel is valid for this configuration - CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I) - CHARACTER(*), PARAMETER :: RoutineName = "SetOutParam" - - CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(1103) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically - "B1AZIMUTH","B1N1ALPHA","B1N1AXIND","B1N1CD ","B1N1CL ","B1N1CLRNC","B1N1CM ", & - "B1N1CN ","B1N1CT ","B1N1CURVE","B1N1CX ","B1N1CY ","B1N1DYNP ","B1N1FD ", & - "B1N1FL ","B1N1FN ","B1N1FT ","B1N1FX ","B1N1FY ","B1N1M ","B1N1MM ", & - "B1N1PHI ","B1N1RE ","B1N1STVX ","B1N1STVY ","B1N1STVZ ","B1N1THETA","B1N1TNIND", & - "B1N1VDISX","B1N1VDISY","B1N1VDISZ","B1N1VINDX","B1N1VINDY","B1N1VREL ","B1N1VUNDX", & - "B1N1VUNDY","B1N1VUNDZ","B1N2ALPHA","B1N2AXIND","B1N2CD ","B1N2CL ","B1N2CLRNC", & - "B1N2CM ","B1N2CN ","B1N2CT ","B1N2CURVE","B1N2CX ","B1N2CY ","B1N2DYNP ", & - "B1N2FD ","B1N2FL ","B1N2FN ","B1N2FT ","B1N2FX ","B1N2FY ","B1N2M ", & - "B1N2MM ","B1N2PHI ","B1N2RE ","B1N2STVX ","B1N2STVY ","B1N2STVZ ","B1N2THETA", & - "B1N2TNIND","B1N2VDISX","B1N2VDISY","B1N2VDISZ","B1N2VINDX","B1N2VINDY","B1N2VREL ", & - "B1N2VUNDX","B1N2VUNDY","B1N2VUNDZ","B1N3ALPHA","B1N3AXIND","B1N3CD ","B1N3CL ", & - "B1N3CLRNC","B1N3CM ","B1N3CN ","B1N3CT ","B1N3CURVE","B1N3CX ","B1N3CY ", & - "B1N3DYNP ","B1N3FD ","B1N3FL ","B1N3FN ","B1N3FT ","B1N3FX ","B1N3FY ", & - "B1N3M ","B1N3MM ","B1N3PHI ","B1N3RE ","B1N3STVX ","B1N3STVY ","B1N3STVZ ", & - "B1N3THETA","B1N3TNIND","B1N3VDISX","B1N3VDISY","B1N3VDISZ","B1N3VINDX","B1N3VINDY", & - "B1N3VREL ","B1N3VUNDX","B1N3VUNDY","B1N3VUNDZ","B1N4ALPHA","B1N4AXIND","B1N4CD ", & - "B1N4CL ","B1N4CLRNC","B1N4CM ","B1N4CN ","B1N4CT ","B1N4CURVE","B1N4CX ", & - "B1N4CY ","B1N4DYNP ","B1N4FD ","B1N4FL ","B1N4FN ","B1N4FT ","B1N4FX ", & - "B1N4FY ","B1N4M ","B1N4MM ","B1N4PHI ","B1N4RE ","B1N4STVX ","B1N4STVY ", & - "B1N4STVZ ","B1N4THETA","B1N4TNIND","B1N4VDISX","B1N4VDISY","B1N4VDISZ","B1N4VINDX", & - "B1N4VINDY","B1N4VREL ","B1N4VUNDX","B1N4VUNDY","B1N4VUNDZ","B1N5ALPHA","B1N5AXIND", & - "B1N5CD ","B1N5CL ","B1N5CLRNC","B1N5CM ","B1N5CN ","B1N5CT ","B1N5CURVE", & - "B1N5CX ","B1N5CY ","B1N5DYNP ","B1N5FD ","B1N5FL ","B1N5FN ","B1N5FT ", & - "B1N5FX ","B1N5FY ","B1N5M ","B1N5MM ","B1N5PHI ","B1N5RE ","B1N5STVX ", & - "B1N5STVY ","B1N5STVZ ","B1N5THETA","B1N5TNIND","B1N5VDISX","B1N5VDISY","B1N5VDISZ", & - "B1N5VINDX","B1N5VINDY","B1N5VREL ","B1N5VUNDX","B1N5VUNDY","B1N5VUNDZ","B1N6ALPHA", & - "B1N6AXIND","B1N6CD ","B1N6CL ","B1N6CLRNC","B1N6CM ","B1N6CN ","B1N6CT ", & - "B1N6CURVE","B1N6CX ","B1N6CY ","B1N6DYNP ","B1N6FD ","B1N6FL ","B1N6FN ", & - "B1N6FT ","B1N6FX ","B1N6FY ","B1N6M ","B1N6MM ","B1N6PHI ","B1N6RE ", & - "B1N6STVX ","B1N6STVY ","B1N6STVZ ","B1N6THETA","B1N6TNIND","B1N6VDISX","B1N6VDISY", & - "B1N6VDISZ","B1N6VINDX","B1N6VINDY","B1N6VREL ","B1N6VUNDX","B1N6VUNDY","B1N6VUNDZ", & - "B1N7ALPHA","B1N7AXIND","B1N7CD ","B1N7CL ","B1N7CLRNC","B1N7CM ","B1N7CN ", & - "B1N7CT ","B1N7CURVE","B1N7CX ","B1N7CY ","B1N7DYNP ","B1N7FD ","B1N7FL ", & - "B1N7FN ","B1N7FT ","B1N7FX ","B1N7FY ","B1N7M ","B1N7MM ","B1N7PHI ", & - "B1N7RE ","B1N7STVX ","B1N7STVY ","B1N7STVZ ","B1N7THETA","B1N7TNIND","B1N7VDISX", & - "B1N7VDISY","B1N7VDISZ","B1N7VINDX","B1N7VINDY","B1N7VREL ","B1N7VUNDX","B1N7VUNDY", & - "B1N7VUNDZ","B1N8ALPHA","B1N8AXIND","B1N8CD ","B1N8CL ","B1N8CLRNC","B1N8CM ", & - "B1N8CN ","B1N8CT ","B1N8CURVE","B1N8CX ","B1N8CY ","B1N8DYNP ","B1N8FD ", & - "B1N8FL ","B1N8FN ","B1N8FT ","B1N8FX ","B1N8FY ","B1N8M ","B1N8MM ", & - "B1N8PHI ","B1N8RE ","B1N8STVX ","B1N8STVY ","B1N8STVZ ","B1N8THETA","B1N8TNIND", & - "B1N8VDISX","B1N8VDISY","B1N8VDISZ","B1N8VINDX","B1N8VINDY","B1N8VREL ","B1N8VUNDX", & - "B1N8VUNDY","B1N8VUNDZ","B1N9ALPHA","B1N9AXIND","B1N9CD ","B1N9CL ","B1N9CLRNC", & - "B1N9CM ","B1N9CN ","B1N9CT ","B1N9CURVE","B1N9CX ","B1N9CY ","B1N9DYNP ", & - "B1N9FD ","B1N9FL ","B1N9FN ","B1N9FT ","B1N9FX ","B1N9FY ","B1N9M ", & - "B1N9MM ","B1N9PHI ","B1N9RE ","B1N9STVX ","B1N9STVY ","B1N9STVZ ","B1N9THETA", & - "B1N9TNIND","B1N9VDISX","B1N9VDISY","B1N9VDISZ","B1N9VINDX","B1N9VINDY","B1N9VREL ", & - "B1N9VUNDX","B1N9VUNDY","B1N9VUNDZ","B1PITCH ","B2AZIMUTH","B2N1ALPHA","B2N1AXIND", & - "B2N1CD ","B2N1CL ","B2N1CLRNC","B2N1CM ","B2N1CN ","B2N1CT ","B2N1CURVE", & - "B2N1CX ","B2N1CY ","B2N1DYNP ","B2N1FD ","B2N1FL ","B2N1FN ","B2N1FT ", & - "B2N1FX ","B2N1FY ","B2N1M ","B2N1MM ","B2N1PHI ","B2N1RE ","B2N1STVX ", & - "B2N1STVY ","B2N1STVZ ","B2N1THETA","B2N1TNIND","B2N1VDISX","B2N1VDISY","B2N1VDISZ", & - "B2N1VINDX","B2N1VINDY","B2N1VREL ","B2N1VUNDX","B2N1VUNDY","B2N1VUNDZ","B2N2ALPHA", & - "B2N2AXIND","B2N2CD ","B2N2CL ","B2N2CLRNC","B2N2CM ","B2N2CN ","B2N2CT ", & - "B2N2CURVE","B2N2CX ","B2N2CY ","B2N2DYNP ","B2N2FD ","B2N2FL ","B2N2FN ", & - "B2N2FT ","B2N2FX ","B2N2FY ","B2N2M ","B2N2MM ","B2N2PHI ","B2N2RE ", & - "B2N2STVX ","B2N2STVY ","B2N2STVZ ","B2N2THETA","B2N2TNIND","B2N2VDISX","B2N2VDISY", & - "B2N2VDISZ","B2N2VINDX","B2N2VINDY","B2N2VREL ","B2N2VUNDX","B2N2VUNDY","B2N2VUNDZ", & - "B2N3ALPHA","B2N3AXIND","B2N3CD ","B2N3CL ","B2N3CLRNC","B2N3CM ","B2N3CN ", & - "B2N3CT ","B2N3CURVE","B2N3CX ","B2N3CY ","B2N3DYNP ","B2N3FD ","B2N3FL ", & - "B2N3FN ","B2N3FT ","B2N3FX ","B2N3FY ","B2N3M ","B2N3MM ","B2N3PHI ", & - "B2N3RE ","B2N3STVX ","B2N3STVY ","B2N3STVZ ","B2N3THETA","B2N3TNIND","B2N3VDISX", & - "B2N3VDISY","B2N3VDISZ","B2N3VINDX","B2N3VINDY","B2N3VREL ","B2N3VUNDX","B2N3VUNDY", & - "B2N3VUNDZ","B2N4ALPHA","B2N4AXIND","B2N4CD ","B2N4CL ","B2N4CLRNC","B2N4CM ", & - "B2N4CN ","B2N4CT ","B2N4CURVE","B2N4CX ","B2N4CY ","B2N4DYNP ","B2N4FD ", & - "B2N4FL ","B2N4FN ","B2N4FT ","B2N4FX ","B2N4FY ","B2N4M ","B2N4MM ", & - "B2N4PHI ","B2N4RE ","B2N4STVX ","B2N4STVY ","B2N4STVZ ","B2N4THETA","B2N4TNIND", & - "B2N4VDISX","B2N4VDISY","B2N4VDISZ","B2N4VINDX","B2N4VINDY","B2N4VREL ","B2N4VUNDX", & - "B2N4VUNDY","B2N4VUNDZ","B2N5ALPHA","B2N5AXIND","B2N5CD ","B2N5CL ","B2N5CLRNC", & - "B2N5CM ","B2N5CN ","B2N5CT ","B2N5CURVE","B2N5CX ","B2N5CY ","B2N5DYNP ", & - "B2N5FD ","B2N5FL ","B2N5FN ","B2N5FT ","B2N5FX ","B2N5FY ","B2N5M ", & - "B2N5MM ","B2N5PHI ","B2N5RE ","B2N5STVX ","B2N5STVY ","B2N5STVZ ","B2N5THETA", & - "B2N5TNIND","B2N5VDISX","B2N5VDISY","B2N5VDISZ","B2N5VINDX","B2N5VINDY","B2N5VREL ", & - "B2N5VUNDX","B2N5VUNDY","B2N5VUNDZ","B2N6ALPHA","B2N6AXIND","B2N6CD ","B2N6CL ", & - "B2N6CLRNC","B2N6CM ","B2N6CN ","B2N6CT ","B2N6CURVE","B2N6CX ","B2N6CY ", & - "B2N6DYNP ","B2N6FD ","B2N6FL ","B2N6FN ","B2N6FT ","B2N6FX ","B2N6FY ", & - "B2N6M ","B2N6MM ","B2N6PHI ","B2N6RE ","B2N6STVX ","B2N6STVY ","B2N6STVZ ", & - "B2N6THETA","B2N6TNIND","B2N6VDISX","B2N6VDISY","B2N6VDISZ","B2N6VINDX","B2N6VINDY", & - "B2N6VREL ","B2N6VUNDX","B2N6VUNDY","B2N6VUNDZ","B2N7ALPHA","B2N7AXIND","B2N7CD ", & - "B2N7CL ","B2N7CLRNC","B2N7CM ","B2N7CN ","B2N7CT ","B2N7CURVE","B2N7CX ", & - "B2N7CY ","B2N7DYNP ","B2N7FD ","B2N7FL ","B2N7FN ","B2N7FT ","B2N7FX ", & - "B2N7FY ","B2N7M ","B2N7MM ","B2N7PHI ","B2N7RE ","B2N7STVX ","B2N7STVY ", & - "B2N7STVZ ","B2N7THETA","B2N7TNIND","B2N7VDISX","B2N7VDISY","B2N7VDISZ","B2N7VINDX", & - "B2N7VINDY","B2N7VREL ","B2N7VUNDX","B2N7VUNDY","B2N7VUNDZ","B2N8ALPHA","B2N8AXIND", & - "B2N8CD ","B2N8CL ","B2N8CLRNC","B2N8CM ","B2N8CN ","B2N8CT ","B2N8CURVE", & - "B2N8CX ","B2N8CY ","B2N8DYNP ","B2N8FD ","B2N8FL ","B2N8FN ","B2N8FT ", & - "B2N8FX ","B2N8FY ","B2N8M ","B2N8MM ","B2N8PHI ","B2N8RE ","B2N8STVX ", & - "B2N8STVY ","B2N8STVZ ","B2N8THETA","B2N8TNIND","B2N8VDISX","B2N8VDISY","B2N8VDISZ", & - "B2N8VINDX","B2N8VINDY","B2N8VREL ","B2N8VUNDX","B2N8VUNDY","B2N8VUNDZ","B2N9ALPHA", & - "B2N9AXIND","B2N9CD ","B2N9CL ","B2N9CLRNC","B2N9CM ","B2N9CN ","B2N9CT ", & - "B2N9CURVE","B2N9CX ","B2N9CY ","B2N9DYNP ","B2N9FD ","B2N9FL ","B2N9FN ", & - "B2N9FT ","B2N9FX ","B2N9FY ","B2N9M ","B2N9MM ","B2N9PHI ","B2N9RE ", & - "B2N9STVX ","B2N9STVY ","B2N9STVZ ","B2N9THETA","B2N9TNIND","B2N9VDISX","B2N9VDISY", & - "B2N9VDISZ","B2N9VINDX","B2N9VINDY","B2N9VREL ","B2N9VUNDX","B2N9VUNDY","B2N9VUNDZ", & - "B2PITCH ","B3AZIMUTH","B3N1ALPHA","B3N1AXIND","B3N1CD ","B3N1CL ","B3N1CLRNC", & - "B3N1CM ","B3N1CN ","B3N1CT ","B3N1CURVE","B3N1CX ","B3N1CY ","B3N1DYNP ", & - "B3N1FD ","B3N1FL ","B3N1FN ","B3N1FT ","B3N1FX ","B3N1FY ","B3N1M ", & - "B3N1MM ","B3N1PHI ","B3N1RE ","B3N1STVX ","B3N1STVY ","B3N1STVZ ","B3N1THETA", & - "B3N1TNIND","B3N1VDISX","B3N1VDISY","B3N1VDISZ","B3N1VINDX","B3N1VINDY","B3N1VREL ", & - "B3N1VUNDX","B3N1VUNDY","B3N1VUNDZ","B3N2ALPHA","B3N2AXIND","B3N2CD ","B3N2CL ", & - "B3N2CLRNC","B3N2CM ","B3N2CN ","B3N2CT ","B3N2CURVE","B3N2CX ","B3N2CY ", & - "B3N2DYNP ","B3N2FD ","B3N2FL ","B3N2FN ","B3N2FT ","B3N2FX ","B3N2FY ", & - "B3N2M ","B3N2MM ","B3N2PHI ","B3N2RE ","B3N2STVX ","B3N2STVY ","B3N2STVZ ", & - "B3N2THETA","B3N2TNIND","B3N2VDISX","B3N2VDISY","B3N2VDISZ","B3N2VINDX","B3N2VINDY", & - "B3N2VREL ","B3N2VUNDX","B3N2VUNDY","B3N2VUNDZ","B3N3ALPHA","B3N3AXIND","B3N3CD ", & - "B3N3CL ","B3N3CLRNC","B3N3CM ","B3N3CN ","B3N3CT ","B3N3CURVE","B3N3CX ", & - "B3N3CY ","B3N3DYNP ","B3N3FD ","B3N3FL ","B3N3FN ","B3N3FT ","B3N3FX ", & - "B3N3FY ","B3N3M ","B3N3MM ","B3N3PHI ","B3N3RE ","B3N3STVX ","B3N3STVY ", & - "B3N3STVZ ","B3N3THETA","B3N3TNIND","B3N3VDISX","B3N3VDISY","B3N3VDISZ","B3N3VINDX", & - "B3N3VINDY","B3N3VREL ","B3N3VUNDX","B3N3VUNDY","B3N3VUNDZ","B3N4ALPHA","B3N4AXIND", & - "B3N4CD ","B3N4CL ","B3N4CLRNC","B3N4CM ","B3N4CN ","B3N4CT ","B3N4CURVE", & - "B3N4CX ","B3N4CY ","B3N4DYNP ","B3N4FD ","B3N4FL ","B3N4FN ","B3N4FT ", & - "B3N4FX ","B3N4FY ","B3N4M ","B3N4MM ","B3N4PHI ","B3N4RE ","B3N4STVX ", & - "B3N4STVY ","B3N4STVZ ","B3N4THETA","B3N4TNIND","B3N4VDISX","B3N4VDISY","B3N4VDISZ", & - "B3N4VINDX","B3N4VINDY","B3N4VREL ","B3N4VUNDX","B3N4VUNDY","B3N4VUNDZ","B3N5ALPHA", & - "B3N5AXIND","B3N5CD ","B3N5CL ","B3N5CLRNC","B3N5CM ","B3N5CN ","B3N5CT ", & - "B3N5CURVE","B3N5CX ","B3N5CY ","B3N5DYNP ","B3N5FD ","B3N5FL ","B3N5FN ", & - "B3N5FT ","B3N5FX ","B3N5FY ","B3N5M ","B3N5MM ","B3N5PHI ","B3N5RE ", & - "B3N5STVX ","B3N5STVY ","B3N5STVZ ","B3N5THETA","B3N5TNIND","B3N5VDISX","B3N5VDISY", & - "B3N5VDISZ","B3N5VINDX","B3N5VINDY","B3N5VREL ","B3N5VUNDX","B3N5VUNDY","B3N5VUNDZ", & - "B3N6ALPHA","B3N6AXIND","B3N6CD ","B3N6CL ","B3N6CLRNC","B3N6CM ","B3N6CN ", & - "B3N6CT ","B3N6CURVE","B3N6CX ","B3N6CY ","B3N6DYNP ","B3N6FD ","B3N6FL ", & - "B3N6FN ","B3N6FT ","B3N6FX ","B3N6FY ","B3N6M ","B3N6MM ","B3N6PHI ", & - "B3N6RE ","B3N6STVX ","B3N6STVY ","B3N6STVZ ","B3N6THETA","B3N6TNIND","B3N6VDISX", & - "B3N6VDISY","B3N6VDISZ","B3N6VINDX","B3N6VINDY","B3N6VREL ","B3N6VUNDX","B3N6VUNDY", & - "B3N6VUNDZ","B3N7ALPHA","B3N7AXIND","B3N7CD ","B3N7CL ","B3N7CLRNC","B3N7CM ", & - "B3N7CN ","B3N7CT ","B3N7CURVE","B3N7CX ","B3N7CY ","B3N7DYNP ","B3N7FD ", & - "B3N7FL ","B3N7FN ","B3N7FT ","B3N7FX ","B3N7FY ","B3N7M ","B3N7MM ", & - "B3N7PHI ","B3N7RE ","B3N7STVX ","B3N7STVY ","B3N7STVZ ","B3N7THETA","B3N7TNIND", & - "B3N7VDISX","B3N7VDISY","B3N7VDISZ","B3N7VINDX","B3N7VINDY","B3N7VREL ","B3N7VUNDX", & - "B3N7VUNDY","B3N7VUNDZ","B3N8ALPHA","B3N8AXIND","B3N8CD ","B3N8CL ","B3N8CLRNC", & - "B3N8CM ","B3N8CN ","B3N8CT ","B3N8CURVE","B3N8CX ","B3N8CY ","B3N8DYNP ", & - "B3N8FD ","B3N8FL ","B3N8FN ","B3N8FT ","B3N8FX ","B3N8FY ","B3N8M ", & - "B3N8MM ","B3N8PHI ","B3N8RE ","B3N8STVX ","B3N8STVY ","B3N8STVZ ","B3N8THETA", & - "B3N8TNIND","B3N8VDISX","B3N8VDISY","B3N8VDISZ","B3N8VINDX","B3N8VINDY","B3N8VREL ", & - "B3N8VUNDX","B3N8VUNDY","B3N8VUNDZ","B3N9ALPHA","B3N9AXIND","B3N9CD ","B3N9CL ", & - "B3N9CLRNC","B3N9CM ","B3N9CN ","B3N9CT ","B3N9CURVE","B3N9CX ","B3N9CY ", & - "B3N9DYNP ","B3N9FD ","B3N9FL ","B3N9FN ","B3N9FT ","B3N9FX ","B3N9FY ", & - "B3N9M ","B3N9MM ","B3N9PHI ","B3N9RE ","B3N9STVX ","B3N9STVY ","B3N9STVZ ", & - "B3N9THETA","B3N9TNIND","B3N9VDISX","B3N9VDISY","B3N9VDISZ","B3N9VINDX","B3N9VINDY", & - "B3N9VREL ","B3N9VUNDX","B3N9VUNDY","B3N9VUNDZ","B3PITCH ","RTAEROCP ","RTAEROCQ ", & - "RTAEROCT ","RTAEROFXH","RTAEROFYH","RTAEROFZH","RTAEROMXH","RTAEROMYH","RTAEROMZH", & - "RTAEROPWR","RTAREA ","RTSKEW ","RTSPEED ","RTTSR ","RTVAVGXH ","RTVAVGYH ", & - "RTVAVGZH ","TWN1DYNP ","TWN1FDX ","TWN1FDY ","TWN1M ","TWN1RE ","TWN1STVX ", & - "TWN1STVY ","TWN1STVZ ","TWN1VREL ","TWN1VUNDX","TWN1VUNDY","TWN1VUNDZ","TWN2DYNP ", & - "TWN2FDX ","TWN2FDY ","TWN2M ","TWN2RE ","TWN2STVX ","TWN2STVY ","TWN2STVZ ", & - "TWN2VREL ","TWN2VUNDX","TWN2VUNDY","TWN2VUNDZ","TWN3DYNP ","TWN3FDX ","TWN3FDY ", & - "TWN3M ","TWN3RE ","TWN3STVX ","TWN3STVY ","TWN3STVZ ","TWN3VREL ","TWN3VUNDX", & - "TWN3VUNDY","TWN3VUNDZ","TWN4DYNP ","TWN4FDX ","TWN4FDY ","TWN4M ","TWN4RE ", & - "TWN4STVX ","TWN4STVY ","TWN4STVZ ","TWN4VREL ","TWN4VUNDX","TWN4VUNDY","TWN4VUNDZ", & - "TWN5DYNP ","TWN5FDX ","TWN5FDY ","TWN5M ","TWN5RE ","TWN5STVX ","TWN5STVY ", & - "TWN5STVZ ","TWN5VREL ","TWN5VUNDX","TWN5VUNDY","TWN5VUNDZ","TWN6DYNP ","TWN6FDX ", & - "TWN6FDY ","TWN6M ","TWN6RE ","TWN6STVX ","TWN6STVY ","TWN6STVZ ","TWN6VREL ", & - "TWN6VUNDX","TWN6VUNDY","TWN6VUNDZ","TWN7DYNP ","TWN7FDX ","TWN7FDY ","TWN7M ", & - "TWN7RE ","TWN7STVX ","TWN7STVY ","TWN7STVZ ","TWN7VREL ","TWN7VUNDX","TWN7VUNDY", & - "TWN7VUNDZ","TWN8DYNP ","TWN8FDX ","TWN8FDY ","TWN8M ","TWN8RE ","TWN8STVX ", & - "TWN8STVY ","TWN8STVZ ","TWN8VREL ","TWN8VUNDX","TWN8VUNDY","TWN8VUNDZ","TWN9DYNP ", & - "TWN9FDX ","TWN9FDY ","TWN9M ","TWN9RE ","TWN9STVX ","TWN9STVY ","TWN9STVZ ", & - "TWN9VREL ","TWN9VUNDX","TWN9VUNDY","TWN9VUNDZ"/) - INTEGER(IntKi), PARAMETER :: ParamIndxAry(1103) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) - B1Azimuth , B1N1Alpha , B1N1AxInd , B1N1Cd , B1N1Cl , B1N1Clrnc , B1N1Cm , & - B1N1Cn , B1N1Ct , B1N1Curve , B1N1Cx , B1N1Cy , B1N1DynP , B1N1Fd , & - B1N1Fl , B1N1Fn , B1N1Ft , B1N1Fx , B1N1Fy , B1N1M , B1N1Mm , & - B1N1Phi , B1N1Re , B1N1STVx , B1N1STVy , B1N1STVz , B1N1Theta , B1N1TnInd , & - B1N1VDisx , B1N1VDisy , B1N1VDisz , B1N1Vindx , B1N1Vindy , B1N1VRel , B1N1VUndx , & - B1N1VUndy , B1N1VUndz , B1N2Alpha , B1N2AxInd , B1N2Cd , B1N2Cl , B1N2Clrnc , & - B1N2Cm , B1N2Cn , B1N2Ct , B1N2Curve , B1N2Cx , B1N2Cy , B1N2DynP , & - B1N2Fd , B1N2Fl , B1N2Fn , B1N2Ft , B1N2Fx , B1N2Fy , B1N2M , & - B1N2Mm , B1N2Phi , B1N2Re , B1N2STVx , B1N2STVy , B1N2STVz , B1N2Theta , & - B1N2TnInd , B1N2VDisx , B1N2VDisy , B1N2VDisz , B1N2Vindx , B1N2Vindy , B1N2VRel , & - B1N2VUndx , B1N2VUndy , B1N2VUndz , B1N3Alpha , B1N3AxInd , B1N3Cd , B1N3Cl , & - B1N3Clrnc , B1N3Cm , B1N3Cn , B1N3Ct , B1N3Curve , B1N3Cx , B1N3Cy , & - B1N3DynP , B1N3Fd , B1N3Fl , B1N3Fn , B1N3Ft , B1N3Fx , B1N3Fy , & - B1N3M , B1N3Mm , B1N3Phi , B1N3Re , B1N3STVx , B1N3STVy , B1N3STVz , & - B1N3Theta , B1N3TnInd , B1N3VDisx , B1N3VDisy , B1N3VDisz , B1N3Vindx , B1N3Vindy , & - B1N3VRel , B1N3VUndx , B1N3VUndy , B1N3VUndz , B1N4Alpha , B1N4AxInd , B1N4Cd , & - B1N4Cl , B1N4Clrnc , B1N4Cm , B1N4Cn , B1N4Ct , B1N4Curve , B1N4Cx , & - B1N4Cy , B1N4DynP , B1N4Fd , B1N4Fl , B1N4Fn , B1N4Ft , B1N4Fx , & - B1N4Fy , B1N4M , B1N4Mm , B1N4Phi , B1N4Re , B1N4STVx , B1N4STVy , & - B1N4STVz , B1N4Theta , B1N4TnInd , B1N4VDisx , B1N4VDisy , B1N4VDisz , B1N4Vindx , & - B1N4Vindy , B1N4VRel , B1N4VUndx , B1N4VUndy , B1N4VUndz , B1N5Alpha , B1N5AxInd , & - B1N5Cd , B1N5Cl , B1N5Clrnc , B1N5Cm , B1N5Cn , B1N5Ct , B1N5Curve , & - B1N5Cx , B1N5Cy , B1N5DynP , B1N5Fd , B1N5Fl , B1N5Fn , B1N5Ft , & - B1N5Fx , B1N5Fy , B1N5M , B1N5Mm , B1N5Phi , B1N5Re , B1N5STVx , & - B1N5STVy , B1N5STVz , B1N5Theta , B1N5TnInd , B1N5VDisx , B1N5VDisy , B1N5VDisz , & - B1N5Vindx , B1N5Vindy , B1N5VRel , B1N5VUndx , B1N5VUndy , B1N5VUndz , B1N6Alpha , & - B1N6AxInd , B1N6Cd , B1N6Cl , B1N6Clrnc , B1N6Cm , B1N6Cn , B1N6Ct , & - B1N6Curve , B1N6Cx , B1N6Cy , B1N6DynP , B1N6Fd , B1N6Fl , B1N6Fn , & - B1N6Ft , B1N6Fx , B1N6Fy , B1N6M , B1N6Mm , B1N6Phi , B1N6Re , & - B1N6STVx , B1N6STVy , B1N6STVz , B1N6Theta , B1N6TnInd , B1N6VDisx , B1N6VDisy , & - B1N6VDisz , B1N6Vindx , B1N6Vindy , B1N6VRel , B1N6VUndx , B1N6VUndy , B1N6VUndz , & - B1N7Alpha , B1N7AxInd , B1N7Cd , B1N7Cl , B1N7Clrnc , B1N7Cm , B1N7Cn , & - B1N7Ct , B1N7Curve , B1N7Cx , B1N7Cy , B1N7DynP , B1N7Fd , B1N7Fl , & - B1N7Fn , B1N7Ft , B1N7Fx , B1N7Fy , B1N7M , B1N7Mm , B1N7Phi , & - B1N7Re , B1N7STVx , B1N7STVy , B1N7STVz , B1N7Theta , B1N7TnInd , B1N7VDisx , & - B1N7VDisy , B1N7VDisz , B1N7Vindx , B1N7Vindy , B1N7VRel , B1N7VUndx , B1N7VUndy , & - B1N7VUndz , B1N8Alpha , B1N8AxInd , B1N8Cd , B1N8Cl , B1N8Clrnc , B1N8Cm , & - B1N8Cn , B1N8Ct , B1N8Curve , B1N8Cx , B1N8Cy , B1N8DynP , B1N8Fd , & - B1N8Fl , B1N8Fn , B1N8Ft , B1N8Fx , B1N8Fy , B1N8M , B1N8Mm , & - B1N8Phi , B1N8Re , B1N8STVx , B1N8STVy , B1N8STVz , B1N8Theta , B1N8TnInd , & - B1N8VDisx , B1N8VDisy , B1N8VDisz , B1N8Vindx , B1N8Vindy , B1N8VRel , B1N8VUndx , & - B1N8VUndy , B1N8VUndz , B1N9Alpha , B1N9AxInd , B1N9Cd , B1N9Cl , B1N9Clrnc , & - B1N9Cm , B1N9Cn , B1N9Ct , B1N9Curve , B1N9Cx , B1N9Cy , B1N9DynP , & - B1N9Fd , B1N9Fl , B1N9Fn , B1N9Ft , B1N9Fx , B1N9Fy , B1N9M , & - B1N9Mm , B1N9Phi , B1N9Re , B1N9STVx , B1N9STVy , B1N9STVz , B1N9Theta , & - B1N9TnInd , B1N9VDisx , B1N9VDisy , B1N9VDisz , B1N9Vindx , B1N9Vindy , B1N9VRel , & - B1N9VUndx , B1N9VUndy , B1N9VUndz , B1Pitch , B2Azimuth , B2N1Alpha , B2N1AxInd , & - B2N1Cd , B2N1Cl , B2N1Clrnc , B2N1Cm , B2N1Cn , B2N1Ct , B2N1Curve , & - B2N1Cx , B2N1Cy , B2N1DynP , B2N1Fd , B2N1Fl , B2N1Fn , B2N1Ft , & - B2N1Fx , B2N1Fy , B2N1M , B2N1Mm , B2N1Phi , B2N1Re , B2N1STVx , & - B2N1STVy , B2N1STVz , B2N1Theta , B2N1TnInd , B2N1VDisx , B2N1VDisy , B2N1VDisz , & - B2N1Vindx , B2N1Vindy , B2N1VRel , B2N1VUndx , B2N1VUndy , B2N1VUndz , B2N2Alpha , & - B2N2AxInd , B2N2Cd , B2N2Cl , B2N2Clrnc , B2N2Cm , B2N2Cn , B2N2Ct , & - B2N2Curve , B2N2Cx , B2N2Cy , B2N2DynP , B2N2Fd , B2N2Fl , B2N2Fn , & - B2N2Ft , B2N2Fx , B2N2Fy , B2N2M , B2N2Mm , B2N2Phi , B2N2Re , & - B2N2STVx , B2N2STVy , B2N2STVz , B2N2Theta , B2N2TnInd , B2N2VDisx , B2N2VDisy , & - B2N2VDisz , B2N2Vindx , B2N2Vindy , B2N2VRel , B2N2VUndx , B2N2VUndy , B2N2VUndz , & - B2N3Alpha , B2N3AxInd , B2N3Cd , B2N3Cl , B2N3Clrnc , B2N3Cm , B2N3Cn , & - B2N3Ct , B2N3Curve , B2N3Cx , B2N3Cy , B2N3DynP , B2N3Fd , B2N3Fl , & - B2N3Fn , B2N3Ft , B2N3Fx , B2N3Fy , B2N3M , B2N3Mm , B2N3Phi , & - B2N3Re , B2N3STVx , B2N3STVy , B2N3STVz , B2N3Theta , B2N3TnInd , B2N3VDisx , & - B2N3VDisy , B2N3VDisz , B2N3Vindx , B2N3Vindy , B2N3VRel , B2N3VUndx , B2N3VUndy , & - B2N3VUndz , B2N4Alpha , B2N4AxInd , B2N4Cd , B2N4Cl , B2N4Clrnc , B2N4Cm , & - B2N4Cn , B2N4Ct , B2N4Curve , B2N4Cx , B2N4Cy , B2N4DynP , B2N4Fd , & - B2N4Fl , B2N4Fn , B2N4Ft , B2N4Fx , B2N4Fy , B2N4M , B2N4Mm , & - B2N4Phi , B2N4Re , B2N4STVx , B2N4STVy , B2N4STVz , B2N4Theta , B2N4TnInd , & - B2N4VDisx , B2N4VDisy , B2N4VDisz , B2N4Vindx , B2N4Vindy , B2N4VRel , B2N4VUndx , & - B2N4VUndy , B2N4VUndz , B2N5Alpha , B2N5AxInd , B2N5Cd , B2N5Cl , B2N5Clrnc , & - B2N5Cm , B2N5Cn , B2N5Ct , B2N5Curve , B2N5Cx , B2N5Cy , B2N5DynP , & - B2N5Fd , B2N5Fl , B2N5Fn , B2N5Ft , B2N5Fx , B2N5Fy , B2N5M , & - B2N5Mm , B2N5Phi , B2N5Re , B2N5STVx , B2N5STVy , B2N5STVz , B2N5Theta , & - B2N5TnInd , B2N5VDisx , B2N5VDisy , B2N5VDisz , B2N5Vindx , B2N5Vindy , B2N5VRel , & - B2N5VUndx , B2N5VUndy , B2N5VUndz , B2N6Alpha , B2N6AxInd , B2N6Cd , B2N6Cl , & - B2N6Clrnc , B2N6Cm , B2N6Cn , B2N6Ct , B2N6Curve , B2N6Cx , B2N6Cy , & - B2N6DynP , B2N6Fd , B2N6Fl , B2N6Fn , B2N6Ft , B2N6Fx , B2N6Fy , & - B2N6M , B2N6Mm , B2N6Phi , B2N6Re , B2N6STVx , B2N6STVy , B2N6STVz , & - B2N6Theta , B2N6TnInd , B2N6VDisx , B2N6VDisy , B2N6VDisz , B2N6Vindx , B2N6Vindy , & - B2N6VRel , B2N6VUndx , B2N6VUndy , B2N6VUndz , B2N7Alpha , B2N7AxInd , B2N7Cd , & - B2N7Cl , B2N7Clrnc , B2N7Cm , B2N7Cn , B2N7Ct , B2N7Curve , B2N7Cx , & - B2N7Cy , B2N7DynP , B2N7Fd , B2N7Fl , B2N7Fn , B2N7Ft , B2N7Fx , & - B2N7Fy , B2N7M , B2N7Mm , B2N7Phi , B2N7Re , B2N7STVx , B2N7STVy , & - B2N7STVz , B2N7Theta , B2N7TnInd , B2N7VDisx , B2N7VDisy , B2N7VDisz , B2N7Vindx , & - B2N7Vindy , B2N7VRel , B2N7VUndx , B2N7VUndy , B2N7VUndz , B2N8Alpha , B2N8AxInd , & - B2N8Cd , B2N8Cl , B2N8Clrnc , B2N8Cm , B2N8Cn , B2N8Ct , B2N8Curve , & - B2N8Cx , B2N8Cy , B2N8DynP , B2N8Fd , B2N8Fl , B2N8Fn , B2N8Ft , & - B2N8Fx , B2N8Fy , B2N8M , B2N8Mm , B2N8Phi , B2N8Re , B2N8STVx , & - B2N8STVy , B2N8STVz , B2N8Theta , B2N8TnInd , B2N8VDisx , B2N8VDisy , B2N8VDisz , & - B2N8Vindx , B2N8Vindy , B2N8VRel , B2N8VUndx , B2N8VUndy , B2N8VUndz , B2N9Alpha , & - B2N9AxInd , B2N9Cd , B2N9Cl , B2N9Clrnc , B2N9Cm , B2N9Cn , B2N9Ct , & - B2N9Curve , B2N9Cx , B2N9Cy , B2N9DynP , B2N9Fd , B2N9Fl , B2N9Fn , & - B2N9Ft , B2N9Fx , B2N9Fy , B2N9M , B2N9Mm , B2N9Phi , B2N9Re , & - B2N9STVx , B2N9STVy , B2N9STVz , B2N9Theta , B2N9TnInd , B2N9VDisx , B2N9VDisy , & - B2N9VDisz , B2N9Vindx , B2N9Vindy , B2N9VRel , B2N9VUndx , B2N9VUndy , B2N9VUndz , & - B2Pitch , B3Azimuth , B3N1Alpha , B3N1AxInd , B3N1Cd , B3N1Cl , B3N1Clrnc , & - B3N1Cm , B3N1Cn , B3N1Ct , B3N1Curve , B3N1Cx , B3N1Cy , B3N1DynP , & - B3N1Fd , B3N1Fl , B3N1Fn , B3N1Ft , B3N1Fx , B3N1Fy , B3N1M , & - B3N1Mm , B3N1Phi , B3N1Re , B3N1STVx , B3N1STVy , B3N1STVz , B3N1Theta , & - B3N1TnInd , B3N1VDisx , B3N1VDisy , B3N1VDisz , B3N1Vindx , B3N1Vindy , B3N1VRel , & - B3N1VUndx , B3N1VUndy , B3N1VUndz , B3N2Alpha , B3N2AxInd , B3N2Cd , B3N2Cl , & - B3N2Clrnc , B3N2Cm , B3N2Cn , B3N2Ct , B3N2Curve , B3N2Cx , B3N2Cy , & - B3N2DynP , B3N2Fd , B3N2Fl , B3N2Fn , B3N2Ft , B3N2Fx , B3N2Fy , & - B3N2M , B3N2Mm , B3N2Phi , B3N2Re , B3N2STVx , B3N2STVy , B3N2STVz , & - B3N2Theta , B3N2TnInd , B3N2VDisx , B3N2VDisy , B3N2VDisz , B3N2Vindx , B3N2Vindy , & - B3N2VRel , B3N2VUndx , B3N2VUndy , B3N2VUndz , B3N3Alpha , B3N3AxInd , B3N3Cd , & - B3N3Cl , B3N3Clrnc , B3N3Cm , B3N3Cn , B3N3Ct , B3N3Curve , B3N3Cx , & - B3N3Cy , B3N3DynP , B3N3Fd , B3N3Fl , B3N3Fn , B3N3Ft , B3N3Fx , & - B3N3Fy , B3N3M , B3N3Mm , B3N3Phi , B3N3Re , B3N3STVx , B3N3STVy , & - B3N3STVz , B3N3Theta , B3N3TnInd , B3N3VDisx , B3N3VDisy , B3N3VDisz , B3N3Vindx , & - B3N3Vindy , B3N3VRel , B3N3VUndx , B3N3VUndy , B3N3VUndz , B3N4Alpha , B3N4AxInd , & - B3N4Cd , B3N4Cl , B3N4Clrnc , B3N4Cm , B3N4Cn , B3N4Ct , B3N4Curve , & - B3N4Cx , B3N4Cy , B3N4DynP , B3N4Fd , B3N4Fl , B3N4Fn , B3N4Ft , & - B3N4Fx , B3N4Fy , B3N4M , B3N4Mm , B3N4Phi , B3N4Re , B3N4STVx , & - B3N4STVy , B3N4STVz , B3N4Theta , B3N4TnInd , B3N4VDisx , B3N4VDisy , B3N4VDisz , & - B3N4Vindx , B3N4Vindy , B3N4VRel , B3N4VUndx , B3N4VUndy , B3N4VUndz , B3N5Alpha , & - B3N5AxInd , B3N5Cd , B3N5Cl , B3N5Clrnc , B3N5Cm , B3N5Cn , B3N5Ct , & - B3N5Curve , B3N5Cx , B3N5Cy , B3N5DynP , B3N5Fd , B3N5Fl , B3N5Fn , & - B3N5Ft , B3N5Fx , B3N5Fy , B3N5M , B3N5Mm , B3N5Phi , B3N5Re , & - B3N5STVx , B3N5STVy , B3N5STVz , B3N5Theta , B3N5TnInd , B3N5VDisx , B3N5VDisy , & - B3N5VDisz , B3N5Vindx , B3N5Vindy , B3N5VRel , B3N5VUndx , B3N5VUndy , B3N5VUndz , & - B3N6Alpha , B3N6AxInd , B3N6Cd , B3N6Cl , B3N6Clrnc , B3N6Cm , B3N6Cn , & - B3N6Ct , B3N6Curve , B3N6Cx , B3N6Cy , B3N6DynP , B3N6Fd , B3N6Fl , & - B3N6Fn , B3N6Ft , B3N6Fx , B3N6Fy , B3N6M , B3N6Mm , B3N6Phi , & - B3N6Re , B3N6STVx , B3N6STVy , B3N6STVz , B3N6Theta , B3N6TnInd , B3N6VDisx , & - B3N6VDisy , B3N6VDisz , B3N6Vindx , B3N6Vindy , B3N6VRel , B3N6VUndx , B3N6VUndy , & - B3N6VUndz , B3N7Alpha , B3N7AxInd , B3N7Cd , B3N7Cl , B3N7Clrnc , B3N7Cm , & - B3N7Cn , B3N7Ct , B3N7Curve , B3N7Cx , B3N7Cy , B3N7DynP , B3N7Fd , & - B3N7Fl , B3N7Fn , B3N7Ft , B3N7Fx , B3N7Fy , B3N7M , B3N7Mm , & - B3N7Phi , B3N7Re , B3N7STVx , B3N7STVy , B3N7STVz , B3N7Theta , B3N7TnInd , & - B3N7VDisx , B3N7VDisy , B3N7VDisz , B3N7Vindx , B3N7Vindy , B3N7VRel , B3N7VUndx , & - B3N7VUndy , B3N7VUndz , B3N8Alpha , B3N8AxInd , B3N8Cd , B3N8Cl , B3N8Clrnc , & - B3N8Cm , B3N8Cn , B3N8Ct , B3N8Curve , B3N8Cx , B3N8Cy , B3N8DynP , & - B3N8Fd , B3N8Fl , B3N8Fn , B3N8Ft , B3N8Fx , B3N8Fy , B3N8M , & - B3N8Mm , B3N8Phi , B3N8Re , B3N8STVx , B3N8STVy , B3N8STVz , B3N8Theta , & - B3N8TnInd , B3N8VDisx , B3N8VDisy , B3N8VDisz , B3N8Vindx , B3N8Vindy , B3N8VRel , & - B3N8VUndx , B3N8VUndy , B3N8VUndz , B3N9Alpha , B3N9AxInd , B3N9Cd , B3N9Cl , & - B3N9Clrnc , B3N9Cm , B3N9Cn , B3N9Ct , B3N9Curve , B3N9Cx , B3N9Cy , & - B3N9DynP , B3N9Fd , B3N9Fl , B3N9Fn , B3N9Ft , B3N9Fx , B3N9Fy , & - B3N9M , B3N9Mm , B3N9Phi , B3N9Re , B3N9STVx , B3N9STVy , B3N9STVz , & - B3N9Theta , B3N9TnInd , B3N9VDisx , B3N9VDisy , B3N9VDisz , B3N9Vindx , B3N9Vindy , & - B3N9VRel , B3N9VUndx , B3N9VUndy , B3N9VUndz , B3Pitch , RtAeroCp , RtAeroCq , & - RtAeroCt , RtAeroFxh , RtAeroFyh , RtAeroFzh , RtAeroMxh , RtAeroMyh , RtAeroMzh , & - RtAeroPwr , RtArea , RtSkew , RtSpeed , RtTSR , RtVAvgxh , RtVAvgyh , & - RtVAvgzh , TwN1DynP , TwN1Fdx , TwN1Fdy , TwN1M , TwN1Re , TwN1STVx , & - TwN1STVy , TwN1STVz , TwN1Vrel , TwN1VUndx , TwN1VUndy , TwN1VUndz , TwN2DynP , & - TwN2Fdx , TwN2Fdy , TwN2M , TwN2Re , TwN2STVx , TwN2STVy , TwN2STVz , & - TwN2Vrel , TwN2VUndx , TwN2VUndy , TwN2VUndz , TwN3DynP , TwN3Fdx , TwN3Fdy , & - TwN3M , TwN3Re , TwN3STVx , TwN3STVy , TwN3STVz , TwN3Vrel , TwN3VUndx , & - TwN3VUndy , TwN3VUndz , TwN4DynP , TwN4Fdx , TwN4Fdy , TwN4M , TwN4Re , & - TwN4STVx , TwN4STVy , TwN4STVz , TwN4Vrel , TwN4VUndx , TwN4VUndy , TwN4VUndz , & - TwN5DynP , TwN5Fdx , TwN5Fdy , TwN5M , TwN5Re , TwN5STVx , TwN5STVy , & - TwN5STVz , TwN5Vrel , TwN5VUndx , TwN5VUndy , TwN5VUndz , TwN6DynP , TwN6Fdx , & - TwN6Fdy , TwN6M , TwN6Re , TwN6STVx , TwN6STVy , TwN6STVz , TwN6Vrel , & - TwN6VUndx , TwN6VUndy , TwN6VUndz , TwN7DynP , TwN7Fdx , TwN7Fdy , TwN7M , & - TwN7Re , TwN7STVx , TwN7STVy , TwN7STVz , TwN7Vrel , TwN7VUndx , TwN7VUndy , & - TwN7VUndz , TwN8DynP , TwN8Fdx , TwN8Fdy , TwN8M , TwN8Re , TwN8STVx , & - TwN8STVy , TwN8STVz , TwN8Vrel , TwN8VUndx , TwN8VUndy , TwN8VUndz , TwN9DynP , & - TwN9Fdx , TwN9Fdy , TwN9M , TwN9Re , TwN9STVx , TwN9STVy , TwN9STVz , & - TwN9Vrel , TwN9VUndx , TwN9VUndy , TwN9VUndz /) - CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(1103) = (/ & ! This lists the units corresponding to the allowed parameters - "(deg) ","(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ", & - "(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ", & - "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ", & - "(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ", & - "(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ", & - "(m) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ", & - "(-) ","(m) ","(-) ","(-) ","(-) ","(deg) ","(-) ", & - "(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(-) ","(-) ","(m) ","(-) ","(-) ","(-) ","(deg) ", & - "(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(-) ","(-) ","(m) ","(-) ","(-) ","(-) ", & - "(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ","(-) ", & - "(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ", & - "(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ", & - "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ", & - "(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ", & - "(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(deg) ","(deg) ","(-) ", & - "(-) ","(-) ","(m) ","(-) ","(-) ","(-) ","(deg) ", & - "(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(-) ","(-) ","(m) ","(-) ","(-) ","(-) ", & - "(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ","(-) ", & - "(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ", & - "(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ", & - "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ", & - "(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ", & - "(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ", & - "(m) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ", & - "(-) ","(m) ","(-) ","(-) ","(-) ","(deg) ","(-) ", & - "(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(-) ","(-) ","(m) ","(-) ","(-) ","(-) ","(deg) ", & - "(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(-) ","(-) ","(m) ","(-) ","(-) ","(-) ", & - "(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(deg) ","(deg) ","(deg) ","(-) ","(-) ","(-) ","(m) ", & - "(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ", & - "(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ", & - "(m) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ", & - "(-) ","(m) ","(-) ","(-) ","(-) ","(deg) ","(-) ", & - "(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(-) ","(-) ","(m) ","(-) ","(-) ","(-) ","(deg) ", & - "(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(-) ","(-) ","(m) ","(-) ","(-) ","(-) ", & - "(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ","(-) ", & - "(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ", & - "(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ", & - "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ", & - "(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ", & - "(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ", & - "(m) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ", & - "(-) ","(N) ","(N) ","(N) ","(N·m) ","(N·m) ","(N·m) ", & - "(W) ","(m^2) ","(deg) ","(rpm) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(Pa) ","(N/m) ","(N/m) ","(-) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(Pa) ", & - "(N/m) ","(N/m) ","(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(Pa) ","(N/m) ","(N/m) ", & - "(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(Pa) ","(N/m) ","(N/m) ","(-) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(Pa) ","(N/m) ","(N/m) ","(-) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(Pa) ","(N/m) ", & - "(N/m) ","(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(Pa) ","(N/m) ","(N/m) ","(-) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(Pa) ","(N/m) ","(N/m) ","(-) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(Pa) ", & - "(N/m) ","(N/m) ","(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) "/) - - - ! Initialize values - ErrStat = ErrID_None - ErrMsg = "" - InvalidOutput = .FALSE. - - -! ..... Developer must add checking for invalid inputs here: ..... - !bjj: do we want to avoid outputting this if we haven't used tower aero? - - if ( p%TwrPotent == TwrPotent_none .and. .not. p%TwrShadow ) then - - ! BNClrnc is set only when we're computing the tower influence - do I = 1,MaxBl ! all blades (need to do this in a loop because we need the index of InvalidOutput to be an array of rank one) - InvalidOutput( BNClrnc(:,i) ) = .true. - end do - - end if - - - DO i = p%NTwOuts+1,9 ! Invalid tower nodes - - InvalidOutput( TwNVUnd(:,i) ) = .true. - InvalidOutput( TwNSTV( :,i) ) = .true. - InvalidOutput( TwNVRel( i) ) = .true. - InvalidOutput( TwNDynP( i) ) = .true. - InvalidOutput( TwNRe( i) ) = .true. - InvalidOutput( TwNM( i) ) = .true. - InvalidOutput( TwNFdx( i) ) = .true. - InvalidOutput( TwNFdy( i) ) = .true. - - END DO - - DO I = p%NumBlades+1,MaxBl ! Invalid blades - - InvalidOutput( BAzimuth( i) ) = .true. - InvalidOutput( BPitch( i) ) = .true. - InvalidOutput( BNVUndx(:,i) ) = .true. - InvalidOutput( BNVUndy(:,i) ) = .true. - InvalidOutput( BNVUndz(:,i) ) = .true. - InvalidOutput( BNVDisx(:,i) ) = .true. - InvalidOutput( BNVDisy(:,i) ) = .true. - InvalidOutput( BNVDisz(:,i) ) = .true. - InvalidOutput( BNSTVx( :,i) ) = .true. - InvalidOutput( BNSTVy( :,i) ) = .true. - InvalidOutput( BNSTVz( :,i) ) = .true. - InvalidOutput( BNVRel( :,i) ) = .true. - InvalidOutput( BNDynP( :,i) ) = .true. - InvalidOutput( BNRe( :,i) ) = .true. - InvalidOutput( BNM( :,i) ) = .true. - InvalidOutput( BNVIndx(:,i) ) = .true. - InvalidOutput( BNVIndy(:,i) ) = .true. - InvalidOutput( BNAxInd(:,i) ) = .true. - InvalidOutput( BNTnInd(:,i) ) = .true. - InvalidOutput( BNAlpha(:,i) ) = .true. - InvalidOutput( BNTheta(:,i) ) = .true. - InvalidOutput( BNPhi( :,i) ) = .true. - InvalidOutput( BNCurve(:,i) ) = .true. - InvalidOutput( BNCl( :,i) ) = .true. - InvalidOutput( BNCd( :,i) ) = .true. - InvalidOutput( BNCm( :,i) ) = .true. - InvalidOutput( BNCx( :,i) ) = .true. - InvalidOutput( BNCy( :,i) ) = .true. - InvalidOutput( BNCn( :,i) ) = .true. - InvalidOutput( BNCt( :,i) ) = .true. - InvalidOutput( BNFl( :,i) ) = .true. - InvalidOutput( BNFd( :,i) ) = .true. - InvalidOutput( BNMm( :,i) ) = .true. - InvalidOutput( BNFx( :,i) ) = .true. - InvalidOutput( BNFy( :,i) ) = .true. - InvalidOutput( BNFn( :,i) ) = .true. - InvalidOutput( BNFt( :,i) ) = .true. - InvalidOutput( BNClrnc(:,i) ) = .true. - - END DO - - DO I = p%NBlOuts+1,9 ! Invalid blade nodes - - InvalidOutput( BNVUndx(i,:) ) = .true. - InvalidOutput( BNVUndy(i,:) ) = .true. - InvalidOutput( BNVUndz(i,:) ) = .true. - InvalidOutput( BNVDisx(i,:) ) = .true. - InvalidOutput( BNVDisy(i,:) ) = .true. - InvalidOutput( BNVDisz(i,:) ) = .true. - InvalidOutput( BNSTVx( i,:) ) = .true. - InvalidOutput( BNSTVy( i,:) ) = .true. - InvalidOutput( BNSTVz( i,:) ) = .true. - InvalidOutput( BNVRel( i,:) ) = .true. - InvalidOutput( BNDynP( i,:) ) = .true. - InvalidOutput( BNRe( i,:) ) = .true. - InvalidOutput( BNM( i,:) ) = .true. - InvalidOutput( BNVIndx(i,:) ) = .true. - InvalidOutput( BNVIndy(i,:) ) = .true. - InvalidOutput( BNAxInd(i,:) ) = .true. - InvalidOutput( BNTnInd(i,:) ) = .true. - InvalidOutput( BNAlpha(i,:) ) = .true. - InvalidOutput( BNTheta(i,:) ) = .true. - InvalidOutput( BNPhi( i,:) ) = .true. - InvalidOutput( BNCurve(i,:) ) = .true. - InvalidOutput( BNCl( i,:) ) = .true. - InvalidOutput( BNCd( i,:) ) = .true. - InvalidOutput( BNCm( i,:) ) = .true. - InvalidOutput( BNCx( i,:) ) = .true. - InvalidOutput( BNCy( i,:) ) = .true. - InvalidOutput( BNCn( i,:) ) = .true. - InvalidOutput( BNCt( i,:) ) = .true. - InvalidOutput( BNFl( i,:) ) = .true. - InvalidOutput( BNFd( i,:) ) = .true. - InvalidOutput( BNMm( i,:) ) = .true. - InvalidOutput( BNFx( i,:) ) = .true. - InvalidOutput( BNFy( i,:) ) = .true. - InvalidOutput( BNFn( i,:) ) = .true. - InvalidOutput( BNFt( i,:) ) = .true. - InvalidOutput( BNClrnc(i,:) ) = .true. - - END DO - -! ................. End of validity checking ................. - - - !------------------------------------------------------------------------------------------------- - ! Allocate and set index, name, and units for the output channels - ! If a selected output channel is not available in this module, set error flag. - !------------------------------------------------------------------------------------------------- - - ALLOCATE ( p%OutParam(0:p%NumOuts) , STAT=ErrStat2 ) - IF ( ErrStat2 /= 0_IntKi ) THEN - CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the AeroDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) - RETURN - ENDIF - - ! Set index, name, and units for the time output channel: - - p%OutParam(0)%Indx = Time - p%OutParam(0)%Name = "Time" ! OutParam(0) is the time channel by default. - p%OutParam(0)%Units = "(s)" - p%OutParam(0)%SignM = 1 - - - ! Set index, name, and units for all of the output channels. - ! If a selected output channel is not available by this module set ErrStat = ErrID_Warn. - - DO I = 1,p%NumOuts - - p%OutParam(I)%Name = OutList(I) - OutListTmp = OutList(I) - - ! Reverse the sign (+/-) of the output channel if the user prefixed the - ! channel name with a "-", "_", "m", or "M" character indicating "minus". - - - CheckOutListAgain = .FALSE. - - IF ( INDEX( "-_", OutListTmp(1:1) ) > 0 ) THEN - p%OutParam(I)%SignM = -1 ! ex, "-TipDxc1" causes the sign of TipDxc1 to be switched. - OutListTmp = OutListTmp(2:) - ELSE IF ( INDEX( "mM", OutListTmp(1:1) ) > 0 ) THEN ! We'll assume this is a variable name for now, (if not, we will check later if OutListTmp(2:) is also a variable name) - CheckOutListAgain = .TRUE. - p%OutParam(I)%SignM = 1 - ELSE - p%OutParam(I)%SignM = 1 - END IF - - CALL Conv2UC( OutListTmp ) ! Convert OutListTmp to upper case - - - Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) - - - ! If it started with an "M" (CheckOutListAgain) we didn't find the value in our list (Indx < 1) - - IF ( CheckOutListAgain .AND. Indx < 1 ) THEN ! Let's assume that "M" really meant "minus" and then test again - p%OutParam(I)%SignM = -1 ! ex, "MTipDxc1" causes the sign of TipDxc1 to be switched. - OutListTmp = OutListTmp(2:) - - Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) - END IF - - - IF ( Indx > 0 ) THEN ! we found the channel name - p%OutParam(I)%Indx = ParamIndxAry(Indx) - IF ( InvalidOutput( ParamIndxAry(Indx) ) ) THEN ! but, it isn't valid for these settings - p%OutParam(I)%Units = "INVALID" - p%OutParam(I)%SignM = 0 - ELSE - p%OutParam(I)%Units = ParamUnitsAry(Indx) ! it's a valid output - END IF - ELSE ! this channel isn't valid - p%OutParam(I)%Indx = Time ! pick any valid channel (I just picked "Time" here because it's universal) - p%OutParam(I)%Units = "INVALID" - p%OutParam(I)%SignM = 0 ! multiply all results by zero - - CALL SetErrStat(ErrID_Fatal, TRIM(p%OutParam(I)%Name)//" is not an available output channel.",ErrStat,ErrMsg,RoutineName) - END IF - - END DO - - RETURN -END SUBROUTINE SetOutParam -!---------------------------------------------------------------------------------------------------------------------------------- -!End of code generated by Matlab script -!********************************************************************************************************************************** - - - -END MODULE AeroDyn_IO diff --git a/modules/aerodyn/AeroDynF8/AeroDyn_Registry.txt b/modules/aerodyn/AeroDynF8/AeroDyn_Registry.txt deleted file mode 100644 index f9373e98e..000000000 --- a/modules/aerodyn/AeroDynF8/AeroDyn_Registry.txt +++ /dev/null @@ -1,182 +0,0 @@ -################################################################################################################################### -# Registry for AeroDyn 15 in the FAST Modularization Framework -# This Registry file is used to create AeroDyn_Types which contains data used in the AeroDyn module. -# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. -# See the NWTC Programmer's Handbook for further information on the format/contents of this file. -# -# Entries are of the form -# -# -# Use ^ as a shortcut for the value in the same column from the previous line. -################################################################################################################################### -# File last committed $Date$ -# (File) Revision #: $Rev$ -# URL: $HeadURL$ -################################################################################################################################### -# ...... Include files (definitions from NWTC Library) ............................................................................ -include Registry_NWTC_Library.txt -usefrom AirfoilInfo_Registry.txt -usefrom BEMT_Registry.txt -usefrom UnsteadyAero_Registry.txt - -# ..... Initialization data ....................................................................................................... -# Define inputs that the initialization routine may need here: -typedef AeroDyn/AD InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - -typedef ^ InitInputType Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - -typedef ^ InitInputType IntKi NumBlades - - - "Number of blades on the turbine" -typedef ^ InitInputType CHARACTER(1024) RootName - - - "RootName for writing output files" - -typedef ^ InitInputType ReKi HubPosition {3} - - "X-Y-Z reference position of hub" m -typedef ^ InitInputType R8Ki HubOrientation {3}{3} - - "DCM reference orientation of hub" - -typedef ^ InitInputType ReKi BladeRootPosition {:}{:} - - "X-Y-Z reference position of each blade root (3 x NumBlades)" m -typedef ^ InitInputType R8Ki BladeRootOrientation {:}{:}{:} - - "DCM reference orientation of blade roots (3x3 x NumBlades)" - - -# Define outputs from the initialization routine here: -typedef ^ AD_BladeShape SiKi AirfoilCoords {:}{:}{:} - - "x-y coordinates for airfoils, relative to node" m -# Define outputs from the initialization routine here: -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - -typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - -typedef ^ InitOutputType ReKi AirDens - - - "Air density" kg/m^3 -typedef ^ InitOutputType AD_BladeShape BladeShape {:} - - "airfoil coordinates for each blade" m -typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - -typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_z {:} - - "Names of the constraint states used in linearization" - -typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - -typedef ^ InitOutputType LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - -typedef ^ InitOutputType LOGICAL RotFrame_z {:} - - "Flag that tells FAST/MBC3 if the constraint states used in linearization are in the rotating frame (not used for glue)" - -typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - - -# ..... Input file data ........................................................................................................... -# This is data defined in the Input File for this module (or could otherwise be passed in) -# ..... Blade Input file data ..................................................................................................... -typedef ^ AD_BladePropsType IntKi NumBlNds - - - "Number of blade nodes used in the analysis" - -typedef ^ AD_BladePropsType ReKi BlSpn {:} - - "Span at blade node" m -typedef ^ AD_BladePropsType ReKi BlCrvAC {:} - - "Curve at blade node" m -typedef ^ AD_BladePropsType ReKi BlSwpAC {:} - - "Sweep at blade node" m -typedef ^ AD_BladePropsType ReKi BlCrvAng {:} - - "Curve angle at blade node" radians -typedef ^ AD_BladePropsType ReKi BlTwist {:} - - "Twist at blade node" radians -typedef ^ AD_BladePropsType ReKi BlChord {:} - - "Chord at blade node" m -typedef ^ AD_BladePropsType IntKi BlAFID {:} - - "ID of Airfoil at blade node" - - -# ..... Primary Input file data ................................................................................................... -typedef ^ AD_InputFile DbKi DTAero - - - "Time interval for aerodynamic calculations {or "default"}" s -typedef ^ AD_InputFile IntKi WakeMod - - - "Type of wake/induction model {0=none, 1=BEMT}" - -typedef ^ AD_InputFile IntKi AFAeroMod - - - "Type of blade airfoil aerodynamics model {1=steady model, 2=Beddoes-Leishman unsteady model}" - -typedef ^ AD_InputFile IntKi TwrPotent - - - "Type tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - -typedef ^ AD_InputFile LOGICAL TwrShadow - - - "Calculate tower influence on wind based on downstream tower shadow?" - -typedef ^ AD_InputFile LOGICAL TwrAero - - - "Calculate tower aerodynamic loads?" flag -typedef ^ AD_InputFile Logical FrozenWake - - - "Flag that tells this module it should assume a frozen wake during linearization." - -typedef ^ AD_InputFile ReKi AirDens - - - "Air density" kg/m^3 -typedef ^ AD_InputFile ReKi KinVisc - - - "Kinematic air viscosity" m^2/s -typedef ^ AD_InputFile ReKi SpdSound - - - "Speed of sound" m/s -typedef ^ AD_InputFile IntKi SkewMod - - - "Type of skewed-wake correction model {1=uncoupled, 2=Pitt/Peters, 3=coupled} [used only when WakeMod=1]" - -typedef ^ AD_InputFile LOGICAL TipLoss - - - "Use the Prandtl tip-loss model? [used only when WakeMod=1]" flag -typedef ^ AD_InputFile LOGICAL HubLoss - - - "Use the Prandtl hub-loss model? [used only when WakeMod=1]" flag -typedef ^ AD_InputFile LOGICAL TanInd - - - "Include tangential induction in BEMT calculations? [used only when WakeMod=1]" flag -typedef ^ AD_InputFile LOGICAL AIDrag - - - "Include the drag term in the axial-induction calculation? [used only when WakeMod=1]" flag -typedef ^ AD_InputFile LOGICAL TIDrag - - - "Include the drag term in the tangential-induction calculation? [used only when WakeMod=1 and TanInd=TRUE]" flag -typedef ^ AD_InputFile ReKi IndToler - - - "Convergence tolerance for BEM induction factors [used only when WakeMod=1]" - -typedef ^ AD_InputFile ReKi MaxIter - - - "Maximum number of iteration steps [used only when WakeMod=1]" - -typedef ^ AD_InputFile IntKi UAMod - - - "Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAreoMod=2]" - -typedef ^ AD_InputFile LOGICAL FLookup - - - "Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAreoMod=2]" flag -typedef ^ AD_InputFile ReKi InCol_Alfa - - - "The column in the airfoil tables that contains the angle of attack" - -typedef ^ AD_InputFile ReKi InCol_Cl - - - "The column in the airfoil tables that contains the lift coefficient" - -typedef ^ AD_InputFile ReKi InCol_Cd - - - "The column in the airfoil tables that contains the drag coefficient" - -typedef ^ AD_InputFile ReKi InCol_Cm - - - "The column in the airfoil tables that contains the pitching-moment coefficient; use zero if there is no Cm column" - -typedef ^ AD_InputFile ReKi InCol_Cpmin - - - "The column in the airfoil tables that contains the drag coefficient; use zero if there is no Cpmin column" - -typedef ^ AD_InputFile IntKi NumAFfiles - - - "Number of airfoil files used" - -typedef ^ AD_InputFile CHARACTER(1024) AFNames {:} - - "Airfoil file names (NumAF lines)" "quoted strings" -typedef ^ AD_InputFile LOGICAL UseBlCm - - - "Include aerodynamic pitching moment in calculations?" flag -#typedef ^ AD_InputFile IntKi NumBlNds - - - "Number of blade nodes used in the analysis" - -typedef ^ AD_InputFile AD_BladePropsType BladeProps {:} - - "blade property information from blade input files" - -typedef ^ AD_InputFile IntKi NumTwrNds - - - "Number of tower nodes used in the analysis" - -typedef ^ AD_InputFile ReKi TwrElev {:} - - "Elevation at tower node" m -typedef ^ AD_InputFile ReKi TwrDiam {:} - - "Diameter of tower at node" m -typedef ^ AD_InputFile ReKi TwrCd {:} - - "Coefficient of drag at tower node" - -typedef ^ AD_InputFile LOGICAL SumPrint - - - "Generate a summary file listing input options and interpolated properties to ".AD.sum"?" flag -typedef ^ AD_InputFile IntKi NBlOuts - - - "Number of blade node outputs [0 - 9]" - -typedef ^ AD_InputFile IntKi BlOutNd {9} - - "Blade nodes whose values will be output" - -typedef ^ AD_InputFile IntKi NTwOuts - - - "Number of tower node outputs [0 - 9]" - -typedef ^ AD_InputFile IntKi TwOutNd {9} - - "Tower nodes whose values will be output" - -typedef ^ AD_InputFile IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ AD_InputFile CHARACTER(ChanLen) OutList {:} - - "List of user-requested output channels" - - -# ..... States .................................................................................................................... -# Define continuous (differentiable) states here: -typedef ^ ContinuousStateType BEMT_ContinuousStateType BEMT - - - "Continuous states from the BEMT module" - - -# Define discrete (nondifferentiable) states here: -typedef ^ DiscreteStateType BEMT_DiscreteStateType BEMT - - - "Discrete states from the BEMT module" - - -# Define constraint states here: -typedef ^ ConstraintStateType BEMT_ConstraintStateType BEMT - - - "Constraint states from the BEMT module" - - -# Define "other" states here: -typedef ^ OtherStateType BEMT_OtherStateType BEMT - - - "OtherStates from the BEMT module" - - -# Define misc/optimization variables (any data that are not considered actual states) here: -typedef ^ MiscVarType BEMT_MiscVarType BEMT - - - "MiscVars from the BEMT module" - -typedef ^ MiscVarType BEMT_OutputType BEMT_y - - - "Outputs from the BEMT module" - -typedef ^ MiscVarType BEMT_InputType BEMT_u 2 - - "Inputs to the BEMT module" - -typedef ^ MiscVarType ReKi DisturbedInflow {:}{:}{:} - - "InflowOnBlade values modified by tower influence" m/s -typedef ^ MiscVarType ReKi WithoutSweepPitchTwist {:}{:}{:}{:} - - "Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles" - -typedef ^ MiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" - -typedef ^ MiscVarType ReKi W_Twr {:} - - "relative wind speed normal to the tower at node j" m/s -typedef ^ MiscVarType ReKi X_Twr {:} - - "local x-component of force per unit length of the jth node in the tower" m/s -typedef ^ MiscVarType ReKi Y_Twr {:} - - "local y-component of force per unit length of the jth node in the tower" m/s -typedef ^ MiscVarType ReKi Curve {:}{:} - - "curvature angle, saved for possible output to file" rad -typedef ^ MiscVarType ReKi TwrClrnc {:}{:} - - "Distance between tower (including tower radius) and blade node (not including blade width), saved for possible output to file" m -typedef ^ MiscVarType ReKi X {:}{:} - - "normal force per unit length (normal to the plane, not chord) of the jth node in the kth blade" N/m -typedef ^ MiscVarType ReKi Y {:}{:} - - "tangential force per unit length (tangential to the plane, not chord) of the jth node in the kth blade" N/m -typedef ^ MiscVarType ReKi M {:}{:} - - "pitching moment per unit length of the jth node in the kth blade" Nm/m -typedef ^ MiscVarType ReKi V_DiskAvg {3} - - "disk-average relative wind speed" m/s -typedef ^ MiscVarType ReKi V_dot_x - - - -typedef ^ MiscVarType 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)" - -typedef ^ MiscVarType MeshMapType B_L_2_H_P {:} - - "mapping data structure to map each bladeLoad output mesh to the MiscVar%HubLoad mesh" - -# ..... Parameters ................................................................................................................ -# Define parameters here: -# Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: -typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds -typedef ^ ParameterType IntKi WakeMod - - - "Type of wake/induction model {0=none, 1=BEMT}" - -typedef ^ ParameterType IntKi TwrPotent - - - "Type tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - -typedef ^ ParameterType LOGICAL TwrShadow - - - "Calculate tower influence on wind based on downstream tower shadow?" - -typedef ^ ParameterType LOGICAL TwrAero - - - "Calculate tower aerodynamic loads?" flag -typedef ^ ParameterType Logical FrozenWake - - - "Flag that tells this module it should assume a frozen wake during linearization." - -typedef ^ ParameterType IntKi NumBlades - - - "Number of blades on the turbine" - -typedef ^ ParameterType IntKi NumBlNds - - - "Number of nodes on each blade" - -typedef ^ ParameterType IntKi NumTwrNds - - - "Number of nodes on the tower" - -typedef ^ ParameterType ReKi TwrDiam {:} - - "Diameter of tower at node" m -typedef ^ ParameterType ReKi TwrCd {:} - - "Coefficient of drag at tower node" - -typedef ^ ParameterType ReKi AirDens - - - "Air density" kg/m^3 -typedef ^ ParameterType ReKi KinVisc - - - "Kinematic air viscosity" m^2/s -typedef ^ ParameterType ReKi SpdSound - - - "Speed of sound" m/s -typedef ^ ParameterType AFI_ParameterType AFI - - - "AirfoilInfo parameters" -typedef ^ ParameterType BEMT_ParameterType BEMT - - - "Parameters for BEMT module" -# parameters for output -typedef ^ ParameterType IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ ParameterType CHARACTER(1024) RootName - - - "RootName for writing output files" - -typedef ^ ParameterType OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - -typedef ^ ParameterType IntKi NBlOuts - - - "Number of blade node outputs [0 - 9]" - -typedef ^ ParameterType IntKi BlOutNd {9} - - "Blade nodes whose values will be output" - -typedef ^ ParameterType IntKi NTwOuts - - - "Number of tower node outputs [0 - 9]" - -typedef ^ ParameterType IntKi TwOutNd {9} - - "Tower nodes whose values will be output" - -typedef ^ ParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - -typedef ^ ParameterType ReKi du {:} - - "vector that determines size of perturbation for u (inputs)" -typedef ^ ParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - - -# ..... Inputs .................................................................................................................... -# Define inputs that are contained on the mesh here: -typedef ^ InputType MeshType TowerMotion - - - "motion on the tower" - -typedef ^ InputType MeshType HubMotion - - - "motion on the hub" - -typedef ^ InputType MeshType BladeRootMotion {:} - - "motion on each blade root" - -typedef ^ InputType MeshType BladeMotion {:} - - "motion on each blade" - -# Define inputs that are not on this mesh here: -typedef ^ InputType ReKi InflowOnBlade {:}{:}{:} "U,V,W at nodes on each blade (note if we change the requirement that NumNodes is the same for each blade, this will need to change)" m/s -typedef ^ InputType ReKi InflowOnTower {:}{:} "U,V,W at nodes on the tower" m/s - -# ..... Outputs ................................................................................................................... -# Define outputs that are contained on the mesh here: -typedef ^ OutputType MeshType TowerLoad - - - "loads on the tower" - -typedef ^ OutputType MeshType BladeLoad {:} - - "loads on each blade" - -# Define outputs that are not on this mesh here: -typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" diff --git a/modules/aerodyn/AeroDynF8_Emre/AeroDyn.f90 b/modules/aerodyn/AeroDynF8_Emre/AeroDyn.f90 deleted file mode 100644 index 5d6f21361..000000000 --- a/modules/aerodyn/AeroDynF8_Emre/AeroDyn.f90 +++ /dev/null @@ -1,3988 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2015-2016 National Renewable Energy Laboratory -! -! This file is part of AeroDyn. -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -! -!********************************************************************************************************************************** -! File last committed: $Date$ -! (File) Revision #: $Rev$ -! URL: $HeadURL$ -!********************************************************************************************************************************** -!> AeroDyn is a time-domain aerodynamics module for horizontal-axis wind turbines. -module AeroDyn - - use NWTC_Library - use AeroDyn_Types - use AeroDyn_IO - use BEMT - use AirfoilInfo - use NWTC_LAPACK - use AeroAcoustics - - - implicit none - - private - - - ! ..... Public Subroutines ................................................................................................... - - public :: AD_Init ! Initialization routine - public :: AD_End ! Ending routine (includes clean up) - public :: AD_UpdateStates ! Loose coupling routine for solving for constraint states, integrating - ! continuous states, and updating discrete states - public :: AD_CalcOutput ! Routine for computing outputs - public :: AD_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual - - - PUBLIC :: AD_JacobianPInput ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - - ! (Xd), and constraint - state(Z) functions all with respect to the inputs(u) - PUBLIC :: AD_JacobianPContState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - - ! (Xd), and constraint - state(Z) functions all with respect to the continuous - ! states(x) - PUBLIC :: AD_JacobianPDiscState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - - ! (Xd), and constraint - state(Z) functions all with respect to the discrete - ! states(xd) - PUBLIC :: AD_JacobianPConstrState ! Routine to compute the Jacobians of the output(Y), continuous - (X), discrete - - ! (Xd), and constraint - state(Z) functions all with respect to the constraint - ! states(z) - PUBLIC :: AD_GetOP !< Routine to pack the operating point values (for linearization) into arrays - - -contains -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine sets the initialization output data structure, which contains data to be returned to the calling program (e.g., -!! FAST or AeroDyn_Driver) -subroutine AD_SetInitOut(p, InputFileData, InitOut, errStat, errMsg) - - type(AD_InitOutputType), intent( out) :: InitOut ! output data - type(AD_InputFile), intent(in ) :: InputFileData ! input file data (for setting airfoil shape outputs) - type(AD_ParameterType), intent(in ) :: p ! Parameters - integer(IntKi), intent( out) :: errStat ! Error status of the operation - character(*), intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None - - - ! Local variables - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'AD_SetInitOut' - - - - integer(IntKi) :: i, j, k, f - integer(IntKi) :: NumCoords -#ifdef DBG_OUTS - integer(IntKi) :: m - character(5) ::chanPrefix -#endif - ! Initialize variables for this routine - - errStat = ErrID_None - errMsg = "" - - InitOut%AirDens = p%AirDens - - call AllocAry( InitOut%WriteOutputHdr, p%numOuts, 'WriteOutputHdr', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - call AllocAry( InitOut%WriteOutputUnt, p%numOuts, 'WriteOutputUnt', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (ErrStat >= AbortErrLev) return - - -#ifdef DBG_OUTS - ! Loop over blades and nodes to populate the output channel names and units - - do k=1,p%numBlades - do j=1, p%NumBlNds - - m = (k-1)*p%NumBlNds*23 + (j-1)*23 - - chanPrefix = "B"//trim(num2lstr(k))//"N"//trim(num2lstr(j)) - InitOut%WriteOutputHdr( m + 1 ) = trim(chanPrefix)//"Twst" - InitOut%WriteOutputUnt( m + 1 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 2 ) = trim(chanPrefix)//"Psi" - InitOut%WriteOutputUnt( m + 2 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 3 ) = trim(chanPrefix)//"Vx" - InitOut%WriteOutputUnt( m + 3 ) = ' (m/s) ' - InitOut%WriteOutputHdr( m + 4 ) = trim(chanPrefix)//"Vy" - InitOut%WriteOutputUnt( m + 4 ) = ' (m/s) ' - InitOut%WriteOutputHdr( m + 5 ) = ' '//trim(chanPrefix)//"AIn" - InitOut%WriteOutputUnt( m + 5 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 6 ) = ' '//trim(chanPrefix)//"ApIn" - InitOut%WriteOutputUnt( m + 6 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 7 ) = trim(chanPrefix)//"Vrel" - InitOut%WriteOutputUnt( m + 7 ) = ' (m/s) ' - InitOut%WriteOutputHdr( m + 8 ) = ' '//trim(chanPrefix)//"Phi" - InitOut%WriteOutputUnt( m + 8 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 9 ) = ' '//trim(chanPrefix)//"AOA" - InitOut%WriteOutputUnt( m + 9 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 10 ) = ' '//trim(chanPrefix)//"Cl" - InitOut%WriteOutputUnt( m + 10 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 11 ) = ' '//trim(chanPrefix)//"Cd" - InitOut%WriteOutputUnt( m + 11 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 12 ) = ' '//trim(chanPrefix)//"Cm" - InitOut%WriteOutputUnt( m + 12 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 13 ) = ' '//trim(chanPrefix)//"Cx" - InitOut%WriteOutputUnt( m + 13 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 14 ) = ' '//trim(chanPrefix)//"Cy" - InitOut%WriteOutputUnt( m + 14 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 15 ) = ' '//trim(chanPrefix)//"Cn" - InitOut%WriteOutputUnt( m + 15 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 16 ) = ' '//trim(chanPrefix)//"Ct" - InitOut%WriteOutputUnt( m + 16 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 17 ) = ' '//trim(chanPrefix)//"Fl" - InitOut%WriteOutputUnt( m + 17 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 18 ) = ' '//trim(chanPrefix)//"Fd" - InitOut%WriteOutputUnt( m + 18 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 19 ) = ' '//trim(chanPrefix)//"M" - InitOut%WriteOutputUnt( m + 19 ) = ' (N/m^2) ' - InitOut%WriteOutputHdr( m + 20 ) = ' '//trim(chanPrefix)//"Fx" - InitOut%WriteOutputUnt( m + 20 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 21 ) = ' '//trim(chanPrefix)//"Fy" - InitOut%WriteOutputUnt( m + 21 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 22 ) = ' '//trim(chanPrefix)//"Fn" - InitOut%WriteOutputUnt( m + 22 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 23 ) = ' '//trim(chanPrefix)//"Ft" - InitOut%WriteOutputUnt( m + 23 ) = ' (N/m) ' - - end do - end do -#else - do i=1,p%NumOuts - InitOut%WriteOutputHdr(i) = p%OutParam(i)%Name - InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units - end do -#endif - - - InitOut%Ver = AD_Ver - -! set visualization data: - ! this check is overly restrictive, but it would be a lot of work to ensure that only the *used* airfoil - ! tables have the same number of coordinates. - if ( allocated(p%AFI%AFInfo) ) then - - if ( p%AFI%AFInfo(1)%NumCoords > 0 ) then - NumCoords = p%AFI%AFInfo(1)%NumCoords - do i=2,size(p%AFI%AFInfo) - if (p%AFI%AFInfo(1)%NumCoords /= NumCoords) then - call SetErrStat( ErrID_Info, 'Airfoil files do not contain the same number of x-y coordinates.', ErrStat, ErrMsg, RoutineName ) - NumCoords = -1 - exit - end if - end do - - if (NumCoords > 0) then - if (NumCoords < 3) then - call SetErrStat( ErrID_Info, 'Airfoil files with NumCoords > 0 must contain at least 2 coordinates.', ErrStat, ErrMsg, RoutineName ) - return - end if - - allocate( InitOut%BladeShape( p%numBlades ), STAT=ErrStat2 ) - if (ErrStat2 /= 0) then - call SetErrStat( ErrID_Info, 'Error allocationg InitOut%AD_BladeShape', ErrStat, ErrMsg, RoutineName ) - return - end if - - do k=1,p%numBlades - call allocAry( InitOut%BladeShape(k)%AirfoilCoords, 2, NumCoords-1, InputFileData%BladeProps(k)%NumBlNds, 'AirfoilCoords', ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return - - do j=1,InputFileData%BladeProps(k)%NumBlNds - f = InputFileData%BladeProps(k)%BlAFID(j) - - do i=1,NumCoords-1 - InitOut%BladeShape(k)%AirfoilCoords(1,i,j) = InputFileData%BladeProps(k)%BlChord(j)*( p%AFI%AFInfo(f)%Y_Coord(i+1) - p%AFI%AFInfo(f)%Y_Coord(1) ) - InitOut%BladeShape(k)%AirfoilCoords(2,i,j) = InputFileData%BladeProps(k)%BlChord(j)*( p%AFI%AFInfo(f)%X_Coord(i+1) - p%AFI%AFInfo(f)%X_Coord(1) ) - end do - end do - - end do - - end if - end if - - end if - - - - - -end subroutine AD_SetInitOut -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is called at the start of the simulation to perform initialization steps. -!! The parameters are set here and not changed during the simulation. -!! The initial states and initial guess for the input are defined. -subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) -!.................................................................................................................................. - - type(AD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine - type(AD_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined - type(AD_ParameterType), intent( out) :: p !< Parameters - type(AD_ContinuousStateType), intent( out) :: x !< Initial continuous states - type(AD_DiscreteStateType), intent( out) :: xd !< Initial discrete states - type(AD_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states - type(AD_OtherStateType), intent( out) :: OtherState !< Initial other states - type(AD_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; - !! only the output mesh is initialized) - type(AD_MiscVarType), intent( out) :: m !< Initial misc/optimization variables - real(DbKi), intent(inout) :: interval !< Coupling interval in seconds: the rate that - !! (1) AD_UpdateStates() is called in loose coupling & - !! (2) AD_UpdateDiscState() is called in tight coupling. - !! Input is the suggested time from the glue code; - !! Output is the actual coupling interval that will be used - !! by the glue code. - type(AD_InitOutputType), intent( out) :: InitOut !< Output for initialization routine - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - - ! Local variables - integer(IntKi) :: i ! loop counter - - integer(IntKi) :: errStat2 ! temporary error status of the operation - character(ErrMsgLen) :: errMsg2 ! temporary error message - - type(AD_InputFile) :: InputFileData ! Data stored in the module's input file - integer(IntKi) :: UnEcho ! Unit number for the echo file - - character(*), parameter :: RoutineName = 'AD_Init' - - - ! Initialize variables for this routine - - errStat = ErrID_None - errMsg = "" - UnEcho = -1 - - ! Initialize the NWTC Subroutine Library - - call NWTC_Init( EchoLibVer=.FALSE. ) - - ! Display the module information - - call DispNVD( AD_Ver ) - - - p%NumBlades = InitInp%NumBlades ! need this before reading the AD input file so that we know how many blade files to read - !bjj: note that we haven't validated p%NumBlades before using it below! - p%RootName = TRIM(InitInp%RootName)//'.AD' - - ! Read the primary AeroDyn input file - call ReadInputFiles( InitInp%InputFile, InputFileData, interval, p%RootName, p%NumBlades, UnEcho, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - - ! Validate the inputs - call ValidateInputData( InitInp, InputFileData, p%NumBlades, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - -!======================================================================================= -! TODO: Fix this - ! Hardcode some values for now until the File I/O code is added for the AA module. -! InputFileData%AA_InputFile = 'NoiseInput.dat' - ! p%CompAA = .true. -!======================================================================================= - - - !............................................................................................ - ! Define parameters - !............................................................................................ - - ! Initialize AFI module (read Airfoil tables) - call Init_AFIparams( InputFileData, p%AFI, UnEcho, p%NumBlades, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - - ! set the rest of the parameters - call SetParameters( InitInp, InputFileData, p, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - !............................................................................................ - ! Define and initialize inputs here - !............................................................................................ - - call Init_u( u, p, InputFileData, InitInp, errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - ! - - !............................................................................................ - ! Initialize the BEMT module (also sets other variables for sub module) - !............................................................................................ - - ! initialize BEMT after setting parameters and inputs because we are going to use the already- - ! calculated node positions from the input meshes - - call Init_BEMTmodule( InputFileData, u, m%BEMT_u(1), p, x%BEMT, xd%BEMT, z%BEMT, & - OtherState%BEMT, m%BEMT_y, m%BEMT, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - call BEMT_CopyInput( m%BEMT_u(1), m%BEMT_u(2), MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Initialize the AeroAcoustics Module if the CompAA flag is set - if (p%CompAA) then - call Init_AAmodule( InitInp, InputFileData, u, m%AA_u, p, x%AA, xd%AA, z%AA, OtherState%AA, m%AA_y, m%AA, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if - - !............................................................................................ - ! Define outputs here - !............................................................................................ - call Init_y(y, u, p, errStat2, errMsg2) ! do this after input meshes have been initialized - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - - !............................................................................................ - ! Initialize states and misc vars - !............................................................................................ - - ! many states are in the BEMT module, which were initialized in BEMT_Init() - - call Init_MiscVars(m, p, u, y, errStat2, errMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - !............................................................................................ - ! Define initialization output here - !............................................................................................ - call AD_SetInitOut(p, InputFileData, InitOut, errStat2, errMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! after setting InitOut variables, we really don't need the airfoil coordinates taking up - ! space in AeroDyn - if ( allocated(p%AFI%AFInfo) ) then - do i=1,size(p%AFI%AFInfo) - if (allocated(p%AFI%AFInfo(i)%X_Coord)) deallocate( p%AFI%AFInfo(i)%X_Coord) - if (allocated(p%AFI%AFInfo(i)%Y_Coord)) deallocate( p%AFI%AFInfo(i)%Y_Coord) - end do - end if - - !............................................................................................ - ! Initialize Jacobian: - !............................................................................................ - if (InitInp%Linearize) then - call Init_Jacobian(InputFileData, p, u, y, m, InitOut, ErrStat2, ErrMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if - - !............................................................................................ - ! Print the summary file if requested: - !............................................................................................ - if (InputFileData%SumPrint) then - call AD_PrintSum( InputFileData, p, u, y, ErrStat2, ErrMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - end if - - - call Cleanup() - -contains - subroutine Cleanup() - - CALL AD_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2 ) - IF ( UnEcho > 0 ) CLOSE( UnEcho ) - - end subroutine Cleanup - -end subroutine AD_Init -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes (allocates) the misc variables for use during the simulation. -subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) - type(AD_MiscVarType), intent(inout) :: m !< misc/optimization data (not defined in submodules) - type(AD_ParameterType), intent(in ) :: p !< Parameters - type(AD_InputType), intent(inout) :: u !< input for HubMotion mesh (create sibling mesh here) - type(AD_OutputType), intent(in ) :: y !< output (create mapping between output and otherstate mesh here) - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - - ! Local variables - integer(intKi) :: k - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'Init_OtherStates' - - ! Initialize variables for this routine - - errStat = ErrID_None - 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 SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - ! arrays for output -#ifdef DBG_OUTS - allocate( m%AllOuts(0:p%NumOuts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels -#else - allocate( m%AllOuts(0:MaxOutPts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels -#endif - if (ErrStat2 /= 0) then - call SetErrStat( ErrID_Fatal, "Error allocating AllOuts.", errStat, errMsg, RoutineName ) - return - end if - m%AllOuts = 0.0_ReKi - - ! save these tower calculations for output: - call AllocAry( m%W_Twr, p%NumTwrNds, 'm%W_Twr', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( m%X_Twr, p%NumTwrNds, 'm%X_Twr', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( m%Y_Twr, p%NumTwrNds, 'm%Y_Twr', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - ! save blade calculations for output: -if (p%TwrPotent /= TwrPotent_none .or. p%TwrShadow) then - call AllocAry( m%TwrClrnc, p%NumBlNds, p%NumBlades, 'm%TwrClrnc', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) -end if - call AllocAry( m%Curve, p%NumBlNds, p%NumBlades, 'm%Curve', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( m%X, p%NumBlNds, p%NumBlades, 'm%X', ErrStat2, ErrMsg2 ) - 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 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) - if (ErrStat2 /= 0) then - call SetErrStat( ErrID_Fatal, "Error allocating B_L_2_H_P mapping structure.", errStat, errMsg, RoutineName ) - return - end if - - call MeshCopy ( SrcMesh = u%HubMotion & - , DestMesh = m%HubLoad & - , CtrlCode = MESH_SIBLING & - , IOS = COMPONENT_OUTPUT & - , force = .TRUE. & - , moment = .TRUE. & - , ErrStat = ErrStat2 & - , ErrMess = ErrMsg2 ) - - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - - do k=1,p%NumBlades - CALL MeshMapCreate( y%BladeLoad(k), m%HubLoad, m%B_L_2_H_P(k), ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':B_L_2_H_P('//TRIM(Num2LStr(K))//')' ) - end do - - if (ErrStat >= AbortErrLev) RETURN - - ! - if (p%NumTwrNds > 0) then - m%W_Twr = 0.0_ReKi - m%X_Twr = 0.0_ReKi - m%Y_Twr = 0.0_ReKi - end if - - - -end subroutine Init_MiscVars -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes AeroDyn meshes and output array variables for use during the simulation. -subroutine Init_y(y, u, p, errStat, errMsg) - type(AD_OutputType), intent( out) :: y !< Module outputs - type(AD_InputType), intent(inout) :: u !< Module inputs -- intent(out) because of mesh sibling copy - type(AD_ParameterType), intent(in ) :: p !< Parameters - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - - ! Local variables - integer(intKi) :: k ! loop counter for blades - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'Init_y' - - ! Initialize variables for this routine - - errStat = ErrID_None - errMsg = "" - - - if (p%TwrAero) then - - call MeshCopy ( SrcMesh = u%TowerMotion & - , DestMesh = y%TowerLoad & - , CtrlCode = MESH_SIBLING & - , IOS = COMPONENT_OUTPUT & - , force = .TRUE. & - , moment = .TRUE. & - , ErrStat = ErrStat2 & - , ErrMess = ErrMsg2 ) - - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - - !y%TowerLoad%force = 0.0_ReKi ! shouldn't have to initialize this - !y%TowerLoad%moment= 0.0_ReKi ! shouldn't have to initialize this - else - y%TowerLoad%nnodes = 0 - end if - - - allocate( y%BladeLoad(p%numBlades), stat=ErrStat2 ) - if (errStat2 /= 0) then - call SetErrStat( ErrID_Fatal, 'Error allocating y%BladeLoad.', ErrStat, ErrMsg, RoutineName ) - return - end if - - - do k = 1, p%numBlades - - call MeshCopy ( SrcMesh = u%BladeMotion(k) & - , DestMesh = y%BladeLoad(k) & - , CtrlCode = MESH_SIBLING & - , IOS = COMPONENT_OUTPUT & - , force = .TRUE. & - , moment = .TRUE. & - , ErrStat = ErrStat2 & - , ErrMess = ErrMsg2 ) - - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - end do - - call AllocAry( y%WriteOutput, p%numOuts, 'WriteOutput', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - - - -end subroutine Init_y -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes AeroDyn meshes and input array variables for use during the simulation. -subroutine Init_u( u, p, InputFileData, InitInp, errStat, errMsg ) -!.................................................................................................................................. - - type(AD_InputType), intent( out) :: u !< Input data - type(AD_ParameterType), intent(in ) :: p !< Parameters - type(AD_InputFile), intent(in ) :: InputFileData !< Data stored in the module's input file - type(AD_InitInputType), intent(in ) :: InitInp !< Input data for AD initialization routine - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - - ! Local variables - real(reKi) :: position(3) ! node reference position - real(reKi) :: positionL(3) ! node local position - real(R8Ki) :: theta(3) ! Euler angles - real(R8Ki) :: orientation(3,3) ! node reference orientation - real(R8Ki) :: orientationL(3,3) ! node local orientation - - integer(intKi) :: j ! counter for nodes - integer(intKi) :: k ! counter for blades - - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'Init_u' - - ! Initialize variables for this routine - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Arrays for InflowWind inputs: - - call AllocAry( u%InflowOnBlade, 3_IntKi, p%NumBlNds, p%numBlades, 'u%InflowOnBlade', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( u%InflowOnTower, 3_IntKi, p%NumTwrNds, 'u%InflowOnTower', ErrStat2, ErrMsg2 ) ! could be size zero - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (errStat >= AbortErrLev) return - - u%InflowOnBlade = 0.0_ReKi - - ! Meshes for motion inputs (ElastoDyn and/or BeamDyn) - !................ - ! tower - !................ - if (p%NumTwrNds > 0) then - - u%InflowOnTower = 0.0_ReKi - - call MeshCreate ( BlankMesh = u%TowerMotion & - ,IOS = COMPONENT_INPUT & - ,Nnodes = p%NumTwrNds & - ,ErrStat = ErrStat2 & - ,ErrMess = ErrMsg2 & - ,Orientation = .true. & - ,TranslationDisp = .true. & - ,TranslationVel = .true. & - ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (errStat >= AbortErrLev) return - - ! set node initial position/orientation - position = 0.0_ReKi - do j=1,p%NumTwrNds - position(3) = InputFileData%TwrElev(j) - - call MeshPositionNode(u%TowerMotion, j, position, errStat2, errMsg2) ! orientation is identity by default - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - end do !j - - ! create line2 elements - do j=1,p%NumTwrNds-1 - call MeshConstructElement( u%TowerMotion, ELEMENT_LINE2, errStat2, errMsg2, p1=j, p2=j+1 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - end do !j - - call MeshCommit(u%TowerMotion, errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (errStat >= AbortErrLev) return - - - u%TowerMotion%Orientation = u%TowerMotion%RefOrientation - u%TowerMotion%TranslationDisp = 0.0_R8Ki - u%TowerMotion%TranslationVel = 0.0_ReKi - - end if ! we compute tower loads - - !................ - ! hub - !................ - - call MeshCreate ( BlankMesh = u%HubMotion & - ,IOS = COMPONENT_INPUT & - ,Nnodes = 1 & - ,ErrStat = ErrStat2 & - ,ErrMess = ErrMsg2 & - ,Orientation = .true. & - ,TranslationDisp = .true. & - ,RotationVel = .true. & - ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (errStat >= AbortErrLev) return - - call MeshPositionNode(u%HubMotion, 1, InitInp%HubPosition, errStat2, errMsg2, InitInp%HubOrientation) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - call MeshConstructElement( u%HubMotion, ELEMENT_POINT, errStat2, errMsg2, p1=1 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - call MeshCommit(u%HubMotion, errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (errStat >= AbortErrLev) return - - - u%HubMotion%Orientation = u%HubMotion%RefOrientation - u%HubMotion%TranslationDisp = 0.0_R8Ki - u%HubMotion%RotationVel = 0.0_ReKi - - - !................ - ! blade roots - !................ - - allocate( u%BladeRootMotion(p%NumBlades), STAT = ErrStat2 ) - if (ErrStat2 /= 0) then - call SetErrStat( ErrID_Fatal, 'Error allocating u%BladeRootMotion array.', ErrStat, ErrMsg, RoutineName ) - return - end if - - do k=1,p%NumBlades - call MeshCreate ( BlankMesh = u%BladeRootMotion(k) & - ,IOS = COMPONENT_INPUT & - ,Nnodes = 1 & - ,ErrStat = ErrStat2 & - ,ErrMess = ErrMsg2 & - ,Orientation = .true. & - ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (errStat >= AbortErrLev) return - - call MeshPositionNode(u%BladeRootMotion(k), 1, InitInp%BladeRootPosition(:,k), errStat2, errMsg2, InitInp%BladeRootOrientation(:,:,k)) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - call MeshConstructElement( u%BladeRootMotion(k), ELEMENT_POINT, errStat2, errMsg2, p1=1 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - call MeshCommit(u%BladeRootMotion(k), errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (errStat >= AbortErrLev) return - - - u%BladeRootMotion(k)%Orientation = u%BladeRootMotion(k)%RefOrientation - - end do !k=numBlades - - - !................ - ! blades - !................ - - allocate( u%BladeMotion(p%NumBlades), STAT = ErrStat2 ) - if (ErrStat2 /= 0) then - call SetErrStat( ErrID_Fatal, 'Error allocating u%BladeMotion array.', ErrStat, ErrMsg, RoutineName ) - return - end if - - do k=1,p%NumBlades - call MeshCreate ( BlankMesh = u%BladeMotion(k) & - ,IOS = COMPONENT_INPUT & - ,Nnodes = InputFileData%BladeProps(k)%NumBlNds & - ,ErrStat = ErrStat2 & - ,ErrMess = ErrMsg2 & - ,Orientation = .true. & - ,TranslationDisp = .true. & - ,TranslationVel = .true. & - ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (errStat >= AbortErrLev) return - - - do j=1,InputFileData%BladeProps(k)%NumBlNds - - ! reference position of the jth node in the kth blade, relative to the root in the local blade coordinate system: - positionL(1) = InputFileData%BladeProps(k)%BlCrvAC(j) - positionL(2) = InputFileData%BladeProps(k)%BlSwpAC(j) - positionL(3) = InputFileData%BladeProps(k)%BlSpn( j) - - ! reference position of the jth node in the kth blade: - position = u%BladeRootMotion(k)%Position(:,1) + matmul(positionL,u%BladeRootMotion(k)%RefOrientation(:,:,1)) ! note that because positionL is a 1-D array, we're doing the transpose of matmul(transpose(u%BladeRootMotion(k)%RefOrientation),positionL) - - - ! reference orientation of the jth node in the kth blade, relative to the root in the local blade coordinate system: - theta(1) = 0.0_R8Ki - theta(2) = InputFileData%BladeProps(k)%BlCrvAng(j) - theta(3) = -InputFileData%BladeProps(k)%BlTwist( j) - orientationL = EulerConstruct( theta ) - - ! reference orientation of the jth node in the kth blade - orientation = matmul( orientationL, u%BladeRootMotion(k)%RefOrientation(:,:,1) ) - - - call MeshPositionNode(u%BladeMotion(k), j, position, errStat2, errMsg2, orientation) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - end do ! j=blade nodes - - ! create line2 elements - do j=1,InputFileData%BladeProps(k)%NumBlNds-1 - call MeshConstructElement( u%BladeMotion(k), ELEMENT_LINE2, errStat2, errMsg2, p1=j, p2=j+1 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - end do !j - - call MeshCommit(u%BladeMotion(k), errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - if (errStat >= AbortErrLev) return - - - u%BladeMotion(k)%Orientation = u%BladeMotion(k)%RefOrientation - u%BladeMotion(k)%TranslationDisp = 0.0_R8Ki - u%BladeMotion(k)%TranslationVel = 0.0_ReKi - - end do !k=numBlades - - -end subroutine Init_u -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets AeroDyn parameters for use during the simulation; these variables are not changed after AD_Init. -subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) - TYPE(AD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine, out is needed because of copy below - TYPE(AD_InputFile), INTENT(INout) :: InputFileData !< Data stored in the module's input file -- intent(out) only for move_alloc statements - TYPE(AD_ParameterType), INTENT(INOUT) :: p !< Parameters - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - ! Local variables - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - !INTEGER(IntKi) :: i, j - character(*), parameter :: RoutineName = 'SetParameters' - - ! Initialize variables for this routine - - ErrStat = ErrID_None - ErrMsg = "" - - p%DT = InputFileData%DTAero - p%WakeMod = InputFileData%WakeMod - p%TwrPotent = InputFileData%TwrPotent - p%TwrShadow = InputFileData%TwrShadow - p%TwrAero = InputFileData%TwrAero - - if (InitInp%Linearize) then - p%FrozenWake = InputFileData%FrozenWake - else - p%FrozenWake = .FALSE. - end if - - p%CompAA = InputFileData%CompAA - - ! p%numBlades = InitInp%numBlades ! this was set earlier because it was necessary - p%NumBlNds = InputFileData%BladeProps(1)%NumBlNds - if (p%TwrPotent == TwrPotent_none .and. .not. p%TwrShadow .and. .not. p%TwrAero) then - p%NumTwrNds = 0 - else - p%NumTwrNds = InputFileData%NumTwrNds - - call move_alloc( InputFileData%TwrDiam, p%TwrDiam ) - call move_alloc( InputFileData%TwrCd, p%TwrCd ) - end if - - p%AirDens = InputFileData%AirDens - p%KinVisc = InputFileData%KinVisc - p%SpdSound = InputFileData%SpdSound - - !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() - - !p%RootName = TRIM(InitInp%RootName)//'.AD' ! set earlier to it could be used - -#ifdef DBG_OUTS - p%NBlOuts = 23 - p%numOuts = p%NumBlNds*p%NumBlades*p%NBlOuts - p%NTwOuts = 0 - -#else - p%numOuts = InputFileData%NumOuts - p%NBlOuts = InputFileData%NBlOuts - p%BlOutNd = InputFileData%BlOutNd - - if (p%NumTwrNds > 0) then - p%NTwOuts = InputFileData%NTwOuts - p%TwOutNd = InputFileData%TwOutNd - else - p%NTwOuts = 0 - end if - - call SetOutParam(InputFileData%OutList, p, ErrStat2, ErrMsg2 ) ! requires: p%NumOuts, p%numBlades, p%NumBlNds, p%NumTwrNds; sets: p%OutParam. - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return - -#endif - -end subroutine SetParameters -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is called at the end of the simulation. -subroutine AD_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(AD_InputType), INTENT(INOUT) :: u !< System inputs - TYPE(AD_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(AD_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states - TYPE(AD_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states - TYPE(AD_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states - TYPE(AD_OtherStateType), INTENT(INOUT) :: OtherState !< Other states - TYPE(AD_OutputType), INTENT(INOUT) :: y !< System outputs - TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Place any last minute operations or calculations here: - - - ! Close files here: - - - - ! Destroy the input data: - - CALL AD_DestroyInput( u, ErrStat, ErrMsg ) - - - ! Destroy the parameter data: - - CALL AD_DestroyParam( p, ErrStat, ErrMsg ) - - - ! Destroy the state data: - - CALL AD_DestroyContState( x, ErrStat, ErrMsg ) - CALL AD_DestroyDiscState( xd, ErrStat, ErrMsg ) - CALL AD_DestroyConstrState( z, ErrStat, ErrMsg ) - CALL AD_DestroyOtherState( OtherState, ErrStat, ErrMsg ) - CALL AD_DestroyMisc( m, ErrStat, ErrMsg ) - - ! Destroy the output data: - - CALL AD_DestroyOutput( y, ErrStat, ErrMsg ) - - - - -END SUBROUTINE AD_End -!---------------------------------------------------------------------------------------------------------------------------------- -!> Loose coupling routine for solving for constraint states, integrating continuous states, and updating discrete and other states. -!! Continuous, constraint, discrete, and other states are updated for t + Interval -subroutine AD_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, m, errStat, errMsg ) -!.................................................................................................................................. - - real(DbKi), intent(in ) :: t !< Current simulation time in seconds - integer(IntKi), intent(in ) :: n !< Current simulation time step n = 0,1,... - type(AD_InputType), intent(inout) :: u(:) !< Inputs at utimes (out only for mesh record-keeping in ExtrapInterp routine) - real(DbKi), intent(in ) :: utimes(:) !< Times associated with u(:), in seconds - type(AD_ParameterType), intent(in ) :: p !< Parameters - type(AD_ContinuousStateType), intent(inout) :: x !< Input: Continuous states at t; - !! Output: Continuous states at t + Interval - type(AD_DiscreteStateType), intent(inout) :: xd !< Input: Discrete states at t; - !! Output: Discrete states at t + Interval - type(AD_ConstraintStateType), intent(inout) :: z !< Input: Constraint states at t; - !! Output: Constraint states at t+dt - type(AD_OtherStateType), intent(inout) :: OtherState !< Input: Other states at t; - !! Output: Other states at t+dt - type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - type(AD_InputType) :: uInterp ! Interpolated/Extrapolated input - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'AD_UpdateStates' - - ErrStat = ErrID_None - ErrMsg = "" - - - call AD_CopyInput( u(1), uInterp, MESH_NEWCOPY, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) then - call Cleanup() - return - end if - - ! set values of m%BEMT_u(2) from inputs interpolated at t+dt: - call AD_Input_ExtrapInterp(u,utimes,uInterp,t+p%DT, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call SetInputs(p, uInterp, m, 2, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! set values of m%BEMT_u(1) from inputs (uInterp) interpolated at t: - ! 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) - - call SetInputs(p, uInterp, m, 1, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - ! Call into the BEMT update states NOTE: This is a non-standard framework interface!!!!! GJH - call BEMT_UpdateStates(t, n, m%BEMT_u(1), m%BEMT_u(2), p%BEMT, x%BEMT, xd%BEMT, z%BEMT, OtherState%BEMT, p%AFI%AFInfo, m%BEMT, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - if ( p%CompAA ) then - ! We need the outputs from BEMT as inputs to AeroAcoustics module - ! Also, SetInputs() [called above] calls SetInputsForBEMT() which in turn establishes current versions of the Global to local transformations we need as inputs to AA - call SetInputsForAA(p, u(1), m, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AA_UpdateStates(t, n,m%AA, m%AA_u, p%AA, xd%AA, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end if - - call Cleanup() - -contains - subroutine Cleanup() - call AD_DestroyInput( uInterp, errStat2, errMsg2) - end subroutine Cleanup -end subroutine AD_UpdateStates -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine for computing outputs, used in both loose and tight coupling. -!! This subroutine is used to compute the output channels (motions and loads) and place them in the WriteOutput() array. -!! The descriptions of the output channels are not given here. Please see the included OutListParameters.xlsx sheet for -!! for a complete description of each output parameter. -subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -! NOTE: no matter how many channels are selected for output, all of the outputs are calcalated -! All of the calculated output channels are placed into the m%AllOuts(:), while the channels selected for outputs are -! placed in the y%WriteOutput(:) array. -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at Time t - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(AD_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- - !! nectivity information does not have to be recalculated) - type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - integer(intKi) :: i - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CalcOutput' - - - ErrStat = ErrID_None - ErrMsg = "" - - - call SetInputs(p, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! Call the BEMT module CalcOutput. Notice that the BEMT outputs are purposely attached to AeroDyn's MiscVar structure to - ! avoid issues with the coupling code - - call BEMT_CalcOutput(t, m%BEMT_u(indx), p%BEMT, x%BEMT, xd%BEMT, z%BEMT, OtherState%BEMT, p%AFI%AFInfo, m%BEMT_y, m%BEMT, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call SetOutputsFromBEMT(p, m, y ) - - if ( p%CompAA ) then - ! We need the outputs from BEMT as inputs to AeroAcoustics module - ! Also, SetInputs() [called above] calls SetInputsForBEMT() which in turn establishes current versions of the Global to local transformations we need as inputs to AA - call SetInputsForAA(p, u, m, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AA_CalcOutput(t, m%AA_u, p%AA, x%AA, xd%AA, z%AA, OtherState%AA, m%AA_y, m%AA, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end if - - - - if ( p%TwrAero ) then - call ADTwr_CalcOutput(p, u, m, y, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end if - - !------------------------------------------------------- - ! get values to output to file: - !------------------------------------------------------- - if (p%NumOuts > 0) then -#ifdef DBG_OUTS - call Calc_WriteDbgOutput( p, u, m, y, ErrStat2, ErrMsg2 ) -#else - call Calc_WriteOutput( p, u, m, y, indx, ErrStat2, ErrMsg2 ) -#endif - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - !............................................................................................................................... - ! Place the selected output channels into the WriteOutput(:) array with the proper sign: - !............................................................................................................................... - - do i = 1,p%NumOuts ! Loop through all selected output channels -#ifdef DBG_OUTS - y%WriteOutput(i) = m%AllOuts( i ) -#else - y%WriteOutput(i) = p%OutParam(i)%SignM * m%AllOuts( p%OutParam(i)%Indx ) -#endif - - end do ! i - All selected output channels - - end if - - - -end subroutine AD_CalcOutput -!---------------------------------------------------------------------------------------------------------------------------------- -!> Tight coupling routine for solving for the residual of the constraint state equations -subroutine AD_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_residual, ErrStat, ErrMsg ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: Time !< Current simulation time in seconds - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at Time - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at Time - TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at Time - TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at Time (possibly a guess) - TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at Time - TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - TYPE(AD_ConstraintStateType), INTENT(INOUT) :: Z_residual !< Residual of the constraint state equations using - !! the input values described above - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - - ! Local variables - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_CalcConstrStateResidual' - - - - ErrStat = ErrID_None - ErrMsg = "" - - if (.not. allocated(Z_residual%BEMT%phi)) then ! BEMT_CalcConstrStateResidual expects memory to be allocated, so let's make sure it is - call AD_CopyConstrState( z, Z_residual, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - end if - - - call SetInputs(p, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - call BEMT_CalcConstrStateResidual( Time, m%BEMT_u(indx), p%BEMT, x%BEMT, xd%BEMT, z%BEMT, OtherState%BEMT, m%BEMT, & - Z_residual%BEMT, p%AFI%AFInfo, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - -end subroutine AD_CalcConstrStateResidual -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine converts the AeroDyn inputs into values that can be used for its submodules. It calculates the disturbed inflow -!! on the blade if tower shadow or tower influence are enabled, then uses these values to set m%BEMT_u(indx). -subroutine SetInputs(p, u, m, indx, errStat, errMsg) - type(AD_ParameterType), intent(in ) :: p !< AD parameters - type(AD_InputType), intent(in ) :: u !< AD Inputs at Time - type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables - integer, intent(in ) :: indx !< index into m%BEMT_u(indx) array; 1=t and 2=t+dt (but not checked here) - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SetInputs' - - - ErrStat = ErrID_None - ErrMsg = "" - - if (p%TwrPotent /= TwrPotent_none .or. p%TwrShadow) then - call TwrInfl( p, u, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - else - m%DisturbedInflow = u%InflowOnBlade - end if - - ! This needs to extract the inputs from the AD data types (mesh) and massage them for the BEMT module - call SetInputsForBEMT(p, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - -end subroutine SetInputs -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine sets m%BEMT_u(indx). -subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) - - type(AD_ParameterType), intent(in ) :: p !< AD parameters - type(AD_InputType), intent(in ) :: u !< AD Inputs at Time - type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables - integer, intent(in ) :: indx !< index into m%BEMT_u array; must be 1 or 2 (but not checked here) - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - real(ReKi) :: x_hat(3) - real(ReKi) :: y_hat(3) - real(ReKi) :: z_hat(3) - real(ReKi) :: x_hat_disk(3) - real(ReKi) :: y_hat_disk(3) - real(ReKi) :: z_hat_disk(3) - real(ReKi) :: tmp(3) - real(R8Ki) :: theta(3) - real(R8Ki) :: orientation(3,3) - real(R8Ki) :: orientation_nopitch(3,3) - real(ReKi) :: tmp_sz, tmp_sz_y - - integer(intKi) :: j ! loop counter for nodes - integer(intKi) :: k ! loop counter for blades - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SetInputsForBEMT' - - - ErrStat = ErrID_None - ErrMsg = "" - - - ! 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 - end do - end do - m%V_diskAvg = m%V_diskAvg / real( p%NumBlades * p%NumBlNds, ReKi ) - - ! orientation vectors: - x_hat_disk = u%HubMotion%Orientation(1,:,1) !actually also x_hat_hub - - m%V_dot_x = dot_product( m%V_diskAvg, x_hat_disk ) - tmp = m%V_dot_x * x_hat_disk - m%V_diskAvg - tmp_sz = TwoNorm(tmp) - if ( EqualRealNos( tmp_sz, 0.0_ReKi ) ) then - y_hat_disk = u%HubMotion%Orientation(2,:,1) - z_hat_disk = u%HubMotion%Orientation(3,:,1) - else - y_hat_disk = tmp / tmp_sz - z_hat_disk = cross_product( m%V_diskAvg, x_hat_disk ) / tmp_sz - end if - - ! "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 - 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 = max( -1.0_ReKi, tmp_sz_y ) - - m%BEMT_u(indx)%chi0 = acos( tmp_sz_y ) - - end if - - ! "Azimuth angle" rad - do k=1,p%NumBlades - z_hat = u%BladeRootMotion(k)%Orientation(3,:,1) - tmp_sz_y = -1.0*dot_product(z_hat,y_hat_disk) - tmp_sz = dot_product(z_hat,z_hat_disk) - if ( EqualRealNos(tmp_sz_y,0.0_ReKi) .and. EqualRealNos(tmp_sz,0.0_ReKi) ) then - m%BEMT_u(indx)%psi(k) = 0.0_ReKi - else - m%BEMT_u(indx)%psi(k) = atan2( tmp_sz_y, tmp_sz ) - end if - end do - - ! 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 - 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)) ) - 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) -#ifndef DBG_OUTS - m%AllOuts( BPitch( k) ) = -theta(3)*R2D ! save this value of pitch for potential output -#endif - theta(3) = 0.0_ReKi - orientation = EulerConstruct( theta ) - orientation_nopitch = matmul( orientation, u%HubMotion%Orientation(:,:,1) ) ! withoutPitch_theta_Root(k) - - do j=1,p%NumBlNds - - ! form coordinate system equivalent to u%BladeMotion(k)%Orientation(:,:,j) but without live sweep (due to in-plane - ! deflection), blade-pitch and twist (aerodynamic + elastic) angles: - - ! orientation = matmul( u%BladeMotion(k)%Orientation(:,:,j), transpose(orientation_nopitch) ) - call LAPACK_gemm( 'n', 't', 1.0_R8Ki, u%BladeMotion(k)%Orientation(:,:,j), orientation_nopitch, 0.0_R8Ki, orientation, errStat2, errMsg2) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - theta = EulerExtract( orientation ) !root(k)WithoutPitch_theta(j)_blade(k) - - m%BEMT_u(indx)%theta(j,k) = -theta(3) ! local pitch + twist (aerodyanmic + elastic) angle of the jth node in the kth blade - - - theta(1) = 0.0_ReKi - theta(3) = 0.0_ReKi - m%Curve(j,k) = theta(2) ! save value for possible output later - m%WithoutSweepPitchTwist(:,:,j,k) = matmul( EulerConstruct( theta ), orientation_nopitch ) ! WithoutSweepPitch+Twist_theta(j)_Blade(k) - - 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 - - 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 - -end subroutine SetInputsForBEMT -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine sets m%AA_u. -subroutine SetInputsForAA(p, u, m, errStat, errMsg) - - type(AD_ParameterType), intent(in ) :: p !< AD parameters - type(AD_InputType), intent(in ) :: u !< AD Inputs at Time - type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables - 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 ! loop counter for nodes - integer(intKi) :: j ! loop counter for blades - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'SetInputsForAA' - - - ErrStat = ErrID_None - ErrMsg = "" - - do j=1,p%NumBlades - do i = 1,p%NumBlNds - ! Get local orientation matrix to transform from blade element coordinates to global coordinates - !m%AA_u%RotLtoG(:,:,i,j) = m%WithoutSweepPitchTwist(:,:,i,j) - - m%AA_u%RotLtoG(:,:,i,j) = u%BladeMotion(j)%Orientation(:,:,i) - - ! Get blade element aerodynamic center in global coordinates - m%AA_u%AeroCent_G(:,i,j) = u%BladeMotion(j)%Position(:,i) + u%BladeMotion(j)%TranslationDisp(:,i) - ! Set the blade element relative velocity (including induction) - m%AA_u%Vrel(i,j) = m%BEMT_y%Vrel(i,j) - - ! Set the blade element angle of attack - m%AA_u%AoANoise(i,j) = m%BEMT_y%AOA(i,j) - - ! Set the blade element undisturbed flow - m%AA_u%Inflow(1,i,j) = u%InflowonBlade(1,i,j) - m%AA_u%Inflow(2,i,j) = u%InflowonBlade(2,i,j) - m%AA_u%Inflow(3,i,j) = u%InflowonBlade(3,i,j) - end do - end do - - - -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 ) - - type(AD_ParameterType), intent(in ) :: p !< AD parameters - type(AD_OutputType), intent(inout) :: y !< AD outputs - type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables - !type(BEMT_OutputType), intent(in ) :: BEMT_y ! BEMT outputs - !real(ReKi), intent(in ) :: WithoutSweepPitchTwist(:,:,:,:) ! modified orientation matrix - - 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 - - - - force(3) = 0.0_ReKi - moment(1:2) = 0.0_ReKi - do k=1,p%NumBlades - do j=1,p%NumBlNds - - q = 0.5 * p%airDens * m%BEMT_y%Vrel(j,k)**2 ! dynamic pressure of the jth node in the kth blade - 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 - - ! 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) - - ! 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 - - end do !j=nodes - end do !k=blades - - -end subroutine SetOutputsFromBEMT - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine validates the inputs from the AeroDyn input files. -SUBROUTINE ValidateInputData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) -!.................................................................................................................................. - - ! Passed variables: - - type(AD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine - type(AD_InputFile), intent(in) :: InputFileData !< All the data in the AeroDyn input file - integer(IntKi), intent(in) :: NumBl !< Number of blades - integer(IntKi), intent(out) :: ErrStat !< Error status - character(*), intent(out) :: ErrMsg !< Error message - - - ! local variables - integer(IntKi) :: k ! Blade number - integer(IntKi) :: j ! node number - character(*), parameter :: RoutineName = 'ValidateInputData' - - ErrStat = ErrID_None - ErrMsg = "" - - - if (NumBl > MaxBl .or. NumBl < 1) call SetErrStat( ErrID_Fatal, 'Number of blades must be between 1 and '//trim(num2lstr(MaxBl))//'.', ErrSTat, ErrMsg, RoutineName ) - if (InputFileData%DTAero <= 0.0) call SetErrStat ( ErrID_Fatal, 'DTAero must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%WakeMod /= WakeMod_None .and. InputFileData%WakeMod /= WakeMod_BEMT) call SetErrStat ( ErrID_Fatal, & - 'WakeMod must '//trim(num2lstr(WakeMod_None))//' (none) or '//trim(num2lstr(WakeMod_BEMT))//' (BEMT).', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%AFAeroMod /= AFAeroMod_Steady .and. InputFileData%AFAeroMod /= AFAeroMod_BL_unsteady) then - call SetErrStat ( ErrID_Fatal, 'AFAeroMod must be '//trim(num2lstr(AFAeroMod_Steady))//' (steady) or '//& - trim(num2lstr(AFAeroMod_BL_unsteady))//' (Beddoes-Leishman unsteady).', ErrStat, ErrMsg, RoutineName ) - end if - if (InputFileData%TwrPotent /= TwrPotent_none .and. InputFileData%TwrPotent /= TwrPotent_baseline .and. InputFileData%TwrPotent /= TwrPotent_Bak) then - call SetErrStat ( ErrID_Fatal, 'TwrPotent must be 0 (none), 1 (baseline potential flow), or 2 (potential flow with Bak correction).', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%AirDens <= 0.0) call SetErrStat ( ErrID_Fatal, 'The air density (AirDens) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%KinVisc <= 0.0) call SetErrStat ( ErrID_Fatal, 'The kinesmatic viscosity (KinVisc) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%SpdSound <= 0.0) call SetErrStat ( ErrID_Fatal, 'The speed of sound (SpdSound) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - - - ! BEMT inputs - ! bjj: these checks should probably go into BEMT where they are used... - if (InputFileData%WakeMod == WakeMod_BEMT) then - if ( InputFileData%MaxIter < 1 ) call SetErrStat( ErrID_Fatal, 'MaxIter must be greater than 0.', ErrStat, ErrMsg, RoutineName ) - - if ( InputFileData%IndToler < 0.0 .or. EqualRealNos(InputFileData%IndToler, 0.0_ReKi) ) & - call SetErrStat( ErrID_Fatal, 'IndToler must be greater than 0.', ErrStat, ErrMsg, RoutineName ) - - if ( InputFileData%SkewMod /= SkewMod_Uncoupled .and. InputFileData%SkewMod /= SkewMod_PittPeters) & ! .and. InputFileData%SkewMod /= SkewMod_Coupled ) - call SetErrStat( ErrID_Fatal, 'SkewMod must be 1, or 2. Option 3 will be implemented in a future version.', ErrStat, ErrMsg, RoutineName ) - - end if !BEMT checks - - ! UA inputs - if (InputFileData%AFAeroMod == AFAeroMod_BL_unsteady ) then - if (InputFileData%UAMod < 2 .or. InputFileData%UAMod > 3 ) call SetErrStat( ErrID_Fatal, & - "In this version, UAMod must be 2 (Gonzalez's variant) or 3 (Minemma/Pierce variant).", ErrStat, ErrMsg, RoutineName ) ! NOTE: for later- 1 (baseline/original) - - if (.not. InputFileData%FLookUp ) call SetErrStat( ErrID_Fatal, 'FLookUp must be TRUE for this version.', ErrStat, ErrMsg, RoutineName ) - end if - - - ! validate the AFI input data because it doesn't appear to be done in AFI - if (InputFileData%NumAFfiles < 1) call SetErrStat( ErrID_Fatal, 'The number of unique airfoil tables (NumAFfiles) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%InCol_Alfa < 0) call SetErrStat( ErrID_Fatal, 'InCol_Alfa must not be a negative number.', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%InCol_Cl < 0) call SetErrStat( ErrID_Fatal, 'InCol_Cl must not be a negative number.', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%InCol_Cd < 0) call SetErrStat( ErrID_Fatal, 'InCol_Cd must not be a negative number.', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%InCol_Cm < 0) call SetErrStat( ErrID_Fatal, 'InCol_Cm must not be a negative number.', ErrStat, ErrMsg, RoutineName ) - if (InputFileData%InCol_Cpmin < 0) call SetErrStat( ErrID_Fatal, 'InCol_Cpmin must not be a negative number.', ErrStat, ErrMsg, RoutineName ) - - ! ............................. - ! check blade mesh data: - ! ............................. - if ( InputFileData%BladeProps(1)%NumBlNds < 2 ) call SetErrStat( ErrID_Fatal, 'There must be at least two nodes per blade.',ErrStat, ErrMsg, RoutineName ) - do k=2,NumBl - if ( InputFileData%BladeProps(k)%NumBlNds /= InputFileData%BladeProps(k-1)%NumBlNds ) then - call SetErrStat( ErrID_Fatal, 'All blade property files must have the same number of blade nodes.', ErrStat, ErrMsg, RoutineName ) - exit ! exit do loop - end if - end do - - ! Check the list of airfoil tables for blades to make sure they are all within limits. - do k=1,NumBl - do j=1,InputFileData%BladeProps(k)%NumBlNds - if ( ( InputFileData%BladeProps(k)%BlAFID(j) < 1 ) .OR. ( InputFileData%BladeProps(k)%BlAFID(j) > InputFileData%NumAFfiles ) ) then - call SetErrStat( ErrID_Fatal, 'Blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j))//' must be a number between 1 and NumAFfiles (' & - //TRIM(Num2LStr(InputFileData%NumAFfiles))//').', ErrStat, ErrMsg, RoutineName ) - end if - end do ! j=nodes - end do ! k=blades - - ! Check that the blade chord is > 0. - do k=1,NumBl - do j=1,InputFileData%BladeProps(k)%NumBlNds - if ( InputFileData%BladeProps(k)%BlChord(j) <= 0.0_ReKi ) then - call SetErrStat( ErrID_Fatal, 'The chord for blade '//trim(Num2LStr(k))//' node '//trim(Num2LStr(j)) & - //' must be greater than 0.', ErrStat, ErrMsg, RoutineName ) - endif - end do ! j=nodes - end do ! k=blades - - do k=1,NumBl - if ( .not. EqualRealNos(InputFileData%BladeProps(k)%BlSpn(1), 0.0_ReKi) ) call SetErrStat( ErrID_Fatal, 'Blade '//trim(Num2LStr(k))//' span location must start at 0.0 m', ErrStat, ErrMsg, RoutineName) - do j=2,InputFileData%BladeProps(k)%NumBlNds - if ( InputFileData%BladeProps(k)%BlSpn(j) <= InputFileData%BladeProps(k)%BlSpn(j-1) ) then - call SetErrStat( ErrID_Fatal, 'Blade '//trim(Num2LStr(k))//' nodes must be entered in increasing elevation.', ErrStat, ErrMsg, RoutineName ) - exit - end if - end do ! j=nodes - end do ! k=blades - - ! ............................. - ! check tower mesh data: - ! ............................. - if (InputFileData%TwrPotent /= TwrPotent_none .or. InputFileData%TwrShadow .or. InputFileData%TwrAero ) then - - if (InputFileData%NumTwrNds < 2) call SetErrStat( ErrID_Fatal, 'There must be at least two nodes on the tower.',ErrStat, ErrMsg, RoutineName ) - - ! Check that the tower diameter is > 0. - do j=1,InputFileData%NumTwrNds - if ( InputFileData%TwrDiam(j) <= 0.0_ReKi ) then - call SetErrStat( ErrID_Fatal, 'The diameter for tower node '//trim(Num2LStr(j))//' must be greater than 0.' & - , ErrStat, ErrMsg, RoutineName ) - end if - end do ! j=nodes - - ! check that the elevation is increasing: - do j=2,InputFileData%NumTwrNds - if ( InputFileData%TwrElev(j) <= InputFileData%TwrElev(j-1) ) then - call SetErrStat( ErrID_Fatal, 'The tower nodes must be entered in increasing elevation.', ErrStat, ErrMsg, RoutineName ) - exit - end if - end do ! j=nodes - - end if - - ! ............................. - ! check outputs: - ! ............................. - - if ( ( InputFileData%NTwOuts < 0_IntKi ) .OR. ( InputFileData%NTwOuts > 9_IntKi ) ) then - call SetErrStat( ErrID_Fatal, 'NTwOuts must be between 0 and 9 (inclusive).', ErrStat, ErrMsg, RoutineName ) - else - ! Check to see if all TwOutNd(:) analysis points are existing analysis points: - - do j=1,InputFileData%NTwOuts - if ( InputFileData%TwOutNd(j) < 1_IntKi .OR. InputFileData%TwOutNd(j) > InputFileData%NumTwrNds ) then - call SetErrStat( ErrID_Fatal, ' All TwOutNd values must be between 1 and '//& - trim( Num2LStr( InputFileData%NumTwrNds ) )//' (inclusive).', ErrStat, ErrMsg, RoutineName ) - exit ! stop checking this loop - end if - end do - - end if - - - if ( ( InputFileData%NBlOuts < 0_IntKi ) .OR. ( InputFileData%NBlOuts > 9_IntKi ) ) then - call SetErrStat( ErrID_Fatal, 'NBlOuts must be between 0 and 9 (inclusive).', ErrStat, ErrMsg, RoutineName ) - else - - ! Check to see if all BlOutNd(:) analysis points are existing analysis points: - - do j=1,InputFileData%NBlOuts - if ( InputFileData%BlOutNd(j) < 1_IntKi .OR. InputFileData%BlOutNd(j) > InputFileData%BladeProps(1)%NumBlNds ) then - call SetErrStat( ErrID_Fatal, ' All BlOutNd values must be between 1 and '//& - trim( Num2LStr( InputFileData%BladeProps(1)%NumBlNds ) )//' (inclusive).', ErrStat, ErrMsg, RoutineName ) - exit ! stop checking this loop - end if - end do - - end if - - !.................. - ! check for linearization - !.................. - if (InitInp%Linearize) then - if (InputFileData%AFAeroMod /= AFAeroMod_Steady) then - call SetErrStat( ErrID_Fatal, 'Steady blade airfoil aerodynamics must be used for linearization. Set AFAeroMod=1.', ErrStat, ErrMsg, RoutineName ) - end if - end if - - -END SUBROUTINE ValidateInputData -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine sets up the data structures and initializes AirfoilInfo to get the necessary AFI parameters. It then verifies -!! that the UA parameters are included in the AFI tables if UA is being used. -SUBROUTINE Init_AFIparams( InputFileData, p_AFI, UnEc, NumBl, ErrStat, ErrMsg ) - - - ! Passed variables - type(AD_InputFile), intent(inout) :: InputFileData !< All the data in the AeroDyn input file (intent(out) only because of the call to MOVE_ALLOC) - type(AFI_ParameterType), intent( out) :: p_AFI !< parameters returned from the AFI (airfoil info) module - integer(IntKi), intent(in ) :: UnEc !< I/O unit for echo file. If > 0, file is open for writing. - integer(IntKi), intent(in ) :: NumBl !< number of blades (for performing check on valid airfoil data read in) - integer(IntKi), intent( out) :: ErrStat !< Error status - character(*), intent( out) :: ErrMsg !< Error message - - ! local variables - type(AFI_InitInputType) :: AFI_InitInputs ! initialization data for the AFI routines - - integer(IntKi) :: j ! loop counter for nodes - integer(IntKi) :: k ! loop counter for blades - integer(IntKi) :: File ! loop counter for airfoil files - integer(IntKi) :: Table ! loop counter for airfoil tables in a file - logical, allocatable :: fileUsed(:) - - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'Init_AFIparams' - - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Setup Airfoil InitInput data structure: - AFI_InitInputs%NumAFfiles = InputFileData%NumAFfiles - call MOVE_ALLOC( InputFileData%AFNames, AFI_InitInputs%FileNames ) ! move from AFNames to FileNames - AFI_InitInputs%InCol_Alfa = InputFileData%InCol_Alfa - AFI_InitInputs%InCol_Cl = InputFileData%InCol_Cl - AFI_InitInputs%InCol_Cd = InputFileData%InCol_Cd - AFI_InitInputs%InCol_Cm = InputFileData%InCol_Cm - AFI_InitInputs%InCol_Cpmin = InputFileData%InCol_Cpmin - - ! Call AFI_Init to read in and process the airfoil files. - ! This includes creating the spline coefficients to be used for interpolation. - - call AFI_Init ( AFI_InitInputs, p_AFI, ErrStat2, ErrMsg2, UnEc ) - call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - call MOVE_ALLOC( AFI_InitInputs%FileNames, InputFileData%AFNames ) ! move from FileNames back to AFNames - call AFI_DestroyInitInput( AFI_InitInputs, ErrStat2, ErrMsg2 ) - - if (ErrStat >= AbortErrLev) return - - - ! check that we read the correct airfoil parameters for UA: - if ( InputFileData%AFAeroMod == AFAeroMod_BL_unsteady ) then - - - ! determine which airfoil files will be used - call AllocAry( fileUsed, InputFileData%NumAFfiles, 'fileUsed', errStat2, errMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (errStat >= AbortErrLev) return - fileUsed = .false. - - do k=1,NumBl - do j=1,InputFileData%BladeProps(k)%NumBlNds - fileUsed ( InputFileData%BladeProps(k)%BlAFID(j) ) = .true. - end do ! j=nodes - end do ! k=blades - - ! make sure all files in use have UA input parameters: - do File = 1,InputFileData%NumAFfiles - - if (fileUsed(File)) then - do Table=1,p_AFI%AFInfo(File)%NumTabs - if ( .not. p_AFI%AFInfo(File)%Table(Table)%InclUAdata ) then - call SetErrStat( ErrID_Fatal, 'Airfoil file '//trim(InputFileData%AFNames(File))//', table #'// & - trim(num2lstr(Table))//' does not contain parameters for UA data.', ErrStat, ErrMsg, RoutineName ) - end if - end do - end if - - end do - - if ( allocated(fileUsed) ) deallocate(fileUsed) - - end if - - -END SUBROUTINE Init_AFIparams - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the Airfoil Noise module from within AeroDyn. -SUBROUTINE Init_AAmodule( DrvInitInp, AD_InputFileData, u_AD, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - type(AD_InitInputType), intent(in ) :: DrvInitInp !< AeroDyn-level initialization inputs - type(AD_InputFile), intent(in ) :: AD_InputFileData !< All the data in the AeroDyn input file - type(AD_InputType), intent(in ) :: u_AD !< AD inputs - used for input mesh node positions - type(AA_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined - type(AD_ParameterType), intent(inout) :: p !< Parameters ! intent out b/c we set the AA parameters here - type(AA_ContinuousStateType), intent( out) :: x !< Initial continuous states - type(AA_DiscreteStateType), intent( out) :: xd !< Initial discrete states - type(AA_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states - type(AA_OtherStateType), intent( out) :: OtherState !< Initial other states - type(AA_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; - !! only the output mesh is initialized) - type(AA_MiscVarType), intent( out) :: m !< Initial misc/optimization variables - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - - ! Local variables - real(DbKi) :: Interval ! Coupling interval in seconds: the rate that - ! (1) BEMT_UpdateStates() is called in loose coupling & - ! (2) BEMT_UpdateDiscState() is called in tight coupling. - ! Input is the suggested time from the glue code; - ! Output is the actual coupling interval that will be used - ! by the glue code. - type(AA_InitInputType) :: InitInp ! Input data for initialization routine - type(AA_InitOutputType) :: InitOut ! Output for initialization routine - integer(intKi) :: i ! airfoil file index - integer(intKi) :: j ! node index - integer(intKi) :: k ! blade index - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'Init_AAmodule' - - ! note here that each blade is required to have the same number of nodes - - ErrStat = ErrID_None - ErrMsg = "" - - - - ! set initialization data here: - Interval = p%DT - InitInp%NumBlades = p%NumBlades - InitInp%NumBlNds = p%NumBlNds - InitInp%airDens = AD_InputFileData%AirDens - InitInp%kinVisc = AD_InputFileData%KinVisc - InitInp%InputFile = AD_InputFileData%AA_InputFile - InitInp%RootName = DrvInitInp%RootName - InitInp%SpdSound = AD_InputFileData%SpdSound - InitInp%HubHeight = DrvInitInp%HubPosition(3) - ALLOCATE ( InitInp%AFInfo( size(p%AFI%AFInfo) ), STAT=ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat ( ErrID_Fatal, 'Error allocating memory for the InitInp%AFInfo array.', ErrStat2, ErrMsg2, RoutineName ) - RETURN - ENDIF - - do i=1,size(p%AFI%AFInfo) - call AFI_Copyafinfotype( p%AFI%AFInfo(i), InitInp%AFInfo(i), MESH_NEWCOPY, errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - end do - - call AllocAry( InitInp%BlAFID, p%NumBlNds, p%NumBlades,'InitInp%BlAFID', errStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - - !======================================= - - !InitInp%RootName = TRIM(DrvInitInp%RootName)//'.AA' - - call AllocAry( InitInp%BlChord, p%NumBlNds, p%NumBlades, 'BlChord', errStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - - call AllocAry( InitInp%BlSpn, p%NumBlNds, p%NumBlades, 'BlSpn', errStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if - - do k = 1, p%NumBlades - do j=1, AD_InputFileData%BladeProps(k)%NumBlNds - InitInp%BlChord(j,k) = AD_InputFileData%BladeProps(k)%BlChord( j) - InitInp%BlSpn (j,k) = AD_InputFileData%BladeProps(k)%BlSpn(j) - InitInp%BlAFID(j,k) = AD_InputFileData%BladeProps(k)%BlAFID(j) - end do - end do - - call AA_Init(InitInp, u, p%AA, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - - if (.not. equalRealNos(Interval, p%DT) ) & - call SetErrStat( ErrID_Fatal, "DTAero was changed in Init_AAmodule(); this is not allowed.", ErrStat2, ErrMsg2, RoutineName) - call Cleanup() - return - - - - - - - !call NN_Init(InitInData, NN%u(1), NN%p, NN%x, NN%xd, NN%z, NN%OtherState, NN%y, NN%m, dt, InitOutData, ErrStat2, ErrMsg2 ) - ! call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - !if (ErrStat >= AbortErrLev) then - ! call Cleanup() - ! return - !end if - - ! we know exact values, so we're going to initialize inputs this way (instead of using the input guesses from AD_Init) - !NN%InputTime = -999 - !DO j = 1-numInp, 0 - ! call Set_NN_Inputs(iCase,j,DvrData,NN,errStat2,errMsg2) - ! call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - !END DO - ! - ! - ! ! move NN initOut data to NN Driver - !call move_alloc( InitOutData%WriteOutputHdr, DvrData%OutFileData%WriteOutputHdr ) - !call move_alloc( InitOutData%WriteOutputUnt, DvrData%OutFileData%WriteOutputUnt ) - ! - !DvrData%OutFileData%NN_ver = InitOutData%ver - ! - - - -contains - subroutine Cleanup() - call AA_DestroyInitInput( InitInp, ErrStat2, ErrMsg2 ) - call AA_DestroyInitOutput( InitOut, ErrStat2, ErrMsg2 ) - end subroutine Cleanup - -END SUBROUTINE Init_AAmodule - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the BEMT module from within AeroDyn. -SUBROUTINE Init_BEMTmodule( InputFileData, u_AD, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - type(AD_InputFile), intent(in ) :: InputFileData !< All the data in the AeroDyn input file - type(AD_InputType), intent(in ) :: u_AD !< AD inputs - used for input mesh node positions - type(BEMT_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined - type(AD_ParameterType), intent(inout) :: p !< Parameters ! intent out b/c we set the BEMT parameters here - type(BEMT_ContinuousStateType), intent( out) :: x !< Initial continuous states - type(BEMT_DiscreteStateType), intent( out) :: xd !< Initial discrete states - type(BEMT_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states - type(BEMT_OtherStateType), intent( out) :: OtherState !< Initial other states - type(BEMT_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; - !! only the output mesh is initialized) - type(BEMT_MiscVarType), intent( out) :: m !< Initial misc/optimization variables - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - - ! Local variables - real(DbKi) :: Interval ! Coupling interval in seconds: the rate that - ! (1) BEMT_UpdateStates() is called in loose coupling & - ! (2) BEMT_UpdateDiscState() is called in tight coupling. - ! Input is the suggested time from the glue code; - ! Output is the actual coupling interval that will be used - ! by the glue code. - type(BEMT_InitInputType) :: InitInp ! Input data for initialization routine - type(BEMT_InitOutputType) :: InitOut ! Output for initialization routine - - integer(intKi) :: j ! node index - integer(intKi) :: k ! blade index - integer(IntKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'Init_BEMTmodule' - - ! note here that each blade is required to have the same number of nodes - - ErrStat = ErrID_None - ErrMsg = "" - - - ! set initialization data here: - Interval = p%DT - InitInp%numBlades = p%NumBlades - - InitInp%airDens = InputFileData%AirDens - InitInp%kinVisc = InputFileData%KinVisc - InitInp%skewWakeMod = InputFileData%SkewMod - InitInp%aTol = InputFileData%IndToler - InitInp%useTipLoss = InputFileData%TipLoss - InitInp%useHubLoss = InputFileData%HubLoss - InitInp%useInduction = InputFileData%WakeMod == WakeMod_BEMT - InitInp%useTanInd = InputFileData%TanInd - InitInp%useAIDrag = InputFileData%AIDrag - InitInp%useTIDrag = InputFileData%TIDrag - InitInp%numBladeNodes = p%NumBlNds - InitInp%numReIterations = 1 ! This is currently not available in the input file and is only for testing - InitInp%maxIndIterations = InputFileData%MaxIter - - call AllocAry(InitInp%chord, InitInp%numBladeNodes,InitInp%numBlades,'chord', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(InitInp%AFindx,InitInp%numBladeNodes,InitInp%numBlades,'AFindx',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(InitInp%zHub, InitInp%numBlades,'zHub', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(InitInp%zLocal,InitInp%numBladeNodes,InitInp%numBlades,'zLocal',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(InitInp%zTip, InitInp%numBlades,'zTip', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - if ( ErrStat >= AbortErrLev ) then - call Cleanup() - return - end if - - - do k=1,p%numBlades - - InitInp%zHub(k) = TwoNorm( u_AD%BladeRootMotion(k)%Position(:,1) - u_AD%HubMotion%Position(:,1) ) - if (EqualRealNos(InitInp%zHub(k),0.0_ReKi) ) & - call SetErrStat( ErrID_Fatal, "zHub for blade "//trim(num2lstr(k))//" is zero.", ErrStat, ErrMsg, RoutineName) - - InitInp%zLocal(1,k) = InitInp%zHub(k) + TwoNorm( u_AD%BladeMotion(k)%Position(:,1) - u_AD%BladeRootMotion(k)%Position(:,1) ) - do j=2,p%NumBlNds - InitInp%zLocal(j,k) = InitInp%zLocal(j-1,k) + TwoNorm( u_AD%BladeMotion(k)%Position(:,j) - u_AD%BladeMotion(k)%Position(:,j-1) ) - end do !j=nodes - - InitInp%zTip(k) = InitInp%zLocal(p%NumBlNds,k) - - end do !k=blades - - - do k=1,p%numBlades - do j=1,p%NumBlNds - InitInp%chord (j,k) = InputFileData%BladeProps(k)%BlChord(j) - InitInp%AFindx(j,k) = InputFileData%BladeProps(k)%BlAFID(j) - end do - end do - - InitInp%UA_Flag = InputFileData%AFAeroMod == AFAeroMod_BL_unsteady - InitInp%UAMod = InputFileData%UAMod - InitInp%Flookup = InputFileData%Flookup - InitInp%a_s = InputFileData%SpdSound - - if (ErrStat >= AbortErrLev) then - call cleanup() - return - end if - - - call BEMT_Init(InitInp, u, p%BEMT, x, xd, z, OtherState, p%AFI%AFInfo, y, m, Interval, InitOut, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - - if (.not. equalRealNos(Interval, p%DT) ) & - call SetErrStat( ErrID_Fatal, "DTAero was changed in Init_BEMTmodule(); this is not allowed.", ErrStat2, ErrMsg2, RoutineName) - - !m%UseFrozenWake = .FALSE. !BJJ: set this in BEMT - - call Cleanup() - return - -contains - subroutine Cleanup() - call BEMT_DestroyInitInput( InitInp, ErrStat2, ErrMsg2 ) - call BEMT_DestroyInitOutput( InitOut, ErrStat2, ErrMsg2 ) - end subroutine Cleanup - -END SUBROUTINE Init_BEMTmodule -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine calculates the tower loads for the AeroDyn TowerLoad output mesh. -SUBROUTINE ADTwr_CalcOutput(p, u, m, y, ErrStat, ErrMsg ) - - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at Time t - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - TYPE(AD_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- - !! 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 - - - INTEGER(IntKi) :: j - real(ReKi) :: q - real(ReKi) :: V_rel(3) ! relative wind speed on a tower node - real(ReKi) :: VL(2) ! relative local x- and y-components of the wind speed on a tower node - real(ReKi) :: tmp(3) - - !integer(intKi) :: ErrStat2 - !character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'ADTwr_CalcOutput' - - - ErrStat = ErrID_None - ErrMsg = "" - - - do j=1,p%NumTwrNds - - V_rel = u%InflowOnTower(:,j) - u%TowerMotion%TranslationDisp(:,j) ! relative wind speed at tower node - - tmp = u%TowerMotion%Orientation(1,:,j) - VL(1) = dot_product( V_Rel, tmp ) ! relative local x-component of wind speed of the jth node in the tower - tmp = u%TowerMotion%Orientation(2,:,j) - VL(2) = dot_product( V_Rel, tmp ) ! relative local y-component of wind speed of the jth node in the tower - - m%W_Twr(j) = TwoNorm( VL ) ! relative wind speed normal to the tower at node j - q = 0.5 * p%TwrCd(j) * p%AirDens * p%TwrDiam(j) * m%W_Twr(j) - - ! force per unit length of the jth node in the tower - tmp(1) = q * VL(1) - tmp(2) = q * VL(2) - tmp(3) = 0.0_ReKi - - y%TowerLoad%force(:,j) = matmul( tmp, u%TowerMotion%Orientation(:,:,j) ) ! note that I'm calculating the transpose here, which is okay because we have 1-d arrays - m%X_Twr(j) = tmp(1) - m%Y_Twr(j) = tmp(2) - - - ! moment per unit length of the jth node in the tower - y%TowerLoad%moment(:,j) = 0.0_ReKi - - end do - - -END SUBROUTINE ADTwr_CalcOutput -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine checks for invalid inputs to the tower influence models. -SUBROUTINE CheckTwrInfl(u, ErrStat, ErrMsg ) - - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at Time t - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - real(reKi) :: ElemSize - real(reKi) :: tmp(3) - integer(intKi) :: j - character(*), parameter :: RoutineName = 'CheckTwrInfl' - - - ErrStat = ErrID_None - ErrMsg = "" - - !! the tower-influence models (tower potential flow and tower shadow) are valid only for small tower deflections; - !! so, first throw an error to avoid a division-by-zero error if any line2 elements on the tower mesh are colocated. - - do j = 2,u%TowerMotion%Nnodes - tmp = u%TowerMotion%Position(:,j ) + u%TowerMotion%TranslationDisp(:,j ) & - - u%TowerMotion%Position(:,j-1) - u%TowerMotion%TranslationDisp(:,j-1) - - ElemSize = TwoNorm(tmp) - if ( EqualRealNos(ElemSize,0.0_ReKi) ) then - call SetErrStat(ErrID_Fatal, "Division by zero:Elements "//trim(num2lstr(j))//' and '//trim(num2lstr(j-1))//' are colocated.', ErrStat, ErrMsg, RoutineName ) - exit - end if - end do - - -END SUBROUTINE CheckTwrInfl -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine calculates m%DisturbedInflow, the influence of tower shadow and/or potential flow on the inflow velocities -SUBROUTINE TwrInfl( p, u, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at Time t - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - real(ReKi) :: xbar ! local x^ component of r_TowerBlade (distance from tower to blade) normalized by tower radius - real(ReKi) :: ybar ! local y^ component of r_TowerBlade (distance from tower to blade) normalized by tower radius - real(ReKi) :: zbar ! local z^ component of r_TowerBlade (distance from tower to blade) normalized by tower radius - real(ReKi) :: theta_tower_trans(3,3) ! transpose of local tower orientation expressed as a DCM - real(ReKi) :: TwrCd ! local tower drag coefficient - real(ReKi) :: W_tower ! local relative wind speed normal to the tower - - real(ReKi) :: BladeNodePosition(3) ! local blade node position - - - real(ReKi) :: u_TwrShadow ! axial velocity deficit fraction from tower shadow - real(ReKi) :: u_TwrPotent ! axial velocity deficit fraction from tower potential flow - real(ReKi) :: v_TwrPotent ! transverse velocity deficit fraction from tower potential flow - - real(ReKi) :: denom ! denominator - real(ReKi) :: v(3) ! temp vector - - integer(IntKi) :: j, k ! loop counters for elements, blades - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'TwrInfl' - - - ErrStat = ErrID_None - ErrMsg = "" - - - ! these models are valid for only small tower deflections; check for potential division-by-zero errors: - call CheckTwrInfl( u, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return - - do k = 1, p%NumBlades - do j = 1, u%BladeMotion(k)%NNodes - - ! for each line2-element node of the blade mesh, a nearest-neighbor line2 element or node of the tower - ! mesh is found in the deflected configuration, returning theta_tower, W_tower, xbar, ybar, zbar, and TowerCd: - - BladeNodePosition = u%BladeMotion(k)%Position(:,j) + u%BladeMotion(k)%TranslationDisp(:,j) - - call getLocalTowerProps(p, u, BladeNodePosition, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, m%TwrClrnc(j,k), ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return - - - ! calculate tower influence: - if ( abs(zbar) < 1.0_ReKi .and. p%TwrPotent /= TwrPotent_none ) then - if ( p%TwrPotent == TwrPotent_baseline ) then - - denom = (xbar**2 + ybar**2)**2 - - u_TwrPotent = ( -1.0*xbar**2 + ybar**2 ) / denom - v_TwrPotent = ( -2.0*xbar * ybar ) / denom - - elseif (p%TwrPotent == TwrPotent_Bak) then - - xbar = xbar + 0.1 - - denom = (xbar**2 + ybar**2)**2 - u_TwrPotent = ( -1.0*xbar**2 + ybar**2 ) / denom - v_TwrPotent = ( -2.0*xbar * ybar ) / denom - - denom = TwoPi*(xbar**2 + ybar**2) - u_TwrPotent = u_TwrPotent + TwrCd*xbar / denom - v_TwrPotent = v_TwrPotent + TwrCd*ybar / denom - - end if - else - u_TwrPotent = 0.0_ReKi - v_TwrPotent = 0.0_ReKi - end if - - if ( p%TwrShadow .and. xbar > 0.0_ReKi .and. abs(zbar) < 1.0_ReKi) then - denom = sqrt( sqrt( xbar**2 + ybar**2 ) ) - if ( abs(ybar) < denom ) then - u_TwrShadow = -TwrCd / denom * cos( PiBy2*ybar / denom )**2 - else - u_TwrShadow = 0.0_ReKi - end if - else - u_TwrShadow = 0.0_ReKi - end if - - v(1) = (u_TwrPotent + u_TwrShadow)*W_tower - v(2) = v_TwrPotent*W_tower - v(3) = 0.0_ReKi - - m%DisturbedInflow(:,j,k) = u%InflowOnBlade(:,j,k) + matmul( theta_tower_trans, v ) - - end do !j=NumBlNds - end do ! NumBlades - - -END SUBROUTINE TwrInfl -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine returns the tower constants necessary to compute the tower influence. -!! if u%TowerMotion does not have any nodes there will be serious problems. I assume that has been checked earlier. -SUBROUTINE getLocalTowerProps(p, u, BladeNodePosition, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrClrnc, ErrStat, ErrMsg) -!.................................................................................................................................. - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at Time t - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - REAL(ReKi) ,INTENT(IN ) :: BladeNodePosition(3) !< local blade node position - REAL(ReKi) ,INTENT( OUT) :: theta_tower_trans(3,3) !< transpose of local tower orientation expressed as a DCM - REAL(ReKi) ,INTENT( OUT) :: W_tower !< local relative wind speed normal to the tower - REAL(ReKi) ,INTENT( OUT) :: xbar !< local x^ component of r_TowerBlade normalized by tower radius - REAL(ReKi) ,INTENT( OUT) :: ybar !< local y^ component of r_TowerBlade normalized by tower radius - REAL(ReKi) ,INTENT( OUT) :: zbar !< local z^ component of r_TowerBlade normalized by tower radius - REAL(ReKi) ,INTENT( OUT) :: TwrCd !< local tower drag coefficient - REAL(ReKi) ,INTENT( OUT) :: TwrClrnc !< tower clearance for potential output - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - real(ReKi) :: r_TowerBlade(3) ! distance vector from tower to blade - real(ReKi) :: TwrDiam ! local tower diameter - logical :: found - character(*), parameter :: RoutineName = 'getLocalTowerProps' - - - ErrStat = ErrID_None - ErrMsg = "" - - ! .............................................. - ! option 1: nearest line2 element - ! .............................................. - call TwrInfl_NearestLine2Element(p, u, BladeNodePosition, r_TowerBlade, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrDiam, found) - - if ( .not. found) then - ! .............................................. - ! option 2: nearest node - ! .............................................. - call TwrInfl_NearestPoint(p, u, BladeNodePosition, r_TowerBlade, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrDiam) - - end if - - TwrClrnc = TwoNorm(r_TowerBlade) - 0.5_ReKi*TwrDiam - if ( TwrClrnc <= 0.0_ReKi ) then - call SetErrStat(ErrID_Severe, "Tower strike.", ErrStat, ErrMsg, RoutineName) - end if - - -END SUBROUTINE getLocalTowerProps -!---------------------------------------------------------------------------------------------------------------------------------- -!> Option 1: Find the nearest-neighbor line2 element of the tower mesh for which the blade line2-element node projects orthogonally onto -!! the tower line2-element domain (following an approach similar to the line2_to_line2 mapping search for motion and scalar quantities). -!! That is, for each node of the blade mesh, an orthogonal projection is made onto all possible Line2 elements of the tower mesh and -!! the line2 element of the tower mesh that is the minimum distance away is found. -!! Adapted from modmesh_mapping::createmapping_projecttoline2() -SUBROUTINE TwrInfl_NearestLine2Element(p, u, BladeNodePosition, r_TowerBlade, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrDiam, found) -!.................................................................................................................................. - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at Time t - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - REAL(ReKi) ,INTENT(IN ) :: BladeNodePosition(3) !< local blade node position - REAL(ReKi) ,INTENT( OUT) :: r_TowerBlade(3) !< distance vector from tower to blade - REAL(ReKi) ,INTENT( OUT) :: theta_tower_trans(3,3) !< transpose of local tower orientation expressed as a DCM - REAL(ReKi) ,INTENT( OUT) :: W_tower !< local relative wind speed normal to the tower - REAL(ReKi) ,INTENT( OUT) :: xbar !< local x^ component of r_TowerBlade normalized by tower radius - REAL(ReKi) ,INTENT( OUT) :: ybar !< local y^ component of r_TowerBlade normalized by tower radius - REAL(ReKi) ,INTENT( OUT) :: zbar !< local z^ component of r_TowerBlade normalized by tower radius - REAL(ReKi) ,INTENT( OUT) :: TwrCd !< local tower drag coefficient - REAL(ReKi) ,INTENT( OUT) :: TwrDiam !< local tower diameter - logical ,INTENT( OUT) :: found !< whether a mapping was found with this option - - ! local variables - REAL(ReKi) :: denom - REAL(ReKi) :: dist - REAL(ReKi) :: min_dist - REAL(ReKi) :: elem_position, elem_position2 - REAL(SiKi) :: elem_position_SiKi - - REAL(ReKi) :: p1(3), p2(3) ! position vectors for nodes on tower line 2 element - - REAL(ReKi) :: V_rel_tower(3) - - REAL(ReKi) :: n1_n2_vector(3) ! vector going from node 1 to node 2 in Line2 element - REAL(ReKi) :: n1_Point_vector(3) ! vector going from node 1 in Line 2 element to Destination Point - REAL(ReKi) :: tmp(3) ! temporary vector for cross product calculation - - INTEGER(IntKi) :: jElem ! do-loop counter for elements on tower mesh - - INTEGER(IntKi) :: n1, n2 ! nodes associated with an element - - LOGICAL :: on_element - - - found = .false. - min_dist = HUGE(min_dist) - - do jElem = 1, u%TowerMotion%ElemTable(ELEMENT_LINE2)%nelem ! number of elements on TowerMesh - ! grab node numbers associated with the jElem_th element - n1 = u%TowerMotion%ElemTable(ELEMENT_LINE2)%Elements(jElem)%ElemNodes(1) - n2 = u%TowerMotion%ElemTable(ELEMENT_LINE2)%Elements(jElem)%ElemNodes(2) - - p1 = u%TowerMotion%Position(:,n1) + u%TowerMotion%TranslationDisp(:,n1) - p2 = u%TowerMotion%Position(:,n2) + u%TowerMotion%TranslationDisp(:,n2) - - ! Calculate vectors used in projection operation - n1_n2_vector = p2 - p1 - n1_Point_vector = BladeNodePosition - p1 - - denom = DOT_PRODUCT( n1_n2_vector, n1_n2_vector ) ! we've already checked that these aren't zero - - ! project point onto line defined by n1 and n2 - - elem_position = DOT_PRODUCT(n1_n2_vector,n1_Point_vector) / denom - - ! note: i forumlated it this way because Fortran doesn't necessarially do shortcutting and I don't want to call EqualRealNos if we don't need it: - if ( elem_position .ge. 0.0_ReKi .and. elem_position .le. 1.0_ReKi ) then !we're ON the element (between the two nodes) - on_element = .true. - else - elem_position_SiKi = REAL( elem_position, SiKi ) - if (EqualRealNos( elem_position_SiKi, 1.0_SiKi )) then !we're ON the element (at a node) - on_element = .true. - elem_position = 1.0_ReKi - elseif (EqualRealNos( elem_position_SiKi, 0.0_SiKi )) then !we're ON the element (at a node) - on_element = .true. - elem_position = 0.0_ReKi - else !we're not on the element - on_element = .false. - end if - - end if - - if (on_element) then - - ! calculate distance between point and line (note: this is actually the distance squared); - ! will only store information once we have determined the closest element - elem_position2 = 1.0_ReKi - elem_position - - r_TowerBlade = BladeNodePosition - elem_position2*p1 - elem_position*p2 - dist = dot_product( r_TowerBlade, r_TowerBlade ) - - if (dist .lt. min_dist) then - found = .true. - min_dist = dist - - V_rel_tower = ( u%InflowOnTower(:,n1) - u%TowerMotion%TranslationVel(:,n1) ) * elem_position2 & - + ( u%InflowOnTower(:,n2) - u%TowerMotion%TranslationVel(:,n2) ) * elem_position - - TwrDiam = elem_position2*p%TwrDiam(n1) + elem_position*p%TwrDiam(n2) - TwrCd = elem_position2*p%TwrCd( n1) + elem_position*p%TwrCd( n2) - - - ! z_hat - theta_tower_trans(:,3) = n1_n2_vector / sqrt( denom ) ! = n1_n2_vector / twoNorm( n1_n2_vector ) - - tmp = V_rel_tower - dot_product(V_rel_tower,theta_tower_trans(:,3)) * theta_tower_trans(:,3) - denom = TwoNorm( tmp ) - if (.not. EqualRealNos( denom, 0.0_ReKi ) ) then - ! x_hat - theta_tower_trans(:,1) = tmp / denom - - ! y_hat - tmp = cross_product( theta_tower_trans(:,3), V_rel_tower ) - theta_tower_trans(:,2) = tmp / denom - - W_tower = dot_product( V_rel_tower,theta_tower_trans(:,1) ) - xbar = 2.0/TwrDiam * dot_product( r_TowerBlade, theta_tower_trans(:,1) ) - ybar = 2.0/TwrDiam * dot_product( r_TowerBlade, theta_tower_trans(:,2) ) - zbar = 0.0_ReKi - - else - ! there is no tower influence because dot_product(V_rel_tower,x_hat) = 0 - ! thus, we don't need to set the other values (except we don't want the sum of xbar^2 and ybar^2 to be 0) - theta_tower_trans = 0.0_ReKi - W_tower = 0.0_ReKi - xbar = 1.0_ReKi - ybar = 0.0_ReKi - zbar = 0.0_ReKi - end if - - - end if !the point is closest to this line2 element - - end if - - end do !jElem - -END SUBROUTINE TwrInfl_NearestLine2Element -!---------------------------------------------------------------------------------------------------------------------------------- -!> Option 2: used when the blade node does not orthogonally intersect a tower element. -!! Find the nearest-neighbor node in the tower Line2-element domain (following an approach similar to the point_to_point mapping -!! search for motion and scalar quantities). That is, for each node of the blade mesh, the node of the tower mesh that is the minimum -!! distance away is found. -SUBROUTINE TwrInfl_NearestPoint(p, u, BladeNodePosition, r_TowerBlade, theta_tower_trans, W_tower, xbar, ybar, zbar, TwrCd, TwrDiam) -!.................................................................................................................................. - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at Time t - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - REAL(ReKi) ,INTENT(IN ) :: BladeNodePosition(3) !< local blade node position - REAL(ReKi) ,INTENT( OUT) :: r_TowerBlade(3) !< distance vector from tower to blade - REAL(ReKi) ,INTENT( OUT) :: theta_tower_trans(3,3) !< transpose of local tower orientation expressed as a DCM - REAL(ReKi) ,INTENT( OUT) :: W_tower !< local relative wind speed normal to the tower - REAL(ReKi) ,INTENT( OUT) :: xbar !< local x^ component of r_TowerBlade normalized by tower radius - REAL(ReKi) ,INTENT( OUT) :: ybar !< local y^ component of r_TowerBlade normalized by tower radius - REAL(ReKi) ,INTENT( OUT) :: zbar !< local z^ component of r_TowerBlade normalized by tower radius - REAL(ReKi) ,INTENT( OUT) :: TwrCd !< local tower drag coefficient - REAL(ReKi) ,INTENT( OUT) :: TwrDiam !< local tower diameter - - ! local variables - REAL(ReKi) :: denom - REAL(ReKi) :: dist - REAL(ReKi) :: min_dist - REAL(ReKi) :: cosTaper - - REAL(ReKi) :: p1(3) ! position vectors for nodes on tower - REAL(ReKi) :: V_rel_tower(3) - - REAL(ReKi) :: tmp(3) ! temporary vector for cross product calculation - - INTEGER(IntKi) :: n1 ! node - INTEGER(IntKi) :: node_with_min_distance - - - - !................. - ! find the closest node - !................. - - min_dist = HUGE(min_dist) - node_with_min_distance = 0 - - do n1 = 1, u%TowerMotion%NNodes ! number of nodes on TowerMesh - - p1 = u%TowerMotion%Position(:,n1) + u%TowerMotion%TranslationDisp(:,n1) - - ! calculate distance between points (note: this is actually the distance squared); - ! will only store information once we have determined the closest node - r_TowerBlade = BladeNodePosition - p1 - dist = dot_product( r_TowerBlade, r_TowerBlade ) - - if (dist .lt. min_dist) then - min_dist = dist - node_with_min_distance = n1 - - end if !the point is (so far) closest to this blade node - - end do !n1 - - !................. - ! calculate the values to be returned: - !.................. - if (node_with_min_distance == 0) then - node_with_min_distance = 1 - if (NWTC_VerboseLevel == NWTC_Verbose) call WrScr( 'AD:TwrInfl_NearestPoint:Error finding minimum distance. Positions may be invalid.' ) - end if - - n1 = node_with_min_distance - - r_TowerBlade = BladeNodePosition - u%TowerMotion%Position(:,n1) - u%TowerMotion%TranslationDisp(:,n1) - V_rel_tower = u%InflowOnTower(:,n1) - u%TowerMotion%TranslationVel(:,n1) - TwrDiam = p%TwrDiam(n1) - TwrCd = p%TwrCd( n1) - - ! z_hat - theta_tower_trans(:,3) = u%TowerMotion%Orientation(3,:,n1) - - tmp = V_rel_tower - dot_product(V_rel_tower,theta_tower_trans(:,3)) * theta_tower_trans(:,3) - denom = TwoNorm( tmp ) - - if (.not. EqualRealNos( denom, 0.0_ReKi ) ) then - - ! x_hat - theta_tower_trans(:,1) = tmp / denom - - ! y_hat - tmp = cross_product( theta_tower_trans(:,3), V_rel_tower ) - theta_tower_trans(:,2) = tmp / denom - - W_tower = dot_product( V_rel_tower,theta_tower_trans(:,1) ) - - if ( n1 == 1 .or. n1 == u%TowerMotion%NNodes) then - ! option 2b - zbar = 2.0/TwrDiam * dot_product( r_TowerBlade, theta_tower_trans(:,3) ) - if (abs(zbar) < 1) then - cosTaper = cos( PiBy2*zbar ) - xbar = 2.0/TwrDiam * dot_product( r_TowerBlade, theta_tower_trans(:,1) ) / cosTaper - ybar = 2.0/TwrDiam * dot_product( r_TowerBlade, theta_tower_trans(:,2) ) / cosTaper - else ! we check that zbar < 1 before using xbar and ybar later, but I'm going to set them here anyway: - xbar = 1.0_ReKi - ybar = 0.0_ReKi - end if - else - ! option 2a - xbar = 2.0/TwrDiam * dot_product( r_TowerBlade, theta_tower_trans(:,1) ) - ybar = 2.0/TwrDiam * dot_product( r_TowerBlade, theta_tower_trans(:,2) ) - zbar = 0.0_ReKi - end if - - else - - ! there is no tower influence because W_tower = dot_product(V_rel_tower,x_hat) = 0 - ! thus, we don't need to set the other values (except we don't want the sum of xbar^2 and ybar^2 to be 0) - W_tower = 0.0_ReKi - theta_tower_trans = 0.0_ReKi - xbar = 1.0_ReKi - ybar = 0.0_ReKi - zbar = 0.0_ReKi - - end if - -END SUBROUTINE TwrInfl_NearestPoint -!---------------------------------------------------------------------------------------------------------------------------------- - -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -! ###### The following four routines are Jacobian routines for linearization capabilities ####### -! If the module does not implement them, set ErrStat = ErrID_Fatal in AD_Init() when InitInp%Linearize is .true. -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and DZ/du are returned. -SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(AD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(AD_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); - !! Output fields are not used by this routine, but type is - !! available here so that mesh parameter information (i.e., - !! connectivity) does not have to be recalculated for dYdu. - TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect - !! to the inputs (u) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with - !! respect to the inputs (u) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with - !! respect to the inputs (u) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with - !! respect to the inputs (u) [intent in to avoid deallocation] - ! local variables - TYPE(AD_OutputType) :: y_p - TYPE(AD_OutputType) :: y_m - TYPE(AD_ConstraintStateType) :: z_p - TYPE(AD_ConstraintStateType) :: z_m - TYPE(AD_InputType) :: u_perturb - REAL(ReKi) :: delta_p, delta_m ! delta change in input - INTEGER(IntKi) :: i, j, k, n - logical :: ValidInput - - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - integer, parameter :: op_indx = 2 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt or the input at OP - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_JacobianPInput' - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - - ! get OP values here: - !call AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) - call SetInputsForBEMT(p, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call BEMT_CopyInput( m%BEMT_u(indx), m%BEMT_u(op_indx), MESH_UPDATECOPY, ErrStat2, ErrMsg2) ! copy the BEMT OP inputs to a temporary location that won't be overwritten - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - if ( p%FrozenWake ) then - ! compare arguments with call to BEMT_CalcOutput - call computeFrozenWake(m%BEMT_u(op_indx), p%BEMT, m%BEMT_y, m%BEMT ) - m%BEMT%UseFrozenWake = .true. - end if - - - ! make a copy of the inputs to perturb - call AD_CopyInput( u, u_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - IF ( PRESENT( dYdu ) ) THEN - ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: - - ! allocate dYdu - if (.not. allocated(dYdu) ) then - call AllocAry(dYdu,p%Jac_ny, size(p%Jac_u_indx,1),'dYdu', ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - end if - - - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call AD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta_p u - call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_u( p, i, 1, u_perturb, delta_p ) - - ! we need to see if these perturbed inputs put us in different solution regions: - call SetInputsForBEMT(p, u_perturb, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ValidInput = CheckBEMTInputPerturbations( p, m ) - - ! if so, we do a 1-sided difference: - if (.not. ValidInput) then - call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - delta_p = 0 - end if - - - ! compute y at u_op + delta_p u - call AD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_p, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get u_op - delta_m u - call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_u( p, i, -1, u_perturb, delta_m ) - - ! we need to see if these perturbed inputs put us in different solution regions: - call SetInputsForBEMT(p, u_perturb, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ValidInput = CheckBEMTInputPerturbations( p, m ) - - ! if so, we do a 1-sided difference: - if (.not. ValidInput) then - call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - delta_m = 0 - if (EqualRealNos(delta_p, 0.0_ReKi)) then - call SetErrStat(ErrID_Fatal,'Both sides of central difference equation change solution region. '// & - 'dYdu cannot be calculated for column '//trim(num2lstr(i))//'.',ErrStat,ErrMsg,RoutineName) - return - end if - end if - - - ! compute y at u_op - delta_m u - call AD_CalcOutput( t, u_perturb, p, x, xd, z, OtherState, y_m, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get central difference: - call Compute_dY( p, y_p, y_m, delta_p, delta_m, dYdu(:,i) ) - - end do - - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call AD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - - END IF - - IF ( PRESENT( dXdu ) ) THEN - if (allocated(dXdu)) deallocate(dXdu) - END IF - - IF ( PRESENT( dXddu ) ) THEN - if (allocated(dXddu)) deallocate(dXddu) - END IF - - IF ( PRESENT( dZdu ) ) THEN - - call CheckLinearizationInput(p%BEMT, m%BEMT_u(op_indx), z%BEMT, m%BEMT, ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the inputs (u) here: - - ! allocate dZdu - if (.not. allocated(dZdu)) then - call AllocAry(dZdu,size(z%BEMT%phi), size(p%Jac_u_indx,1),'dZdu', ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - end if - - - do i=1,size(p%Jac_u_indx,1) - - ! get u_op + delta_p u - call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call Perturb_u( p, i, 1, u_perturb, delta_p ) - - ! we need to see if these perturbed inputs put us in different solution regions: - call SetInputsForBEMT(p, u_perturb, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ValidInput = CheckBEMTInputPerturbations( p, m ) - - ! if so, we do a 1-sided difference: - if (.not. ValidInput) then - call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - delta_p = 0 - end if - - - ! compute z_p at u_op + delta_p u - call AD_CalcConstrStateResidual( t, u_perturb, p, x, xd, z, OtherState, m, z_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get u_op - delta_m u - call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call Perturb_u( p, i, -1, u_perturb, delta_m ) - - ! we need to see if these perturbed inputs put us in different solution regions: - call SetInputsForBEMT(p, u_perturb, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ValidInput = CheckBEMTInputPerturbations( p, m ) - - ! if so, we do a 1-sided difference: - if (.not. ValidInput) then - call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - delta_m = 0 - if (EqualRealNos(delta_p, 0.0_ReKi)) then - call SetErrStat(ErrID_Fatal,'Both sides of central difference equation change solution region. '// & - 'dYdu cannot be calculated for column '//trim(num2lstr(i))//'.',ErrStat,ErrMsg,RoutineName) - return - end if - end if - - - ! compute z_m at u_op - delta_m u - call AD_CalcConstrStateResidual( t, u_perturb, p, x, xd, z, OtherState, m, z_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get central difference: - - ! we may have had an error allocating memory, so we'll check - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - do k=1,p%NumBlades ! size(z%BEMT%Phi,2) - do j=1,p%NumBlNds ! size(z%BEMT%Phi,1) - n = (k-1)*p%NumBlNds + j - dZdu(n,i) = z_p%BEMT%Phi(j,k) - z_m%BEMT%Phi(j,k) - end do - end do - - dZdu(:,i) = dZdu(:,i) / (delta_p + delta_m) - - end do - - call AD_DestroyConstrState( z_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyConstrState( z_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - END IF -contains - subroutine cleanup() - m%BEMT%UseFrozenWake = .false. - - call AD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call AD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call AD_DestroyConstrState( z_p, ErrStat2, ErrMsg2 ) - call AD_DestroyConstrState( z_m, ErrStat2, ErrMsg2 ) - call AD_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - -END SUBROUTINE AD_JacobianPInput -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and DZ/dx are returned. -SUBROUTINE AD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdx, dXdx, dXddx, dZdx ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(AD_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); - !! Output fields are not used by this routine, but type is - !! available here so that mesh parameter information (i.e., - !! connectivity) does not have to be recalculated for dYdx. - TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdx(:,:) !< Partial derivatives of output functions - !! (Y) with respect to the continuous - !! states (x) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdx(:,:) !< Partial derivatives of continuous state - !! functions (X) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddx(:,:) !< Partial derivatives of discrete state - !! functions (Xd) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdx(:,:) !< Partial derivatives of constraint state - !! functions (Z) with respect to - !! the continuous states (x) [intent in to avoid deallocation] - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - - - IF ( PRESENT( dYdx ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: - - ! allocate and set dYdx - - END IF - - IF ( PRESENT( dXdx ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the continuous states (x) here: - - ! allocate and set dXdx - - END IF - - IF ( PRESENT( dXddx ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the continuous states (x) here: - - ! allocate and set dXddx - - END IF - - IF ( PRESENT( dZdx ) ) THEN - - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the continuous states (x) here: - - ! allocate and set dZdx - - END IF - - -END SUBROUTINE AD_JacobianPContState -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the discrete states (xd). The partial derivatives dY/dxd, dX/dxd, dXd/dxd, and DZ/dxd are returned. -SUBROUTINE AD_JacobianPDiscState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdxd, dXdxd, dXddxd, dZdxd ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(AD_OutputType), INTENT(IN ) :: y !< Output (change to inout if a mesh copy is required); - !! Output fields are not used by this routine, but type is - !! available here so that mesh parameter information (i.e., - !! connectivity) does not have to be recalculated for dYdxd. - TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdxd(:,:) !< Partial derivatives of output functions - !! (Y) with respect to the discrete - !! states (xd) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdxd(:,:) !< Partial derivatives of continuous state - !! functions (X) with respect to the - !! discrete states (xd) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddxd(:,:)!< Partial derivatives of discrete state - !! functions (Xd) with respect to the - !! discrete states (xd) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdxd(:,:) !< Partial derivatives of constraint state - !! functions (Z) with respect to the - !! discrete states (xd) [intent in to avoid deallocation] - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - - IF ( PRESENT( dYdxd ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the discrete states (xd) here: - - ! allocate and set dYdxd - - END IF - - IF ( PRESENT( dXdxd ) ) THEN - - ! Calculate the partial derivative of the continuous state functions (X) with respect to the discrete states (xd) here: - - ! allocate and set dXdxd - - END IF - - IF ( PRESENT( dXddxd ) ) THEN - - ! Calculate the partial derivative of the discrete state functions (Xd) with respect to the discrete states (xd) here: - - ! allocate and set dXddxd - - END IF - - IF ( PRESENT( dZdxd ) ) THEN - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the discrete states (xd) here: - - ! allocate and set dZdxd - - END IF - - -END SUBROUTINE AD_JacobianPDiscState -!---------------------------------------------------------------------------------------------------------------------------------- -!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions -!! with respect to the constraint states (z). The partial derivatives dY/dz, dX/dz, dXd/dz, and DZ/dz are returned. -SUBROUTINE AD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdz, dXdz, dXddz, dZdz ) -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(AD_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); - !! Output fields are not used by this routine, but type is - !! available here so that mesh parameter information (i.e., - !! connectivity) does not have to be recalculated for dYdz. - TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdz(:,:) !< Partial derivatives of output - !! functions (Y) with respect to the - !! constraint states (z) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdz(:,:) !< Partial derivatives of continuous - !! state functions (X) with respect to - !! the constraint states (z) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddz(:,:) !< Partial derivatives of discrete state - !! functions (Xd) with respect to the - !! constraint states (z) [intent in to avoid deallocation] - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdz(:,:) !< Partial derivatives of constraint - !! state functions (Z) with respect to - !! the constraint states (z) [intent in to avoid deallocation] - - ! local variables - TYPE(AD_OutputType) :: y_p - TYPE(AD_OutputType) :: y_m - TYPE(AD_ConstraintStateType) :: Z_p - TYPE(AD_ConstraintStateType) :: Z_m - TYPE(AD_ConstraintStateType) :: z_perturb - REAL(ReKi) :: delta_p, delta_m ! delta change in state - INTEGER(IntKi) :: i, j, k, n, k2, j2 - - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - integer, parameter :: op_indx = 2 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt or the input at OP - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AD_JacobianPConstrState' - - - ! local variables - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - -!bjj: how do I figure out if F is 0??? In that case, need to se dY/dz = 0 and dZ/dz = 1 {and need to ask jmj if this is the whole matrix or just a row/column where it applies} - - ! get OP values here: - !call AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) ! (bjj: is this necessary? if not, still need to get BEMT inputs) - call SetInputsForBEMT(p, u, m, indx, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - call BEMT_CopyInput( m%BEMT_u(indx), m%BEMT_u(op_indx), MESH_UPDATECOPY, ErrStat2, ErrMsg2) ! copy the BEMT OP inputs to a temporary location that won't be overwritten - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - if ( p%FrozenWake ) then - ! compare arguments with call to BEMT_CalcOutput - call computeFrozenWake(m%BEMT_u(op_indx), p%BEMT, m%BEMT_y, m%BEMT ) - m%BEMT%UseFrozenWake = .true. - end if - - - ! make a copy of the constraint states to perturb - call AD_CopyConstrState( z, z_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - IF ( PRESENT( dYdz ) ) THEN - - ! Calculate the partial derivative of the output functions (Y) with respect to the constraint states (z) here: - - ! allocate and set dYdz - if (.not. allocated(dYdz) ) then - call AllocAry(dYdz,p%Jac_ny, size(z%BEMT%phi),'dYdz', ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - end if - - - ! make a copy of outputs because we will need two for the central difference computations (with orientations) - call AD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - - do k=1,p%NumBlades ! size(z%BEMT%Phi,2) - do j=1,p%NumBlNds ! size(z%BEMT%Phi,1) - i = (k-1)*p%NumBlNds + j - - ! need a check if F = 0 for this case: - - if ( ( p%BEMT%UseTipLoss .and. EqualRealNos(p%BEMT%tipLossConst(j,k),0.0_ReKi) ) .or. & - ( p%BEMT%useHubLoss .and. EqualRealNos(p%BEMT%hubLossConst(j,k),0.0_ReKi) ) ) then - ! F is zero, we we need to skip this perturbation - dYdz(:,i) = 0.0_ReKi - else - - call Get_phi_perturbations(p%BEMT, m%BEMT, z%BEMT%phi(j,k), delta_p, delta_m) - - ! get z_op + delta_p z - z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) + delta_p - - ! compute y at z_op + delta_p z - call AD_CalcOutput( t, u, p, x, xd, z_perturb, OtherState, y_p, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get z_op - delta_m z - z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) - delta_m - - ! compute y at z_op - delta_m z - call AD_CalcOutput( t, u, p, x, xd, z_perturb, OtherState, y_m, m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - - - ! get central difference: - call Compute_dY( p, y_p, y_m, delta_p, delta_m, dYdz(:,i) ) - - - ! put z_perturb back (for next iteration): - z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) - end if - - end do - end do - - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - call AD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - - END IF - - IF ( PRESENT( dXdz ) ) THEN - if (allocated(dXdz)) deallocate(dXdz) - END IF - - IF ( PRESENT( dXddz ) ) THEN - if (allocated(dXddz)) deallocate(dXddz) - END IF - - IF ( PRESENT(dZdz) ) THEN - - call CheckLinearizationInput(p%BEMT, m%BEMT_u(op_indx), z%BEMT, m%BEMT, ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - ! Calculate the partial derivative of the constraint state functions (Z) with respect to the constraint states (z) here: - - ! allocate and set dZdz - if (.not. allocated(dZdz)) then - call AllocAry(dZdz,size(z%BEMT%phi), size(z%BEMT%phi),'dZdz', ErrStat2, ErrMsg2) - call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - end if - - - call AD_CopyConstrState( z, z_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - - do k=1,p%NumBlades ! size(z%BEMT%Phi,2) - do j=1,p%NumBlNds ! size(z%BEMT%Phi,1) - i = (k-1)*p%NumBlNds + j - - if ( ( p%BEMT%UseTipLoss .and. EqualRealNos(p%BEMT%tipLossConst(j,k),0.0_ReKi) ) .or. & - ( p%BEMT%useHubLoss .and. EqualRealNos(p%BEMT%hubLossConst(j,k),0.0_ReKi) ) ) then - ! F is zero, we we need to skip this perturbation - dZdz(:,i) = 0.0_ReKi - dZdz(i,i) = 1.0_ReKi - else - - call Get_phi_perturbations(p%BEMT, m%BEMT, z%BEMT%phi(j,k), delta_p, delta_m) - - ! get z_op + delta_p z - z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) + delta_p - - ! compute z_p at z_op + delta_p z - call AD_CalcConstrStateResidual( t, u, p, x, xd, z_perturb, OtherState, m, z_p, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - - ! get z_op - delta_m z - z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) - delta_m - - ! compute z_m at u_op - delta_m u - call AD_CalcConstrStateResidual( t, u, p, x, xd, z_perturb, OtherState, m, z_m, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat>=AbortErrLev) then - call cleanup() - return - end if - - ! get central difference: - - do k2=1,p%NumBlades ! size(z%BEMT%Phi,2) - do j2=1,p%NumBlNds ! size(z%BEMT%Phi,1) - n = (k2-1)*p%NumBlNds + j2 - dZdz(n,i) = z_p%BEMT%Phi(j2,k2) - z_m%BEMT%Phi(j2,k2) - end do - end do - - dZdz(:,i) = dZdz(:,i) / (delta_p + delta_m) - - ! put z_perturb back (for next iteration): - z_perturb%BEMT%phi(j,k) = z%BEMT%phi(j,k) - - end if - - end do - end do - - call AD_DestroyConstrState( z_p, ErrStat2, ErrMsg2 ) ! we don't need this any more - call AD_DestroyConstrState( z_m, ErrStat2, ErrMsg2 ) ! we don't need this any more - - END IF - - -contains - subroutine cleanup() - call AD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) - call AD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) - call AD_DestroyConstrState( z_p, ErrStat2, ErrMsg2 ) - call AD_DestroyConstrState( z_m, ErrStat2, ErrMsg2 ) - call AD_DestroyConstrState( z_perturb, ErrStat2, ErrMsg2 ) - end subroutine cleanup - -END SUBROUTINE AD_JacobianPConstrState -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -!> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE AD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) - - REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point - TYPE(AD_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) - TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point - TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point - TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point - TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point - TYPE(AD_OutputType), INTENT(IN ) :: y !< Output at operating point - TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: u_op(:) !< values of linearized inputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: y_op(:) !< values of linearized outputs - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: x_op(:) !< values of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states - REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states - - INTEGER(IntKi) :: index, i, j, k - INTEGER(IntKi) :: nu - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AD_GetOP' - LOGICAL :: FieldMask(FIELDMASK_SIZE) - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = '' - - IF ( PRESENT( u_op ) ) THEN - - nu = size(p%Jac_u_indx,1) + u%TowerMotion%NNodes * 6 & ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - + u%hubMotion%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - do i=1,p%NumBlades - nu = nu + u%BladeMotion(i)%NNodes * 6 & ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - + u%BladeRootMotion(i)%NNodes * 6 ! Jac_u_indx has 3 orientation angles, but the OP needs the full 9 elements of the DCM - end do - - if (.not. allocated(u_op)) then - call AllocAry(u_op, nu, 'u_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if - - - index = 1 - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - call PackMotionMesh(u%TowerMotion, u_op, index, FieldMask=FieldMask) - - FieldMask(MASKID_TRANSLATIONVel) = .false. - FieldMask(MASKID_RotationVel) = .true. - call PackMotionMesh(u%HubMotion, u_op, index, FieldMask=FieldMask) - - FieldMask = .false. - FieldMask(MASKID_Orientation) = .true. - do k = 1,p%NumBlades - call PackMotionMesh(u%BladeRootMotion(k), u_op, index, FieldMask=FieldMask) - end do - - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - do k=1,p%NumBlades - call PackMotionMesh(u%BladeMotion(k), u_op, index, FieldMask=FieldMask) - end do - - do k=1,p%NumBlades - do i=1,p%NumBlNds - do j=1,3 - u_op(index) = u%InflowOnBlade(j,i,k) - index = index + 1 - end do - end do - end do - - do i=1,p%NumTwrNds - do j=1,3 - u_op(index) = u%InflowOnTower(j,i) - index = index + 1 - end do - end do - - END IF - - IF ( PRESENT( y_op ) ) THEN - - if (.not. allocated(y_op)) then - call AllocAry(y_op, p%Jac_ny, 'y_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if - - - - index = 1 - call PackLoadMesh(y%TowerLoad, y_op, index) - do k=1,p%NumBlades - call PackLoadMesh(y%BladeLoad(k), y_op, index) - end do - - index = index - 1 - do i=1,p%NumOuts - y_op(i+index) = y%WriteOutput(i) - end do - - - END IF - - IF ( PRESENT( x_op ) ) THEN - - END IF - - IF ( PRESENT( dx_op ) ) THEN - - END IF - - IF ( PRESENT( xd_op ) ) THEN - - END IF - - IF ( PRESENT( z_op ) ) THEN - - if (.not. allocated(z_op)) then - call AllocAry(z_op, p%NumBlades*p%NumBlNds, 'z_op', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - end if - - - index = 1 - do k=1,p%NumBlades ! size(z%BEMT%Phi,2) - do i=1,p%NumBlNds ! size(z%BEMT%Phi,1) - z_op(index) = z%BEMT%phi(i,k) - index = index + 1 - end do - end do - - END IF - -END SUBROUTINE AD_GetOP -!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ -SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) - - TYPE(AD_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(AD_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(AD_InitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - - 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, j, k, indx_next, indx_last - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian_y' - logical, allocatable :: AllOut(:) - - - ErrStat = ErrID_None - ErrMsg = "" - - - ! determine how many outputs there are in the Jacobians - p%Jac_ny = y%TowerLoad%NNodes * 6 & ! 3 forces + 3 moments at each node - + p%NumOuts ! WriteOutput values - - do k=1,p%NumBlades - p%Jac_ny = p%Jac_ny + y%BladeLoad(k)%NNodes * 6 ! 3 forces + 3 moments at each node - end do - - - ! get the names of the linearized outputs: - call AllocAry(InitOut%LinNames_y, p%Jac_ny,'',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(InitOut%RotFrame_y, p%Jac_ny,'',ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (ErrStat >= AbortErrLev) return - - - InitOut%RotFrame_y = .false. ! default all to false, then set the true ones below - indx_next = 1 - call PackLoadMesh_Names(y%TowerLoad, 'Tower', InitOut%LinNames_y, indx_next) - - indx_last = indx_next - do k=1,p%NumBlades - call PackLoadMesh_Names(y%BladeLoad(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_y, indx_next) - end do - InitOut%RotFrame_y(indx_last:indx_next-1) = .true. - - do i=1,p%NumOuts - InitOut%LinNames_y(i+indx_next-1) = trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units - end do - - ! check for all the WriteOutput values that are functions of blade number: - allocate( AllOut(0:MaxOutPts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels - if (ErrStat2 /=0 ) then - call SetErrStat(ErrID_Info, 'error allocating temporary space for AllOut',ErrStat,ErrMsg,RoutineName) - return; - end if - - AllOut = .false. - do k=1,3 - AllOut( BAzimuth(k)) = .true. - AllOut( BPitch (k)) = .true. - do j=1,9 - AllOut(BNVUndx(j,k)) = .true. - AllOut(BNVUndy(j,k)) = .true. - AllOut(BNVUndz(j,k)) = .true. - AllOut(BNVDisx(j,k)) = .true. - AllOut(BNVDisy(j,k)) = .true. - AllOut(BNVDisz(j,k)) = .true. - AllOut(BNSTVx (j,k)) = .true. - AllOut(BNSTVy (j,k)) = .true. - AllOut(BNSTVz (j,k)) = .true. - AllOut(BNVRel (j,k)) = .true. - AllOut(BNDynP (j,k)) = .true. - AllOut(BNRe (j,k)) = .true. - AllOut(BNM (j,k)) = .true. - AllOut(BNVIndx(j,k)) = .true. - AllOut(BNVIndy(j,k)) = .true. - AllOut(BNAxInd(j,k)) = .true. - AllOut(BNTnInd(j,k)) = .true. - AllOut(BNAlpha(j,k)) = .true. - AllOut(BNTheta(j,k)) = .true. - AllOut(BNPhi (j,k)) = .true. - AllOut(BNCurve(j,k)) = .true. - AllOut(BNCl (j,k)) = .true. - AllOut(BNCd (j,k)) = .true. - AllOut(BNCm (j,k)) = .true. - AllOut(BNCx (j,k)) = .true. - AllOut(BNCy (j,k)) = .true. - AllOut(BNCn (j,k)) = .true. - AllOut(BNCt (j,k)) = .true. - AllOut(BNFl (j,k)) = .true. - AllOut(BNFd (j,k)) = .true. - AllOut(BNMm (j,k)) = .true. - AllOut(BNFx (j,k)) = .true. - AllOut(BNFy (j,k)) = .true. - AllOut(BNFn (j,k)) = .true. - AllOut(BNFt (j,k)) = .true. - AllOut(BNClrnc(j,k)) = .true. - end do - end do - - - do i=1,p%NumOuts - InitOut%RotFrame_y(i+indx_next-1) = AllOut( p%OutParam(i)%Indx ) - end do - - deallocate(AllOut) - -END SUBROUTINE Init_Jacobian_y -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes the array that maps rows/columns of the Jacobian to specific mesh fields. -!! Do not change the order of this packing without changing subroutine elastodyn::create_ed_uvector ! -SUBROUTINE Init_Jacobian( InputFileData, p, u, y, m, InitOut, ErrStat, ErrMsg) - - type(AD_InputFile) , intent(in ) :: InputFileData !< input file data (for default blade perturbation) - TYPE(AD_ParameterType) , INTENT(INOUT) :: p !< parameters - TYPE(AD_InputType) , INTENT(IN ) :: u !< inputs - TYPE(AD_OutputType) , INTENT(IN ) :: y !< outputs - TYPE(AD_MiscVarType) , INTENT(IN ) :: m !< miscellaneous variable - TYPE(AD_InitOutputType) , INTENT(INOUT) :: InitOut !< Initialization output data (for Jacobian row/column names) - - INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'Init_Jacobian' - - ! local variables: - INTEGER(IntKi) :: i, j, k, index, index_last, nu, i_meshField - REAL(ReKi) :: perturb, perturb_t, perturb_b(MaxBl) - LOGICAL :: FieldMask(FIELDMASK_SIZE) - CHARACTER(1), PARAMETER :: UVW(3) = (/'U','V','W'/) - - - - ErrStat = ErrID_None - ErrMsg = "" - - call Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) - - ! these matrices will be needed for linearization with frozen wake feature - if (p%FrozenWake) then - call AllocAry(m%BEMT%AxInd_op,p%NumBlNds,p%numBlades,'m%BEMT%AxInd_op', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry(m%BEMT%TnInd_op,p%NumBlNds,p%numBlades,'m%BEMT%TnInd_op', ErrStat2,ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - end if - - - - ! determine how many inputs there are in the Jacobians - nu = u%TowerMotion%NNodes * 9 & ! 3 Translation Displacements + 3 orientations + 3 Translation velocities at each node - + u%hubMotion%NNodes * 9 & ! 3 Translation Displacements + 3 orientations + 3 Rotation velocities at each node - + size( u%InflowOnBlade) & - + size( u%InflowOnTower) - - do i=1,p%NumBlades - nu = nu + u%BladeMotion(i)%NNodes * 9 & ! 3 Translation Displacements + 3 orientations + 3 Translation velocities at each node - + u%BladeRootMotion(i)%NNodes * 3 ! 3 orientations at each node - end do - - ! all other inputs ignored - - - !............................ - ! fill matrix to store index to help us figure out what the ith value of the u vector really means - ! (see aerodyn::perturb_u ... these MUST match ) - ! column 1 indicates module's mesh and field - ! column 2 indicates the first index (x-y-z component) of the field - ! column 3 is the node - !............................ - - call allocAry( p%Jac_u_indx, nu, 3, 'p%Jac_u_indx', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - !............... - ! AD input mappings stored in p%Jac_u_indx: - !............... - index = 1 - !Module/Mesh/Field: u%TowerMotion%TranslationDisp = 1; - !Module/Mesh/Field: u%TowerMotion%Orientation = 2; - !Module/Mesh/Field: u%TowerMotion%TranslationVel = 3; - do i_meshField = 1,3 - do i=1,u%TowerMotion%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - !Module/Mesh/Field: u%HubMotion%TranslationDisp = 4; - !Module/Mesh/Field: u%HubMotion%Orientation = 5; - !Module/Mesh/Field: u%HubMotion%RotationVel = 6; - do i_meshField = 4,6 - do i=1,u%HubMotion%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do - - !bjj: if MaxBl (max blades) changes, we need to modify this - !Module/Mesh/Field: u%BladeRootMotion(1)%Orientation = 7; - !Module/Mesh/Field: u%BladeRootMotion(2)%Orientation = 8; - !Module/Mesh/Field: u%BladeRootMotion(3)%Orientation = 9; - do k=1,p%NumBlades - do i_meshField = 6,6 - do i=1,u%BladeRootMotion(k)%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = i_meshField + k - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - - end do !i_meshField - end do !k - - !bjj: if MaxBl (max blades) changes, we need to modify this - !Module/Mesh/Field: u%BladeMotion(1)%TranslationDisp = 10; - !Module/Mesh/Field: u%BladeMotion(1)%Orientation = 11; - !Module/Mesh/Field: u%BladeMotion(1)%TranslationVel = 12; - !Module/Mesh/Field: u%BladeMotion(2)%TranslationDisp = 13; - !Module/Mesh/Field: u%BladeMotion(2)%Orientation = 14; - !Module/Mesh/Field: u%BladeMotion(2)%TranslationVel = 15; - !Module/Mesh/Field: u%BladeMotion(3)%TranslationDisp = 16; - !Module/Mesh/Field: u%BladeMotion(3)%Orientation = 17; - !Module/Mesh/Field: u%BladeMotion(3)%TranslationVel = 18; - do k=1,p%NumBlades - do i_meshField = 1,3 - do i=1,u%BladeMotion(k)%NNodes - do j=1,3 - p%Jac_u_indx(index,1) = 9 + i_meshField + (k-1)*3 - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - - end do !i_meshField - end do !k - - !Module/Mesh/Field: u%InflowOnBlade(:,:,1) = 19; - !Module/Mesh/Field: u%InflowOnBlade(:,:,2) = 20; - !Module/Mesh/Field: u%InflowOnBlade(:,:,3) = 21; - do k=1,size(u%InflowOnBlade,3) ! p%NumBlades - do i=1,size(u%InflowOnBlade,2) ! numNodes - do j=1,3 - p%Jac_u_indx(index,1) = 18 + k - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - end do !k - - !Module/Mesh/Field: u%InflowOnTower(:,:) = 22; - do i=1,size(u%InflowOnTower,2) ! numNodes - do j=1,3 - p%Jac_u_indx(index,1) = 22 - p%Jac_u_indx(index,2) = j !component index: j - p%Jac_u_indx(index,3) = i !Node: i - index = index + 1 - end do !j - end do !i - - - !...................................... - ! default perturbations, p%du: - !...................................... - call allocAry( p%du, 22, 'p%du', ErrStat2, ErrMsg2) ! 22 = number of unique values in p%Jac_u_indx(:,1) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - perturb = 2*D2R - - do k=1,p%NumBlades - perturb_b(k) = 0.2_ReKi*D2R * InputFileData%BladeProps(k)%BlSpn( InputFileData%BladeProps(k)%NumBlNds ) - end do - - if ( u%TowerMotion%NNodes > 0) then - perturb_t = 0.2_ReKi*D2R * u%TowerMotion%Position( 3, u%TowerMotion%NNodes ) - else - perturb_t = 0.0_ReKi - end if - - p%du(1) = perturb_t ! u%TowerMotion%TranslationDisp = 1 - p%du(2) = perturb ! u%TowerMotion%Orientation = 2 - p%du(3) = perturb_t ! u%TowerMotion%TranslationVel = 3 - p%du(4) = perturb_b(1) ! u%HubMotion%TranslationDisp = 4 - p%du(5) = perturb ! u%HubMotion%Orientation = 5 - p%du(6) = perturb ! u%HubMotion%RotationVel = 6 - do i_meshField = 7,9 - p%du(i_meshField) = perturb ! u%BladeRootMotion(k)%Orientation = 6+k, for k in [1, 3] - end do - do k=1,p%NumBlades - p%du(10 + (k-1)*3) = perturb_b(k) ! u%BladeMotion(k)%TranslationDisp = 10 + (k-1)*3 - p%du(11 + (k-1)*3) = perturb ! u%BladeMotion(k)%Orientation = 11 + (k-1)*3 - p%du(12 + (k-1)*3) = perturb_b(k) ! u%BladeMotion(k)%TranslationVel = 12 + (k-1)*3 - end do - do k=1,p%NumBlades - p%du(18 + k) = perturb_b(k) ! u%InflowOnBlade(:,:,k) = 18 + k - end do - p%du(22) = perturb_t ! u%InflowOnTower(:,:) = 22 - - - !..................... - ! get names of linearized inputs - !..................... - call AllocAry(InitOut%LinNames_u, nu, 'LinNames_u', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%RotFrame_u, nu, 'RotFrame_u', ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - InitOut%RotFrame_u = .false. - - index = 1 - FieldMask = .false. - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_Orientation) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - call PackMotionMesh_Names(u%TowerMotion, 'Tower', InitOut%LinNames_u, index, FieldMask=FieldMask) - - FieldMask(MASKID_TRANSLATIONVel) = .false. - FieldMask(MASKID_RotationVel) = .true. - call PackMotionMesh_Names(u%HubMotion, 'Hub', InitOut%LinNames_u, index, FieldMask=FieldMask) - - index_last = index - FieldMask = .false. - FieldMask(MASKID_Orientation) = .true. - do k = 1,p%NumBlades - call PackMotionMesh_Names(u%BladeRootMotion(k), 'Blade root '//trim(num2lstr(k)), InitOut%LinNames_u, index, FieldMask=FieldMask) - end do - - FieldMask(MASKID_TRANSLATIONDISP) = .true. - FieldMask(MASKID_TRANSLATIONVel) = .true. - do k=1,p%NumBlades - call PackMotionMesh_Names(u%BladeMotion(k), 'Blade '//trim(num2lstr(k)), InitOut%LinNames_u, index, FieldMask=FieldMask) - end do - - do k=1,p%NumBlades - do i=1,p%NumBlNds - do j=1,3 - InitOut%LinNames_u(index) = UVW(j)//'-component inflow on blade '//trim(num2lstr(k))//', node '//trim(num2lstr(i))//', m/s' - index = index + 1 - end do - end do - end do - InitOut%RotFrame_u(index_last:index-1) = .true. - - do i=1,p%NumTwrNds - do j=1,3 - InitOut%LinNames_u(index) = UVW(j)//'-component inflow on tower node '//trim(num2lstr(i))//', m/s' - index = index + 1 - end do - end do - - - - !..................... - ! get names of linearized constraint states (though i don't think we really need them) - !..................... - call AllocAry(InitOut%LinNames_z, p%NumBlades*p%NumBlNds, 'LinNames_z', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - call AllocAry(InitOut%RotFrame_z, p%NumBlades*p%NumBlNds, 'RotFrame_z', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - InitOut%RotFrame_z = .true. - - index = 1 - do k=1,p%NumBlades ! size(z%BEMT%Phi,2) - do i=1,p%NumBlNds ! size(z%BEMT%Phi,1) - InitOut%LinNames_z(index) = 'phi at blade '//trim(num2lstr(k))//', node '//trim(num2lstr(i))//', rad' - index = index + 1 - end do - end do - -END SUBROUTINE Init_Jacobian -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine perturbs the nth element of the u array (and mesh/field it corresponds to) -!! Do not change this without making sure subroutine aerodyn::init_jacobian is consistant with this routine! -SUBROUTINE Perturb_u( p, n, perturb_sign, u, du ) - - TYPE(AD_ParameterType) , INTENT(IN ) :: p !< parameters - INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use - INTEGER( IntKi ) , INTENT(IN ) :: perturb_sign !< +1 or -1 (value to multiply perturbation by; positive or negative difference) - TYPE(AD_InputType) , INTENT(INOUT) :: u !< perturbed ED inputs - REAL( ReKi ) , INTENT( OUT) :: du !< amount that specific input was perturbed - - - ! local variables - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - - INTEGER :: fieldIndx - INTEGER :: node - REAL(R8Ki) :: orientation(3,3) - REAL(R8Ki) :: angles(3) - - fieldIndx = p%Jac_u_indx(n,2) - node = p%Jac_u_indx(n,3) - - du = p%du( p%Jac_u_indx(n,1) ) - - ! determine which mesh we're trying to perturb and perturb the input: - SELECT CASE( p%Jac_u_indx(n,1) ) - - CASE ( 1) !Module/Mesh/Field: u%TowerMotion%TranslationDisp = 1; - u%TowerMotion%TranslationDisp( fieldIndx,node) = u%TowerMotion%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE ( 2) !Module/Mesh/Field: u%TowerMotion%Orientation = 2; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%TowerMotion%Orientation(:,:,node) = matmul(u%TowerMotion%Orientation(:,:,node), orientation) - CASE ( 3) !Module/Mesh/Field: u%TowerMotion%TranslationVel = 3; - u%TowerMotion%TranslationVel( fieldIndx,node) = u%TowerMotion%TranslationVel( fieldIndx,node) + du * perturb_sign - - CASE ( 4) !Module/Mesh/Field: u%HubMotion%TranslationDisp = 4; - u%HubMotion%TranslationDisp(fieldIndx,node) = u%HubMotion%TranslationDisp(fieldIndx,node) + du * perturb_sign - CASE ( 5) !Module/Mesh/Field: u%HubMotion%Orientation = 5; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%HubMotion%Orientation(:,:,node) = matmul(u%HubMotion%Orientation(:,:,node), orientation) - CASE ( 6) !Module/Mesh/Field: u%HubMotion%RotationVel = 6; - u%HubMotion%RotationVel(fieldIndx,node) = u%HubMotion%RotationVel(fieldIndx,node) + du * perturb_sign - - CASE ( 7) !Module/Mesh/Field: u%BladeRootMotion(1)%Orientation = 7; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%BladeRootMotion(1)%Orientation(:,:,node) = matmul(u%BladeRootMotion(1)%Orientation(:,:,node), orientation) - CASE ( 8) !Module/Mesh/Field: u%BladeRootMotion(2)%Orientation = 8; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%BladeRootMotion(2)%Orientation(:,:,node) = matmul(u%BladeRootMotion(2)%Orientation(:,:,node), orientation) - CASE ( 9) !Module/Mesh/Field: u%BladeRootMotion(3)%Orientation = 9; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%BladeRootMotion(3)%Orientation(:,:,node) = matmul(u%BladeRootMotion(3)%Orientation(:,:,node), orientation) - - CASE (10) !Module/Mesh/Field: u%BladeMotion(1)%TranslationDisp = 10; - u%BladeMotion(1)%TranslationDisp(fieldIndx,node) = u%BladeMotion(1)%TranslationDisp(fieldIndx,node) + du * perturb_sign - CASE (11) !Module/Mesh/Field: u%BladeMotion(1)%Orientation = 11; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%BladeMotion(1)%Orientation(:,:,node) = matmul(u%BladeMotion(1)%Orientation(:,:,node), orientation) - CASE (12) !Module/Mesh/Field: u%BladeMotion(1)%TranslationVel = 12; - u%BladeMotion(1)%TranslationVel(fieldIndx,node) = u%BladeMotion(1)%TranslationVel(fieldIndx,node) + du * perturb_sign - - CASE (13) !Module/Mesh/Field: u%BladeMotion(2)%TranslationDisp = 13; - u%BladeMotion(2)%TranslationDisp( fieldIndx,node) = u%BladeMotion(2)%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE (14) !Module/Mesh/Field: u%BladeMotion(2)%Orientation = 14; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%BladeMotion(2)%Orientation(:,:,node) = matmul(u%BladeMotion(2)%Orientation(:,:,node), orientation) - CASE (15) !Module/Mesh/Field: u%BladeMotion(2)%TranslationVel = 15; - u%BladeMotion(2)%TranslationVel(fieldIndx,node) = u%BladeMotion(2)%TranslationVel(fieldIndx,node) + du * perturb_sign - - CASE (16) !Module/Mesh/Field: u%BladeMotion(3)%TranslationDisp = 16; - u%BladeMotion(3)%TranslationDisp( fieldIndx,node) = u%BladeMotion(3)%TranslationDisp( fieldIndx,node) + du * perturb_sign - CASE (17) !Module/Mesh/Field: u%BladeMotion(3)%Orientation = 17; - angles = 0.0_R8Ki - angles(fieldIndx) = du * perturb_sign - call SmllRotTrans( 'linearization perturbation', angles(1), angles(2), angles(3), orientation, ErrStat=ErrStat2, ErrMsg=ErrMsg2 ) - u%BladeMotion(3)%Orientation(:,:,node) = matmul(u%BladeMotion(3)%Orientation(:,:,node), orientation) - CASE (18) !Module/Mesh/Field: u%BladeMotion(3)%TranslationVel = 18; - u%BladeMotion(3)%TranslationVel(fieldIndx,node) = u%BladeMotion(3)%TranslationVel(fieldIndx,node) + du * perturb_sign - - CASE (19) !Module/Mesh/Field: u%InflowOnBlade(:,:,1) = 19; - u%InflowOnBlade(fieldIndx,node,1) = u%InflowOnBlade(fieldIndx,node,1) + du * perturb_sign - CASE (20) !Module/Mesh/Field: u%InflowOnBlade(:,:,2) = 20; - u%InflowOnBlade(fieldIndx,node,2) = u%InflowOnBlade(fieldIndx,node,2) + du * perturb_sign - CASE (21) !Module/Mesh/Field: u%InflowOnBlade(:,:,3) = 21; - u%InflowOnBlade(fieldIndx,node,3) = u%InflowOnBlade(fieldIndx,node,3) + du * perturb_sign - - CASE (22) !Module/Mesh/Field: u%InflowOnTower(:,:) = 22; - u%InflowOnTower(fieldIndx,node) = u%InflowOnTower(fieldIndx,node) + du * perturb_sign - - END SELECT - -END SUBROUTINE Perturb_u -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine uses values of two output types to compute an array of differences. -!! Do not change this packing without making sure subroutine elastodyn::ed_init_jacobian is consistant with this routine! -SUBROUTINE Compute_dY(p, y_p, y_m, delta_p, delta_m, dY) - - TYPE(AD_ParameterType) , INTENT(IN ) :: p !< parameters - TYPE(AD_OutputType) , INTENT(IN ) :: y_p !< AD outputs at \f$ u + \Delta_p u \f$ or \f$ z + \Delta_p z \f$ (p=plus) - TYPE(AD_OutputType) , INTENT(IN ) :: y_m !< AD outputs at \f$ u - \Delta_m u \f$ or \f$ z - \Delta_m z \f$ (m=minus) - REAL(ReKi) , INTENT(IN ) :: delta_p !< difference in inputs or states \f$ delta_p = \Delta_p u \f$ or \f$ delta_p = \Delta_p z \f$ - REAL(ReKi) , INTENT(IN ) :: delta_m !< difference in inputs or states \f$ delta_m = \Delta_m u \f$ or \f$ delta_m = \Delta_m z \f$ - REAL(ReKi) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdz: \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ or \f$ \frac{\partial Y}{\partial z_i} = \frac{y_p - y_m}{2 \, \Delta z}\f$ - - ! local variables: - INTEGER(IntKi) :: k ! loop over blades - INTEGER(IntKi) :: indx_first ! index indicating next value of dY to be filled - - - - indx_first = 1 - call PackLoadMesh_dY(y_p%TowerLoad, y_m%TowerLoad, dY, indx_first) - do k=1,p%NumBlades - call PackLoadMesh_dY(y_p%BladeLoad(k), y_m%BladeLoad(k), dY, indx_first) - end do - - - !indx_last = indx_first + p%NumOuts - 1 - !if (p%NumOuts > 0) dY(indx_first:) = y_p%WriteOutput - y_m%WriteOutput - do k=1,p%NumOuts - dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) - end do - - - dY = dY / (delta_p + delta_m) - -END SUBROUTINE Compute_dY -!---------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine computes the differences of two meshes and packs that value into appropriate locations in the dY array. -!! Do not change this packing without making sure subroutines elastodyn::ed_init_jacobian and elastodyn::compute_dt are consistant with this routine! -SUBROUTINE PackLoadMesh_dY(M_p, M_m, dY, indx_first) - - TYPE(MeshType) , INTENT(IN ) :: M_p !< AD outputs on given mesh at \f$ u + \Delta u \f$ (p=plus) - TYPE(MeshType) , INTENT(IN ) :: M_m !< AD outputs on given mesh at \f$ u - \Delta u \f$ (m=minus) - REAL(ReKi) , INTENT(INOUT) :: dY(:) !< column of dYdu or dYdz \f$ \frac{\partial Y}{\partial u_i} = \frac{y_p - y_m}{2 \, \Delta u}\f$ - INTEGER(IntKi) , INTENT(INOUT) :: indx_first !< index into dY array; gives location of next array position to fill - - ! local variables: - INTEGER(IntKi) :: i, indx_last - - - do i=1,M_p%NNodes - indx_last = indx_first + 2 - dY(indx_first:indx_last) = M_p%Force(:,i) - M_m%Force(:,i) - indx_first = indx_last + 1 - end do - - do i=1,M_p%NNodes - indx_last = indx_first + 2 - dY(indx_first:indx_last) = M_p%Moment(:,i) - M_m%Moment(:,i) - indx_first = indx_last + 1 - end do - -END SUBROUTINE PackLoadMesh_dY -!---------------------------------------------------------------------------------------------------------------------------------- -FUNCTION CheckBEMTInputPerturbations( p, m ) RESULT(ValidPerturb) - - type(AD_ParameterType), intent(in ) :: p !< AD parameters - type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables - logical :: ValidPerturb !< if .true., the perturbation is valid; if false, invalid (and thus don't use it) - - integer :: j,k - - integer, parameter :: indx = 1 ! index of perturbed input - integer, parameter :: indx_op = 2 ! index of operating point - - ValidPerturb = .true. - - if ( p%BEMT%UseInduction ) then - if (p%FrozenWake ) then - - do k=1,p%NumBlades - do j=1,p%NumBlNds - - ! don't allow the input perturbations to change Vx or Vy so that Vx+AxInd_op=0 and Vy+TnInd_op=0 to - ! avoid ill-conditioning in CalcConstrStateResidual: - if ( EqualRealNos( m%BEMT_u(indx)%Vx(j,k), -m%BEMT%AxInd_op(j,k) ) .and. & - EqualRealNos( m%BEMT_u(indx)%Vy(j,k), -m%BEMT%TnInd_op(j,k) ) ) then - ValidPerturb = .false. - return - end if - - ! don't allow the input perturbations to change Vx or Vy so that Vx=0 or Vy=0 to - ! avoid division-by-zero errors in CalcOutput: - if ( EqualRealNos( m%BEMT_u(indx)%Vx(j,k), 0.0_ReKi ) .or. & - EqualRealNos( m%BEMT_u(indx)%Vy(j,k), 0.0_ReKi ) ) then - ValidPerturb = .false. - return - end if - - end do !j=nodes - end do !k=blades - - else ! not FrozenWake - - do k=1,p%NumBlades - do j=1,p%NumBlNds - - ! don't allow the input perturbations to change Vx or Vy far enough to switch sign (or go to zero) - ! so as to change solution regions. - if ( m%BEMT_u(indx)%Vx(j,k) * m%BEMT_u(indx_op)%Vx(j,k) <= 0.0_ReKi ) then - ValidPerturb = .false. - return - elseif (m%BEMT_u(indx)%Vy(j,k) * m%BEMT_u(indx_op)%Vy(j,k) <= 0.0_ReKi ) then - ValidPerturb = .false. - return - end if - - end do !j=nodes - end do !k=blades - - end if - - else ! not UseInduction - - do k=1,p%NumBlades - do j=1,p%NumBlNds - - ! don't allow the input perturbations to change Vx or Vy so that Vx=0 or Vy=0: - if ( EqualRealNos( m%BEMT_u(indx)%Vx(j,k), 0.0_ReKi ) .or. & - EqualRealNos( m%BEMT_u(indx)%Vy(j,k), 0.0_ReKi ) ) then - ValidPerturb = .false. - return - end if - - end do !j=nodes - end do !k=blades - - end if - -END FUNCTION CheckBEMTInputPerturbations -!---------------------------------------------------------------------------------------------------------------------------------- -END MODULE AeroDyn diff --git a/modules/aerodyn/AeroDynF8_Emre/AeroDyn_IO.f90 b/modules/aerodyn/AeroDynF8_Emre/AeroDyn_IO.f90 deleted file mode 100644 index f22f3bfd7..000000000 --- a/modules/aerodyn/AeroDynF8_Emre/AeroDyn_IO.f90 +++ /dev/null @@ -1,3308 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2015-2016 National Renewable Energy Laboratory -! -! This file is part of AeroDyn. -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -! -!********************************************************************************************************************************** -! File last committed: $Date$ -! (File) Revision #: $Rev$ -! URL: $HeadURL$ -!********************************************************************************************************************************** -MODULE AeroDyn_IO - - use NWTC_Library - use AeroDyn_Types - use BEMTUncoupled, only : SkewMod_Uncoupled, SkewMod_PittPeters - - - implicit none - - type(ProgDesc), parameter :: AD_Ver = ProgDesc( 'AeroDyn', 'v15.03.00', '27-Jul-2016' ) - character(*), parameter :: AD_Nickname = 'AD' - -! =================================================================================================== -! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" -! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these -! lines should be modified in the Matlab script and/or Excel worksheet as necessary. -! =================================================================================================== -! This code was generated by Write_ChckOutLst.m at 11-Mar-2016 14:45:58. - - - ! Parameters related to output length (number of characters allowed in the output data headers): - - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 - - - ! Indices for computing output channels: - ! NOTES: - ! (1) These parameters are in the order stored in "OutListParameters.xlsx" - ! (2) Array AllOuts() must be dimensioned to the value of the largest output parameter - - ! Time: - - INTEGER(IntKi), PARAMETER :: Time = 0 - - - ! Tower: - - INTEGER(IntKi), PARAMETER :: TwN1VUndx = 1 - INTEGER(IntKi), PARAMETER :: TwN1VUndy = 2 - INTEGER(IntKi), PARAMETER :: TwN1VUndz = 3 - INTEGER(IntKi), PARAMETER :: TwN2VUndx = 4 - INTEGER(IntKi), PARAMETER :: TwN2VUndy = 5 - INTEGER(IntKi), PARAMETER :: TwN2VUndz = 6 - INTEGER(IntKi), PARAMETER :: TwN3VUndx = 7 - INTEGER(IntKi), PARAMETER :: TwN3VUndy = 8 - INTEGER(IntKi), PARAMETER :: TwN3VUndz = 9 - INTEGER(IntKi), PARAMETER :: TwN4VUndx = 10 - INTEGER(IntKi), PARAMETER :: TwN4VUndy = 11 - INTEGER(IntKi), PARAMETER :: TwN4VUndz = 12 - INTEGER(IntKi), PARAMETER :: TwN5VUndx = 13 - INTEGER(IntKi), PARAMETER :: TwN5VUndy = 14 - INTEGER(IntKi), PARAMETER :: TwN5VUndz = 15 - INTEGER(IntKi), PARAMETER :: TwN6VUndx = 16 - INTEGER(IntKi), PARAMETER :: TwN6VUndy = 17 - INTEGER(IntKi), PARAMETER :: TwN6VUndz = 18 - INTEGER(IntKi), PARAMETER :: TwN7VUndx = 19 - INTEGER(IntKi), PARAMETER :: TwN7VUndy = 20 - INTEGER(IntKi), PARAMETER :: TwN7VUndz = 21 - INTEGER(IntKi), PARAMETER :: TwN8VUndx = 22 - INTEGER(IntKi), PARAMETER :: TwN8VUndy = 23 - INTEGER(IntKi), PARAMETER :: TwN8VUndz = 24 - INTEGER(IntKi), PARAMETER :: TwN9VUndx = 25 - INTEGER(IntKi), PARAMETER :: TwN9VUndy = 26 - INTEGER(IntKi), PARAMETER :: TwN9VUndz = 27 - INTEGER(IntKi), PARAMETER :: TwN1STVx = 28 - INTEGER(IntKi), PARAMETER :: TwN1STVy = 29 - INTEGER(IntKi), PARAMETER :: TwN1STVz = 30 - INTEGER(IntKi), PARAMETER :: TwN2STVx = 31 - INTEGER(IntKi), PARAMETER :: TwN2STVy = 32 - INTEGER(IntKi), PARAMETER :: TwN2STVz = 33 - INTEGER(IntKi), PARAMETER :: TwN3STVx = 34 - INTEGER(IntKi), PARAMETER :: TwN3STVy = 35 - INTEGER(IntKi), PARAMETER :: TwN3STVz = 36 - INTEGER(IntKi), PARAMETER :: TwN4STVx = 37 - INTEGER(IntKi), PARAMETER :: TwN4STVy = 38 - INTEGER(IntKi), PARAMETER :: TwN4STVz = 39 - INTEGER(IntKi), PARAMETER :: TwN5STVx = 40 - INTEGER(IntKi), PARAMETER :: TwN5STVy = 41 - INTEGER(IntKi), PARAMETER :: TwN5STVz = 42 - INTEGER(IntKi), PARAMETER :: TwN6STVx = 43 - INTEGER(IntKi), PARAMETER :: TwN6STVy = 44 - INTEGER(IntKi), PARAMETER :: TwN6STVz = 45 - INTEGER(IntKi), PARAMETER :: TwN7STVx = 46 - INTEGER(IntKi), PARAMETER :: TwN7STVy = 47 - INTEGER(IntKi), PARAMETER :: TwN7STVz = 48 - INTEGER(IntKi), PARAMETER :: TwN8STVx = 49 - INTEGER(IntKi), PARAMETER :: TwN8STVy = 50 - INTEGER(IntKi), PARAMETER :: TwN8STVz = 51 - INTEGER(IntKi), PARAMETER :: TwN9STVx = 52 - INTEGER(IntKi), PARAMETER :: TwN9STVy = 53 - INTEGER(IntKi), PARAMETER :: TwN9STVz = 54 - INTEGER(IntKi), PARAMETER :: TwN1Vrel = 55 - INTEGER(IntKi), PARAMETER :: TwN2Vrel = 56 - INTEGER(IntKi), PARAMETER :: TwN3Vrel = 57 - INTEGER(IntKi), PARAMETER :: TwN4Vrel = 58 - INTEGER(IntKi), PARAMETER :: TwN5Vrel = 59 - INTEGER(IntKi), PARAMETER :: TwN6Vrel = 60 - INTEGER(IntKi), PARAMETER :: TwN7Vrel = 61 - INTEGER(IntKi), PARAMETER :: TwN8Vrel = 62 - INTEGER(IntKi), PARAMETER :: TwN9Vrel = 63 - INTEGER(IntKi), PARAMETER :: TwN1DynP = 64 - INTEGER(IntKi), PARAMETER :: TwN2DynP = 65 - INTEGER(IntKi), PARAMETER :: TwN3DynP = 66 - INTEGER(IntKi), PARAMETER :: TwN4DynP = 67 - INTEGER(IntKi), PARAMETER :: TwN5DynP = 68 - INTEGER(IntKi), PARAMETER :: TwN6DynP = 69 - INTEGER(IntKi), PARAMETER :: TwN7DynP = 70 - INTEGER(IntKi), PARAMETER :: TwN8DynP = 71 - INTEGER(IntKi), PARAMETER :: TwN9DynP = 72 - INTEGER(IntKi), PARAMETER :: TwN1Re = 73 - INTEGER(IntKi), PARAMETER :: TwN2Re = 74 - INTEGER(IntKi), PARAMETER :: TwN3Re = 75 - INTEGER(IntKi), PARAMETER :: TwN4Re = 76 - INTEGER(IntKi), PARAMETER :: TwN5Re = 77 - INTEGER(IntKi), PARAMETER :: TwN6Re = 78 - INTEGER(IntKi), PARAMETER :: TwN7Re = 79 - INTEGER(IntKi), PARAMETER :: TwN8Re = 80 - INTEGER(IntKi), PARAMETER :: TwN9Re = 81 - INTEGER(IntKi), PARAMETER :: TwN1M = 82 - INTEGER(IntKi), PARAMETER :: TwN2M = 83 - INTEGER(IntKi), PARAMETER :: TwN3M = 84 - INTEGER(IntKi), PARAMETER :: TwN4M = 85 - INTEGER(IntKi), PARAMETER :: TwN5M = 86 - INTEGER(IntKi), PARAMETER :: TwN6M = 87 - INTEGER(IntKi), PARAMETER :: TwN7M = 88 - INTEGER(IntKi), PARAMETER :: TwN8M = 89 - INTEGER(IntKi), PARAMETER :: TwN9M = 90 - INTEGER(IntKi), PARAMETER :: TwN1Fdx = 91 - INTEGER(IntKi), PARAMETER :: TwN2Fdx = 92 - INTEGER(IntKi), PARAMETER :: TwN3Fdx = 93 - INTEGER(IntKi), PARAMETER :: TwN4Fdx = 94 - INTEGER(IntKi), PARAMETER :: TwN5Fdx = 95 - INTEGER(IntKi), PARAMETER :: TwN6Fdx = 96 - INTEGER(IntKi), PARAMETER :: TwN7Fdx = 97 - INTEGER(IntKi), PARAMETER :: TwN8Fdx = 98 - INTEGER(IntKi), PARAMETER :: TwN9Fdx = 99 - INTEGER(IntKi), PARAMETER :: TwN1Fdy = 100 - INTEGER(IntKi), PARAMETER :: TwN2Fdy = 101 - INTEGER(IntKi), PARAMETER :: TwN3Fdy = 102 - INTEGER(IntKi), PARAMETER :: TwN4Fdy = 103 - INTEGER(IntKi), PARAMETER :: TwN5Fdy = 104 - INTEGER(IntKi), PARAMETER :: TwN6Fdy = 105 - INTEGER(IntKi), PARAMETER :: TwN7Fdy = 106 - INTEGER(IntKi), PARAMETER :: TwN8Fdy = 107 - INTEGER(IntKi), PARAMETER :: TwN9Fdy = 108 - - - ! Blade: - - INTEGER(IntKi), PARAMETER :: B1Azimuth = 109 - INTEGER(IntKi), PARAMETER :: B2Azimuth = 110 - INTEGER(IntKi), PARAMETER :: B3Azimuth = 111 - INTEGER(IntKi), PARAMETER :: B1Pitch = 112 - INTEGER(IntKi), PARAMETER :: B2Pitch = 113 - INTEGER(IntKi), PARAMETER :: B3Pitch = 114 - INTEGER(IntKi), PARAMETER :: B1N1VUndx = 115 - INTEGER(IntKi), PARAMETER :: B1N2VUndx = 116 - INTEGER(IntKi), PARAMETER :: B1N3VUndx = 117 - INTEGER(IntKi), PARAMETER :: B1N4VUndx = 118 - INTEGER(IntKi), PARAMETER :: B1N5VUndx = 119 - INTEGER(IntKi), PARAMETER :: B1N6VUndx = 120 - INTEGER(IntKi), PARAMETER :: B1N7VUndx = 121 - INTEGER(IntKi), PARAMETER :: B1N8VUndx = 122 - INTEGER(IntKi), PARAMETER :: B1N9VUndx = 123 - INTEGER(IntKi), PARAMETER :: B1N1VUndy = 124 - INTEGER(IntKi), PARAMETER :: B1N2VUndy = 125 - INTEGER(IntKi), PARAMETER :: B1N3VUndy = 126 - INTEGER(IntKi), PARAMETER :: B1N4VUndy = 127 - INTEGER(IntKi), PARAMETER :: B1N5VUndy = 128 - INTEGER(IntKi), PARAMETER :: B1N6VUndy = 129 - INTEGER(IntKi), PARAMETER :: B1N7VUndy = 130 - INTEGER(IntKi), PARAMETER :: B1N8VUndy = 131 - INTEGER(IntKi), PARAMETER :: B1N9VUndy = 132 - INTEGER(IntKi), PARAMETER :: B1N1VUndz = 133 - INTEGER(IntKi), PARAMETER :: B1N2VUndz = 134 - INTEGER(IntKi), PARAMETER :: B1N3VUndz = 135 - INTEGER(IntKi), PARAMETER :: B1N4VUndz = 136 - INTEGER(IntKi), PARAMETER :: B1N5VUndz = 137 - INTEGER(IntKi), PARAMETER :: B1N6VUndz = 138 - INTEGER(IntKi), PARAMETER :: B1N7VUndz = 139 - INTEGER(IntKi), PARAMETER :: B1N8VUndz = 140 - INTEGER(IntKi), PARAMETER :: B1N9VUndz = 141 - INTEGER(IntKi), PARAMETER :: B2N1VUndx = 142 - INTEGER(IntKi), PARAMETER :: B2N2VUndx = 143 - INTEGER(IntKi), PARAMETER :: B2N3VUndx = 144 - INTEGER(IntKi), PARAMETER :: B2N4VUndx = 145 - INTEGER(IntKi), PARAMETER :: B2N5VUndx = 146 - INTEGER(IntKi), PARAMETER :: B2N6VUndx = 147 - INTEGER(IntKi), PARAMETER :: B2N7VUndx = 148 - INTEGER(IntKi), PARAMETER :: B2N8VUndx = 149 - INTEGER(IntKi), PARAMETER :: B2N9VUndx = 150 - INTEGER(IntKi), PARAMETER :: B2N1VUndy = 151 - INTEGER(IntKi), PARAMETER :: B2N2VUndy = 152 - INTEGER(IntKi), PARAMETER :: B2N3VUndy = 153 - INTEGER(IntKi), PARAMETER :: B2N4VUndy = 154 - INTEGER(IntKi), PARAMETER :: B2N5VUndy = 155 - INTEGER(IntKi), PARAMETER :: B2N6VUndy = 156 - INTEGER(IntKi), PARAMETER :: B2N7VUndy = 157 - INTEGER(IntKi), PARAMETER :: B2N8VUndy = 158 - INTEGER(IntKi), PARAMETER :: B2N9VUndy = 159 - INTEGER(IntKi), PARAMETER :: B2N1VUndz = 160 - INTEGER(IntKi), PARAMETER :: B2N2VUndz = 161 - INTEGER(IntKi), PARAMETER :: B2N3VUndz = 162 - INTEGER(IntKi), PARAMETER :: B2N4VUndz = 163 - INTEGER(IntKi), PARAMETER :: B2N5VUndz = 164 - INTEGER(IntKi), PARAMETER :: B2N6VUndz = 165 - INTEGER(IntKi), PARAMETER :: B2N7VUndz = 166 - INTEGER(IntKi), PARAMETER :: B2N8VUndz = 167 - INTEGER(IntKi), PARAMETER :: B2N9VUndz = 168 - INTEGER(IntKi), PARAMETER :: B3N1VUndx = 169 - INTEGER(IntKi), PARAMETER :: B3N2VUndx = 170 - INTEGER(IntKi), PARAMETER :: B3N3VUndx = 171 - INTEGER(IntKi), PARAMETER :: B3N4VUndx = 172 - INTEGER(IntKi), PARAMETER :: B3N5VUndx = 173 - INTEGER(IntKi), PARAMETER :: B3N6VUndx = 174 - INTEGER(IntKi), PARAMETER :: B3N7VUndx = 175 - INTEGER(IntKi), PARAMETER :: B3N8VUndx = 176 - INTEGER(IntKi), PARAMETER :: B3N9VUndx = 177 - INTEGER(IntKi), PARAMETER :: B3N1VUndy = 178 - INTEGER(IntKi), PARAMETER :: B3N2VUndy = 179 - INTEGER(IntKi), PARAMETER :: B3N3VUndy = 180 - INTEGER(IntKi), PARAMETER :: B3N4VUndy = 181 - INTEGER(IntKi), PARAMETER :: B3N5VUndy = 182 - INTEGER(IntKi), PARAMETER :: B3N6VUndy = 183 - INTEGER(IntKi), PARAMETER :: B3N7VUndy = 184 - INTEGER(IntKi), PARAMETER :: B3N8VUndy = 185 - INTEGER(IntKi), PARAMETER :: B3N9VUndy = 186 - INTEGER(IntKi), PARAMETER :: B3N1VUndz = 187 - INTEGER(IntKi), PARAMETER :: B3N2VUndz = 188 - INTEGER(IntKi), PARAMETER :: B3N3VUndz = 189 - INTEGER(IntKi), PARAMETER :: B3N4VUndz = 190 - INTEGER(IntKi), PARAMETER :: B3N5VUndz = 191 - INTEGER(IntKi), PARAMETER :: B3N6VUndz = 192 - INTEGER(IntKi), PARAMETER :: B3N7VUndz = 193 - INTEGER(IntKi), PARAMETER :: B3N8VUndz = 194 - INTEGER(IntKi), PARAMETER :: B3N9VUndz = 195 - INTEGER(IntKi), PARAMETER :: B1N1VDisx = 196 - INTEGER(IntKi), PARAMETER :: B1N2VDisx = 197 - INTEGER(IntKi), PARAMETER :: B1N3VDisx = 198 - INTEGER(IntKi), PARAMETER :: B1N4VDisx = 199 - INTEGER(IntKi), PARAMETER :: B1N5VDisx = 200 - INTEGER(IntKi), PARAMETER :: B1N6VDisx = 201 - INTEGER(IntKi), PARAMETER :: B1N7VDisx = 202 - INTEGER(IntKi), PARAMETER :: B1N8VDisx = 203 - INTEGER(IntKi), PARAMETER :: B1N9VDisx = 204 - INTEGER(IntKi), PARAMETER :: B1N1VDisy = 205 - INTEGER(IntKi), PARAMETER :: B1N2VDisy = 206 - INTEGER(IntKi), PARAMETER :: B1N3VDisy = 207 - INTEGER(IntKi), PARAMETER :: B1N4VDisy = 208 - INTEGER(IntKi), PARAMETER :: B1N5VDisy = 209 - INTEGER(IntKi), PARAMETER :: B1N6VDisy = 210 - INTEGER(IntKi), PARAMETER :: B1N7VDisy = 211 - INTEGER(IntKi), PARAMETER :: B1N8VDisy = 212 - INTEGER(IntKi), PARAMETER :: B1N9VDisy = 213 - INTEGER(IntKi), PARAMETER :: B1N1VDisz = 214 - INTEGER(IntKi), PARAMETER :: B1N2VDisz = 215 - INTEGER(IntKi), PARAMETER :: B1N3VDisz = 216 - INTEGER(IntKi), PARAMETER :: B1N4VDisz = 217 - INTEGER(IntKi), PARAMETER :: B1N5VDisz = 218 - INTEGER(IntKi), PARAMETER :: B1N6VDisz = 219 - INTEGER(IntKi), PARAMETER :: B1N7VDisz = 220 - INTEGER(IntKi), PARAMETER :: B1N8VDisz = 221 - INTEGER(IntKi), PARAMETER :: B1N9VDisz = 222 - INTEGER(IntKi), PARAMETER :: B2N1VDisx = 223 - INTEGER(IntKi), PARAMETER :: B2N2VDisx = 224 - INTEGER(IntKi), PARAMETER :: B2N3VDisx = 225 - INTEGER(IntKi), PARAMETER :: B2N4VDisx = 226 - INTEGER(IntKi), PARAMETER :: B2N5VDisx = 227 - INTEGER(IntKi), PARAMETER :: B2N6VDisx = 228 - INTEGER(IntKi), PARAMETER :: B2N7VDisx = 229 - INTEGER(IntKi), PARAMETER :: B2N8VDisx = 230 - INTEGER(IntKi), PARAMETER :: B2N9VDisx = 231 - INTEGER(IntKi), PARAMETER :: B2N1VDisy = 232 - INTEGER(IntKi), PARAMETER :: B2N2VDisy = 233 - INTEGER(IntKi), PARAMETER :: B2N3VDisy = 234 - INTEGER(IntKi), PARAMETER :: B2N4VDisy = 235 - INTEGER(IntKi), PARAMETER :: B2N5VDisy = 236 - INTEGER(IntKi), PARAMETER :: B2N6VDisy = 237 - INTEGER(IntKi), PARAMETER :: B2N7VDisy = 238 - INTEGER(IntKi), PARAMETER :: B2N8VDisy = 239 - INTEGER(IntKi), PARAMETER :: B2N9VDisy = 240 - INTEGER(IntKi), PARAMETER :: B2N1VDisz = 241 - INTEGER(IntKi), PARAMETER :: B2N2VDisz = 242 - INTEGER(IntKi), PARAMETER :: B2N3VDisz = 243 - INTEGER(IntKi), PARAMETER :: B2N4VDisz = 244 - INTEGER(IntKi), PARAMETER :: B2N5VDisz = 245 - INTEGER(IntKi), PARAMETER :: B2N6VDisz = 246 - INTEGER(IntKi), PARAMETER :: B2N7VDisz = 247 - INTEGER(IntKi), PARAMETER :: B2N8VDisz = 248 - INTEGER(IntKi), PARAMETER :: B2N9VDisz = 249 - INTEGER(IntKi), PARAMETER :: B3N1VDisx = 250 - INTEGER(IntKi), PARAMETER :: B3N2VDisx = 251 - INTEGER(IntKi), PARAMETER :: B3N3VDisx = 252 - INTEGER(IntKi), PARAMETER :: B3N4VDisx = 253 - INTEGER(IntKi), PARAMETER :: B3N5VDisx = 254 - INTEGER(IntKi), PARAMETER :: B3N6VDisx = 255 - INTEGER(IntKi), PARAMETER :: B3N7VDisx = 256 - INTEGER(IntKi), PARAMETER :: B3N8VDisx = 257 - INTEGER(IntKi), PARAMETER :: B3N9VDisx = 258 - INTEGER(IntKi), PARAMETER :: B3N1VDisy = 259 - INTEGER(IntKi), PARAMETER :: B3N2VDisy = 260 - INTEGER(IntKi), PARAMETER :: B3N3VDisy = 261 - INTEGER(IntKi), PARAMETER :: B3N4VDisy = 262 - INTEGER(IntKi), PARAMETER :: B3N5VDisy = 263 - INTEGER(IntKi), PARAMETER :: B3N6VDisy = 264 - INTEGER(IntKi), PARAMETER :: B3N7VDisy = 265 - INTEGER(IntKi), PARAMETER :: B3N8VDisy = 266 - INTEGER(IntKi), PARAMETER :: B3N9VDisy = 267 - INTEGER(IntKi), PARAMETER :: B3N1VDisz = 268 - INTEGER(IntKi), PARAMETER :: B3N2VDisz = 269 - INTEGER(IntKi), PARAMETER :: B3N3VDisz = 270 - INTEGER(IntKi), PARAMETER :: B3N4VDisz = 271 - INTEGER(IntKi), PARAMETER :: B3N5VDisz = 272 - INTEGER(IntKi), PARAMETER :: B3N6VDisz = 273 - INTEGER(IntKi), PARAMETER :: B3N7VDisz = 274 - INTEGER(IntKi), PARAMETER :: B3N8VDisz = 275 - INTEGER(IntKi), PARAMETER :: B3N9VDisz = 276 - INTEGER(IntKi), PARAMETER :: B1N1STVx = 277 - INTEGER(IntKi), PARAMETER :: B1N2STVx = 278 - INTEGER(IntKi), PARAMETER :: B1N3STVx = 279 - INTEGER(IntKi), PARAMETER :: B1N4STVx = 280 - INTEGER(IntKi), PARAMETER :: B1N5STVx = 281 - INTEGER(IntKi), PARAMETER :: B1N6STVx = 282 - INTEGER(IntKi), PARAMETER :: B1N7STVx = 283 - INTEGER(IntKi), PARAMETER :: B1N8STVx = 284 - INTEGER(IntKi), PARAMETER :: B1N9STVx = 285 - INTEGER(IntKi), PARAMETER :: B1N1STVy = 286 - INTEGER(IntKi), PARAMETER :: B1N2STVy = 287 - INTEGER(IntKi), PARAMETER :: B1N3STVy = 288 - INTEGER(IntKi), PARAMETER :: B1N4STVy = 289 - INTEGER(IntKi), PARAMETER :: B1N5STVy = 290 - INTEGER(IntKi), PARAMETER :: B1N6STVy = 291 - INTEGER(IntKi), PARAMETER :: B1N7STVy = 292 - INTEGER(IntKi), PARAMETER :: B1N8STVy = 293 - INTEGER(IntKi), PARAMETER :: B1N9STVy = 294 - INTEGER(IntKi), PARAMETER :: B1N1STVz = 295 - INTEGER(IntKi), PARAMETER :: B1N2STVz = 296 - INTEGER(IntKi), PARAMETER :: B1N3STVz = 297 - INTEGER(IntKi), PARAMETER :: B1N4STVz = 298 - INTEGER(IntKi), PARAMETER :: B1N5STVz = 299 - INTEGER(IntKi), PARAMETER :: B1N6STVz = 300 - INTEGER(IntKi), PARAMETER :: B1N7STVz = 301 - INTEGER(IntKi), PARAMETER :: B1N8STVz = 302 - INTEGER(IntKi), PARAMETER :: B1N9STVz = 303 - INTEGER(IntKi), PARAMETER :: B2N1STVx = 304 - INTEGER(IntKi), PARAMETER :: B2N2STVx = 305 - INTEGER(IntKi), PARAMETER :: B2N3STVx = 306 - INTEGER(IntKi), PARAMETER :: B2N4STVx = 307 - INTEGER(IntKi), PARAMETER :: B2N5STVx = 308 - INTEGER(IntKi), PARAMETER :: B2N6STVx = 309 - INTEGER(IntKi), PARAMETER :: B2N7STVx = 310 - INTEGER(IntKi), PARAMETER :: B2N8STVx = 311 - INTEGER(IntKi), PARAMETER :: B2N9STVx = 312 - INTEGER(IntKi), PARAMETER :: B2N1STVy = 313 - INTEGER(IntKi), PARAMETER :: B2N2STVy = 314 - INTEGER(IntKi), PARAMETER :: B2N3STVy = 315 - INTEGER(IntKi), PARAMETER :: B2N4STVy = 316 - INTEGER(IntKi), PARAMETER :: B2N5STVy = 317 - INTEGER(IntKi), PARAMETER :: B2N6STVy = 318 - INTEGER(IntKi), PARAMETER :: B2N7STVy = 319 - INTEGER(IntKi), PARAMETER :: B2N8STVy = 320 - INTEGER(IntKi), PARAMETER :: B2N9STVy = 321 - INTEGER(IntKi), PARAMETER :: B2N1STVz = 322 - INTEGER(IntKi), PARAMETER :: B2N2STVz = 323 - INTEGER(IntKi), PARAMETER :: B2N3STVz = 324 - INTEGER(IntKi), PARAMETER :: B2N4STVz = 325 - INTEGER(IntKi), PARAMETER :: B2N5STVz = 326 - INTEGER(IntKi), PARAMETER :: B2N6STVz = 327 - INTEGER(IntKi), PARAMETER :: B2N7STVz = 328 - INTEGER(IntKi), PARAMETER :: B2N8STVz = 329 - INTEGER(IntKi), PARAMETER :: B2N9STVz = 330 - INTEGER(IntKi), PARAMETER :: B3N1STVx = 331 - INTEGER(IntKi), PARAMETER :: B3N2STVx = 332 - INTEGER(IntKi), PARAMETER :: B3N3STVx = 333 - INTEGER(IntKi), PARAMETER :: B3N4STVx = 334 - INTEGER(IntKi), PARAMETER :: B3N5STVx = 335 - INTEGER(IntKi), PARAMETER :: B3N6STVx = 336 - INTEGER(IntKi), PARAMETER :: B3N7STVx = 337 - INTEGER(IntKi), PARAMETER :: B3N8STVx = 338 - INTEGER(IntKi), PARAMETER :: B3N9STVx = 339 - INTEGER(IntKi), PARAMETER :: B3N1STVy = 340 - INTEGER(IntKi), PARAMETER :: B3N2STVy = 341 - INTEGER(IntKi), PARAMETER :: B3N3STVy = 342 - INTEGER(IntKi), PARAMETER :: B3N4STVy = 343 - INTEGER(IntKi), PARAMETER :: B3N5STVy = 344 - INTEGER(IntKi), PARAMETER :: B3N6STVy = 345 - INTEGER(IntKi), PARAMETER :: B3N7STVy = 346 - INTEGER(IntKi), PARAMETER :: B3N8STVy = 347 - INTEGER(IntKi), PARAMETER :: B3N9STVy = 348 - INTEGER(IntKi), PARAMETER :: B3N1STVz = 349 - INTEGER(IntKi), PARAMETER :: B3N2STVz = 350 - INTEGER(IntKi), PARAMETER :: B3N3STVz = 351 - INTEGER(IntKi), PARAMETER :: B3N4STVz = 352 - INTEGER(IntKi), PARAMETER :: B3N5STVz = 353 - INTEGER(IntKi), PARAMETER :: B3N6STVz = 354 - INTEGER(IntKi), PARAMETER :: B3N7STVz = 355 - INTEGER(IntKi), PARAMETER :: B3N8STVz = 356 - INTEGER(IntKi), PARAMETER :: B3N9STVz = 357 - INTEGER(IntKi), PARAMETER :: B1N1VRel = 358 - INTEGER(IntKi), PARAMETER :: B1N2VRel = 359 - INTEGER(IntKi), PARAMETER :: B1N3VRel = 360 - INTEGER(IntKi), PARAMETER :: B1N4VRel = 361 - INTEGER(IntKi), PARAMETER :: B1N5VRel = 362 - INTEGER(IntKi), PARAMETER :: B1N6VRel = 363 - INTEGER(IntKi), PARAMETER :: B1N7VRel = 364 - INTEGER(IntKi), PARAMETER :: B1N8VRel = 365 - INTEGER(IntKi), PARAMETER :: B1N9VRel = 366 - INTEGER(IntKi), PARAMETER :: B2N1VRel = 367 - INTEGER(IntKi), PARAMETER :: B2N2VRel = 368 - INTEGER(IntKi), PARAMETER :: B2N3VRel = 369 - INTEGER(IntKi), PARAMETER :: B2N4VRel = 370 - INTEGER(IntKi), PARAMETER :: B2N5VRel = 371 - INTEGER(IntKi), PARAMETER :: B2N6VRel = 372 - INTEGER(IntKi), PARAMETER :: B2N7VRel = 373 - INTEGER(IntKi), PARAMETER :: B2N8VRel = 374 - INTEGER(IntKi), PARAMETER :: B2N9VRel = 375 - INTEGER(IntKi), PARAMETER :: B3N1VRel = 376 - INTEGER(IntKi), PARAMETER :: B3N2VRel = 377 - INTEGER(IntKi), PARAMETER :: B3N3VRel = 378 - INTEGER(IntKi), PARAMETER :: B3N4VRel = 379 - INTEGER(IntKi), PARAMETER :: B3N5VRel = 380 - INTEGER(IntKi), PARAMETER :: B3N6VRel = 381 - INTEGER(IntKi), PARAMETER :: B3N7VRel = 382 - INTEGER(IntKi), PARAMETER :: B3N8VRel = 383 - INTEGER(IntKi), PARAMETER :: B3N9VRel = 384 - INTEGER(IntKi), PARAMETER :: B1N1DynP = 385 - INTEGER(IntKi), PARAMETER :: B1N2DynP = 386 - INTEGER(IntKi), PARAMETER :: B1N3DynP = 387 - INTEGER(IntKi), PARAMETER :: B1N4DynP = 388 - INTEGER(IntKi), PARAMETER :: B1N5DynP = 389 - INTEGER(IntKi), PARAMETER :: B1N6DynP = 390 - INTEGER(IntKi), PARAMETER :: B1N7DynP = 391 - INTEGER(IntKi), PARAMETER :: B1N8DynP = 392 - INTEGER(IntKi), PARAMETER :: B1N9DynP = 393 - INTEGER(IntKi), PARAMETER :: B2N1DynP = 394 - INTEGER(IntKi), PARAMETER :: B2N2DynP = 395 - INTEGER(IntKi), PARAMETER :: B2N3DynP = 396 - INTEGER(IntKi), PARAMETER :: B2N4DynP = 397 - INTEGER(IntKi), PARAMETER :: B2N5DynP = 398 - INTEGER(IntKi), PARAMETER :: B2N6DynP = 399 - INTEGER(IntKi), PARAMETER :: B2N7DynP = 400 - INTEGER(IntKi), PARAMETER :: B2N8DynP = 401 - INTEGER(IntKi), PARAMETER :: B2N9DynP = 402 - INTEGER(IntKi), PARAMETER :: B3N1DynP = 403 - INTEGER(IntKi), PARAMETER :: B3N2DynP = 404 - INTEGER(IntKi), PARAMETER :: B3N3DynP = 405 - INTEGER(IntKi), PARAMETER :: B3N4DynP = 406 - INTEGER(IntKi), PARAMETER :: B3N5DynP = 407 - INTEGER(IntKi), PARAMETER :: B3N6DynP = 408 - INTEGER(IntKi), PARAMETER :: B3N7DynP = 409 - INTEGER(IntKi), PARAMETER :: B3N8DynP = 410 - INTEGER(IntKi), PARAMETER :: B3N9DynP = 411 - INTEGER(IntKi), PARAMETER :: B1N1Re = 412 - INTEGER(IntKi), PARAMETER :: B1N2Re = 413 - INTEGER(IntKi), PARAMETER :: B1N3Re = 414 - INTEGER(IntKi), PARAMETER :: B1N4Re = 415 - INTEGER(IntKi), PARAMETER :: B1N5Re = 416 - INTEGER(IntKi), PARAMETER :: B1N6Re = 417 - INTEGER(IntKi), PARAMETER :: B1N7Re = 418 - INTEGER(IntKi), PARAMETER :: B1N8Re = 419 - INTEGER(IntKi), PARAMETER :: B1N9Re = 420 - INTEGER(IntKi), PARAMETER :: B2N1Re = 421 - INTEGER(IntKi), PARAMETER :: B2N2Re = 422 - INTEGER(IntKi), PARAMETER :: B2N3Re = 423 - INTEGER(IntKi), PARAMETER :: B2N4Re = 424 - INTEGER(IntKi), PARAMETER :: B2N5Re = 425 - INTEGER(IntKi), PARAMETER :: B2N6Re = 426 - INTEGER(IntKi), PARAMETER :: B2N7Re = 427 - INTEGER(IntKi), PARAMETER :: B2N8Re = 428 - INTEGER(IntKi), PARAMETER :: B2N9Re = 429 - INTEGER(IntKi), PARAMETER :: B3N1Re = 430 - INTEGER(IntKi), PARAMETER :: B3N2Re = 431 - INTEGER(IntKi), PARAMETER :: B3N3Re = 432 - INTEGER(IntKi), PARAMETER :: B3N4Re = 433 - INTEGER(IntKi), PARAMETER :: B3N5Re = 434 - INTEGER(IntKi), PARAMETER :: B3N6Re = 435 - INTEGER(IntKi), PARAMETER :: B3N7Re = 436 - INTEGER(IntKi), PARAMETER :: B3N8Re = 437 - INTEGER(IntKi), PARAMETER :: B3N9Re = 438 - INTEGER(IntKi), PARAMETER :: B1N1M = 439 - INTEGER(IntKi), PARAMETER :: B1N2M = 440 - INTEGER(IntKi), PARAMETER :: B1N3M = 441 - INTEGER(IntKi), PARAMETER :: B1N4M = 442 - INTEGER(IntKi), PARAMETER :: B1N5M = 443 - INTEGER(IntKi), PARAMETER :: B1N6M = 444 - INTEGER(IntKi), PARAMETER :: B1N7M = 445 - INTEGER(IntKi), PARAMETER :: B1N8M = 446 - INTEGER(IntKi), PARAMETER :: B1N9M = 447 - INTEGER(IntKi), PARAMETER :: B2N1M = 448 - INTEGER(IntKi), PARAMETER :: B2N2M = 449 - INTEGER(IntKi), PARAMETER :: B2N3M = 450 - INTEGER(IntKi), PARAMETER :: B2N4M = 451 - INTEGER(IntKi), PARAMETER :: B2N5M = 452 - INTEGER(IntKi), PARAMETER :: B2N6M = 453 - INTEGER(IntKi), PARAMETER :: B2N7M = 454 - INTEGER(IntKi), PARAMETER :: B2N8M = 455 - INTEGER(IntKi), PARAMETER :: B2N9M = 456 - INTEGER(IntKi), PARAMETER :: B3N1M = 457 - INTEGER(IntKi), PARAMETER :: B3N2M = 458 - INTEGER(IntKi), PARAMETER :: B3N3M = 459 - INTEGER(IntKi), PARAMETER :: B3N4M = 460 - INTEGER(IntKi), PARAMETER :: B3N5M = 461 - INTEGER(IntKi), PARAMETER :: B3N6M = 462 - INTEGER(IntKi), PARAMETER :: B3N7M = 463 - INTEGER(IntKi), PARAMETER :: B3N8M = 464 - INTEGER(IntKi), PARAMETER :: B3N9M = 465 - INTEGER(IntKi), PARAMETER :: B1N1Vindx = 466 - INTEGER(IntKi), PARAMETER :: B1N2Vindx = 467 - INTEGER(IntKi), PARAMETER :: B1N3Vindx = 468 - INTEGER(IntKi), PARAMETER :: B1N4Vindx = 469 - INTEGER(IntKi), PARAMETER :: B1N5Vindx = 470 - INTEGER(IntKi), PARAMETER :: B1N6Vindx = 471 - INTEGER(IntKi), PARAMETER :: B1N7Vindx = 472 - INTEGER(IntKi), PARAMETER :: B1N8Vindx = 473 - INTEGER(IntKi), PARAMETER :: B1N9Vindx = 474 - INTEGER(IntKi), PARAMETER :: B2N1Vindx = 475 - INTEGER(IntKi), PARAMETER :: B2N2Vindx = 476 - INTEGER(IntKi), PARAMETER :: B2N3Vindx = 477 - INTEGER(IntKi), PARAMETER :: B2N4Vindx = 478 - INTEGER(IntKi), PARAMETER :: B2N5Vindx = 479 - INTEGER(IntKi), PARAMETER :: B2N6Vindx = 480 - INTEGER(IntKi), PARAMETER :: B2N7Vindx = 481 - INTEGER(IntKi), PARAMETER :: B2N8Vindx = 482 - INTEGER(IntKi), PARAMETER :: B2N9Vindx = 483 - INTEGER(IntKi), PARAMETER :: B3N1Vindx = 484 - INTEGER(IntKi), PARAMETER :: B3N2Vindx = 485 - INTEGER(IntKi), PARAMETER :: B3N3Vindx = 486 - INTEGER(IntKi), PARAMETER :: B3N4Vindx = 487 - INTEGER(IntKi), PARAMETER :: B3N5Vindx = 488 - INTEGER(IntKi), PARAMETER :: B3N6Vindx = 489 - INTEGER(IntKi), PARAMETER :: B3N7Vindx = 490 - INTEGER(IntKi), PARAMETER :: B3N8Vindx = 491 - INTEGER(IntKi), PARAMETER :: B3N9Vindx = 492 - INTEGER(IntKi), PARAMETER :: B1N1Vindy = 493 - INTEGER(IntKi), PARAMETER :: B1N2Vindy = 494 - INTEGER(IntKi), PARAMETER :: B1N3Vindy = 495 - INTEGER(IntKi), PARAMETER :: B1N4Vindy = 496 - INTEGER(IntKi), PARAMETER :: B1N5Vindy = 497 - INTEGER(IntKi), PARAMETER :: B1N6Vindy = 498 - INTEGER(IntKi), PARAMETER :: B1N7Vindy = 499 - INTEGER(IntKi), PARAMETER :: B1N8Vindy = 500 - INTEGER(IntKi), PARAMETER :: B1N9Vindy = 501 - INTEGER(IntKi), PARAMETER :: B2N1Vindy = 502 - INTEGER(IntKi), PARAMETER :: B2N2Vindy = 503 - INTEGER(IntKi), PARAMETER :: B2N3Vindy = 504 - INTEGER(IntKi), PARAMETER :: B2N4Vindy = 505 - INTEGER(IntKi), PARAMETER :: B2N5Vindy = 506 - INTEGER(IntKi), PARAMETER :: B2N6Vindy = 507 - INTEGER(IntKi), PARAMETER :: B2N7Vindy = 508 - INTEGER(IntKi), PARAMETER :: B2N8Vindy = 509 - INTEGER(IntKi), PARAMETER :: B2N9Vindy = 510 - INTEGER(IntKi), PARAMETER :: B3N1Vindy = 511 - INTEGER(IntKi), PARAMETER :: B3N2Vindy = 512 - INTEGER(IntKi), PARAMETER :: B3N3Vindy = 513 - INTEGER(IntKi), PARAMETER :: B3N4Vindy = 514 - INTEGER(IntKi), PARAMETER :: B3N5Vindy = 515 - INTEGER(IntKi), PARAMETER :: B3N6Vindy = 516 - INTEGER(IntKi), PARAMETER :: B3N7Vindy = 517 - INTEGER(IntKi), PARAMETER :: B3N8Vindy = 518 - INTEGER(IntKi), PARAMETER :: B3N9Vindy = 519 - INTEGER(IntKi), PARAMETER :: B1N1AxInd = 520 - INTEGER(IntKi), PARAMETER :: B1N2AxInd = 521 - INTEGER(IntKi), PARAMETER :: B1N3AxInd = 522 - INTEGER(IntKi), PARAMETER :: B1N4AxInd = 523 - INTEGER(IntKi), PARAMETER :: B1N5AxInd = 524 - INTEGER(IntKi), PARAMETER :: B1N6AxInd = 525 - INTEGER(IntKi), PARAMETER :: B1N7AxInd = 526 - INTEGER(IntKi), PARAMETER :: B1N8AxInd = 527 - INTEGER(IntKi), PARAMETER :: B1N9AxInd = 528 - INTEGER(IntKi), PARAMETER :: B2N1AxInd = 529 - INTEGER(IntKi), PARAMETER :: B2N2AxInd = 530 - INTEGER(IntKi), PARAMETER :: B2N3AxInd = 531 - INTEGER(IntKi), PARAMETER :: B2N4AxInd = 532 - INTEGER(IntKi), PARAMETER :: B2N5AxInd = 533 - INTEGER(IntKi), PARAMETER :: B2N6AxInd = 534 - INTEGER(IntKi), PARAMETER :: B2N7AxInd = 535 - INTEGER(IntKi), PARAMETER :: B2N8AxInd = 536 - INTEGER(IntKi), PARAMETER :: B2N9AxInd = 537 - INTEGER(IntKi), PARAMETER :: B3N1AxInd = 538 - INTEGER(IntKi), PARAMETER :: B3N2AxInd = 539 - INTEGER(IntKi), PARAMETER :: B3N3AxInd = 540 - INTEGER(IntKi), PARAMETER :: B3N4AxInd = 541 - INTEGER(IntKi), PARAMETER :: B3N5AxInd = 542 - INTEGER(IntKi), PARAMETER :: B3N6AxInd = 543 - INTEGER(IntKi), PARAMETER :: B3N7AxInd = 544 - INTEGER(IntKi), PARAMETER :: B3N8AxInd = 545 - INTEGER(IntKi), PARAMETER :: B3N9AxInd = 546 - INTEGER(IntKi), PARAMETER :: B1N1TnInd = 547 - INTEGER(IntKi), PARAMETER :: B1N2TnInd = 548 - INTEGER(IntKi), PARAMETER :: B1N3TnInd = 549 - INTEGER(IntKi), PARAMETER :: B1N4TnInd = 550 - INTEGER(IntKi), PARAMETER :: B1N5TnInd = 551 - INTEGER(IntKi), PARAMETER :: B1N6TnInd = 552 - INTEGER(IntKi), PARAMETER :: B1N7TnInd = 553 - INTEGER(IntKi), PARAMETER :: B1N8TnInd = 554 - INTEGER(IntKi), PARAMETER :: B1N9TnInd = 555 - INTEGER(IntKi), PARAMETER :: B2N1TnInd = 556 - INTEGER(IntKi), PARAMETER :: B2N2TnInd = 557 - INTEGER(IntKi), PARAMETER :: B2N3TnInd = 558 - INTEGER(IntKi), PARAMETER :: B2N4TnInd = 559 - INTEGER(IntKi), PARAMETER :: B2N5TnInd = 560 - INTEGER(IntKi), PARAMETER :: B2N6TnInd = 561 - INTEGER(IntKi), PARAMETER :: B2N7TnInd = 562 - INTEGER(IntKi), PARAMETER :: B2N8TnInd = 563 - INTEGER(IntKi), PARAMETER :: B2N9TnInd = 564 - INTEGER(IntKi), PARAMETER :: B3N1TnInd = 565 - INTEGER(IntKi), PARAMETER :: B3N2TnInd = 566 - INTEGER(IntKi), PARAMETER :: B3N3TnInd = 567 - INTEGER(IntKi), PARAMETER :: B3N4TnInd = 568 - INTEGER(IntKi), PARAMETER :: B3N5TnInd = 569 - INTEGER(IntKi), PARAMETER :: B3N6TnInd = 570 - INTEGER(IntKi), PARAMETER :: B3N7TnInd = 571 - INTEGER(IntKi), PARAMETER :: B3N8TnInd = 572 - INTEGER(IntKi), PARAMETER :: B3N9TnInd = 573 - INTEGER(IntKi), PARAMETER :: B1N1Alpha = 574 - INTEGER(IntKi), PARAMETER :: B1N2Alpha = 575 - INTEGER(IntKi), PARAMETER :: B1N3Alpha = 576 - INTEGER(IntKi), PARAMETER :: B1N4Alpha = 577 - INTEGER(IntKi), PARAMETER :: B1N5Alpha = 578 - INTEGER(IntKi), PARAMETER :: B1N6Alpha = 579 - INTEGER(IntKi), PARAMETER :: B1N7Alpha = 580 - INTEGER(IntKi), PARAMETER :: B1N8Alpha = 581 - INTEGER(IntKi), PARAMETER :: B1N9Alpha = 582 - INTEGER(IntKi), PARAMETER :: B2N1Alpha = 583 - INTEGER(IntKi), PARAMETER :: B2N2Alpha = 584 - INTEGER(IntKi), PARAMETER :: B2N3Alpha = 585 - INTEGER(IntKi), PARAMETER :: B2N4Alpha = 586 - INTEGER(IntKi), PARAMETER :: B2N5Alpha = 587 - INTEGER(IntKi), PARAMETER :: B2N6Alpha = 588 - INTEGER(IntKi), PARAMETER :: B2N7Alpha = 589 - INTEGER(IntKi), PARAMETER :: B2N8Alpha = 590 - INTEGER(IntKi), PARAMETER :: B2N9Alpha = 591 - INTEGER(IntKi), PARAMETER :: B3N1Alpha = 592 - INTEGER(IntKi), PARAMETER :: B3N2Alpha = 593 - INTEGER(IntKi), PARAMETER :: B3N3Alpha = 594 - INTEGER(IntKi), PARAMETER :: B3N4Alpha = 595 - INTEGER(IntKi), PARAMETER :: B3N5Alpha = 596 - INTEGER(IntKi), PARAMETER :: B3N6Alpha = 597 - INTEGER(IntKi), PARAMETER :: B3N7Alpha = 598 - INTEGER(IntKi), PARAMETER :: B3N8Alpha = 599 - INTEGER(IntKi), PARAMETER :: B3N9Alpha = 600 - INTEGER(IntKi), PARAMETER :: B1N1Theta = 601 - INTEGER(IntKi), PARAMETER :: B1N2Theta = 602 - INTEGER(IntKi), PARAMETER :: B1N3Theta = 603 - INTEGER(IntKi), PARAMETER :: B1N4Theta = 604 - INTEGER(IntKi), PARAMETER :: B1N5Theta = 605 - INTEGER(IntKi), PARAMETER :: B1N6Theta = 606 - INTEGER(IntKi), PARAMETER :: B1N7Theta = 607 - INTEGER(IntKi), PARAMETER :: B1N8Theta = 608 - INTEGER(IntKi), PARAMETER :: B1N9Theta = 609 - INTEGER(IntKi), PARAMETER :: B2N1Theta = 610 - INTEGER(IntKi), PARAMETER :: B2N2Theta = 611 - INTEGER(IntKi), PARAMETER :: B2N3Theta = 612 - INTEGER(IntKi), PARAMETER :: B2N4Theta = 613 - INTEGER(IntKi), PARAMETER :: B2N5Theta = 614 - INTEGER(IntKi), PARAMETER :: B2N6Theta = 615 - INTEGER(IntKi), PARAMETER :: B2N7Theta = 616 - INTEGER(IntKi), PARAMETER :: B2N8Theta = 617 - INTEGER(IntKi), PARAMETER :: B2N9Theta = 618 - INTEGER(IntKi), PARAMETER :: B3N1Theta = 619 - INTEGER(IntKi), PARAMETER :: B3N2Theta = 620 - INTEGER(IntKi), PARAMETER :: B3N3Theta = 621 - INTEGER(IntKi), PARAMETER :: B3N4Theta = 622 - INTEGER(IntKi), PARAMETER :: B3N5Theta = 623 - INTEGER(IntKi), PARAMETER :: B3N6Theta = 624 - INTEGER(IntKi), PARAMETER :: B3N7Theta = 625 - INTEGER(IntKi), PARAMETER :: B3N8Theta = 626 - INTEGER(IntKi), PARAMETER :: B3N9Theta = 627 - INTEGER(IntKi), PARAMETER :: B1N1Phi = 628 - INTEGER(IntKi), PARAMETER :: B1N2Phi = 629 - INTEGER(IntKi), PARAMETER :: B1N3Phi = 630 - INTEGER(IntKi), PARAMETER :: B1N4Phi = 631 - INTEGER(IntKi), PARAMETER :: B1N5Phi = 632 - INTEGER(IntKi), PARAMETER :: B1N6Phi = 633 - INTEGER(IntKi), PARAMETER :: B1N7Phi = 634 - INTEGER(IntKi), PARAMETER :: B1N8Phi = 635 - INTEGER(IntKi), PARAMETER :: B1N9Phi = 636 - INTEGER(IntKi), PARAMETER :: B2N1Phi = 637 - INTEGER(IntKi), PARAMETER :: B2N2Phi = 638 - INTEGER(IntKi), PARAMETER :: B2N3Phi = 639 - INTEGER(IntKi), PARAMETER :: B2N4Phi = 640 - INTEGER(IntKi), PARAMETER :: B2N5Phi = 641 - INTEGER(IntKi), PARAMETER :: B2N6Phi = 642 - INTEGER(IntKi), PARAMETER :: B2N7Phi = 643 - INTEGER(IntKi), PARAMETER :: B2N8Phi = 644 - INTEGER(IntKi), PARAMETER :: B2N9Phi = 645 - INTEGER(IntKi), PARAMETER :: B3N1Phi = 646 - INTEGER(IntKi), PARAMETER :: B3N2Phi = 647 - INTEGER(IntKi), PARAMETER :: B3N3Phi = 648 - INTEGER(IntKi), PARAMETER :: B3N4Phi = 649 - INTEGER(IntKi), PARAMETER :: B3N5Phi = 650 - INTEGER(IntKi), PARAMETER :: B3N6Phi = 651 - INTEGER(IntKi), PARAMETER :: B3N7Phi = 652 - INTEGER(IntKi), PARAMETER :: B3N8Phi = 653 - INTEGER(IntKi), PARAMETER :: B3N9Phi = 654 - INTEGER(IntKi), PARAMETER :: B1N1Curve = 655 - INTEGER(IntKi), PARAMETER :: B1N2Curve = 656 - INTEGER(IntKi), PARAMETER :: B1N3Curve = 657 - INTEGER(IntKi), PARAMETER :: B1N4Curve = 658 - INTEGER(IntKi), PARAMETER :: B1N5Curve = 659 - INTEGER(IntKi), PARAMETER :: B1N6Curve = 660 - INTEGER(IntKi), PARAMETER :: B1N7Curve = 661 - INTEGER(IntKi), PARAMETER :: B1N8Curve = 662 - INTEGER(IntKi), PARAMETER :: B1N9Curve = 663 - INTEGER(IntKi), PARAMETER :: B2N1Curve = 664 - INTEGER(IntKi), PARAMETER :: B2N2Curve = 665 - INTEGER(IntKi), PARAMETER :: B2N3Curve = 666 - INTEGER(IntKi), PARAMETER :: B2N4Curve = 667 - INTEGER(IntKi), PARAMETER :: B2N5Curve = 668 - INTEGER(IntKi), PARAMETER :: B2N6Curve = 669 - INTEGER(IntKi), PARAMETER :: B2N7Curve = 670 - INTEGER(IntKi), PARAMETER :: B2N8Curve = 671 - INTEGER(IntKi), PARAMETER :: B2N9Curve = 672 - INTEGER(IntKi), PARAMETER :: B3N1Curve = 673 - INTEGER(IntKi), PARAMETER :: B3N2Curve = 674 - INTEGER(IntKi), PARAMETER :: B3N3Curve = 675 - INTEGER(IntKi), PARAMETER :: B3N4Curve = 676 - INTEGER(IntKi), PARAMETER :: B3N5Curve = 677 - INTEGER(IntKi), PARAMETER :: B3N6Curve = 678 - INTEGER(IntKi), PARAMETER :: B3N7Curve = 679 - INTEGER(IntKi), PARAMETER :: B3N8Curve = 680 - INTEGER(IntKi), PARAMETER :: B3N9Curve = 681 - INTEGER(IntKi), PARAMETER :: B1N1Cl = 682 - INTEGER(IntKi), PARAMETER :: B1N2Cl = 683 - INTEGER(IntKi), PARAMETER :: B1N3Cl = 684 - INTEGER(IntKi), PARAMETER :: B1N4Cl = 685 - INTEGER(IntKi), PARAMETER :: B1N5Cl = 686 - INTEGER(IntKi), PARAMETER :: B1N6Cl = 687 - INTEGER(IntKi), PARAMETER :: B1N7Cl = 688 - INTEGER(IntKi), PARAMETER :: B1N8Cl = 689 - INTEGER(IntKi), PARAMETER :: B1N9Cl = 690 - INTEGER(IntKi), PARAMETER :: B2N1Cl = 691 - INTEGER(IntKi), PARAMETER :: B2N2Cl = 692 - INTEGER(IntKi), PARAMETER :: B2N3Cl = 693 - INTEGER(IntKi), PARAMETER :: B2N4Cl = 694 - INTEGER(IntKi), PARAMETER :: B2N5Cl = 695 - INTEGER(IntKi), PARAMETER :: B2N6Cl = 696 - INTEGER(IntKi), PARAMETER :: B2N7Cl = 697 - INTEGER(IntKi), PARAMETER :: B2N8Cl = 698 - INTEGER(IntKi), PARAMETER :: B2N9Cl = 699 - INTEGER(IntKi), PARAMETER :: B3N1Cl = 700 - INTEGER(IntKi), PARAMETER :: B3N2Cl = 701 - INTEGER(IntKi), PARAMETER :: B3N3Cl = 702 - INTEGER(IntKi), PARAMETER :: B3N4Cl = 703 - INTEGER(IntKi), PARAMETER :: B3N5Cl = 704 - INTEGER(IntKi), PARAMETER :: B3N6Cl = 705 - INTEGER(IntKi), PARAMETER :: B3N7Cl = 706 - INTEGER(IntKi), PARAMETER :: B3N8Cl = 707 - INTEGER(IntKi), PARAMETER :: B3N9Cl = 708 - INTEGER(IntKi), PARAMETER :: B1N1Cd = 709 - INTEGER(IntKi), PARAMETER :: B1N2Cd = 710 - INTEGER(IntKi), PARAMETER :: B1N3Cd = 711 - INTEGER(IntKi), PARAMETER :: B1N4Cd = 712 - INTEGER(IntKi), PARAMETER :: B1N5Cd = 713 - INTEGER(IntKi), PARAMETER :: B1N6Cd = 714 - INTEGER(IntKi), PARAMETER :: B1N7Cd = 715 - INTEGER(IntKi), PARAMETER :: B1N8Cd = 716 - INTEGER(IntKi), PARAMETER :: B1N9Cd = 717 - INTEGER(IntKi), PARAMETER :: B2N1Cd = 718 - INTEGER(IntKi), PARAMETER :: B2N2Cd = 719 - INTEGER(IntKi), PARAMETER :: B2N3Cd = 720 - INTEGER(IntKi), PARAMETER :: B2N4Cd = 721 - INTEGER(IntKi), PARAMETER :: B2N5Cd = 722 - INTEGER(IntKi), PARAMETER :: B2N6Cd = 723 - INTEGER(IntKi), PARAMETER :: B2N7Cd = 724 - INTEGER(IntKi), PARAMETER :: B2N8Cd = 725 - INTEGER(IntKi), PARAMETER :: B2N9Cd = 726 - INTEGER(IntKi), PARAMETER :: B3N1Cd = 727 - INTEGER(IntKi), PARAMETER :: B3N2Cd = 728 - INTEGER(IntKi), PARAMETER :: B3N3Cd = 729 - INTEGER(IntKi), PARAMETER :: B3N4Cd = 730 - INTEGER(IntKi), PARAMETER :: B3N5Cd = 731 - INTEGER(IntKi), PARAMETER :: B3N6Cd = 732 - INTEGER(IntKi), PARAMETER :: B3N7Cd = 733 - INTEGER(IntKi), PARAMETER :: B3N8Cd = 734 - INTEGER(IntKi), PARAMETER :: B3N9Cd = 735 - INTEGER(IntKi), PARAMETER :: B1N1Cm = 736 - INTEGER(IntKi), PARAMETER :: B1N2Cm = 737 - INTEGER(IntKi), PARAMETER :: B1N3Cm = 738 - INTEGER(IntKi), PARAMETER :: B1N4Cm = 739 - INTEGER(IntKi), PARAMETER :: B1N5Cm = 740 - INTEGER(IntKi), PARAMETER :: B1N6Cm = 741 - INTEGER(IntKi), PARAMETER :: B1N7Cm = 742 - INTEGER(IntKi), PARAMETER :: B1N8Cm = 743 - INTEGER(IntKi), PARAMETER :: B1N9Cm = 744 - INTEGER(IntKi), PARAMETER :: B2N1Cm = 745 - INTEGER(IntKi), PARAMETER :: B2N2Cm = 746 - INTEGER(IntKi), PARAMETER :: B2N3Cm = 747 - INTEGER(IntKi), PARAMETER :: B2N4Cm = 748 - INTEGER(IntKi), PARAMETER :: B2N5Cm = 749 - INTEGER(IntKi), PARAMETER :: B2N6Cm = 750 - INTEGER(IntKi), PARAMETER :: B2N7Cm = 751 - INTEGER(IntKi), PARAMETER :: B2N8Cm = 752 - INTEGER(IntKi), PARAMETER :: B2N9Cm = 753 - INTEGER(IntKi), PARAMETER :: B3N1Cm = 754 - INTEGER(IntKi), PARAMETER :: B3N2Cm = 755 - INTEGER(IntKi), PARAMETER :: B3N3Cm = 756 - INTEGER(IntKi), PARAMETER :: B3N4Cm = 757 - INTEGER(IntKi), PARAMETER :: B3N5Cm = 758 - INTEGER(IntKi), PARAMETER :: B3N6Cm = 759 - INTEGER(IntKi), PARAMETER :: B3N7Cm = 760 - INTEGER(IntKi), PARAMETER :: B3N8Cm = 761 - INTEGER(IntKi), PARAMETER :: B3N9Cm = 762 - INTEGER(IntKi), PARAMETER :: B1N1Cx = 763 - INTEGER(IntKi), PARAMETER :: B1N2Cx = 764 - INTEGER(IntKi), PARAMETER :: B1N3Cx = 765 - INTEGER(IntKi), PARAMETER :: B1N4Cx = 766 - INTEGER(IntKi), PARAMETER :: B1N5Cx = 767 - INTEGER(IntKi), PARAMETER :: B1N6Cx = 768 - INTEGER(IntKi), PARAMETER :: B1N7Cx = 769 - INTEGER(IntKi), PARAMETER :: B1N8Cx = 770 - INTEGER(IntKi), PARAMETER :: B1N9Cx = 771 - INTEGER(IntKi), PARAMETER :: B2N1Cx = 772 - INTEGER(IntKi), PARAMETER :: B2N2Cx = 773 - INTEGER(IntKi), PARAMETER :: B2N3Cx = 774 - INTEGER(IntKi), PARAMETER :: B2N4Cx = 775 - INTEGER(IntKi), PARAMETER :: B2N5Cx = 776 - INTEGER(IntKi), PARAMETER :: B2N6Cx = 777 - INTEGER(IntKi), PARAMETER :: B2N7Cx = 778 - INTEGER(IntKi), PARAMETER :: B2N8Cx = 779 - INTEGER(IntKi), PARAMETER :: B2N9Cx = 780 - INTEGER(IntKi), PARAMETER :: B3N1Cx = 781 - INTEGER(IntKi), PARAMETER :: B3N2Cx = 782 - INTEGER(IntKi), PARAMETER :: B3N3Cx = 783 - INTEGER(IntKi), PARAMETER :: B3N4Cx = 784 - INTEGER(IntKi), PARAMETER :: B3N5Cx = 785 - INTEGER(IntKi), PARAMETER :: B3N6Cx = 786 - INTEGER(IntKi), PARAMETER :: B3N7Cx = 787 - INTEGER(IntKi), PARAMETER :: B3N8Cx = 788 - INTEGER(IntKi), PARAMETER :: B3N9Cx = 789 - INTEGER(IntKi), PARAMETER :: B1N1Cy = 790 - INTEGER(IntKi), PARAMETER :: B1N2Cy = 791 - INTEGER(IntKi), PARAMETER :: B1N3Cy = 792 - INTEGER(IntKi), PARAMETER :: B1N4Cy = 793 - INTEGER(IntKi), PARAMETER :: B1N5Cy = 794 - INTEGER(IntKi), PARAMETER :: B1N6Cy = 795 - INTEGER(IntKi), PARAMETER :: B1N7Cy = 796 - INTEGER(IntKi), PARAMETER :: B1N8Cy = 797 - INTEGER(IntKi), PARAMETER :: B1N9Cy = 798 - INTEGER(IntKi), PARAMETER :: B2N1Cy = 799 - INTEGER(IntKi), PARAMETER :: B2N2Cy = 800 - INTEGER(IntKi), PARAMETER :: B2N3Cy = 801 - INTEGER(IntKi), PARAMETER :: B2N4Cy = 802 - INTEGER(IntKi), PARAMETER :: B2N5Cy = 803 - INTEGER(IntKi), PARAMETER :: B2N6Cy = 804 - INTEGER(IntKi), PARAMETER :: B2N7Cy = 805 - INTEGER(IntKi), PARAMETER :: B2N8Cy = 806 - INTEGER(IntKi), PARAMETER :: B2N9Cy = 807 - INTEGER(IntKi), PARAMETER :: B3N1Cy = 808 - INTEGER(IntKi), PARAMETER :: B3N2Cy = 809 - INTEGER(IntKi), PARAMETER :: B3N3Cy = 810 - INTEGER(IntKi), PARAMETER :: B3N4Cy = 811 - INTEGER(IntKi), PARAMETER :: B3N5Cy = 812 - INTEGER(IntKi), PARAMETER :: B3N6Cy = 813 - INTEGER(IntKi), PARAMETER :: B3N7Cy = 814 - INTEGER(IntKi), PARAMETER :: B3N8Cy = 815 - INTEGER(IntKi), PARAMETER :: B3N9Cy = 816 - INTEGER(IntKi), PARAMETER :: B1N1Cn = 817 - INTEGER(IntKi), PARAMETER :: B1N2Cn = 818 - INTEGER(IntKi), PARAMETER :: B1N3Cn = 819 - INTEGER(IntKi), PARAMETER :: B1N4Cn = 820 - INTEGER(IntKi), PARAMETER :: B1N5Cn = 821 - INTEGER(IntKi), PARAMETER :: B1N6Cn = 822 - INTEGER(IntKi), PARAMETER :: B1N7Cn = 823 - INTEGER(IntKi), PARAMETER :: B1N8Cn = 824 - INTEGER(IntKi), PARAMETER :: B1N9Cn = 825 - INTEGER(IntKi), PARAMETER :: B2N1Cn = 826 - INTEGER(IntKi), PARAMETER :: B2N2Cn = 827 - INTEGER(IntKi), PARAMETER :: B2N3Cn = 828 - INTEGER(IntKi), PARAMETER :: B2N4Cn = 829 - INTEGER(IntKi), PARAMETER :: B2N5Cn = 830 - INTEGER(IntKi), PARAMETER :: B2N6Cn = 831 - INTEGER(IntKi), PARAMETER :: B2N7Cn = 832 - INTEGER(IntKi), PARAMETER :: B2N8Cn = 833 - INTEGER(IntKi), PARAMETER :: B2N9Cn = 834 - INTEGER(IntKi), PARAMETER :: B3N1Cn = 835 - INTEGER(IntKi), PARAMETER :: B3N2Cn = 836 - INTEGER(IntKi), PARAMETER :: B3N3Cn = 837 - INTEGER(IntKi), PARAMETER :: B3N4Cn = 838 - INTEGER(IntKi), PARAMETER :: B3N5Cn = 839 - INTEGER(IntKi), PARAMETER :: B3N6Cn = 840 - INTEGER(IntKi), PARAMETER :: B3N7Cn = 841 - INTEGER(IntKi), PARAMETER :: B3N8Cn = 842 - INTEGER(IntKi), PARAMETER :: B3N9Cn = 843 - INTEGER(IntKi), PARAMETER :: B1N1Ct = 844 - INTEGER(IntKi), PARAMETER :: B1N2Ct = 845 - INTEGER(IntKi), PARAMETER :: B1N3Ct = 846 - INTEGER(IntKi), PARAMETER :: B1N4Ct = 847 - INTEGER(IntKi), PARAMETER :: B1N5Ct = 848 - INTEGER(IntKi), PARAMETER :: B1N6Ct = 849 - INTEGER(IntKi), PARAMETER :: B1N7Ct = 850 - INTEGER(IntKi), PARAMETER :: B1N8Ct = 851 - INTEGER(IntKi), PARAMETER :: B1N9Ct = 852 - INTEGER(IntKi), PARAMETER :: B2N1Ct = 853 - INTEGER(IntKi), PARAMETER :: B2N2Ct = 854 - INTEGER(IntKi), PARAMETER :: B2N3Ct = 855 - INTEGER(IntKi), PARAMETER :: B2N4Ct = 856 - INTEGER(IntKi), PARAMETER :: B2N5Ct = 857 - INTEGER(IntKi), PARAMETER :: B2N6Ct = 858 - INTEGER(IntKi), PARAMETER :: B2N7Ct = 859 - INTEGER(IntKi), PARAMETER :: B2N8Ct = 860 - INTEGER(IntKi), PARAMETER :: B2N9Ct = 861 - INTEGER(IntKi), PARAMETER :: B3N1Ct = 862 - INTEGER(IntKi), PARAMETER :: B3N2Ct = 863 - INTEGER(IntKi), PARAMETER :: B3N3Ct = 864 - INTEGER(IntKi), PARAMETER :: B3N4Ct = 865 - INTEGER(IntKi), PARAMETER :: B3N5Ct = 866 - INTEGER(IntKi), PARAMETER :: B3N6Ct = 867 - INTEGER(IntKi), PARAMETER :: B3N7Ct = 868 - INTEGER(IntKi), PARAMETER :: B3N8Ct = 869 - INTEGER(IntKi), PARAMETER :: B3N9Ct = 870 - INTEGER(IntKi), PARAMETER :: B1N1Fl = 871 - INTEGER(IntKi), PARAMETER :: B1N2Fl = 872 - INTEGER(IntKi), PARAMETER :: B1N3Fl = 873 - INTEGER(IntKi), PARAMETER :: B1N4Fl = 874 - INTEGER(IntKi), PARAMETER :: B1N5Fl = 875 - INTEGER(IntKi), PARAMETER :: B1N6Fl = 876 - INTEGER(IntKi), PARAMETER :: B1N7Fl = 877 - INTEGER(IntKi), PARAMETER :: B1N8Fl = 878 - INTEGER(IntKi), PARAMETER :: B1N9Fl = 879 - INTEGER(IntKi), PARAMETER :: B2N1Fl = 880 - INTEGER(IntKi), PARAMETER :: B2N2Fl = 881 - INTEGER(IntKi), PARAMETER :: B2N3Fl = 882 - INTEGER(IntKi), PARAMETER :: B2N4Fl = 883 - INTEGER(IntKi), PARAMETER :: B2N5Fl = 884 - INTEGER(IntKi), PARAMETER :: B2N6Fl = 885 - INTEGER(IntKi), PARAMETER :: B2N7Fl = 886 - INTEGER(IntKi), PARAMETER :: B2N8Fl = 887 - INTEGER(IntKi), PARAMETER :: B2N9Fl = 888 - INTEGER(IntKi), PARAMETER :: B3N1Fl = 889 - INTEGER(IntKi), PARAMETER :: B3N2Fl = 890 - INTEGER(IntKi), PARAMETER :: B3N3Fl = 891 - INTEGER(IntKi), PARAMETER :: B3N4Fl = 892 - INTEGER(IntKi), PARAMETER :: B3N5Fl = 893 - INTEGER(IntKi), PARAMETER :: B3N6Fl = 894 - INTEGER(IntKi), PARAMETER :: B3N7Fl = 895 - INTEGER(IntKi), PARAMETER :: B3N8Fl = 896 - INTEGER(IntKi), PARAMETER :: B3N9Fl = 897 - INTEGER(IntKi), PARAMETER :: B1N1Fd = 898 - INTEGER(IntKi), PARAMETER :: B1N2Fd = 899 - INTEGER(IntKi), PARAMETER :: B1N3Fd = 900 - INTEGER(IntKi), PARAMETER :: B1N4Fd = 901 - INTEGER(IntKi), PARAMETER :: B1N5Fd = 902 - INTEGER(IntKi), PARAMETER :: B1N6Fd = 903 - INTEGER(IntKi), PARAMETER :: B1N7Fd = 904 - INTEGER(IntKi), PARAMETER :: B1N8Fd = 905 - INTEGER(IntKi), PARAMETER :: B1N9Fd = 906 - INTEGER(IntKi), PARAMETER :: B2N1Fd = 907 - INTEGER(IntKi), PARAMETER :: B2N2Fd = 908 - INTEGER(IntKi), PARAMETER :: B2N3Fd = 909 - INTEGER(IntKi), PARAMETER :: B2N4Fd = 910 - INTEGER(IntKi), PARAMETER :: B2N5Fd = 911 - INTEGER(IntKi), PARAMETER :: B2N6Fd = 912 - INTEGER(IntKi), PARAMETER :: B2N7Fd = 913 - INTEGER(IntKi), PARAMETER :: B2N8Fd = 914 - INTEGER(IntKi), PARAMETER :: B2N9Fd = 915 - INTEGER(IntKi), PARAMETER :: B3N1Fd = 916 - INTEGER(IntKi), PARAMETER :: B3N2Fd = 917 - INTEGER(IntKi), PARAMETER :: B3N3Fd = 918 - INTEGER(IntKi), PARAMETER :: B3N4Fd = 919 - INTEGER(IntKi), PARAMETER :: B3N5Fd = 920 - INTEGER(IntKi), PARAMETER :: B3N6Fd = 921 - INTEGER(IntKi), PARAMETER :: B3N7Fd = 922 - INTEGER(IntKi), PARAMETER :: B3N8Fd = 923 - INTEGER(IntKi), PARAMETER :: B3N9Fd = 924 - INTEGER(IntKi), PARAMETER :: B1N1Mm = 925 - INTEGER(IntKi), PARAMETER :: B1N2Mm = 926 - INTEGER(IntKi), PARAMETER :: B1N3Mm = 927 - INTEGER(IntKi), PARAMETER :: B1N4Mm = 928 - INTEGER(IntKi), PARAMETER :: B1N5Mm = 929 - INTEGER(IntKi), PARAMETER :: B1N6Mm = 930 - INTEGER(IntKi), PARAMETER :: B1N7Mm = 931 - INTEGER(IntKi), PARAMETER :: B1N8Mm = 932 - INTEGER(IntKi), PARAMETER :: B1N9Mm = 933 - INTEGER(IntKi), PARAMETER :: B2N1Mm = 934 - INTEGER(IntKi), PARAMETER :: B2N2Mm = 935 - INTEGER(IntKi), PARAMETER :: B2N3Mm = 936 - INTEGER(IntKi), PARAMETER :: B2N4Mm = 937 - INTEGER(IntKi), PARAMETER :: B2N5Mm = 938 - INTEGER(IntKi), PARAMETER :: B2N6Mm = 939 - INTEGER(IntKi), PARAMETER :: B2N7Mm = 940 - INTEGER(IntKi), PARAMETER :: B2N8Mm = 941 - INTEGER(IntKi), PARAMETER :: B2N9Mm = 942 - INTEGER(IntKi), PARAMETER :: B3N1Mm = 943 - INTEGER(IntKi), PARAMETER :: B3N2Mm = 944 - INTEGER(IntKi), PARAMETER :: B3N3Mm = 945 - INTEGER(IntKi), PARAMETER :: B3N4Mm = 946 - INTEGER(IntKi), PARAMETER :: B3N5Mm = 947 - INTEGER(IntKi), PARAMETER :: B3N6Mm = 948 - INTEGER(IntKi), PARAMETER :: B3N7Mm = 949 - INTEGER(IntKi), PARAMETER :: B3N8Mm = 950 - INTEGER(IntKi), PARAMETER :: B3N9Mm = 951 - INTEGER(IntKi), PARAMETER :: B1N1Fx = 952 - INTEGER(IntKi), PARAMETER :: B1N2Fx = 953 - INTEGER(IntKi), PARAMETER :: B1N3Fx = 954 - INTEGER(IntKi), PARAMETER :: B1N4Fx = 955 - INTEGER(IntKi), PARAMETER :: B1N5Fx = 956 - INTEGER(IntKi), PARAMETER :: B1N6Fx = 957 - INTEGER(IntKi), PARAMETER :: B1N7Fx = 958 - INTEGER(IntKi), PARAMETER :: B1N8Fx = 959 - INTEGER(IntKi), PARAMETER :: B1N9Fx = 960 - INTEGER(IntKi), PARAMETER :: B2N1Fx = 961 - INTEGER(IntKi), PARAMETER :: B2N2Fx = 962 - INTEGER(IntKi), PARAMETER :: B2N3Fx = 963 - INTEGER(IntKi), PARAMETER :: B2N4Fx = 964 - INTEGER(IntKi), PARAMETER :: B2N5Fx = 965 - INTEGER(IntKi), PARAMETER :: B2N6Fx = 966 - INTEGER(IntKi), PARAMETER :: B2N7Fx = 967 - INTEGER(IntKi), PARAMETER :: B2N8Fx = 968 - INTEGER(IntKi), PARAMETER :: B2N9Fx = 969 - INTEGER(IntKi), PARAMETER :: B3N1Fx = 970 - INTEGER(IntKi), PARAMETER :: B3N2Fx = 971 - INTEGER(IntKi), PARAMETER :: B3N3Fx = 972 - INTEGER(IntKi), PARAMETER :: B3N4Fx = 973 - INTEGER(IntKi), PARAMETER :: B3N5Fx = 974 - INTEGER(IntKi), PARAMETER :: B3N6Fx = 975 - INTEGER(IntKi), PARAMETER :: B3N7Fx = 976 - INTEGER(IntKi), PARAMETER :: B3N8Fx = 977 - INTEGER(IntKi), PARAMETER :: B3N9Fx = 978 - INTEGER(IntKi), PARAMETER :: B1N1Fy = 979 - INTEGER(IntKi), PARAMETER :: B1N2Fy = 980 - INTEGER(IntKi), PARAMETER :: B1N3Fy = 981 - INTEGER(IntKi), PARAMETER :: B1N4Fy = 982 - INTEGER(IntKi), PARAMETER :: B1N5Fy = 983 - INTEGER(IntKi), PARAMETER :: B1N6Fy = 984 - INTEGER(IntKi), PARAMETER :: B1N7Fy = 985 - INTEGER(IntKi), PARAMETER :: B1N8Fy = 986 - INTEGER(IntKi), PARAMETER :: B1N9Fy = 987 - INTEGER(IntKi), PARAMETER :: B2N1Fy = 988 - INTEGER(IntKi), PARAMETER :: B2N2Fy = 989 - INTEGER(IntKi), PARAMETER :: B2N3Fy = 990 - INTEGER(IntKi), PARAMETER :: B2N4Fy = 991 - INTEGER(IntKi), PARAMETER :: B2N5Fy = 992 - INTEGER(IntKi), PARAMETER :: B2N6Fy = 993 - INTEGER(IntKi), PARAMETER :: B2N7Fy = 994 - INTEGER(IntKi), PARAMETER :: B2N8Fy = 995 - INTEGER(IntKi), PARAMETER :: B2N9Fy = 996 - INTEGER(IntKi), PARAMETER :: B3N1Fy = 997 - INTEGER(IntKi), PARAMETER :: B3N2Fy = 998 - INTEGER(IntKi), PARAMETER :: B3N3Fy = 999 - INTEGER(IntKi), PARAMETER :: B3N4Fy = 1000 - INTEGER(IntKi), PARAMETER :: B3N5Fy = 1001 - INTEGER(IntKi), PARAMETER :: B3N6Fy = 1002 - INTEGER(IntKi), PARAMETER :: B3N7Fy = 1003 - INTEGER(IntKi), PARAMETER :: B3N8Fy = 1004 - INTEGER(IntKi), PARAMETER :: B3N9Fy = 1005 - INTEGER(IntKi), PARAMETER :: B1N1Fn = 1006 - INTEGER(IntKi), PARAMETER :: B1N2Fn = 1007 - INTEGER(IntKi), PARAMETER :: B1N3Fn = 1008 - INTEGER(IntKi), PARAMETER :: B1N4Fn = 1009 - INTEGER(IntKi), PARAMETER :: B1N5Fn = 1010 - INTEGER(IntKi), PARAMETER :: B1N6Fn = 1011 - INTEGER(IntKi), PARAMETER :: B1N7Fn = 1012 - INTEGER(IntKi), PARAMETER :: B1N8Fn = 1013 - INTEGER(IntKi), PARAMETER :: B1N9Fn = 1014 - INTEGER(IntKi), PARAMETER :: B2N1Fn = 1015 - INTEGER(IntKi), PARAMETER :: B2N2Fn = 1016 - INTEGER(IntKi), PARAMETER :: B2N3Fn = 1017 - INTEGER(IntKi), PARAMETER :: B2N4Fn = 1018 - INTEGER(IntKi), PARAMETER :: B2N5Fn = 1019 - INTEGER(IntKi), PARAMETER :: B2N6Fn = 1020 - INTEGER(IntKi), PARAMETER :: B2N7Fn = 1021 - INTEGER(IntKi), PARAMETER :: B2N8Fn = 1022 - INTEGER(IntKi), PARAMETER :: B2N9Fn = 1023 - INTEGER(IntKi), PARAMETER :: B3N1Fn = 1024 - INTEGER(IntKi), PARAMETER :: B3N2Fn = 1025 - INTEGER(IntKi), PARAMETER :: B3N3Fn = 1026 - INTEGER(IntKi), PARAMETER :: B3N4Fn = 1027 - INTEGER(IntKi), PARAMETER :: B3N5Fn = 1028 - INTEGER(IntKi), PARAMETER :: B3N6Fn = 1029 - INTEGER(IntKi), PARAMETER :: B3N7Fn = 1030 - INTEGER(IntKi), PARAMETER :: B3N8Fn = 1031 - INTEGER(IntKi), PARAMETER :: B3N9Fn = 1032 - INTEGER(IntKi), PARAMETER :: B1N1Ft = 1033 - INTEGER(IntKi), PARAMETER :: B1N2Ft = 1034 - INTEGER(IntKi), PARAMETER :: B1N3Ft = 1035 - INTEGER(IntKi), PARAMETER :: B1N4Ft = 1036 - INTEGER(IntKi), PARAMETER :: B1N5Ft = 1037 - INTEGER(IntKi), PARAMETER :: B1N6Ft = 1038 - INTEGER(IntKi), PARAMETER :: B1N7Ft = 1039 - INTEGER(IntKi), PARAMETER :: B1N8Ft = 1040 - INTEGER(IntKi), PARAMETER :: B1N9Ft = 1041 - INTEGER(IntKi), PARAMETER :: B2N1Ft = 1042 - INTEGER(IntKi), PARAMETER :: B2N2Ft = 1043 - INTEGER(IntKi), PARAMETER :: B2N3Ft = 1044 - INTEGER(IntKi), PARAMETER :: B2N4Ft = 1045 - INTEGER(IntKi), PARAMETER :: B2N5Ft = 1046 - INTEGER(IntKi), PARAMETER :: B2N6Ft = 1047 - INTEGER(IntKi), PARAMETER :: B2N7Ft = 1048 - INTEGER(IntKi), PARAMETER :: B2N8Ft = 1049 - INTEGER(IntKi), PARAMETER :: B2N9Ft = 1050 - INTEGER(IntKi), PARAMETER :: B3N1Ft = 1051 - INTEGER(IntKi), PARAMETER :: B3N2Ft = 1052 - INTEGER(IntKi), PARAMETER :: B3N3Ft = 1053 - INTEGER(IntKi), PARAMETER :: B3N4Ft = 1054 - INTEGER(IntKi), PARAMETER :: B3N5Ft = 1055 - INTEGER(IntKi), PARAMETER :: B3N6Ft = 1056 - INTEGER(IntKi), PARAMETER :: B3N7Ft = 1057 - INTEGER(IntKi), PARAMETER :: B3N8Ft = 1058 - INTEGER(IntKi), PARAMETER :: B3N9Ft = 1059 - INTEGER(IntKi), PARAMETER :: B1N1Clrnc = 1060 - INTEGER(IntKi), PARAMETER :: B1N2Clrnc = 1061 - INTEGER(IntKi), PARAMETER :: B1N3Clrnc = 1062 - INTEGER(IntKi), PARAMETER :: B1N4Clrnc = 1063 - INTEGER(IntKi), PARAMETER :: B1N5Clrnc = 1064 - INTEGER(IntKi), PARAMETER :: B1N6Clrnc = 1065 - INTEGER(IntKi), PARAMETER :: B1N7Clrnc = 1066 - INTEGER(IntKi), PARAMETER :: B1N8Clrnc = 1067 - INTEGER(IntKi), PARAMETER :: B1N9Clrnc = 1068 - INTEGER(IntKi), PARAMETER :: B2N1Clrnc = 1069 - INTEGER(IntKi), PARAMETER :: B2N2Clrnc = 1070 - INTEGER(IntKi), PARAMETER :: B2N3Clrnc = 1071 - INTEGER(IntKi), PARAMETER :: B2N4Clrnc = 1072 - INTEGER(IntKi), PARAMETER :: B2N5Clrnc = 1073 - INTEGER(IntKi), PARAMETER :: B2N6Clrnc = 1074 - INTEGER(IntKi), PARAMETER :: B2N7Clrnc = 1075 - INTEGER(IntKi), PARAMETER :: B2N8Clrnc = 1076 - INTEGER(IntKi), PARAMETER :: B2N9Clrnc = 1077 - INTEGER(IntKi), PARAMETER :: B3N1Clrnc = 1078 - INTEGER(IntKi), PARAMETER :: B3N2Clrnc = 1079 - INTEGER(IntKi), PARAMETER :: B3N3Clrnc = 1080 - INTEGER(IntKi), PARAMETER :: B3N4Clrnc = 1081 - INTEGER(IntKi), PARAMETER :: B3N5Clrnc = 1082 - INTEGER(IntKi), PARAMETER :: B3N6Clrnc = 1083 - INTEGER(IntKi), PARAMETER :: B3N7Clrnc = 1084 - INTEGER(IntKi), PARAMETER :: B3N8Clrnc = 1085 - INTEGER(IntKi), PARAMETER :: B3N9Clrnc = 1086 - - - ! Rotor: - - INTEGER(IntKi), PARAMETER :: RtSpeed = 1087 - INTEGER(IntKi), PARAMETER :: RtTSR = 1088 - INTEGER(IntKi), PARAMETER :: RtVAvgxh = 1089 - INTEGER(IntKi), PARAMETER :: RtVAvgyh = 1090 - INTEGER(IntKi), PARAMETER :: RtVAvgzh = 1091 - INTEGER(IntKi), PARAMETER :: RtSkew = 1092 - INTEGER(IntKi), PARAMETER :: RtAeroFxh = 1093 - INTEGER(IntKi), PARAMETER :: RtAeroFyh = 1094 - INTEGER(IntKi), PARAMETER :: RtAeroFzh = 1095 - INTEGER(IntKi), PARAMETER :: RtAeroMxh = 1096 - INTEGER(IntKi), PARAMETER :: RtAeroMyh = 1097 - INTEGER(IntKi), PARAMETER :: RtAeroMzh = 1098 - INTEGER(IntKi), PARAMETER :: RtAeroPwr = 1099 - INTEGER(IntKi), PARAMETER :: RtArea = 1100 - INTEGER(IntKi), PARAMETER :: RtAeroCp = 1101 - INTEGER(IntKi), PARAMETER :: RtAeroCq = 1102 - INTEGER(IntKi), PARAMETER :: RtAeroCt = 1103 - - - ! The maximum number of output channels which can be output by the code. - INTEGER(IntKi), PARAMETER :: MaxOutPts = 1103 - -!End of code generated by Matlab script -! =================================================================================================== - - INTEGER, PARAMETER :: TwNVUnd(3, 9) = RESHAPE( (/ & ! Undisturbed wind velocity - TwN1VUndx,TwN1VUndy,TwN1VUndz, & - TwN2VUndx,TwN2VUndy,TwN2VUndz, & - TwN3VUndx,TwN3VUndy,TwN3VUndz, & - TwN4VUndx,TwN4VUndy,TwN4VUndz, & - TwN5VUndx,TwN5VUndy,TwN5VUndz, & - TwN6VUndx,TwN6VUndy,TwN6VUndz, & - TwN7VUndx,TwN7VUndy,TwN7VUndz, & - TwN8VUndx,TwN8VUndy,TwN8VUndz, & - TwN9VUndx,TwN9VUndy,TwN9VUndz & - /), (/3, 9/) ) - INTEGER, PARAMETER :: TwNSTV(3, 9) = RESHAPE( (/ & ! Structural translational velocity - TwN1STVx,TwN1STVy,TwN1STVz, & - TwN2STVx,TwN2STVy,TwN2STVz, & - TwN3STVx,TwN3STVy,TwN3STVz, & - TwN4STVx,TwN4STVy,TwN4STVz, & - TwN5STVx,TwN5STVy,TwN5STVz, & - TwN6STVx,TwN6STVy,TwN6STVz, & - TwN7STVx,TwN7STVy,TwN7STVz, & - TwN8STVx,TwN8STVy,TwN8STVz, & - TwN9STVx,TwN9STVy,TwN9STVz & - /), (/3, 9/) ) - INTEGER, PARAMETER :: TwNVRel(9) = (/TwN1VRel,TwN2VRel,TwN3VRel,TwN4VRel,TwN5VRel,TwN6VRel,TwN7VRel,TwN8VRel,TwN9VRel/) ! relative wind speed - INTEGER, PARAMETER :: TwNDynP(9) = (/TwN1DynP,TwN2DynP,TwN3DynP,TwN4DynP,TwN5DynP,TwN6DynP,TwN7DynP,TwN8DynP,TwN9DynP/) ! dynamic pressure - INTEGER, PARAMETER :: TwNRe(9) = (/TwN1Re,TwN2Re,TwN3Re,TwN4Re,TwN5Re,TwN6Re,TwN7Re,TwN8Re,TwN9Re/) ! Reynolds number - INTEGER, PARAMETER :: TwNM(9) = (/TwN1M,TwN2M,TwN3M,TwN4M,TwN5M,TwN6M,TwN7M,TwN8M,TwN9M/) ! Mach number - INTEGER, PARAMETER :: TwNFdx(9) = (/TwN1Fdx,TwN2Fdx,TwN3Fdx,TwN4Fdx,TwN5Fdx,TwN6Fdx,TwN7Fdx,TwN8Fdx,TwN9Fdx/) ! x-component drag force per unit length - INTEGER, PARAMETER :: TwNFdy(9) = (/TwN1Fdy,TwN2Fdy,TwN3Fdy,TwN4Fdy,TwN5Fdy,TwN6Fdy,TwN7Fdy,TwN8Fdy,TwN9Fdy/) ! y-component drag force per unit length - INTEGER, PARAMETER :: BAzimuth(3) = (/B1Azimuth,B2Azimuth,B3Azimuth/) ! azimuth angle - INTEGER, PARAMETER :: BPitch(3) = (/B1Pitch, B2Pitch, B3Pitch/) ! pitch - - INTEGER, PARAMETER :: BNVUndx(9, 3) = RESHAPE( (/ & ! undisturbed wind velocity (x component) - B1N1VUndx,B1N2VUndx,B1N3VUndx,B1N4VUndx,B1N5VUndx,B1N6VUndx,B1N7VUndx,B1N8VUndx,B1N9VUndx, & - B2N1VUndx,B2N2VUndx,B2N3VUndx,B2N4VUndx,B2N5VUndx,B2N6VUndx,B2N7VUndx,B2N8VUndx,B2N9VUndx, & - B3N1VUndx,B3N2VUndx,B3N3VUndx,B3N4VUndx,B3N5VUndx,B3N6VUndx,B3N7VUndx,B3N8VUndx,B3N9VUndx & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNVUndy(9, 3) = RESHAPE( (/ & ! undisturbed wind velocity (y component) - B1N1VUndy,B1N2VUndy,B1N3VUndy,B1N4VUndy,B1N5VUndy,B1N6VUndy,B1N7VUndy,B1N8VUndy,B1N9VUndy, & - B2N1VUndy,B2N2VUndy,B2N3VUndy,B2N4VUndy,B2N5VUndy,B2N6VUndy,B2N7VUndy,B2N8VUndy,B2N9VUndy, & - B3N1VUndy,B3N2VUndy,B3N3VUndy,B3N4VUndy,B3N5VUndy,B3N6VUndy,B3N7VUndy,B3N8VUndy,B3N9VUndy & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNVUndz(9, 3) = RESHAPE( (/ & ! undisturbed wind velocity (z component) - B1N1VUndz,B1N2VUndz,B1N3VUndz,B1N4VUndz,B1N5VUndz,B1N6VUndz,B1N7VUndz,B1N8VUndz,B1N9VUndz, & - B2N1VUndz,B2N2VUndz,B2N3VUndz,B2N4VUndz,B2N5VUndz,B2N6VUndz,B2N7VUndz,B2N8VUndz,B2N9VUndz, & - B3N1VUndz,B3N2VUndz,B3N3VUndz,B3N4VUndz,B3N5VUndz,B3N6VUndz,B3N7VUndz,B3N8VUndz,B3N9VUndz & - /), (/9, 3/) ) - - INTEGER, PARAMETER :: BNVDisx(9, 3) = RESHAPE( (/ & ! disturbed wind velocity (x component) - B1N1VDisx,B1N2VDisx,B1N3VDisx,B1N4VDisx,B1N5VDisx,B1N6VDisx,B1N7VDisx,B1N8VDisx,B1N9VDisx, & - B2N1VDisx,B2N2VDisx,B2N3VDisx,B2N4VDisx,B2N5VDisx,B2N6VDisx,B2N7VDisx,B2N8VDisx,B2N9VDisx, & - B3N1VDisx,B3N2VDisx,B3N3VDisx,B3N4VDisx,B3N5VDisx,B3N6VDisx,B3N7VDisx,B3N8VDisx,B3N9VDisx & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNVDisy(9, 3) = RESHAPE( (/ & ! disturbed wind velocity (y component) - B1N1VDisy,B1N2VDisy,B1N3VDisy,B1N4VDisy,B1N5VDisy,B1N6VDisy,B1N7VDisy,B1N8VDisy,B1N9VDisy, & - B2N1VDisy,B2N2VDisy,B2N3VDisy,B2N4VDisy,B2N5VDisy,B2N6VDisy,B2N7VDisy,B2N8VDisy,B2N9VDisy, & - B3N1VDisy,B3N2VDisy,B3N3VDisy,B3N4VDisy,B3N5VDisy,B3N6VDisy,B3N7VDisy,B3N8VDisy,B3N9VDisy & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNVDisz(9, 3) = RESHAPE( (/ & ! disturbed wind velocity (z component) - B1N1VDisz,B1N2VDisz,B1N3VDisz,B1N4VDisz,B1N5VDisz,B1N6VDisz,B1N7VDisz,B1N8VDisz,B1N9VDisz, & - B2N1VDisz,B2N2VDisz,B2N3VDisz,B2N4VDisz,B2N5VDisz,B2N6VDisz,B2N7VDisz,B2N8VDisz,B2N9VDisz, & - B3N1VDisz,B3N2VDisz,B3N3VDisz,B3N4VDisz,B3N5VDisz,B3N6VDisz,B3N7VDisz,B3N8VDisz,B3N9VDisz & - /), (/9, 3/) ) - - INTEGER, PARAMETER :: BNSTVx(9, 3) = RESHAPE( (/ & ! structural translational velocity (x component) - B1N1STVx,B1N2STVx,B1N3STVx,B1N4STVx,B1N5STVx,B1N6STVx,B1N7STVx,B1N8STVx,B1N9STVx, & - B2N1STVx,B2N2STVx,B2N3STVx,B2N4STVx,B2N5STVx,B2N6STVx,B2N7STVx,B2N8STVx,B2N9STVx, & - B3N1STVx,B3N2STVx,B3N3STVx,B3N4STVx,B3N5STVx,B3N6STVx,B3N7STVx,B3N8STVx,B3N9STVx & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNSTVy(9, 3) = RESHAPE( (/ & ! structural translational velocity (y component) - B1N1STVy,B1N2STVy,B1N3STVy,B1N4STVy,B1N5STVy,B1N6STVy,B1N7STVy,B1N8STVy,B1N9STVy, & - B2N1STVy,B2N2STVy,B2N3STVy,B2N4STVy,B2N5STVy,B2N6STVy,B2N7STVy,B2N8STVy,B2N9STVy, & - B3N1STVy,B3N2STVy,B3N3STVy,B3N4STVy,B3N5STVy,B3N6STVy,B3N7STVy,B3N8STVy,B3N9STVy & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNSTVz(9, 3) = RESHAPE( (/ & ! structural translational velocity (z component) - B1N1STVz,B1N2STVz,B1N3STVz,B1N4STVz,B1N5STVz,B1N6STVz,B1N7STVz,B1N8STVz,B1N9STVz, & - B2N1STVz,B2N2STVz,B2N3STVz,B2N4STVz,B2N5STVz,B2N6STVz,B2N7STVz,B2N8STVz,B2N9STVz, & - B3N1STVz,B3N2STVz,B3N3STVz,B3N4STVz,B3N5STVz,B3N6STVz,B3N7STVz,B3N8STVz,B3N9STVz & - /), (/9, 3/) ) - - INTEGER, PARAMETER :: BNVRel(9, 3) = RESHAPE( (/ & ! relative wind speed - B1N1VRel,B1N2VRel,B1N3VRel,B1N4VRel,B1N5VRel,B1N6VRel,B1N7VRel,B1N8VRel,B1N9VRel, & - B2N1VRel,B2N2VRel,B2N3VRel,B2N4VRel,B2N5VRel,B2N6VRel,B2N7VRel,B2N8VRel,B2N9VRel, & - B3N1VRel,B3N2VRel,B3N3VRel,B3N4VRel,B3N5VRel,B3N6VRel,B3N7VRel,B3N8VRel,B3N9VRel & - /), (/9, 3/) ) - - INTEGER, PARAMETER :: BNDynP(9, 3) = RESHAPE( (/ & ! dynamic pressure - B1N1DynP,B1N2DynP,B1N3DynP,B1N4DynP,B1N5DynP,B1N6DynP,B1N7DynP,B1N8DynP,B1N9DynP, & - B2N1DynP,B2N2DynP,B2N3DynP,B2N4DynP,B2N5DynP,B2N6DynP,B2N7DynP,B2N8DynP,B2N9DynP, & - B3N1DynP,B3N2DynP,B3N3DynP,B3N4DynP,B3N5DynP,B3N6DynP,B3N7DynP,B3N8DynP,B3N9DynP & - /), (/9, 3/) ) - - INTEGER, PARAMETER :: BNRe(9, 3) = RESHAPE( (/ & ! Reynolds number - B1N1Re,B1N2Re,B1N3Re,B1N4Re,B1N5Re,B1N6Re,B1N7Re,B1N8Re,B1N9Re, & - B2N1Re,B2N2Re,B2N3Re,B2N4Re,B2N5Re,B2N6Re,B2N7Re,B2N8Re,B2N9Re, & - B3N1Re,B3N2Re,B3N3Re,B3N4Re,B3N5Re,B3N6Re,B3N7Re,B3N8Re,B3N9Re & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNM(9, 3) = RESHAPE( (/ & ! Mach number - B1N1M,B1N2M,B1N3M,B1N4M,B1N5M,B1N6M,B1N7M,B1N8M,B1N9M, & - B2N1M,B2N2M,B2N3M,B2N4M,B2N5M,B2N6M,B2N7M,B2N8M,B2N9M, & - B3N1M,B3N2M,B3N3M,B3N4M,B3N5M,B3N6M,B3N7M,B3N8M,B3N9M & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNVIndx(9, 3) = RESHAPE( (/ & ! axial induced wind velocity - B1N1VIndx,B1N2VIndx,B1N3VIndx,B1N4VIndx,B1N5VIndx,B1N6VIndx,B1N7VIndx,B1N8VIndx,B1N9VIndx, & - B2N1VIndx,B2N2VIndx,B2N3VIndx,B2N4VIndx,B2N5VIndx,B2N6VIndx,B2N7VIndx,B2N8VIndx,B2N9VIndx, & - B3N1VIndx,B3N2VIndx,B3N3VIndx,B3N4VIndx,B3N5VIndx,B3N6VIndx,B3N7VIndx,B3N8VIndx,B3N9VIndx & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNVIndy(9, 3) = RESHAPE( (/ & ! tangential induced wind velocity - B1N1VIndy,B1N2VIndy,B1N3VIndy,B1N4VIndy,B1N5VIndy,B1N6VIndy,B1N7VIndy,B1N8VIndy,B1N9VIndy, & - B2N1VIndy,B2N2VIndy,B2N3VIndy,B2N4VIndy,B2N5VIndy,B2N6VIndy,B2N7VIndy,B2N8VIndy,B2N9VIndy, & - B3N1VIndy,B3N2VIndy,B3N3VIndy,B3N4VIndy,B3N5VIndy,B3N6VIndy,B3N7VIndy,B3N8VIndy,B3N9VIndy & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNAxInd(9, 3) = RESHAPE( (/ & ! axial induction factor - B1N1AxInd,B1N2AxInd,B1N3AxInd,B1N4AxInd,B1N5AxInd,B1N6AxInd,B1N7AxInd,B1N8AxInd,B1N9AxInd, & - B2N1AxInd,B2N2AxInd,B2N3AxInd,B2N4AxInd,B2N5AxInd,B2N6AxInd,B2N7AxInd,B2N8AxInd,B2N9AxInd, & - B3N1AxInd,B3N2AxInd,B3N3AxInd,B3N4AxInd,B3N5AxInd,B3N6AxInd,B3N7AxInd,B3N8AxInd,B3N9AxInd & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNTnInd(9, 3) = RESHAPE( (/ & ! tangential induction factor - B1N1TnInd,B1N2TnInd,B1N3TnInd,B1N4TnInd,B1N5TnInd,B1N6TnInd,B1N7TnInd,B1N8TnInd,B1N9TnInd, & - B2N1TnInd,B2N2TnInd,B2N3TnInd,B2N4TnInd,B2N5TnInd,B2N6TnInd,B2N7TnInd,B2N8TnInd,B2N9TnInd, & - B3N1TnInd,B3N2TnInd,B3N3TnInd,B3N4TnInd,B3N5TnInd,B3N6TnInd,B3N7TnInd,B3N8TnInd,B3N9TnInd & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNAlpha(9, 3) = RESHAPE( (/ & ! angle of attach - B1N1Alpha,B1N2Alpha,B1N3Alpha,B1N4Alpha,B1N5Alpha,B1N6Alpha,B1N7Alpha,B1N8Alpha,B1N9Alpha, & - B2N1Alpha,B2N2Alpha,B2N3Alpha,B2N4Alpha,B2N5Alpha,B2N6Alpha,B2N7Alpha,B2N8Alpha,B2N9Alpha, & - B3N1Alpha,B3N2Alpha,B3N3Alpha,B3N4Alpha,B3N5Alpha,B3N6Alpha,B3N7Alpha,B3N8Alpha,B3N9Alpha & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNTheta(9, 3) = RESHAPE( (/ & ! pitch+twist angle - B1N1Theta,B1N2Theta,B1N3Theta,B1N4Theta,B1N5Theta,B1N6Theta,B1N7Theta,B1N8Theta,B1N9Theta, & - B2N1Theta,B2N2Theta,B2N3Theta,B2N4Theta,B2N5Theta,B2N6Theta,B2N7Theta,B2N8Theta,B2N9Theta, & - B3N1Theta,B3N2Theta,B3N3Theta,B3N4Theta,B3N5Theta,B3N6Theta,B3N7Theta,B3N8Theta,B3N9Theta & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNPhi(9, 3) = RESHAPE( (/ & ! inflow angle - B1N1Phi,B1N2Phi,B1N3Phi,B1N4Phi,B1N5Phi,B1N6Phi,B1N7Phi,B1N8Phi,B1N9Phi, & - B2N1Phi,B2N2Phi,B2N3Phi,B2N4Phi,B2N5Phi,B2N6Phi,B2N7Phi,B2N8Phi,B2N9Phi, & - B3N1Phi,B3N2Phi,B3N3Phi,B3N4Phi,B3N5Phi,B3N6Phi,B3N7Phi,B3N8Phi,B3N9Phi & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNCurve(9, 3) = RESHAPE( (/ & ! curvature angle - B1N1Curve,B1N2Curve,B1N3Curve,B1N4Curve,B1N5Curve,B1N6Curve,B1N7Curve,B1N8Curve,B1N9Curve, & - B2N1Curve,B2N2Curve,B2N3Curve,B2N4Curve,B2N5Curve,B2N6Curve,B2N7Curve,B2N8Curve,B2N9Curve, & - B3N1Curve,B3N2Curve,B3N3Curve,B3N4Curve,B3N5Curve,B3N6Curve,B3N7Curve,B3N8Curve,B3N9Curve & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNCl(9, 3) = RESHAPE( (/ & ! lift force coefficient - B1N1Cl,B1N2Cl,B1N3Cl,B1N4Cl,B1N5Cl,B1N6Cl,B1N7Cl,B1N8Cl,B1N9Cl, & - B2N1Cl,B2N2Cl,B2N3Cl,B2N4Cl,B2N5Cl,B2N6Cl,B2N7Cl,B2N8Cl,B2N9Cl, & - B3N1Cl,B3N2Cl,B3N3Cl,B3N4Cl,B3N5Cl,B3N6Cl,B3N7Cl,B3N8Cl,B3N9Cl & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNCd(9, 3) = RESHAPE( (/ & ! drag force coefficient - B1N1Cd,B1N2Cd,B1N3Cd,B1N4Cd,B1N5Cd,B1N6Cd,B1N7Cd,B1N8Cd,B1N9Cd, & - B2N1Cd,B2N2Cd,B2N3Cd,B2N4Cd,B2N5Cd,B2N6Cd,B2N7Cd,B2N8Cd,B2N9Cd, & - B3N1Cd,B3N2Cd,B3N3Cd,B3N4Cd,B3N5Cd,B3N6Cd,B3N7Cd,B3N8Cd,B3N9Cd & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNCm(9, 3) = RESHAPE( (/ & ! pitching moment coefficient - B1N1Cm,B1N2Cm,B1N3Cm,B1N4Cm,B1N5Cm,B1N6Cm,B1N7Cm,B1N8Cm,B1N9Cm, & - B2N1Cm,B2N2Cm,B2N3Cm,B2N4Cm,B2N5Cm,B2N6Cm,B2N7Cm,B2N8Cm,B2N9Cm, & - B3N1Cm,B3N2Cm,B3N3Cm,B3N4Cm,B3N5Cm,B3N6Cm,B3N7Cm,B3N8Cm,B3N9Cm & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNCx(9, 3) = RESHAPE( (/ & ! normal force (to plane) coefficient - B1N1Cx,B1N2Cx,B1N3Cx,B1N4Cx,B1N5Cx,B1N6Cx,B1N7Cx,B1N8Cx,B1N9Cx, & - B2N1Cx,B2N2Cx,B2N3Cx,B2N4Cx,B2N5Cx,B2N6Cx,B2N7Cx,B2N8Cx,B2N9Cx, & - B3N1Cx,B3N2Cx,B3N3Cx,B3N4Cx,B3N5Cx,B3N6Cx,B3N7Cx,B3N8Cx,B3N9Cx & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNCy(9, 3) = RESHAPE( (/ & ! tangential force (to plane) coefficient - B1N1Cy,B1N2Cy,B1N3Cy,B1N4Cy,B1N5Cy,B1N6Cy,B1N7Cy,B1N8Cy,B1N9Cy, & - B2N1Cy,B2N2Cy,B2N3Cy,B2N4Cy,B2N5Cy,B2N6Cy,B2N7Cy,B2N8Cy,B2N9Cy, & - B3N1Cy,B3N2Cy,B3N3Cy,B3N4Cy,B3N5Cy,B3N6Cy,B3N7Cy,B3N8Cy,B3N9Cy & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNCn(9, 3) = RESHAPE( (/ & ! normal force (to chord) coefficient - B1N1Cn,B1N2Cn,B1N3Cn,B1N4Cn,B1N5Cn,B1N6Cn,B1N7Cn,B1N8Cn,B1N9Cn, & - B2N1Cn,B2N2Cn,B2N3Cn,B2N4Cn,B2N5Cn,B2N6Cn,B2N7Cn,B2N8Cn,B2N9Cn, & - B3N1Cn,B3N2Cn,B3N3Cn,B3N4Cn,B3N5Cn,B3N6Cn,B3N7Cn,B3N8Cn,B3N9Cn & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNCt(9, 3) = RESHAPE( (/ & ! tangential force (to chord) coefficient - B1N1Ct,B1N2Ct,B1N3Ct,B1N4Ct,B1N5Ct,B1N6Ct,B1N7Ct,B1N8Ct,B1N9Ct, & - B2N1Ct,B2N2Ct,B2N3Ct,B2N4Ct,B2N5Ct,B2N6Ct,B2N7Ct,B2N8Ct,B2N9Ct, & - B3N1Ct,B3N2Ct,B3N3Ct,B3N4Ct,B3N5Ct,B3N6Ct,B3N7Ct,B3N8Ct,B3N9Ct & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNFl(9, 3) = RESHAPE( (/ & ! lift force per unit length - B1N1Fl,B1N2Fl,B1N3Fl,B1N4Fl,B1N5Fl,B1N6Fl,B1N7Fl,B1N8Fl,B1N9Fl, & - B2N1Fl,B2N2Fl,B2N3Fl,B2N4Fl,B2N5Fl,B2N6Fl,B2N7Fl,B2N8Fl,B2N9Fl, & - B3N1Fl,B3N2Fl,B3N3Fl,B3N4Fl,B3N5Fl,B3N6Fl,B3N7Fl,B3N8Fl,B3N9Fl & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNFd(9, 3) = RESHAPE( (/ & ! drag force per unit length - B1N1Fd,B1N2Fd,B1N3Fd,B1N4Fd,B1N5Fd,B1N6Fd,B1N7Fd,B1N8Fd,B1N9Fd, & - B2N1Fd,B2N2Fd,B2N3Fd,B2N4Fd,B2N5Fd,B2N6Fd,B2N7Fd,B2N8Fd,B2N9Fd, & - B3N1Fd,B3N2Fd,B3N3Fd,B3N4Fd,B3N5Fd,B3N6Fd,B3N7Fd,B3N8Fd,B3N9Fd & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNMm(9, 3) = RESHAPE( (/ & ! pitching moment per unit length - B1N1Mm,B1N2Mm,B1N3Mm,B1N4Mm,B1N5Mm,B1N6Mm,B1N7Mm,B1N8Mm,B1N9Mm, & - B2N1Mm,B2N2Mm,B2N3Mm,B2N4Mm,B2N5Mm,B2N6Mm,B2N7Mm,B2N8Mm,B2N9Mm, & - B3N1Mm,B3N2Mm,B3N3Mm,B3N4Mm,B3N5Mm,B3N6Mm,B3N7Mm,B3N8Mm,B3N9Mm & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNFx(9, 3) = RESHAPE( (/ & ! normal force (to plane) per unit length - B1N1Fx,B1N2Fx,B1N3Fx,B1N4Fx,B1N5Fx,B1N6Fx,B1N7Fx,B1N8Fx,B1N9Fx, & - B2N1Fx,B2N2Fx,B2N3Fx,B2N4Fx,B2N5Fx,B2N6Fx,B2N7Fx,B2N8Fx,B2N9Fx, & - B3N1Fx,B3N2Fx,B3N3Fx,B3N4Fx,B3N5Fx,B3N6Fx,B3N7Fx,B3N8Fx,B3N9Fx & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNFy(9, 3) = RESHAPE( (/ & ! tangential force (to plane) per unit length - B1N1Fy,B1N2Fy,B1N3Fy,B1N4Fy,B1N5Fy,B1N6Fy,B1N7Fy,B1N8Fy,B1N9Fy, & - B2N1Fy,B2N2Fy,B2N3Fy,B2N4Fy,B2N5Fy,B2N6Fy,B2N7Fy,B2N8Fy,B2N9Fy, & - B3N1Fy,B3N2Fy,B3N3Fy,B3N4Fy,B3N5Fy,B3N6Fy,B3N7Fy,B3N8Fy,B3N9Fy & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNFn(9, 3) = RESHAPE( (/ & ! normal force (to chord) per unit length - B1N1Fn,B1N2Fn,B1N3Fn,B1N4Fn,B1N5Fn,B1N6Fn,B1N7Fn,B1N8Fn,B1N9Fn, & - B2N1Fn,B2N2Fn,B2N3Fn,B2N4Fn,B2N5Fn,B2N6Fn,B2N7Fn,B2N8Fn,B2N9Fn, & - B3N1Fn,B3N2Fn,B3N3Fn,B3N4Fn,B3N5Fn,B3N6Fn,B3N7Fn,B3N8Fn,B3N9Fn & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNFt(9, 3) = RESHAPE( (/ & ! tangential force (to chord) per unit length - B1N1Ft,B1N2Ft,B1N3Ft,B1N4Ft,B1N5Ft,B1N6Ft,B1N7Ft,B1N8Ft,B1N9Ft, & - B2N1Ft,B2N2Ft,B2N3Ft,B2N4Ft,B2N5Ft,B2N6Ft,B2N7Ft,B2N8Ft,B2N9Ft, & - B3N1Ft,B3N2Ft,B3N3Ft,B3N4Ft,B3N5Ft,B3N6Ft,B3N7Ft,B3N8Ft,B3N9Ft & - /), (/9, 3/) ) - INTEGER, PARAMETER :: BNClrnc(9, 3) = RESHAPE( (/ & ! tower clearance - B1N1Clrnc,B1N2Clrnc,B1N3Clrnc,B1N4Clrnc,B1N5Clrnc,B1N6Clrnc,B1N7Clrnc,B1N8Clrnc,B1N9Clrnc, & - B2N1Clrnc,B2N2Clrnc,B2N3Clrnc,B2N4Clrnc,B2N5Clrnc,B2N6Clrnc,B2N7Clrnc,B2N8Clrnc,B2N9Clrnc, & - B3N1Clrnc,B3N2Clrnc,B3N3Clrnc,B3N4Clrnc,B3N5Clrnc,B3N6Clrnc,B3N7Clrnc,B3N8Clrnc,B3N9Clrnc & - /), (/9, 3/) ) - - - INTEGER(IntKi), PARAMETER :: MaxBl = 3 ! Maximum number of blades allowed in simulation - - ! model identifiers - integer(intKi), parameter :: ModelUnknown = -1 - - integer(intKi), parameter :: WakeMod_none = 0 - integer(intKi), parameter :: WakeMod_BEMT = 1 - - integer(intKi), parameter :: AFAeroMod_steady = 1 ! steady model - integer(intKi), parameter :: AFAeroMod_BL_unsteady = 2 ! Beddoes-Leishman unsteady model - - integer(intKi), parameter :: TwrPotent_none = 0 ! none - integer(intKi), parameter :: TwrPotent_baseline = 1 ! baseline potential flow - integer(intKi), parameter :: TwrPotent_Bak = 2 ! potential flow with Bak correction - -contains - - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Calc_WriteDbgOutput( p, u, m, y, ErrStat, ErrMsg ) - - TYPE(AD_ParameterType), INTENT(IN ) :: p ! The module parameters - TYPE(AD_InputType), INTENT(IN ) :: u ! inputs - TYPE(AD_MiscVarType), INTENT(INOUT) :: m ! misc variables - TYPE(AD_OutputType), INTENT(IN ) :: y ! outputs - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code - CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred - - ! local variables - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteOutput' - !INTEGER(intKi) :: ErrStat2 - !CHARACTER(ErrMsgLen) :: ErrMsg2 - - INTEGER(IntKi) :: j,k,i - REAL(ReKi) :: ct, st ! cosine, sine of theta - REAL(ReKi) :: cp, sp ! cosine, sine of phi - - - - ! start routine: - ErrStat = ErrID_None - ErrMsg = "" - - - - ! blade outputs - do k=1,p%numBlades - - ! m%AllOuts( BPitch( k) ) = calculated in SetInputsForBEMT - - do j=1,p%NumBlNds - - i = (k-1)*p%NumBlNds*23 + (j-1)*23 + 1 - - m%AllOuts( i ) = m%BEMT_u(indx)%theta(j,k)*R2D - m%AllOuts( i+1 ) = m%BEMT_u(indx)%psi(k)*R2D - m%AllOuts( i+2 ) = -m%BEMT_u(indx)%Vx(j,k) - m%AllOuts( i+3 ) = m%BEMT_u(indx)%Vy(j,k) - - m%AllOuts( i+4 ) = m%BEMT_y%axInduction(j,k) - m%AllOuts( i+5 ) = m%BEMT_y%tanInduction(j,k) - m%AllOuts( i+6 ) = m%BEMT_y%Vrel(j,k) - m%AllOuts( i+7 ) = m%BEMT_y%phi(j,k)*R2D - m%AllOuts( i+8 ) = (m%BEMT_y%phi(j,k) - m%BEMT_u(indx)%theta(j,k))*R2D - - - m%AllOuts( i+9 ) = m%BEMT_y%Cl(j,k) - m%AllOuts( i+10 ) = m%BEMT_y%Cd(j,k) - m%AllOuts( i+11 ) = m%BEMT_y%Cm(j,k) - m%AllOuts( i+12 ) = m%BEMT_y%Cx(j,k) - m%AllOuts( i+13 ) = m%BEMT_y%Cy(j,k) - - ct=cos(m%BEMT_u(indx)%theta(j,k)) - st=sin(m%BEMT_u(indx)%theta(j,k)) - m%AllOuts( i+14 ) = m%BEMT_y%Cx(j,k)*ct + m%BEMT_y%Cy(j,k)*st - m%AllOuts( i+15 ) = -m%BEMT_y%Cx(j,k)*st + m%BEMT_y%Cy(j,k)*ct - - cp=cos(m%BEMT_y%phi(j,k)) - sp=sin(m%BEMT_y%phi(j,k)) - m%AllOuts( i+16 ) = m%X(j,k)*cp - m%Y(j,k)*sp - m%AllOuts( i+17 ) = m%X(j,k)*sp + m%Y(j,k)*cp - m%AllOuts( i+18 ) = m%M(j,k) - m%AllOuts( i+19 ) = m%X(j,k) - m%AllOuts( i+20 ) = -m%Y(j,k) - m%AllOuts( i+21 ) = m%X(j,k)*ct - m%Y(j,k)*st - m%AllOuts( i+22 ) = -m%X(j,k)*st - m%Y(j,k)*ct - - end do ! nodes - end do ! blades - -END SUBROUTINE Calc_WriteDbgOutput - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Calc_WriteOutput( p, u, m, y, indx, ErrStat, ErrMsg ) - - TYPE(AD_ParameterType), INTENT(IN ) :: p ! The module parameters - TYPE(AD_InputType), INTENT(IN ) :: u ! inputs - TYPE(AD_MiscVarType), INTENT(INOUT) :: m ! misc variables - TYPE(AD_OutputType), INTENT(IN ) :: y ! outputs - integer, intent(in ) :: indx ! index into m%BEMT_u(indx) array; 1=t and 2=t+dt (but not checked here) - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code - CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred - - ! local variables - CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteOutput' - INTEGER(intKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - - INTEGER(IntKi) :: j,k,beta - REAL(ReKi) :: tmp(3) - REAL(ReKi) :: force(3) - REAL(ReKi) :: moment(3) - REAL(ReKi) :: denom, rmax - REAL(ReKi) :: ct, st ! cosine, sine of theta - REAL(ReKi) :: cp, sp ! cosine, sine of phi - - - - ! start routine: - ErrStat = ErrID_None - ErrMsg = "" - - ! tower outputs - do beta=1,p%NTwOuts - j = p%TwOutNd(beta) - - tmp = matmul( u%TowerMotion%Orientation(:,:,j) , u%InflowOnTower(:,j) ) - m%AllOuts( TwNVUnd(:,beta) ) = tmp - - tmp = matmul( u%TowerMotion%Orientation(:,:,j) , u%TowerMotion%TranslationVel(:,j) ) - m%AllOuts( TwNSTV(:,beta) ) = tmp - - m%AllOuts( TwNVrel(beta) ) = m%W_Twr(j) ! relative velocity - m%AllOuts( TwNDynP(beta) ) = 0.5 * p%AirDens * m%W_Twr(j)**2 ! dynamic pressure - m%AllOuts( TwNRe( beta) ) = p%TwrDiam(j) * m%W_Twr(j) / p%KinVisc / 1.0E6 ! reynolds number (in millions) - m%AllOuts( TwNM( beta) ) = m%W_Twr(j) / p%SpdSound ! Mach number - m%AllOuts( TwNFdx( beta) ) = m%X_Twr(j) - m%AllOuts( TwNFdy( beta) ) = m%Y_Twr(j) - - end do ! out nodes - - ! blade outputs - do k=1,p%numBlades - m%AllOuts( BAzimuth(k) ) = m%BEMT_u(indx)%psi(k)*R2D - ! m%AllOuts( BPitch( k) ) = calculated in SetInputsForBEMT - - do beta=1,p%NBlOuts - - j=p%BlOutNd(beta) - - - tmp = matmul( m%WithoutSweepPitchTwist(:,:,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) ) - 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) ) - m%AllOuts( BNSTVx( beta,k) ) = tmp(1) - m%AllOuts( BNSTVy( beta,k) ) = tmp(2) - m%AllOuts( BNSTVz( beta,k) ) = tmp(3) - - m%AllOuts( BNVrel( beta,k) ) = m%BEMT_y%Vrel(j,k) - m%AllOuts( BNDynP( beta,k) ) = 0.5 * p%airDens * m%BEMT_y%Vrel(j,k)**2 - m%AllOuts( BNRe( beta,k) ) = p%BEMT%chord(j,k) * m%BEMT_y%Vrel(j,k) / p%KinVisc / 1.0E6 - m%AllOuts( BNM( beta,k) ) = m%BEMT_y%Vrel(j,k) / p%SpdSound - - m%AllOuts( BNVIndx(beta,k) ) = - m%BEMT_u(indx)%Vx(j,k) * m%BEMT_y%axInduction( j,k) - m%AllOuts( BNVIndy(beta,k) ) = m%BEMT_u(indx)%Vy(j,k) * m%BEMT_y%tanInduction(j,k) - - m%AllOuts( BNAxInd(beta,k) ) = m%BEMT_y%axInduction(j,k) - m%AllOuts( BNTnInd(beta,k) ) = m%BEMT_y%tanInduction(j,k) - - m%AllOuts( BNAlpha(beta,k) ) = (m%BEMT_y%phi(j,k) - m%BEMT_u(indx)%theta(j,k))*R2D - m%AllOuts( BNTheta(beta,k) ) = m%BEMT_u(indx)%theta(j,k)*R2D - m%AllOuts( BNPhi( beta,k) ) = m%BEMT_y%phi(j,k)*R2D - m%AllOuts( BNCurve(beta,k) ) = m%Curve(j,k)*R2D - - !m%AllOuts( BNCl( beta,k) ) = m%BEMT_y%Cl(j,k) - !m%AllOuts( BNCd( beta,k) ) = m%BEMT_y%Cd(j,k) - cp=cos(m%BEMT_y%phi(j,k)) - sp=sin(m%BEMT_y%phi(j,k)) - m%AllOuts( BNCl( beta,k) ) = m%BEMT_y%Cx(j,k)*cp + m%BEMT_y%Cy(j,k)*sp - m%AllOuts( BNCd( beta,k) ) = m%BEMT_y%Cx(j,k)*sp - m%BEMT_y%Cy(j,k)*cp - m%AllOuts( BNCm( beta,k) ) = m%BEMT_y%Cm(j,k) - m%AllOuts( BNCx( beta,k) ) = m%BEMT_y%Cx(j,k) - m%AllOuts( BNCy( beta,k) ) = m%BEMT_y%Cy(j,k) - - ct=cos(m%BEMT_u(indx)%theta(j,k)) - st=sin(m%BEMT_u(indx)%theta(j,k)) - m%AllOuts( BNCn( beta,k) ) = m%BEMT_y%Cx(j,k)*ct + m%BEMT_y%Cy(j,k)*st - m%AllOuts( BNCt( beta,k) ) =-m%BEMT_y%Cx(j,k)*st + m%BEMT_y%Cy(j,k)*ct - - m%AllOuts( BNFl( beta,k) ) = m%X(j,k)*cp - m%Y(j,k)*sp - m%AllOuts( BNFd( beta,k) ) = m%X(j,k)*sp + m%Y(j,k)*cp - m%AllOuts( BNMm( beta,k) ) = m%M(j,k) - m%AllOuts( BNFx( beta,k) ) = m%X(j,k) - m%AllOuts( BNFy( beta,k) ) = -m%Y(j,k) - m%AllOuts( BNFn( beta,k) ) = m%X(j,k)*ct - m%Y(j,k)*st - m%AllOuts( BNFt( beta,k) ) = -m%X(j,k)*st - m%Y(j,k)*ct - - end do ! nodes - end do ! blades - - ! blade node tower clearance (requires tower influence calculation): - if (p%TwrPotent /= TwrPotent_none .or. p%TwrShadow) then - do k=1,p%numBlades - do beta=1,p%NBlOuts - j=p%BlOutNd(beta) - m%AllOuts( BNClrnc( beta,k) ) = m%TwrClrnc(j,k) - end do - end do - end if - - ! rotor outputs: - rmax = 0.0_ReKi - do k=1,p%NumBlades - do j=1,p%NumBlNds - rmax = max(rmax, m%BEMT_u(indx)%rLocal(j,k) ) - end do !j=nodes - end do !k=blades - - m%AllOuts( RtSpeed ) = m%BEMT_u(indx)%omega*RPS2RPM - m%AllOuts( RtArea ) = pi*rmax**2 - - tmp = matmul( u%HubMotion%Orientation(:,:,1), m%V_DiskAvg ) - m%AllOuts( RtVAvgxh ) = tmp(1) - m%AllOuts( RtVAvgyh ) = tmp(2) - m%AllOuts( RtVAvgzh ) = tmp(3) - - m%AllOuts( RtSkew ) = m%BEMT_u(indx)%chi0*R2D - - ! integrate force/moments over blades by performing mesh transfer to hub point: - force = 0.0_ReKi - moment = 0.0_ReKi - do k=1,p%NumBlades - call Transfer_Line2_to_Point( y%BladeLoad(k), m%HubLoad, m%B_L_2_H_P(k), ErrStat2, ErrMsg2, u%BladeMotion(k), u%HubMotion ) - force = force + m%HubLoad%force( :,1) - moment = moment + m%HubLoad%moment(:,1) - end do - tmp = matmul( u%HubMotion%Orientation(:,:,1), force ) - m%AllOuts( RtAeroFxh ) = tmp(1) - m%AllOuts( RtAeroFyh ) = tmp(2) - m%AllOuts( RtAeroFzh ) = tmp(3) - - tmp = matmul( u%HubMotion%Orientation(:,:,1), moment ) - m%AllOuts( RtAeroMxh ) = tmp(1) - m%AllOuts( RtAeroMyh ) = tmp(2) - m%AllOuts( RtAeroMzh ) = tmp(3) - - m%AllOuts( RtAeroPwr ) = m%BEMT_u(indx)%omega * m%AllOuts( RtAeroMxh ) - - - if ( EqualRealNos( m%V_dot_x, 0.0_ReKi ) ) then - m%AllOuts( RtTSR ) = 0.0_ReKi - m%AllOuts( RtAeroCp ) = 0.0_ReKi - m%AllOuts( RtAeroCq ) = 0.0_ReKi - m%AllOuts( RtAeroCt ) = 0.0_ReKi - else - denom = 0.5*p%AirDens*m%AllOuts( RtArea )*m%V_dot_x**2 - m%AllOuts( RtTSR ) = m%BEMT_u(indx)%omega * rmax / m%V_dot_x - - m%AllOuts( RtAeroCp ) = m%AllOuts( RtAeroPwr ) / (denom * m%V_dot_x) - m%AllOuts( RtAeroCq ) = m%AllOuts( RtAeroMxh ) / (denom * rmax) - m%AllOuts( RtAeroCt ) = m%AllOuts( RtAeroFxh ) / denom - end if - - -END SUBROUTINE Calc_WriteOutput -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadInputFiles( InputFileName, InputFileData, Default_DT, OutFileRoot, NumBlades, 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. -!.................................................................................................................................. - - ! Passed variables - REAL(DbKi), INTENT(IN) :: Default_DT ! The default DT (from glue code) - - CHARACTER(*), INTENT(IN) :: InputFileName ! Name of the input file - CHARACTER(*), INTENT(IN) :: OutFileRoot ! The rootname of all the output files written by this routine. - - TYPE(AD_InputFile), INTENT(OUT) :: InputFileData ! Data stored in the module's input file - INTEGER(IntKi), INTENT(OUT) :: UnEcho ! Unit number for the echo file - - INTEGER(IntKi), INTENT(IN) :: NumBlades ! Number of blades for this model - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! The error status code - CHARACTER(*), INTENT(OUT) :: ErrMsg ! The error message, if an error occurred - - ! local variables - - INTEGER(IntKi) :: I - INTEGER(IntKi) :: ErrStat2 ! The error status code - CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred - - CHARACTER(1024) :: ADBlFile(MaxBl) ! File that contains the blade information (specified in the primary input file) - CHARACTER(*), PARAMETER :: RoutineName = 'ReadInputFiles' - - - ! initialize values: - - ErrStat = ErrID_None - ErrMsg = '' - UnEcho = -1 - InputFileData%DTAero = Default_DT ! the glue code's suggested DT for the module (may be overwritten in ReadPrimaryFile()) - - ! get the primary/platform input-file data - ! sets UnEcho, ADBlFile - - CALL ReadPrimaryFile( InputFileName, InputFileData, ADBlFile, OutFileRoot, UnEcho, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - ! get the blade input-file data - - ALLOCATE( InputFileData%BladeProps( NumBlades ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating memory for BladeProps.", ErrStat, ErrMsg, RoutineName) - CALL Cleanup() - RETURN - END IF - - DO I=1,NumBlades - CALL ReadBladeInputs ( ADBlFile(I), InputFileData%BladeProps(I), UnEcho, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName//TRIM(':Blade')//TRIM(Num2LStr(I))) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - END DO - - - - CALL Cleanup ( ) - - -CONTAINS - !............................................................................................................................... - SUBROUTINE Cleanup() - ! This subroutine cleans up before exiting this subroutine - !............................................................................................................................... - - ! IF ( UnEcho > 0 ) CLOSE( UnEcho ) - - END SUBROUTINE Cleanup - -END SUBROUTINE ReadInputFiles -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnEc, ErrStat, ErrMsg ) -! This routine reads in the primary AeroDyn input file and places the values it reads in the InputFileData structure. -! It opens and prints to an echo file if requested. -!.................................................................................................................................. - - - implicit none - - ! Passed variables - integer(IntKi), intent(out) :: UnEc ! I/O unit for echo file. If > 0, file is open for writing. - integer(IntKi), intent(out) :: ErrStat ! Error status - - character(*), intent(out) :: ADBlFile(MaxBl) ! name of the files containing blade inputs - character(*), intent(in) :: InputFile ! Name of the file containing the primary input data - character(*), intent(out) :: ErrMsg ! Error message - character(*), intent(in) :: OutFileRoot ! The rootname of the echo file, possibly opened in this routine - - type(AD_InputFile), intent(inout) :: InputFileData ! All the data in the AeroDyn input file - - ! Local variables: - real(ReKi) :: TmpAry(3) ! array to help read tower properties table - integer(IntKi) :: I ! loop counter - integer(IntKi) :: UnIn ! Unit number for reading file - - integer(IntKi) :: ErrStat2, IOS ! Temporary Error status - logical :: Echo ! Determines if an echo file should be written - character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message - character(1024) :: PriPath ! Path name of the primary file - character(1024) :: FTitle ! "File Title": the 2nd line of the input file, which contains a description of its contents - character(200) :: Line ! Temporary storage of a line from the input file (to compare with "default") - character(*), parameter :: RoutineName = 'ReadPrimaryFile' - - - ! Initialize some variables: - ErrStat = ErrID_None - ErrMsg = "" - - UnEc = -1 - Echo = .FALSE. - CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - - CALL AllocAry( InputFileData%OutList, MaxOutPts, "Outlist", ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Get an available unit number for the file. - - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Open the Primary input file. - - CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - - ! Read the lines up/including to the "Echo" simulation control variable - ! If echo is FALSE, don't write these lines to the echo file. - ! If Echo is TRUE, rewind and write on the second try. - - I = 1 !set the number of times we've read the file - DO - !----------- HEADER ------------------------------------------------------------- - - CALL ReadCom( UnIn, InputFile, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ReadStr( UnIn, InputFile, FTitle, 'FTitle', 'File Header: File Description (line 2)', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - !----------- GENERAL OPTIONS ---------------------------------------------------- - - CALL ReadCom( UnIn, InputFile, 'Section Header: General Options', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Echo - Echo input to ".AD.ech". - - CALL ReadVar( UnIn, InputFile, Echo, 'Echo', 'Echo flag', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - IF (.NOT. Echo .OR. I > 1) EXIT !exit this loop - - ! Otherwise, open the echo file, then rewind the input file and echo everything we've read - - I = I + 1 ! make sure we do this only once (increment counter that says how many times we've read this file) - - CALL OpenEcho ( UnEc, TRIM(OutFileRoot)//'.ech', ErrStat2, ErrMsg2, AD_Ver ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - IF ( UnEc > 0 ) WRITE (UnEc,'(/,A,/)') 'Data from '//TRIM(AD_Ver%Name)//' primary input file "'//TRIM( InputFile )//'":' - - REWIND( UnIn, IOSTAT=ErrStat2 ) - IF (ErrStat2 /= 0_IntKi ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error rewinding file "'//TRIM(InputFile)//'".', ErrStat, ErrMsg, RoutineName ) - CALL Cleanup() - RETURN - END IF - - END DO - - IF (NWTC_VerboseLevel == NWTC_Verbose) THEN - CALL WrScr( ' Heading of the '//TRIM(AD_Ver%Name)//' input file: ' ) - CALL WrScr( ' '//TRIM( FTitle ) ) - END IF - - - ! DTAero - Time interval for aerodynamic calculations {or default} (s): - Line = "" - CALL ReadVar( UnIn, InputFile, Line, "DTAero", "Time interval for aerodynamic calculations {or default} (s)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL Conv2UC( Line ) - IF ( INDEX(Line, "DEFAULT" ) /= 1 ) THEN ! If it's not "default", read this variable; otherwise use the value already stored in InputFileData%DTAero - READ( Line, *, IOSTAT=IOS) InputFileData%DTAero - CALL CheckIOS ( IOS, InputFile, 'DTAero', NumType, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - - ! WakeMod - Type of wake/induction model {0=none, 1=BEMT} (-): - CALL ReadVar( UnIn, InputFile, InputFileData%WakeMod, "WakeMod", "Type of wake/induction model {0=none, 1=BEMT} (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! AFAeroMod - Type of airfoil aerodynamics model {1=steady model, 2=Beddoes-Leishman unsteady model} (-): - CALL ReadVar( UnIn, InputFile, InputFileData%AFAeroMod, "AFAeroMod", "Type of airfoil aerodynamics model {1=steady model, 2=Beddoes-Leishman unsteady model} (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! TwrPotent - Type tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} (switch) : - CALL ReadVar( UnIn, InputFile, InputFileData%TwrPotent, "TwrPotent", "Type tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! TwrShadow - Calculate tower influence on wind based on downstream tower shadow? (flag) : - CALL ReadVar( UnIn, InputFile, InputFileData%TwrShadow, "TwrShadow", "Calculate tower influence on wind based on downstream tower shadow? (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! TwrAero - Calculate tower aerodynamic loads? (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%TwrAero, "TwrAero", "Calculate tower aerodynamic loads? (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! FrozenWake - Assume frozen wake during linearization? (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%FrozenWake, "FrozenWake", "Assume frozen wake during linearization? (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! CompAA - Compute AeroAcoustics? (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%CompAA, "CompAA", "Compute AeroAcoustics? (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ReadVar ( UnIn, InputFile, InputFileData%AA_InputFile, "AA_Inputfile", "AeroAcoustics Input filename", ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( PathIsRelative( InputFileData%AA_InputFile ) ) InputFileData%AA_InputFile = TRIM(PriPath)//TRIM(InputFileData%AA_InputFile) - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !----------- ENVIRONMENTAL CONDITIONS ------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Environmental Conditions', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! AirDens - Air density (kg/m^3): - CALL ReadVar( UnIn, InputFile, InputFileData%AirDens, "AirDens", "Air density (kg/m^3)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! KinVisc - Kinematic air viscosity (m^2/s): - CALL ReadVar( UnIn, InputFile, InputFileData%KinVisc, "KinVisc", "Kinematic air viscosity (m^2/s)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! SpdSound - Speed of sound (m/s): - CALL ReadVar( UnIn, InputFile, InputFileData%SpdSound, "SpdSound", "Speed of sound (m/s)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !----------- BLADE-ELEMENT/MOMENTUM THEORY OPTIONS ------------------------------ - CALL ReadCom( UnIn, InputFile, 'Section Header: Blade-Element/Momentum Theory Options', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! SkewMod - Type of skewed-wake correction model {1=uncoupled, 2=Pitt/Peters, 3=coupled} [used only when WakeMod=1] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%SkewMod, "SkewMod", "Type of skewed-wake correction model {1=uncoupled, 2=Pitt/Peters, 3=coupled} [used only when WakeMod=1] (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! TipLoss - Use the Prandtl tip-loss model? [used only when WakeMod=1] (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%TipLoss, "TipLoss", "Use the Prandtl tip-loss model? [used only when WakeMod=1] (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! HubLoss - Use the Prandtl hub-loss model? [used only when WakeMod=1] (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%HubLoss, "HubLoss", "Use the Prandtl hub-loss model? [used only when WakeMod=1] (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! TanInd - Include tangential induction in BEMT calculations? [used only when WakeMod=1] (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%TanInd, "TanInd", "Include tangential induction in BEMT calculations? [used only when WakeMod=1] (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! AIDrag - Include the drag term in the axial-induction calculation? [used only when WakeMod=1] (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%AIDrag, "AIDrag", "Include the drag term in the axial-induction calculation? [used only when WakeMod=1] (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! TIDrag - Include the drag term in the tangential-induction calculation? [used only when WakeMod=1 and TanInd=TRUE] (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%TIDrag, "TIDrag", "Include the drag term in the tangential-induction calculation? [used only when WakeMod=1 and TanInd=TRUE] (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! IndToler - Convergence tolerance for BEM induction factors (or "default"] [used only when WakeMod=1] (-): - Line = "" - CALL ReadVar( UnIn, InputFile, Line, "IndToler", "Convergence tolerance for BEM induction factors [used only when WakeMod=1] (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL Conv2UC( Line ) - IF ( INDEX(Line, "DEFAULT" ) /= 1 ) THEN ! If it's not "default", read this variable; otherwise set the value based on ReKi precision - READ( Line, *, IOSTAT=IOS) InputFileData%IndToler - CALL CheckIOS ( IOS, InputFile, 'IndToler', NumType, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - else - if (ReKi==SiKi) then - InputFileData%IndToler = 5E-5 - else - InputFileData%IndToler = 5D-10 - end if - END IF - - - - ! MaxIter - Maximum number of iteration steps [used only when WakeMod=1] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%MaxIter, "MaxIter", "Maximum number of iteration steps [used only when WakeMod=1] (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !----------- BEDDOES-LEISHMAN UNSTEADY AIRFOIL AERODYNAMICS OPTIONS ------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Beddoes-Leishman Unsteady Airfoil Aerodynamics Options', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! UAMod - Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez’s variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAreoMod=2] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%UAMod, "UAMod", "Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez’s variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAreoMod=2] (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! FLookup - Flag to indicate whether a lookup for f’ will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAreoMod=2] (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%FLookup, "FLookup", "Flag to indicate whether a lookup for f’ will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAreoMod=2] (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! UACutout - Angle-of-attach beyond which unsteady aerodynamics are disabled (deg) -! CALL ReadVar( UnIn, InputFile, InputFileData%UACutout, "FLookup", "Angle-of-attach beyond which unsteady aerodynamics are disabled (deg)", ErrStat2, ErrMsg2, UnEc) -! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !----------- AIRFOIL INFORMATION ------------------------------------------------ - CALL ReadCom( UnIn, InputFile, 'Section Header: Airfoil Information', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - - ! InCol_Alfa - The column in the airfoil tables that contains the angle of attack (-): - CALL ReadVar( UnIn, InputFile, InputFileData%InCol_Alfa, "InCol_Alfa", "The column in the airfoil tables that contains the angle of attack (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! InCol_Cl - The column in the airfoil tables that contains the lift coefficient (-): - CALL ReadVar( UnIn, InputFile, InputFileData%InCol_Cl, "InCol_Cl", "The column in the airfoil tables that contains the lift coefficient (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! InCol_Cd - The column in the airfoil tables that contains the drag coefficient (-): - CALL ReadVar( UnIn, InputFile, InputFileData%InCol_Cd, "InCol_Cd", "The column in the airfoil tables that contains the drag coefficient (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! InCol_Cm - The column in the airfoil tables that contains the pitching-moment coefficient; use zero if there is no Cm column (-): - CALL ReadVar( UnIn, InputFile, InputFileData%InCol_Cm, "InCol_Cm", "The column in the airfoil tables that contains the pitching-moment coefficient; use zero if there is no Cm column (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! InCol_Cpmin - The column in the airfoil tables that contains the drag coefficient; use zero if there is no Cpmin column (-): - CALL ReadVar( UnIn, InputFile, InputFileData%InCol_Cpmin, "InCol_Cpmin", "The column in the airfoil tables that contains the drag coefficient; use zero if there is no Cpmin column (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! NumAFfiles - Number of airfoil files used (-): - CALL ReadVar( UnIn, InputFile, InputFileData%NumAFfiles, "NumAFfiles", "Number of airfoil files used (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! Allocate space to hold AFNames - ALLOCATE( InputFileData%AFNames(InputFileData%NumAFfiles), STAT=ErrStat2) - IF (ErrStat2 /= 0 ) THEN - CALL SetErrStat( ErrID_Fatal, "Error allocating AFNames.", ErrStat, ErrMsg, RoutineName) - CALL Cleanup() - RETURN - END IF - - ! AFNames - Airfoil file names (NumAFfiles lines) (quoted strings): - DO I = 1,InputFileData%NumAFfiles - CALL ReadVar ( UnIn, InputFile, InputFileData%AFNames(I), 'AFNames('//TRIM(Num2Lstr(I))//')', 'Airfoil '//TRIM(Num2Lstr(I))//' file name', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( PathIsRelative( InputFileData%AFNames(I) ) ) InputFileData%AFNames(I) = TRIM(PriPath)//TRIM(InputFileData%AFNames(I)) - END DO - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !----------- ROTOR/BLADE PROPERTIES -------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Rotor/Blade Properties', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! UseBlCm - Include aerodynamic pitching moment in calculations? (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%UseBlCm, "UseBlCm", "Include aerodynamic pitching moment in calculations? (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! ! NumBlNds - Number of blade nodes used in the analysis (-): - !CALL ReadVar( UnIn, InputFile, InputFileData%NumBlNds, "NumBlNds", "Number of blade nodes used in the analysis (-)", ErrStat2, ErrMsg2, UnEc) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! IF ( ErrStat >= AbortErrLev ) RETURN - - ! ADBlFile - Names of files containing distributed aerodynamic properties for each blade (see AD_BladeInputFile type): - DO I = 1,MaxBl - CALL ReadVar ( UnIn, InputFile, ADBlFile(I), 'ADBlFile('//TRIM(Num2Lstr(I))//')', 'Name of file containing distributed aerodynamic properties for blade '//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( PathIsRelative( ADBlFile(I) ) ) ADBlFile(I) = TRIM(PriPath)//TRIM(ADBlFile(I)) - END DO - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !----------- TOWER INFLUENCE AND AERODYNAMICS ---------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Tower Influence and Aerodynamics', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! NumTwrNds - Number of tower nodes used in the analysis (-): - CALL ReadVar( UnIn, InputFile, InputFileData%NumTwrNds, "NumTwrNds", "Number of tower nodes used in the analysis (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - - !....... tower properties ................... - CALL ReadCom( UnIn, InputFile, 'Section Header: Tower Property Channels', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ReadCom( UnIn, InputFile, 'Section Header: Tower Property Units', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! allocate space for tower inputs: - CALL AllocAry( InputFileData%TwrElev, InputFileData%NumTwrNds, 'TwrElev', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( InputFileData%TwrDiam, InputFileData%NumTwrNds, 'TwrDiam', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( InputFileData%TwrCd, InputFileData%NumTwrNds, 'TwrCd', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Return on error if we didn't allocate space for the next inputs - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - DO I=1,InputFileData%NumTwrNds - call ReadAry ( UnIn, InputFile, TmpAry, 3, 'TwrNds', 'Properties for tower node ' & - //trim( Int2LStr( I ) )//'.', errStat2, errMsg2, UnEc ) - call setErrStat( errStat2, ErrMsg2 , errStat, ErrMsg , RoutineName ) - - InputFileData%TwrElev(I) = TmpAry( 1) - InputFileData%TwrDiam(I) = TmpAry( 2) - InputFileData%TwrCd(I) = TmpAry( 3) - END DO - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !----------- OUTPUTS ----------------------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Outputs', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! SumPrint - Generate a summary file listing input options and interpolated properties to .AD.sum? (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%SumPrint, "SumPrint", "Generate a summary file listing input options and interpolated properties to .AD.sum? (flag)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! NBlOuts - Number of blade node outputs [0 - 9] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%NBlOuts, "NBlOuts", "Number of blade node outputs [0 - 9] (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - IF ( InputFileData%NBlOuts > SIZE(InputFileData%BlOutNd) ) THEN - CALL SetErrStat( ErrID_Warn, ' Warning: number of blade output nodes exceeds '//& - TRIM(Num2LStr(SIZE(InputFileData%BlOutNd))) //'.', ErrStat, ErrMsg, RoutineName ) - InputFileData%NBlOuts = SIZE(InputFileData%BlOutNd) - END IF - - ! BlOutNd - Blade nodes whose values will be output (-): - CALL ReadAry( UnIn, InputFile, InputFileData%BlOutNd, InputFileData%NBlOuts, "BlOutNd", "Blade nodes whose values will be output (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! NTwOuts - Number of tower node outputs [0 - 9] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%NTwOuts, "NTwOuts", "Number of tower node outputs [0 - 9] (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - IF ( InputFileData%NTwOuts > SIZE(InputFileData%TwOutNd) ) THEN - CALL SetErrStat( ErrID_Warn, ' Warning: number of tower output nodes exceeds '//& - TRIM(Num2LStr(SIZE(InputFileData%TwOutNd))) //'.', ErrStat, ErrMsg, RoutineName ) - InputFileData%NTwOuts = SIZE(InputFileData%TwOutNd) - END IF - - ! TwOutNd - Tower nodes whose values will be output (-): - CALL ReadAry( UnIn, InputFile, InputFileData%TwOutNd, InputFileData%NTwOuts, "TwOutNd", "Tower nodes whose values will be output (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !----------- OUTLIST ----------------------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! OutList - List of user-requested output channels (-): - CALL ReadOutputList ( UnIn, InputFile, InputFileData%OutList, InputFileData%NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - !---------------------- END OF FILE ----------------------------------------- - - CALL Cleanup( ) - RETURN - - -CONTAINS - !............................................................................................................................... - SUBROUTINE Cleanup() - ! This subroutine cleans up any local variables and closes input files - !............................................................................................................................... - - IF (UnIn > 0) CLOSE ( UnIn ) - - END SUBROUTINE Cleanup - !............................................................................................................................... -END SUBROUTINE ReadPrimaryFile -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadBladeInputs ( ADBlFile, BladeKInputFileData, UnEc, ErrStat, ErrMsg ) -! This routine reads a blade input file. -!.................................................................................................................................. - - - ! Passed variables: - - 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) :: UnEc ! I/O unit for echo file. If present and > 0, write to UnEc - - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Error status - CHARACTER(*), INTENT(OUT) :: ErrMsg ! Error message - - - ! Local variables: - - INTEGER(IntKi) :: I ! A generic DO index. - INTEGER( IntKi ) :: UnIn ! Unit number for reading file - INTEGER(IntKi) :: ErrStat2 , IOS ! Temporary Error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Err msg - CHARACTER(*), PARAMETER :: RoutineName = 'ReadBladeInputs' - - ErrStat = ErrID_None - ErrMsg = "" - UnIn = -1 - - ! Allocate space for these variables - - - - - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - - ! Open the input file for blade K. - - CALL OpenFInpFile ( UnIn, ADBlFile, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) RETURN - - - ! -------------- HEADER ------------------------------------------------------- - - ! Skip the header. - - CALL ReadCom ( UnIn, ADBlFile, 'unused blade file header line 1', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL ReadCom ( UnIn, ADBlFile, 'unused blade file header line 2', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! -------------- Blade properties table ------------------------------------------ - CALL ReadCom ( UnIn, ADBlFile, 'Section header: Blade Properties', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - ! NumBlNds - Number of blade nodes used in the analysis (-): - CALL ReadVar( UnIn, ADBlFile, BladeKInputFileData%NumBlNds, "NumBlNds", "Number of blade nodes used in the analysis (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - - CALL ReadCom ( UnIn, ADBlFile, 'Table header: names', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL ReadCom ( UnIn, ADBlFile, 'Table header: units', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - IF ( ErrStat>= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - - ! allocate space for blade inputs: - CALL AllocAry( BladeKInputFileData%BlSpn, BladeKInputFileData%NumBlNds, 'BlSpn', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( BladeKInputFileData%BlCrvAC, BladeKInputFileData%NumBlNds, 'BlCrvAC', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( BladeKInputFileData%BlSwpAC, BladeKInputFileData%NumBlNds, 'BlSwpAC', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( BladeKInputFileData%BlCrvAng,BladeKInputFileData%NumBlNds, 'BlCrvAng',ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( BladeKInputFileData%BlTwist, BladeKInputFileData%NumBlNds, 'BlTwist', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( BladeKInputFileData%BlChord, BladeKInputFileData%NumBlNds, 'BlChord', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( BladeKInputFileData%BlAFID, BladeKInputFileData%NumBlNds, 'BlAFID', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Return on error if we didn't allocate space for the next inputs - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - DO I=1,BladeKInputFileData%NumBlNds - READ( UnIn, *, IOStat=IOS ) BladeKInputFileData%BlSpn(I), BladeKInputFileData%BlCrvAC(I), BladeKInputFileData%BlSwpAC(I), & - BladeKInputFileData%BlCrvAng(I), BladeKInputFileData%BlTwist(I), BladeKInputFileData%BlChord(I), & - BladeKInputFileData%BlAFID(I) - CALL CheckIOS( IOS, ADBlFile, 'Blade properties row '//TRIM(Num2LStr(I)), NumType, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! Return on error if we couldn't read this line - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - IF (UnEc > 0) THEN - WRITE( UnEc, "(6(F9.4,1x),I9)", IOStat=IOS) BladeKInputFileData%BlSpn(I), BladeKInputFileData%BlCrvAC(I), BladeKInputFileData%BlSwpAC(I), & - BladeKInputFileData%BlCrvAng(I), BladeKInputFileData%BlTwist(I), BladeKInputFileData%BlChord(I), & - BladeKInputFileData%BlAFID(I) - END IF - END DO - BladeKInputFileData%BlCrvAng = BladeKInputFileData%BlCrvAng*D2R - BladeKInputFileData%BlTwist = BladeKInputFileData%BlTwist*D2R - - ! -------------- END OF FILE -------------------------------------------- - - CALL Cleanup() - RETURN - - -CONTAINS - !............................................................................................................................... - SUBROUTINE Cleanup() - ! This subroutine cleans up local variables and closes files - !............................................................................................................................... - - IF (UnIn > 0) CLOSE(UnIn) - - END SUBROUTINE Cleanup - -END SUBROUTINE ReadBladeInputs -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE AD_PrintSum( InputFileData, p, u, y, ErrStat, ErrMsg ) -! This routine generates the summary file, which contains a summary of input file options. - - ! passed variables - TYPE(AD_InputFile), INTENT(IN) :: InputFileData ! Input-file data - TYPE(AD_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AD_InputType), INTENT(IN) :: u ! inputs - TYPE(AD_OutputType), INTENT(IN) :: y ! outputs - INTEGER(IntKi), INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMsg - - - ! Local variables. - - INTEGER(IntKi) :: I ! Index for the nodes. - INTEGER(IntKi) :: UnSu ! I/O unit number for the summary output file - - CHARACTER(*), PARAMETER :: FmtDat = '(A,T35,1(:,F13.3))' ! Format for outputting mass and modal data. - CHARACTER(*), PARAMETER :: FmtDatT = '(A,T35,1(:,F13.8))' ! Format for outputting time steps. - - CHARACTER(30) :: OutPFmt ! Format to print list of selected output channels to summary file - CHARACTER(100) :: Msg ! temporary string for writing appropriate text to summary file - - ! Open the summary file and give it a heading. - - CALL GetNewUnit( UnSu, ErrStat, ErrMsg ) - CALL OpenFOutFile ( UnSu, TRIM( p%RootName )//'.sum', ErrStat, ErrMsg ) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! Heading: - WRITE (UnSu,'(/,A)') 'This summary information was generated by '//TRIM( GetNVD(AD_Ver) )// & - ' on '//CurDate()//' at '//CurTime()//'.' - - WRITE (UnSu,'(/,A)') '====== General Options ============================================================================' - ! WakeMod - select case (p%WakeMod) - case (WakeMod_BEMT) - Msg = 'Blade-Element/Momentum Theory' - case (WakeMod_None) - Msg = 'steady' - case default - Msg = 'unknown' - end select - WRITE (UnSu,Ec_IntFrmt) p%WakeMod, 'WakeMod', 'Type of wake/induction model: '//TRIM(Msg) - - - ! AFAeroMod - select case (InputFileData%AFAeroMod) - case (AFAeroMod_BL_unsteady) - Msg = 'Beddoes-Leishman unsteady model' - case (AFAeroMod_steady) - Msg = 'steady' - case default - Msg = 'unknown' - end select - WRITE (UnSu,Ec_IntFrmt) InputFileData%AFAeroMod, 'AFAeroMod', 'Type of blade airfoil aerodynamics model: '//TRIM(Msg) - - - ! TwrPotent - select case (p%TwrPotent) - case (TwrPotent_baseline) - Msg = 'baseline potential flow' - case (TwrPotent_Bak) - Msg = 'potential flow with Bak correction' - case (TwrPotent_none) - Msg = 'none' - case default - Msg = 'unknown' - end select - WRITE (UnSu,Ec_IntFrmt) p%TwrPotent, 'TwrPotent', 'Type tower influence on wind based on potential flow around the tower: '//TRIM(Msg) - - - ! TwrShadow - if (p%TwrShadow) then - Msg = 'Yes' - else - Msg = 'No' - end if - WRITE (UnSu,Ec_LgFrmt) p%TwrShadow, 'TwrShadow', 'Calculate tower influence on wind based on downstream tower shadow? '//TRIM(Msg) - - - ! TwrAero - if (p%TwrAero) then - Msg = 'Yes' - else - Msg = 'No' - end if - WRITE (UnSu,Ec_LgFrmt) p%TwrAero, 'TwrAero', 'Calculate tower aerodynamic loads? '//TRIM(Msg) - - - if (p%WakeMod==WakeMod_BEMT) then - WRITE (UnSu,'(A)') '====== Blade-Element/Momentum Theory Options ======================================================' - - ! SkewMod - select case (InputFileData%SkewMod) - case (SkewMod_Uncoupled) - Msg = 'uncoupled' - case (SkewMod_PittPeters) - Msg = 'Pitt/Peters' - case default - Msg = 'unknown' - end select - WRITE (UnSu,Ec_IntFrmt) InputFileData%SkewMod, 'SkewMod', 'Type of skewed-wake correction model: '//TRIM(Msg) - - - ! TipLoss - if (InputFileData%TipLoss) then - Msg = 'Yes' - else - Msg = 'No' - end if - WRITE (UnSu,Ec_LgFrmt) InputFileData%TipLoss, 'TipLoss', "Use the Prandtl tip-loss model? "//TRIM(Msg) - - - ! HubLoss - if (InputFileData%HubLoss) then - Msg = 'Yes' - else - Msg = 'No' - end if - WRITE (UnSu,Ec_LgFrmt) InputFileData%HubLoss, 'HubLoss', "Use the Prandtl hub-loss model? "//TRIM(Msg) - - - ! TanInd - if (InputFileData%TanInd) then - Msg = 'Yes' - else - Msg = 'No' - end if - WRITE (UnSu,Ec_LgFrmt) InputFileData%TanInd, 'TanInd', "Include tangential induction in BEMT calculations? "//TRIM(Msg) - - - ! AIDrag - if (InputFileData%AIDrag) then - Msg = 'Yes' - else - Msg = 'No' - end if - WRITE (UnSu,Ec_LgFrmt) InputFileData%AIDrag, 'AIDrag', "Include the drag term in the axial-induction calculation? "//TRIM(Msg) - - ! TIDrag - if (InputFileData%TIDrag .and. InputFileData%TanInd) then - Msg = 'Yes' - else - Msg = 'No' - end if - WRITE (UnSu,Ec_LgFrmt) InputFileData%AIDrag, 'AIDrag', "Include the drag term in the tangential-induction calculation? "//TRIM(Msg) - - ! IndToler - WRITE (UnSu,Ec_ReFrmt) InputFileData%IndToler, 'IndToler', "Convergence tolerance for BEM induction factors (radians)" - - ! MaxIter - - end if - - if (InputFileData%AFAeroMod==AFAeroMod_BL_unsteady) then - WRITE (UnSu,'(A)') '====== Beddoes-Leishman Unsteady Airfoil Aerodynamics Options =====================================' - - ! UAMod - select case (InputFileData%UAMod) - case (1) - Msg = 'baseline model (original)' - case (2) - Msg = 'Gonzalez’s variant (changes in Cn, Cc, and Cm)' - case (3) - Msg = 'Minemma/Pierce variant (changes in Cc and Cm)' - !case (4) - ! Msg = 'DYSTOOL' - case default - Msg = 'unknown' - end select - WRITE (UnSu,Ec_IntFrmt) InputFileData%UAMod, 'UAMod', 'Unsteady Aero Model: '//TRIM(Msg) - - - ! FLookup - if (InputFileData%FLookup) then - Msg = 'Yes' - else - Msg = 'No, use best-fit exponential equations instead' - end if - WRITE (UnSu,Ec_LgFrmt) InputFileData%FLookup, 'FLookup', "Use a lookup for f'? "//TRIM(Msg) - - end if - - WRITE (UnSu,'(A)') '====== Outputs ====================================================================================' - - OutPFmt = '( 49X, I11, 2X, I13 )' - - WRITE(UnSu,Ec_IntFrmt) p%NBlOuts,'NBlOuts','Number of blade nodes selected for output' - if (p%NBlOuts > 0) then - WRITE(UnSu,Ec_IntFrmt) p%NumBlNds,'NumBlNds','Number of blade nodes in the analysis' - - WRITE (UnSu,"(15x,A)") 'Blade nodes selected for output: Output node Analysis node' - WRITE (UnSu,"(15x,A)") ' ----------- -------------' - DO I = 1,p%NBlOuts - WRITE (UnSu,OutPFmt) I, p%BlOutNd(I) - END DO - end if - - WRITE(UnSu,Ec_IntFrmt) p%NTwOuts,'NTwOuts','Number of tower nodes selected for output' - if (p%NTwOuts > 0) then - WRITE(UnSu,Ec_IntFrmt) p%NumTwrNds,'NumTwrNds','Number of tower nodes in the analysis' - WRITE (UnSu,"(15x,A)") 'Tower nodes selected for output: Output node Analysis node' - WRITE (UnSu,"(15x,A)") ' ----------- -------------' - DO I = 1,p%NTwOuts - WRITE (UnSu,OutPFmt) I, p%TwOutNd(I) - END DO - end if - - -#ifndef DBG_OUTS -! p%OutParam isn't allocated when DBG_OUTS is defined - - OutPFmt = '( 15x, I4, 2X, A '//TRIM(Num2LStr(ChanLen))//',1 X, A'//TRIM(Num2LStr(ChanLen))//' )' - WRITE (UnSu,'(15x,A)') 'Requested Output Channels:' - WRITE (UnSu,'(15x,A)') 'Col Parameter Units' - WRITE (UnSu,'(15x,A)') '---- --------- -----' - - DO I = 0,p%NumOuts - WRITE (UnSu,OutPFmt) I, p%OutParam(I)%Name, p%OutParam(I)%Units - END DO -#endif - - CLOSE(UnSu) - -RETURN -END SUBROUTINE AD_PrintSum -!---------------------------------------------------------------------------------------------------------------------------------- - - - -!********************************************************************************************************************************** -! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" -! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these -! lines should be modified in the Matlab script and/or Excel worksheet as necessary. -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine checks to see if any requested output channel names (stored in the OutList(:)) are invalid. It returns a -!! warning if any of the channels are not available outputs from the module. -!! It assigns the settings for OutParam(:) (i.e, the index, name, and units of the output channels, WriteOutput(:)). -!! the sign is set to 0 if the channel is invalid. -!! It sets assumes the value p%NumOuts has been set before this routine has been called, and it sets the values of p%OutParam here. -!! -!! This routine was generated by Write_ChckOutLst.m using the parameters listed in OutListParameters.xlsx at 11-Mar-2016 14:45:58. -SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) -!.................................................................................................................................. - - IMPLICIT NONE - - ! Passed variables - - CHARACTER(ChanLen), INTENT(IN) :: OutList(:) !< The list out user-requested outputs - TYPE(AD_ParameterType), INTENT(INOUT) :: p !< The module parameters - INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status code - CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if an error occurred - - ! Local variables - - INTEGER :: ErrStat2 ! temporary (local) error status - INTEGER :: I ! Generic loop-counting index - INTEGER :: INDX ! Index for valid arrays - - LOGICAL :: CheckOutListAgain ! Flag used to determine if output parameter starting with "M" is valid (or the negative of another parameter) - LOGICAL :: InvalidOutput(0:MaxOutPts) ! This array determines if the output channel is valid for this configuration - CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I) - CHARACTER(*), PARAMETER :: RoutineName = "SetOutParam" - - CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(1103) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically - "B1AZIMUTH","B1N1ALPHA","B1N1AXIND","B1N1CD ","B1N1CL ","B1N1CLRNC","B1N1CM ", & - "B1N1CN ","B1N1CT ","B1N1CURVE","B1N1CX ","B1N1CY ","B1N1DYNP ","B1N1FD ", & - "B1N1FL ","B1N1FN ","B1N1FT ","B1N1FX ","B1N1FY ","B1N1M ","B1N1MM ", & - "B1N1PHI ","B1N1RE ","B1N1STVX ","B1N1STVY ","B1N1STVZ ","B1N1THETA","B1N1TNIND", & - "B1N1VDISX","B1N1VDISY","B1N1VDISZ","B1N1VINDX","B1N1VINDY","B1N1VREL ","B1N1VUNDX", & - "B1N1VUNDY","B1N1VUNDZ","B1N2ALPHA","B1N2AXIND","B1N2CD ","B1N2CL ","B1N2CLRNC", & - "B1N2CM ","B1N2CN ","B1N2CT ","B1N2CURVE","B1N2CX ","B1N2CY ","B1N2DYNP ", & - "B1N2FD ","B1N2FL ","B1N2FN ","B1N2FT ","B1N2FX ","B1N2FY ","B1N2M ", & - "B1N2MM ","B1N2PHI ","B1N2RE ","B1N2STVX ","B1N2STVY ","B1N2STVZ ","B1N2THETA", & - "B1N2TNIND","B1N2VDISX","B1N2VDISY","B1N2VDISZ","B1N2VINDX","B1N2VINDY","B1N2VREL ", & - "B1N2VUNDX","B1N2VUNDY","B1N2VUNDZ","B1N3ALPHA","B1N3AXIND","B1N3CD ","B1N3CL ", & - "B1N3CLRNC","B1N3CM ","B1N3CN ","B1N3CT ","B1N3CURVE","B1N3CX ","B1N3CY ", & - "B1N3DYNP ","B1N3FD ","B1N3FL ","B1N3FN ","B1N3FT ","B1N3FX ","B1N3FY ", & - "B1N3M ","B1N3MM ","B1N3PHI ","B1N3RE ","B1N3STVX ","B1N3STVY ","B1N3STVZ ", & - "B1N3THETA","B1N3TNIND","B1N3VDISX","B1N3VDISY","B1N3VDISZ","B1N3VINDX","B1N3VINDY", & - "B1N3VREL ","B1N3VUNDX","B1N3VUNDY","B1N3VUNDZ","B1N4ALPHA","B1N4AXIND","B1N4CD ", & - "B1N4CL ","B1N4CLRNC","B1N4CM ","B1N4CN ","B1N4CT ","B1N4CURVE","B1N4CX ", & - "B1N4CY ","B1N4DYNP ","B1N4FD ","B1N4FL ","B1N4FN ","B1N4FT ","B1N4FX ", & - "B1N4FY ","B1N4M ","B1N4MM ","B1N4PHI ","B1N4RE ","B1N4STVX ","B1N4STVY ", & - "B1N4STVZ ","B1N4THETA","B1N4TNIND","B1N4VDISX","B1N4VDISY","B1N4VDISZ","B1N4VINDX", & - "B1N4VINDY","B1N4VREL ","B1N4VUNDX","B1N4VUNDY","B1N4VUNDZ","B1N5ALPHA","B1N5AXIND", & - "B1N5CD ","B1N5CL ","B1N5CLRNC","B1N5CM ","B1N5CN ","B1N5CT ","B1N5CURVE", & - "B1N5CX ","B1N5CY ","B1N5DYNP ","B1N5FD ","B1N5FL ","B1N5FN ","B1N5FT ", & - "B1N5FX ","B1N5FY ","B1N5M ","B1N5MM ","B1N5PHI ","B1N5RE ","B1N5STVX ", & - "B1N5STVY ","B1N5STVZ ","B1N5THETA","B1N5TNIND","B1N5VDISX","B1N5VDISY","B1N5VDISZ", & - "B1N5VINDX","B1N5VINDY","B1N5VREL ","B1N5VUNDX","B1N5VUNDY","B1N5VUNDZ","B1N6ALPHA", & - "B1N6AXIND","B1N6CD ","B1N6CL ","B1N6CLRNC","B1N6CM ","B1N6CN ","B1N6CT ", & - "B1N6CURVE","B1N6CX ","B1N6CY ","B1N6DYNP ","B1N6FD ","B1N6FL ","B1N6FN ", & - "B1N6FT ","B1N6FX ","B1N6FY ","B1N6M ","B1N6MM ","B1N6PHI ","B1N6RE ", & - "B1N6STVX ","B1N6STVY ","B1N6STVZ ","B1N6THETA","B1N6TNIND","B1N6VDISX","B1N6VDISY", & - "B1N6VDISZ","B1N6VINDX","B1N6VINDY","B1N6VREL ","B1N6VUNDX","B1N6VUNDY","B1N6VUNDZ", & - "B1N7ALPHA","B1N7AXIND","B1N7CD ","B1N7CL ","B1N7CLRNC","B1N7CM ","B1N7CN ", & - "B1N7CT ","B1N7CURVE","B1N7CX ","B1N7CY ","B1N7DYNP ","B1N7FD ","B1N7FL ", & - "B1N7FN ","B1N7FT ","B1N7FX ","B1N7FY ","B1N7M ","B1N7MM ","B1N7PHI ", & - "B1N7RE ","B1N7STVX ","B1N7STVY ","B1N7STVZ ","B1N7THETA","B1N7TNIND","B1N7VDISX", & - "B1N7VDISY","B1N7VDISZ","B1N7VINDX","B1N7VINDY","B1N7VREL ","B1N7VUNDX","B1N7VUNDY", & - "B1N7VUNDZ","B1N8ALPHA","B1N8AXIND","B1N8CD ","B1N8CL ","B1N8CLRNC","B1N8CM ", & - "B1N8CN ","B1N8CT ","B1N8CURVE","B1N8CX ","B1N8CY ","B1N8DYNP ","B1N8FD ", & - "B1N8FL ","B1N8FN ","B1N8FT ","B1N8FX ","B1N8FY ","B1N8M ","B1N8MM ", & - "B1N8PHI ","B1N8RE ","B1N8STVX ","B1N8STVY ","B1N8STVZ ","B1N8THETA","B1N8TNIND", & - "B1N8VDISX","B1N8VDISY","B1N8VDISZ","B1N8VINDX","B1N8VINDY","B1N8VREL ","B1N8VUNDX", & - "B1N8VUNDY","B1N8VUNDZ","B1N9ALPHA","B1N9AXIND","B1N9CD ","B1N9CL ","B1N9CLRNC", & - "B1N9CM ","B1N9CN ","B1N9CT ","B1N9CURVE","B1N9CX ","B1N9CY ","B1N9DYNP ", & - "B1N9FD ","B1N9FL ","B1N9FN ","B1N9FT ","B1N9FX ","B1N9FY ","B1N9M ", & - "B1N9MM ","B1N9PHI ","B1N9RE ","B1N9STVX ","B1N9STVY ","B1N9STVZ ","B1N9THETA", & - "B1N9TNIND","B1N9VDISX","B1N9VDISY","B1N9VDISZ","B1N9VINDX","B1N9VINDY","B1N9VREL ", & - "B1N9VUNDX","B1N9VUNDY","B1N9VUNDZ","B1PITCH ","B2AZIMUTH","B2N1ALPHA","B2N1AXIND", & - "B2N1CD ","B2N1CL ","B2N1CLRNC","B2N1CM ","B2N1CN ","B2N1CT ","B2N1CURVE", & - "B2N1CX ","B2N1CY ","B2N1DYNP ","B2N1FD ","B2N1FL ","B2N1FN ","B2N1FT ", & - "B2N1FX ","B2N1FY ","B2N1M ","B2N1MM ","B2N1PHI ","B2N1RE ","B2N1STVX ", & - "B2N1STVY ","B2N1STVZ ","B2N1THETA","B2N1TNIND","B2N1VDISX","B2N1VDISY","B2N1VDISZ", & - "B2N1VINDX","B2N1VINDY","B2N1VREL ","B2N1VUNDX","B2N1VUNDY","B2N1VUNDZ","B2N2ALPHA", & - "B2N2AXIND","B2N2CD ","B2N2CL ","B2N2CLRNC","B2N2CM ","B2N2CN ","B2N2CT ", & - "B2N2CURVE","B2N2CX ","B2N2CY ","B2N2DYNP ","B2N2FD ","B2N2FL ","B2N2FN ", & - "B2N2FT ","B2N2FX ","B2N2FY ","B2N2M ","B2N2MM ","B2N2PHI ","B2N2RE ", & - "B2N2STVX ","B2N2STVY ","B2N2STVZ ","B2N2THETA","B2N2TNIND","B2N2VDISX","B2N2VDISY", & - "B2N2VDISZ","B2N2VINDX","B2N2VINDY","B2N2VREL ","B2N2VUNDX","B2N2VUNDY","B2N2VUNDZ", & - "B2N3ALPHA","B2N3AXIND","B2N3CD ","B2N3CL ","B2N3CLRNC","B2N3CM ","B2N3CN ", & - "B2N3CT ","B2N3CURVE","B2N3CX ","B2N3CY ","B2N3DYNP ","B2N3FD ","B2N3FL ", & - "B2N3FN ","B2N3FT ","B2N3FX ","B2N3FY ","B2N3M ","B2N3MM ","B2N3PHI ", & - "B2N3RE ","B2N3STVX ","B2N3STVY ","B2N3STVZ ","B2N3THETA","B2N3TNIND","B2N3VDISX", & - "B2N3VDISY","B2N3VDISZ","B2N3VINDX","B2N3VINDY","B2N3VREL ","B2N3VUNDX","B2N3VUNDY", & - "B2N3VUNDZ","B2N4ALPHA","B2N4AXIND","B2N4CD ","B2N4CL ","B2N4CLRNC","B2N4CM ", & - "B2N4CN ","B2N4CT ","B2N4CURVE","B2N4CX ","B2N4CY ","B2N4DYNP ","B2N4FD ", & - "B2N4FL ","B2N4FN ","B2N4FT ","B2N4FX ","B2N4FY ","B2N4M ","B2N4MM ", & - "B2N4PHI ","B2N4RE ","B2N4STVX ","B2N4STVY ","B2N4STVZ ","B2N4THETA","B2N4TNIND", & - "B2N4VDISX","B2N4VDISY","B2N4VDISZ","B2N4VINDX","B2N4VINDY","B2N4VREL ","B2N4VUNDX", & - "B2N4VUNDY","B2N4VUNDZ","B2N5ALPHA","B2N5AXIND","B2N5CD ","B2N5CL ","B2N5CLRNC", & - "B2N5CM ","B2N5CN ","B2N5CT ","B2N5CURVE","B2N5CX ","B2N5CY ","B2N5DYNP ", & - "B2N5FD ","B2N5FL ","B2N5FN ","B2N5FT ","B2N5FX ","B2N5FY ","B2N5M ", & - "B2N5MM ","B2N5PHI ","B2N5RE ","B2N5STVX ","B2N5STVY ","B2N5STVZ ","B2N5THETA", & - "B2N5TNIND","B2N5VDISX","B2N5VDISY","B2N5VDISZ","B2N5VINDX","B2N5VINDY","B2N5VREL ", & - "B2N5VUNDX","B2N5VUNDY","B2N5VUNDZ","B2N6ALPHA","B2N6AXIND","B2N6CD ","B2N6CL ", & - "B2N6CLRNC","B2N6CM ","B2N6CN ","B2N6CT ","B2N6CURVE","B2N6CX ","B2N6CY ", & - "B2N6DYNP ","B2N6FD ","B2N6FL ","B2N6FN ","B2N6FT ","B2N6FX ","B2N6FY ", & - "B2N6M ","B2N6MM ","B2N6PHI ","B2N6RE ","B2N6STVX ","B2N6STVY ","B2N6STVZ ", & - "B2N6THETA","B2N6TNIND","B2N6VDISX","B2N6VDISY","B2N6VDISZ","B2N6VINDX","B2N6VINDY", & - "B2N6VREL ","B2N6VUNDX","B2N6VUNDY","B2N6VUNDZ","B2N7ALPHA","B2N7AXIND","B2N7CD ", & - "B2N7CL ","B2N7CLRNC","B2N7CM ","B2N7CN ","B2N7CT ","B2N7CURVE","B2N7CX ", & - "B2N7CY ","B2N7DYNP ","B2N7FD ","B2N7FL ","B2N7FN ","B2N7FT ","B2N7FX ", & - "B2N7FY ","B2N7M ","B2N7MM ","B2N7PHI ","B2N7RE ","B2N7STVX ","B2N7STVY ", & - "B2N7STVZ ","B2N7THETA","B2N7TNIND","B2N7VDISX","B2N7VDISY","B2N7VDISZ","B2N7VINDX", & - "B2N7VINDY","B2N7VREL ","B2N7VUNDX","B2N7VUNDY","B2N7VUNDZ","B2N8ALPHA","B2N8AXIND", & - "B2N8CD ","B2N8CL ","B2N8CLRNC","B2N8CM ","B2N8CN ","B2N8CT ","B2N8CURVE", & - "B2N8CX ","B2N8CY ","B2N8DYNP ","B2N8FD ","B2N8FL ","B2N8FN ","B2N8FT ", & - "B2N8FX ","B2N8FY ","B2N8M ","B2N8MM ","B2N8PHI ","B2N8RE ","B2N8STVX ", & - "B2N8STVY ","B2N8STVZ ","B2N8THETA","B2N8TNIND","B2N8VDISX","B2N8VDISY","B2N8VDISZ", & - "B2N8VINDX","B2N8VINDY","B2N8VREL ","B2N8VUNDX","B2N8VUNDY","B2N8VUNDZ","B2N9ALPHA", & - "B2N9AXIND","B2N9CD ","B2N9CL ","B2N9CLRNC","B2N9CM ","B2N9CN ","B2N9CT ", & - "B2N9CURVE","B2N9CX ","B2N9CY ","B2N9DYNP ","B2N9FD ","B2N9FL ","B2N9FN ", & - "B2N9FT ","B2N9FX ","B2N9FY ","B2N9M ","B2N9MM ","B2N9PHI ","B2N9RE ", & - "B2N9STVX ","B2N9STVY ","B2N9STVZ ","B2N9THETA","B2N9TNIND","B2N9VDISX","B2N9VDISY", & - "B2N9VDISZ","B2N9VINDX","B2N9VINDY","B2N9VREL ","B2N9VUNDX","B2N9VUNDY","B2N9VUNDZ", & - "B2PITCH ","B3AZIMUTH","B3N1ALPHA","B3N1AXIND","B3N1CD ","B3N1CL ","B3N1CLRNC", & - "B3N1CM ","B3N1CN ","B3N1CT ","B3N1CURVE","B3N1CX ","B3N1CY ","B3N1DYNP ", & - "B3N1FD ","B3N1FL ","B3N1FN ","B3N1FT ","B3N1FX ","B3N1FY ","B3N1M ", & - "B3N1MM ","B3N1PHI ","B3N1RE ","B3N1STVX ","B3N1STVY ","B3N1STVZ ","B3N1THETA", & - "B3N1TNIND","B3N1VDISX","B3N1VDISY","B3N1VDISZ","B3N1VINDX","B3N1VINDY","B3N1VREL ", & - "B3N1VUNDX","B3N1VUNDY","B3N1VUNDZ","B3N2ALPHA","B3N2AXIND","B3N2CD ","B3N2CL ", & - "B3N2CLRNC","B3N2CM ","B3N2CN ","B3N2CT ","B3N2CURVE","B3N2CX ","B3N2CY ", & - "B3N2DYNP ","B3N2FD ","B3N2FL ","B3N2FN ","B3N2FT ","B3N2FX ","B3N2FY ", & - "B3N2M ","B3N2MM ","B3N2PHI ","B3N2RE ","B3N2STVX ","B3N2STVY ","B3N2STVZ ", & - "B3N2THETA","B3N2TNIND","B3N2VDISX","B3N2VDISY","B3N2VDISZ","B3N2VINDX","B3N2VINDY", & - "B3N2VREL ","B3N2VUNDX","B3N2VUNDY","B3N2VUNDZ","B3N3ALPHA","B3N3AXIND","B3N3CD ", & - "B3N3CL ","B3N3CLRNC","B3N3CM ","B3N3CN ","B3N3CT ","B3N3CURVE","B3N3CX ", & - "B3N3CY ","B3N3DYNP ","B3N3FD ","B3N3FL ","B3N3FN ","B3N3FT ","B3N3FX ", & - "B3N3FY ","B3N3M ","B3N3MM ","B3N3PHI ","B3N3RE ","B3N3STVX ","B3N3STVY ", & - "B3N3STVZ ","B3N3THETA","B3N3TNIND","B3N3VDISX","B3N3VDISY","B3N3VDISZ","B3N3VINDX", & - "B3N3VINDY","B3N3VREL ","B3N3VUNDX","B3N3VUNDY","B3N3VUNDZ","B3N4ALPHA","B3N4AXIND", & - "B3N4CD ","B3N4CL ","B3N4CLRNC","B3N4CM ","B3N4CN ","B3N4CT ","B3N4CURVE", & - "B3N4CX ","B3N4CY ","B3N4DYNP ","B3N4FD ","B3N4FL ","B3N4FN ","B3N4FT ", & - "B3N4FX ","B3N4FY ","B3N4M ","B3N4MM ","B3N4PHI ","B3N4RE ","B3N4STVX ", & - "B3N4STVY ","B3N4STVZ ","B3N4THETA","B3N4TNIND","B3N4VDISX","B3N4VDISY","B3N4VDISZ", & - "B3N4VINDX","B3N4VINDY","B3N4VREL ","B3N4VUNDX","B3N4VUNDY","B3N4VUNDZ","B3N5ALPHA", & - "B3N5AXIND","B3N5CD ","B3N5CL ","B3N5CLRNC","B3N5CM ","B3N5CN ","B3N5CT ", & - "B3N5CURVE","B3N5CX ","B3N5CY ","B3N5DYNP ","B3N5FD ","B3N5FL ","B3N5FN ", & - "B3N5FT ","B3N5FX ","B3N5FY ","B3N5M ","B3N5MM ","B3N5PHI ","B3N5RE ", & - "B3N5STVX ","B3N5STVY ","B3N5STVZ ","B3N5THETA","B3N5TNIND","B3N5VDISX","B3N5VDISY", & - "B3N5VDISZ","B3N5VINDX","B3N5VINDY","B3N5VREL ","B3N5VUNDX","B3N5VUNDY","B3N5VUNDZ", & - "B3N6ALPHA","B3N6AXIND","B3N6CD ","B3N6CL ","B3N6CLRNC","B3N6CM ","B3N6CN ", & - "B3N6CT ","B3N6CURVE","B3N6CX ","B3N6CY ","B3N6DYNP ","B3N6FD ","B3N6FL ", & - "B3N6FN ","B3N6FT ","B3N6FX ","B3N6FY ","B3N6M ","B3N6MM ","B3N6PHI ", & - "B3N6RE ","B3N6STVX ","B3N6STVY ","B3N6STVZ ","B3N6THETA","B3N6TNIND","B3N6VDISX", & - "B3N6VDISY","B3N6VDISZ","B3N6VINDX","B3N6VINDY","B3N6VREL ","B3N6VUNDX","B3N6VUNDY", & - "B3N6VUNDZ","B3N7ALPHA","B3N7AXIND","B3N7CD ","B3N7CL ","B3N7CLRNC","B3N7CM ", & - "B3N7CN ","B3N7CT ","B3N7CURVE","B3N7CX ","B3N7CY ","B3N7DYNP ","B3N7FD ", & - "B3N7FL ","B3N7FN ","B3N7FT ","B3N7FX ","B3N7FY ","B3N7M ","B3N7MM ", & - "B3N7PHI ","B3N7RE ","B3N7STVX ","B3N7STVY ","B3N7STVZ ","B3N7THETA","B3N7TNIND", & - "B3N7VDISX","B3N7VDISY","B3N7VDISZ","B3N7VINDX","B3N7VINDY","B3N7VREL ","B3N7VUNDX", & - "B3N7VUNDY","B3N7VUNDZ","B3N8ALPHA","B3N8AXIND","B3N8CD ","B3N8CL ","B3N8CLRNC", & - "B3N8CM ","B3N8CN ","B3N8CT ","B3N8CURVE","B3N8CX ","B3N8CY ","B3N8DYNP ", & - "B3N8FD ","B3N8FL ","B3N8FN ","B3N8FT ","B3N8FX ","B3N8FY ","B3N8M ", & - "B3N8MM ","B3N8PHI ","B3N8RE ","B3N8STVX ","B3N8STVY ","B3N8STVZ ","B3N8THETA", & - "B3N8TNIND","B3N8VDISX","B3N8VDISY","B3N8VDISZ","B3N8VINDX","B3N8VINDY","B3N8VREL ", & - "B3N8VUNDX","B3N8VUNDY","B3N8VUNDZ","B3N9ALPHA","B3N9AXIND","B3N9CD ","B3N9CL ", & - "B3N9CLRNC","B3N9CM ","B3N9CN ","B3N9CT ","B3N9CURVE","B3N9CX ","B3N9CY ", & - "B3N9DYNP ","B3N9FD ","B3N9FL ","B3N9FN ","B3N9FT ","B3N9FX ","B3N9FY ", & - "B3N9M ","B3N9MM ","B3N9PHI ","B3N9RE ","B3N9STVX ","B3N9STVY ","B3N9STVZ ", & - "B3N9THETA","B3N9TNIND","B3N9VDISX","B3N9VDISY","B3N9VDISZ","B3N9VINDX","B3N9VINDY", & - "B3N9VREL ","B3N9VUNDX","B3N9VUNDY","B3N9VUNDZ","B3PITCH ","RTAEROCP ","RTAEROCQ ", & - "RTAEROCT ","RTAEROFXH","RTAEROFYH","RTAEROFZH","RTAEROMXH","RTAEROMYH","RTAEROMZH", & - "RTAEROPWR","RTAREA ","RTSKEW ","RTSPEED ","RTTSR ","RTVAVGXH ","RTVAVGYH ", & - "RTVAVGZH ","TWN1DYNP ","TWN1FDX ","TWN1FDY ","TWN1M ","TWN1RE ","TWN1STVX ", & - "TWN1STVY ","TWN1STVZ ","TWN1VREL ","TWN1VUNDX","TWN1VUNDY","TWN1VUNDZ","TWN2DYNP ", & - "TWN2FDX ","TWN2FDY ","TWN2M ","TWN2RE ","TWN2STVX ","TWN2STVY ","TWN2STVZ ", & - "TWN2VREL ","TWN2VUNDX","TWN2VUNDY","TWN2VUNDZ","TWN3DYNP ","TWN3FDX ","TWN3FDY ", & - "TWN3M ","TWN3RE ","TWN3STVX ","TWN3STVY ","TWN3STVZ ","TWN3VREL ","TWN3VUNDX", & - "TWN3VUNDY","TWN3VUNDZ","TWN4DYNP ","TWN4FDX ","TWN4FDY ","TWN4M ","TWN4RE ", & - "TWN4STVX ","TWN4STVY ","TWN4STVZ ","TWN4VREL ","TWN4VUNDX","TWN4VUNDY","TWN4VUNDZ", & - "TWN5DYNP ","TWN5FDX ","TWN5FDY ","TWN5M ","TWN5RE ","TWN5STVX ","TWN5STVY ", & - "TWN5STVZ ","TWN5VREL ","TWN5VUNDX","TWN5VUNDY","TWN5VUNDZ","TWN6DYNP ","TWN6FDX ", & - "TWN6FDY ","TWN6M ","TWN6RE ","TWN6STVX ","TWN6STVY ","TWN6STVZ ","TWN6VREL ", & - "TWN6VUNDX","TWN6VUNDY","TWN6VUNDZ","TWN7DYNP ","TWN7FDX ","TWN7FDY ","TWN7M ", & - "TWN7RE ","TWN7STVX ","TWN7STVY ","TWN7STVZ ","TWN7VREL ","TWN7VUNDX","TWN7VUNDY", & - "TWN7VUNDZ","TWN8DYNP ","TWN8FDX ","TWN8FDY ","TWN8M ","TWN8RE ","TWN8STVX ", & - "TWN8STVY ","TWN8STVZ ","TWN8VREL ","TWN8VUNDX","TWN8VUNDY","TWN8VUNDZ","TWN9DYNP ", & - "TWN9FDX ","TWN9FDY ","TWN9M ","TWN9RE ","TWN9STVX ","TWN9STVY ","TWN9STVZ ", & - "TWN9VREL ","TWN9VUNDX","TWN9VUNDY","TWN9VUNDZ"/) - INTEGER(IntKi), PARAMETER :: ParamIndxAry(1103) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) - B1Azimuth , B1N1Alpha , B1N1AxInd , B1N1Cd , B1N1Cl , B1N1Clrnc , B1N1Cm , & - B1N1Cn , B1N1Ct , B1N1Curve , B1N1Cx , B1N1Cy , B1N1DynP , B1N1Fd , & - B1N1Fl , B1N1Fn , B1N1Ft , B1N1Fx , B1N1Fy , B1N1M , B1N1Mm , & - B1N1Phi , B1N1Re , B1N1STVx , B1N1STVy , B1N1STVz , B1N1Theta , B1N1TnInd , & - B1N1VDisx , B1N1VDisy , B1N1VDisz , B1N1Vindx , B1N1Vindy , B1N1VRel , B1N1VUndx , & - B1N1VUndy , B1N1VUndz , B1N2Alpha , B1N2AxInd , B1N2Cd , B1N2Cl , B1N2Clrnc , & - B1N2Cm , B1N2Cn , B1N2Ct , B1N2Curve , B1N2Cx , B1N2Cy , B1N2DynP , & - B1N2Fd , B1N2Fl , B1N2Fn , B1N2Ft , B1N2Fx , B1N2Fy , B1N2M , & - B1N2Mm , B1N2Phi , B1N2Re , B1N2STVx , B1N2STVy , B1N2STVz , B1N2Theta , & - B1N2TnInd , B1N2VDisx , B1N2VDisy , B1N2VDisz , B1N2Vindx , B1N2Vindy , B1N2VRel , & - B1N2VUndx , B1N2VUndy , B1N2VUndz , B1N3Alpha , B1N3AxInd , B1N3Cd , B1N3Cl , & - B1N3Clrnc , B1N3Cm , B1N3Cn , B1N3Ct , B1N3Curve , B1N3Cx , B1N3Cy , & - B1N3DynP , B1N3Fd , B1N3Fl , B1N3Fn , B1N3Ft , B1N3Fx , B1N3Fy , & - B1N3M , B1N3Mm , B1N3Phi , B1N3Re , B1N3STVx , B1N3STVy , B1N3STVz , & - B1N3Theta , B1N3TnInd , B1N3VDisx , B1N3VDisy , B1N3VDisz , B1N3Vindx , B1N3Vindy , & - B1N3VRel , B1N3VUndx , B1N3VUndy , B1N3VUndz , B1N4Alpha , B1N4AxInd , B1N4Cd , & - B1N4Cl , B1N4Clrnc , B1N4Cm , B1N4Cn , B1N4Ct , B1N4Curve , B1N4Cx , & - B1N4Cy , B1N4DynP , B1N4Fd , B1N4Fl , B1N4Fn , B1N4Ft , B1N4Fx , & - B1N4Fy , B1N4M , B1N4Mm , B1N4Phi , B1N4Re , B1N4STVx , B1N4STVy , & - B1N4STVz , B1N4Theta , B1N4TnInd , B1N4VDisx , B1N4VDisy , B1N4VDisz , B1N4Vindx , & - B1N4Vindy , B1N4VRel , B1N4VUndx , B1N4VUndy , B1N4VUndz , B1N5Alpha , B1N5AxInd , & - B1N5Cd , B1N5Cl , B1N5Clrnc , B1N5Cm , B1N5Cn , B1N5Ct , B1N5Curve , & - B1N5Cx , B1N5Cy , B1N5DynP , B1N5Fd , B1N5Fl , B1N5Fn , B1N5Ft , & - B1N5Fx , B1N5Fy , B1N5M , B1N5Mm , B1N5Phi , B1N5Re , B1N5STVx , & - B1N5STVy , B1N5STVz , B1N5Theta , B1N5TnInd , B1N5VDisx , B1N5VDisy , B1N5VDisz , & - B1N5Vindx , B1N5Vindy , B1N5VRel , B1N5VUndx , B1N5VUndy , B1N5VUndz , B1N6Alpha , & - B1N6AxInd , B1N6Cd , B1N6Cl , B1N6Clrnc , B1N6Cm , B1N6Cn , B1N6Ct , & - B1N6Curve , B1N6Cx , B1N6Cy , B1N6DynP , B1N6Fd , B1N6Fl , B1N6Fn , & - B1N6Ft , B1N6Fx , B1N6Fy , B1N6M , B1N6Mm , B1N6Phi , B1N6Re , & - B1N6STVx , B1N6STVy , B1N6STVz , B1N6Theta , B1N6TnInd , B1N6VDisx , B1N6VDisy , & - B1N6VDisz , B1N6Vindx , B1N6Vindy , B1N6VRel , B1N6VUndx , B1N6VUndy , B1N6VUndz , & - B1N7Alpha , B1N7AxInd , B1N7Cd , B1N7Cl , B1N7Clrnc , B1N7Cm , B1N7Cn , & - B1N7Ct , B1N7Curve , B1N7Cx , B1N7Cy , B1N7DynP , B1N7Fd , B1N7Fl , & - B1N7Fn , B1N7Ft , B1N7Fx , B1N7Fy , B1N7M , B1N7Mm , B1N7Phi , & - B1N7Re , B1N7STVx , B1N7STVy , B1N7STVz , B1N7Theta , B1N7TnInd , B1N7VDisx , & - B1N7VDisy , B1N7VDisz , B1N7Vindx , B1N7Vindy , B1N7VRel , B1N7VUndx , B1N7VUndy , & - B1N7VUndz , B1N8Alpha , B1N8AxInd , B1N8Cd , B1N8Cl , B1N8Clrnc , B1N8Cm , & - B1N8Cn , B1N8Ct , B1N8Curve , B1N8Cx , B1N8Cy , B1N8DynP , B1N8Fd , & - B1N8Fl , B1N8Fn , B1N8Ft , B1N8Fx , B1N8Fy , B1N8M , B1N8Mm , & - B1N8Phi , B1N8Re , B1N8STVx , B1N8STVy , B1N8STVz , B1N8Theta , B1N8TnInd , & - B1N8VDisx , B1N8VDisy , B1N8VDisz , B1N8Vindx , B1N8Vindy , B1N8VRel , B1N8VUndx , & - B1N8VUndy , B1N8VUndz , B1N9Alpha , B1N9AxInd , B1N9Cd , B1N9Cl , B1N9Clrnc , & - B1N9Cm , B1N9Cn , B1N9Ct , B1N9Curve , B1N9Cx , B1N9Cy , B1N9DynP , & - B1N9Fd , B1N9Fl , B1N9Fn , B1N9Ft , B1N9Fx , B1N9Fy , B1N9M , & - B1N9Mm , B1N9Phi , B1N9Re , B1N9STVx , B1N9STVy , B1N9STVz , B1N9Theta , & - B1N9TnInd , B1N9VDisx , B1N9VDisy , B1N9VDisz , B1N9Vindx , B1N9Vindy , B1N9VRel , & - B1N9VUndx , B1N9VUndy , B1N9VUndz , B1Pitch , B2Azimuth , B2N1Alpha , B2N1AxInd , & - B2N1Cd , B2N1Cl , B2N1Clrnc , B2N1Cm , B2N1Cn , B2N1Ct , B2N1Curve , & - B2N1Cx , B2N1Cy , B2N1DynP , B2N1Fd , B2N1Fl , B2N1Fn , B2N1Ft , & - B2N1Fx , B2N1Fy , B2N1M , B2N1Mm , B2N1Phi , B2N1Re , B2N1STVx , & - B2N1STVy , B2N1STVz , B2N1Theta , B2N1TnInd , B2N1VDisx , B2N1VDisy , B2N1VDisz , & - B2N1Vindx , B2N1Vindy , B2N1VRel , B2N1VUndx , B2N1VUndy , B2N1VUndz , B2N2Alpha , & - B2N2AxInd , B2N2Cd , B2N2Cl , B2N2Clrnc , B2N2Cm , B2N2Cn , B2N2Ct , & - B2N2Curve , B2N2Cx , B2N2Cy , B2N2DynP , B2N2Fd , B2N2Fl , B2N2Fn , & - B2N2Ft , B2N2Fx , B2N2Fy , B2N2M , B2N2Mm , B2N2Phi , B2N2Re , & - B2N2STVx , B2N2STVy , B2N2STVz , B2N2Theta , B2N2TnInd , B2N2VDisx , B2N2VDisy , & - B2N2VDisz , B2N2Vindx , B2N2Vindy , B2N2VRel , B2N2VUndx , B2N2VUndy , B2N2VUndz , & - B2N3Alpha , B2N3AxInd , B2N3Cd , B2N3Cl , B2N3Clrnc , B2N3Cm , B2N3Cn , & - B2N3Ct , B2N3Curve , B2N3Cx , B2N3Cy , B2N3DynP , B2N3Fd , B2N3Fl , & - B2N3Fn , B2N3Ft , B2N3Fx , B2N3Fy , B2N3M , B2N3Mm , B2N3Phi , & - B2N3Re , B2N3STVx , B2N3STVy , B2N3STVz , B2N3Theta , B2N3TnInd , B2N3VDisx , & - B2N3VDisy , B2N3VDisz , B2N3Vindx , B2N3Vindy , B2N3VRel , B2N3VUndx , B2N3VUndy , & - B2N3VUndz , B2N4Alpha , B2N4AxInd , B2N4Cd , B2N4Cl , B2N4Clrnc , B2N4Cm , & - B2N4Cn , B2N4Ct , B2N4Curve , B2N4Cx , B2N4Cy , B2N4DynP , B2N4Fd , & - B2N4Fl , B2N4Fn , B2N4Ft , B2N4Fx , B2N4Fy , B2N4M , B2N4Mm , & - B2N4Phi , B2N4Re , B2N4STVx , B2N4STVy , B2N4STVz , B2N4Theta , B2N4TnInd , & - B2N4VDisx , B2N4VDisy , B2N4VDisz , B2N4Vindx , B2N4Vindy , B2N4VRel , B2N4VUndx , & - B2N4VUndy , B2N4VUndz , B2N5Alpha , B2N5AxInd , B2N5Cd , B2N5Cl , B2N5Clrnc , & - B2N5Cm , B2N5Cn , B2N5Ct , B2N5Curve , B2N5Cx , B2N5Cy , B2N5DynP , & - B2N5Fd , B2N5Fl , B2N5Fn , B2N5Ft , B2N5Fx , B2N5Fy , B2N5M , & - B2N5Mm , B2N5Phi , B2N5Re , B2N5STVx , B2N5STVy , B2N5STVz , B2N5Theta , & - B2N5TnInd , B2N5VDisx , B2N5VDisy , B2N5VDisz , B2N5Vindx , B2N5Vindy , B2N5VRel , & - B2N5VUndx , B2N5VUndy , B2N5VUndz , B2N6Alpha , B2N6AxInd , B2N6Cd , B2N6Cl , & - B2N6Clrnc , B2N6Cm , B2N6Cn , B2N6Ct , B2N6Curve , B2N6Cx , B2N6Cy , & - B2N6DynP , B2N6Fd , B2N6Fl , B2N6Fn , B2N6Ft , B2N6Fx , B2N6Fy , & - B2N6M , B2N6Mm , B2N6Phi , B2N6Re , B2N6STVx , B2N6STVy , B2N6STVz , & - B2N6Theta , B2N6TnInd , B2N6VDisx , B2N6VDisy , B2N6VDisz , B2N6Vindx , B2N6Vindy , & - B2N6VRel , B2N6VUndx , B2N6VUndy , B2N6VUndz , B2N7Alpha , B2N7AxInd , B2N7Cd , & - B2N7Cl , B2N7Clrnc , B2N7Cm , B2N7Cn , B2N7Ct , B2N7Curve , B2N7Cx , & - B2N7Cy , B2N7DynP , B2N7Fd , B2N7Fl , B2N7Fn , B2N7Ft , B2N7Fx , & - B2N7Fy , B2N7M , B2N7Mm , B2N7Phi , B2N7Re , B2N7STVx , B2N7STVy , & - B2N7STVz , B2N7Theta , B2N7TnInd , B2N7VDisx , B2N7VDisy , B2N7VDisz , B2N7Vindx , & - B2N7Vindy , B2N7VRel , B2N7VUndx , B2N7VUndy , B2N7VUndz , B2N8Alpha , B2N8AxInd , & - B2N8Cd , B2N8Cl , B2N8Clrnc , B2N8Cm , B2N8Cn , B2N8Ct , B2N8Curve , & - B2N8Cx , B2N8Cy , B2N8DynP , B2N8Fd , B2N8Fl , B2N8Fn , B2N8Ft , & - B2N8Fx , B2N8Fy , B2N8M , B2N8Mm , B2N8Phi , B2N8Re , B2N8STVx , & - B2N8STVy , B2N8STVz , B2N8Theta , B2N8TnInd , B2N8VDisx , B2N8VDisy , B2N8VDisz , & - B2N8Vindx , B2N8Vindy , B2N8VRel , B2N8VUndx , B2N8VUndy , B2N8VUndz , B2N9Alpha , & - B2N9AxInd , B2N9Cd , B2N9Cl , B2N9Clrnc , B2N9Cm , B2N9Cn , B2N9Ct , & - B2N9Curve , B2N9Cx , B2N9Cy , B2N9DynP , B2N9Fd , B2N9Fl , B2N9Fn , & - B2N9Ft , B2N9Fx , B2N9Fy , B2N9M , B2N9Mm , B2N9Phi , B2N9Re , & - B2N9STVx , B2N9STVy , B2N9STVz , B2N9Theta , B2N9TnInd , B2N9VDisx , B2N9VDisy , & - B2N9VDisz , B2N9Vindx , B2N9Vindy , B2N9VRel , B2N9VUndx , B2N9VUndy , B2N9VUndz , & - B2Pitch , B3Azimuth , B3N1Alpha , B3N1AxInd , B3N1Cd , B3N1Cl , B3N1Clrnc , & - B3N1Cm , B3N1Cn , B3N1Ct , B3N1Curve , B3N1Cx , B3N1Cy , B3N1DynP , & - B3N1Fd , B3N1Fl , B3N1Fn , B3N1Ft , B3N1Fx , B3N1Fy , B3N1M , & - B3N1Mm , B3N1Phi , B3N1Re , B3N1STVx , B3N1STVy , B3N1STVz , B3N1Theta , & - B3N1TnInd , B3N1VDisx , B3N1VDisy , B3N1VDisz , B3N1Vindx , B3N1Vindy , B3N1VRel , & - B3N1VUndx , B3N1VUndy , B3N1VUndz , B3N2Alpha , B3N2AxInd , B3N2Cd , B3N2Cl , & - B3N2Clrnc , B3N2Cm , B3N2Cn , B3N2Ct , B3N2Curve , B3N2Cx , B3N2Cy , & - B3N2DynP , B3N2Fd , B3N2Fl , B3N2Fn , B3N2Ft , B3N2Fx , B3N2Fy , & - B3N2M , B3N2Mm , B3N2Phi , B3N2Re , B3N2STVx , B3N2STVy , B3N2STVz , & - B3N2Theta , B3N2TnInd , B3N2VDisx , B3N2VDisy , B3N2VDisz , B3N2Vindx , B3N2Vindy , & - B3N2VRel , B3N2VUndx , B3N2VUndy , B3N2VUndz , B3N3Alpha , B3N3AxInd , B3N3Cd , & - B3N3Cl , B3N3Clrnc , B3N3Cm , B3N3Cn , B3N3Ct , B3N3Curve , B3N3Cx , & - B3N3Cy , B3N3DynP , B3N3Fd , B3N3Fl , B3N3Fn , B3N3Ft , B3N3Fx , & - B3N3Fy , B3N3M , B3N3Mm , B3N3Phi , B3N3Re , B3N3STVx , B3N3STVy , & - B3N3STVz , B3N3Theta , B3N3TnInd , B3N3VDisx , B3N3VDisy , B3N3VDisz , B3N3Vindx , & - B3N3Vindy , B3N3VRel , B3N3VUndx , B3N3VUndy , B3N3VUndz , B3N4Alpha , B3N4AxInd , & - B3N4Cd , B3N4Cl , B3N4Clrnc , B3N4Cm , B3N4Cn , B3N4Ct , B3N4Curve , & - B3N4Cx , B3N4Cy , B3N4DynP , B3N4Fd , B3N4Fl , B3N4Fn , B3N4Ft , & - B3N4Fx , B3N4Fy , B3N4M , B3N4Mm , B3N4Phi , B3N4Re , B3N4STVx , & - B3N4STVy , B3N4STVz , B3N4Theta , B3N4TnInd , B3N4VDisx , B3N4VDisy , B3N4VDisz , & - B3N4Vindx , B3N4Vindy , B3N4VRel , B3N4VUndx , B3N4VUndy , B3N4VUndz , B3N5Alpha , & - B3N5AxInd , B3N5Cd , B3N5Cl , B3N5Clrnc , B3N5Cm , B3N5Cn , B3N5Ct , & - B3N5Curve , B3N5Cx , B3N5Cy , B3N5DynP , B3N5Fd , B3N5Fl , B3N5Fn , & - B3N5Ft , B3N5Fx , B3N5Fy , B3N5M , B3N5Mm , B3N5Phi , B3N5Re , & - B3N5STVx , B3N5STVy , B3N5STVz , B3N5Theta , B3N5TnInd , B3N5VDisx , B3N5VDisy , & - B3N5VDisz , B3N5Vindx , B3N5Vindy , B3N5VRel , B3N5VUndx , B3N5VUndy , B3N5VUndz , & - B3N6Alpha , B3N6AxInd , B3N6Cd , B3N6Cl , B3N6Clrnc , B3N6Cm , B3N6Cn , & - B3N6Ct , B3N6Curve , B3N6Cx , B3N6Cy , B3N6DynP , B3N6Fd , B3N6Fl , & - B3N6Fn , B3N6Ft , B3N6Fx , B3N6Fy , B3N6M , B3N6Mm , B3N6Phi , & - B3N6Re , B3N6STVx , B3N6STVy , B3N6STVz , B3N6Theta , B3N6TnInd , B3N6VDisx , & - B3N6VDisy , B3N6VDisz , B3N6Vindx , B3N6Vindy , B3N6VRel , B3N6VUndx , B3N6VUndy , & - B3N6VUndz , B3N7Alpha , B3N7AxInd , B3N7Cd , B3N7Cl , B3N7Clrnc , B3N7Cm , & - B3N7Cn , B3N7Ct , B3N7Curve , B3N7Cx , B3N7Cy , B3N7DynP , B3N7Fd , & - B3N7Fl , B3N7Fn , B3N7Ft , B3N7Fx , B3N7Fy , B3N7M , B3N7Mm , & - B3N7Phi , B3N7Re , B3N7STVx , B3N7STVy , B3N7STVz , B3N7Theta , B3N7TnInd , & - B3N7VDisx , B3N7VDisy , B3N7VDisz , B3N7Vindx , B3N7Vindy , B3N7VRel , B3N7VUndx , & - B3N7VUndy , B3N7VUndz , B3N8Alpha , B3N8AxInd , B3N8Cd , B3N8Cl , B3N8Clrnc , & - B3N8Cm , B3N8Cn , B3N8Ct , B3N8Curve , B3N8Cx , B3N8Cy , B3N8DynP , & - B3N8Fd , B3N8Fl , B3N8Fn , B3N8Ft , B3N8Fx , B3N8Fy , B3N8M , & - B3N8Mm , B3N8Phi , B3N8Re , B3N8STVx , B3N8STVy , B3N8STVz , B3N8Theta , & - B3N8TnInd , B3N8VDisx , B3N8VDisy , B3N8VDisz , B3N8Vindx , B3N8Vindy , B3N8VRel , & - B3N8VUndx , B3N8VUndy , B3N8VUndz , B3N9Alpha , B3N9AxInd , B3N9Cd , B3N9Cl , & - B3N9Clrnc , B3N9Cm , B3N9Cn , B3N9Ct , B3N9Curve , B3N9Cx , B3N9Cy , & - B3N9DynP , B3N9Fd , B3N9Fl , B3N9Fn , B3N9Ft , B3N9Fx , B3N9Fy , & - B3N9M , B3N9Mm , B3N9Phi , B3N9Re , B3N9STVx , B3N9STVy , B3N9STVz , & - B3N9Theta , B3N9TnInd , B3N9VDisx , B3N9VDisy , B3N9VDisz , B3N9Vindx , B3N9Vindy , & - B3N9VRel , B3N9VUndx , B3N9VUndy , B3N9VUndz , B3Pitch , RtAeroCp , RtAeroCq , & - RtAeroCt , RtAeroFxh , RtAeroFyh , RtAeroFzh , RtAeroMxh , RtAeroMyh , RtAeroMzh , & - RtAeroPwr , RtArea , RtSkew , RtSpeed , RtTSR , RtVAvgxh , RtVAvgyh , & - RtVAvgzh , TwN1DynP , TwN1Fdx , TwN1Fdy , TwN1M , TwN1Re , TwN1STVx , & - TwN1STVy , TwN1STVz , TwN1Vrel , TwN1VUndx , TwN1VUndy , TwN1VUndz , TwN2DynP , & - TwN2Fdx , TwN2Fdy , TwN2M , TwN2Re , TwN2STVx , TwN2STVy , TwN2STVz , & - TwN2Vrel , TwN2VUndx , TwN2VUndy , TwN2VUndz , TwN3DynP , TwN3Fdx , TwN3Fdy , & - TwN3M , TwN3Re , TwN3STVx , TwN3STVy , TwN3STVz , TwN3Vrel , TwN3VUndx , & - TwN3VUndy , TwN3VUndz , TwN4DynP , TwN4Fdx , TwN4Fdy , TwN4M , TwN4Re , & - TwN4STVx , TwN4STVy , TwN4STVz , TwN4Vrel , TwN4VUndx , TwN4VUndy , TwN4VUndz , & - TwN5DynP , TwN5Fdx , TwN5Fdy , TwN5M , TwN5Re , TwN5STVx , TwN5STVy , & - TwN5STVz , TwN5Vrel , TwN5VUndx , TwN5VUndy , TwN5VUndz , TwN6DynP , TwN6Fdx , & - TwN6Fdy , TwN6M , TwN6Re , TwN6STVx , TwN6STVy , TwN6STVz , TwN6Vrel , & - TwN6VUndx , TwN6VUndy , TwN6VUndz , TwN7DynP , TwN7Fdx , TwN7Fdy , TwN7M , & - TwN7Re , TwN7STVx , TwN7STVy , TwN7STVz , TwN7Vrel , TwN7VUndx , TwN7VUndy , & - TwN7VUndz , TwN8DynP , TwN8Fdx , TwN8Fdy , TwN8M , TwN8Re , TwN8STVx , & - TwN8STVy , TwN8STVz , TwN8Vrel , TwN8VUndx , TwN8VUndy , TwN8VUndz , TwN9DynP , & - TwN9Fdx , TwN9Fdy , TwN9M , TwN9Re , TwN9STVx , TwN9STVy , TwN9STVz , & - TwN9Vrel , TwN9VUndx , TwN9VUndy , TwN9VUndz /) - CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(1103) = (/ & ! This lists the units corresponding to the allowed parameters - "(deg) ","(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ", & - "(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ", & - "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ", & - "(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ", & - "(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ", & - "(m) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ", & - "(-) ","(m) ","(-) ","(-) ","(-) ","(deg) ","(-) ", & - "(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(-) ","(-) ","(m) ","(-) ","(-) ","(-) ","(deg) ", & - "(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(-) ","(-) ","(m) ","(-) ","(-) ","(-) ", & - "(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ","(-) ", & - "(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ", & - "(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ", & - "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ", & - "(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ", & - "(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(deg) ","(deg) ","(-) ", & - "(-) ","(-) ","(m) ","(-) ","(-) ","(-) ","(deg) ", & - "(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(-) ","(-) ","(m) ","(-) ","(-) ","(-) ", & - "(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ","(-) ", & - "(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ", & - "(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ", & - "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ", & - "(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ", & - "(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ", & - "(m) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ", & - "(-) ","(m) ","(-) ","(-) ","(-) ","(deg) ","(-) ", & - "(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(-) ","(-) ","(m) ","(-) ","(-) ","(-) ","(deg) ", & - "(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(-) ","(-) ","(m) ","(-) ","(-) ","(-) ", & - "(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(deg) ","(deg) ","(deg) ","(-) ","(-) ","(-) ","(m) ", & - "(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ", & - "(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ", & - "(m) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ", & - "(-) ","(m) ","(-) ","(-) ","(-) ","(deg) ","(-) ", & - "(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(-) ","(-) ","(m) ","(-) ","(-) ","(-) ","(deg) ", & - "(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(-) ","(-) ","(m) ","(-) ","(-) ","(-) ", & - "(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ","(-) ", & - "(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ","(deg) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ","(-) ", & - "(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ","(N/m) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ","(N·m/m) ", & - "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ","(m) ", & - "(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ", & - "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(-) ", & - "(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(deg) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ","(-) ", & - "(m) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ", & - "(Pa) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ", & - "(-) ","(N·m/m) ","(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(deg) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg) ","(-) ","(-) ", & - "(-) ","(N) ","(N) ","(N) ","(N·m) ","(N·m) ","(N·m) ", & - "(W) ","(m^2) ","(deg) ","(rpm) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(Pa) ","(N/m) ","(N/m) ","(-) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(Pa) ", & - "(N/m) ","(N/m) ","(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(Pa) ","(N/m) ","(N/m) ", & - "(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(Pa) ","(N/m) ","(N/m) ","(-) ","(-) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(Pa) ","(N/m) ","(N/m) ","(-) ","(-) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(Pa) ","(N/m) ", & - "(N/m) ","(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(Pa) ","(N/m) ","(N/m) ","(-) ", & - "(-) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(Pa) ","(N/m) ","(N/m) ","(-) ","(-) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(Pa) ", & - "(N/m) ","(N/m) ","(-) ","(-) ","(m/s) ","(m/s) ","(m/s) ", & - "(m/s) ","(m/s) ","(m/s) ","(m/s) "/) - - - ! Initialize values - ErrStat = ErrID_None - ErrMsg = "" - InvalidOutput = .FALSE. - - -! ..... Developer must add checking for invalid inputs here: ..... - !bjj: do we want to avoid outputting this if we haven't used tower aero? - - if ( p%TwrPotent == TwrPotent_none .and. .not. p%TwrShadow ) then - - ! BNClrnc is set only when we're computing the tower influence - do I = 1,MaxBl ! all blades (need to do this in a loop because we need the index of InvalidOutput to be an array of rank one) - InvalidOutput( BNClrnc(:,i) ) = .true. - end do - - end if - - - DO i = p%NTwOuts+1,9 ! Invalid tower nodes - - InvalidOutput( TwNVUnd(:,i) ) = .true. - InvalidOutput( TwNSTV( :,i) ) = .true. - InvalidOutput( TwNVRel( i) ) = .true. - InvalidOutput( TwNDynP( i) ) = .true. - InvalidOutput( TwNRe( i) ) = .true. - InvalidOutput( TwNM( i) ) = .true. - InvalidOutput( TwNFdx( i) ) = .true. - InvalidOutput( TwNFdy( i) ) = .true. - - END DO - - DO I = p%NumBlades+1,MaxBl ! Invalid blades - - InvalidOutput( BAzimuth( i) ) = .true. - InvalidOutput( BPitch( i) ) = .true. - InvalidOutput( BNVUndx(:,i) ) = .true. - InvalidOutput( BNVUndy(:,i) ) = .true. - InvalidOutput( BNVUndz(:,i) ) = .true. - InvalidOutput( BNVDisx(:,i) ) = .true. - InvalidOutput( BNVDisy(:,i) ) = .true. - InvalidOutput( BNVDisz(:,i) ) = .true. - InvalidOutput( BNSTVx( :,i) ) = .true. - InvalidOutput( BNSTVy( :,i) ) = .true. - InvalidOutput( BNSTVz( :,i) ) = .true. - InvalidOutput( BNVRel( :,i) ) = .true. - InvalidOutput( BNDynP( :,i) ) = .true. - InvalidOutput( BNRe( :,i) ) = .true. - InvalidOutput( BNM( :,i) ) = .true. - InvalidOutput( BNVIndx(:,i) ) = .true. - InvalidOutput( BNVIndy(:,i) ) = .true. - InvalidOutput( BNAxInd(:,i) ) = .true. - InvalidOutput( BNTnInd(:,i) ) = .true. - InvalidOutput( BNAlpha(:,i) ) = .true. - InvalidOutput( BNTheta(:,i) ) = .true. - InvalidOutput( BNPhi( :,i) ) = .true. - InvalidOutput( BNCurve(:,i) ) = .true. - InvalidOutput( BNCl( :,i) ) = .true. - InvalidOutput( BNCd( :,i) ) = .true. - InvalidOutput( BNCm( :,i) ) = .true. - InvalidOutput( BNCx( :,i) ) = .true. - InvalidOutput( BNCy( :,i) ) = .true. - InvalidOutput( BNCn( :,i) ) = .true. - InvalidOutput( BNCt( :,i) ) = .true. - InvalidOutput( BNFl( :,i) ) = .true. - InvalidOutput( BNFd( :,i) ) = .true. - InvalidOutput( BNMm( :,i) ) = .true. - InvalidOutput( BNFx( :,i) ) = .true. - InvalidOutput( BNFy( :,i) ) = .true. - InvalidOutput( BNFn( :,i) ) = .true. - InvalidOutput( BNFt( :,i) ) = .true. - InvalidOutput( BNClrnc(:,i) ) = .true. - - END DO - - DO I = p%NBlOuts+1,9 ! Invalid blade nodes - - InvalidOutput( BNVUndx(i,:) ) = .true. - InvalidOutput( BNVUndy(i,:) ) = .true. - InvalidOutput( BNVUndz(i,:) ) = .true. - InvalidOutput( BNVDisx(i,:) ) = .true. - InvalidOutput( BNVDisy(i,:) ) = .true. - InvalidOutput( BNVDisz(i,:) ) = .true. - InvalidOutput( BNSTVx( i,:) ) = .true. - InvalidOutput( BNSTVy( i,:) ) = .true. - InvalidOutput( BNSTVz( i,:) ) = .true. - InvalidOutput( BNVRel( i,:) ) = .true. - InvalidOutput( BNDynP( i,:) ) = .true. - InvalidOutput( BNRe( i,:) ) = .true. - InvalidOutput( BNM( i,:) ) = .true. - InvalidOutput( BNVIndx(i,:) ) = .true. - InvalidOutput( BNVIndy(i,:) ) = .true. - InvalidOutput( BNAxInd(i,:) ) = .true. - InvalidOutput( BNTnInd(i,:) ) = .true. - InvalidOutput( BNAlpha(i,:) ) = .true. - InvalidOutput( BNTheta(i,:) ) = .true. - InvalidOutput( BNPhi( i,:) ) = .true. - InvalidOutput( BNCurve(i,:) ) = .true. - InvalidOutput( BNCl( i,:) ) = .true. - InvalidOutput( BNCd( i,:) ) = .true. - InvalidOutput( BNCm( i,:) ) = .true. - InvalidOutput( BNCx( i,:) ) = .true. - InvalidOutput( BNCy( i,:) ) = .true. - InvalidOutput( BNCn( i,:) ) = .true. - InvalidOutput( BNCt( i,:) ) = .true. - InvalidOutput( BNFl( i,:) ) = .true. - InvalidOutput( BNFd( i,:) ) = .true. - InvalidOutput( BNMm( i,:) ) = .true. - InvalidOutput( BNFx( i,:) ) = .true. - InvalidOutput( BNFy( i,:) ) = .true. - InvalidOutput( BNFn( i,:) ) = .true. - InvalidOutput( BNFt( i,:) ) = .true. - InvalidOutput( BNClrnc(i,:) ) = .true. - - END DO - -! ................. End of validity checking ................. - - - !------------------------------------------------------------------------------------------------- - ! Allocate and set index, name, and units for the output channels - ! If a selected output channel is not available in this module, set error flag. - !------------------------------------------------------------------------------------------------- - - ALLOCATE ( p%OutParam(0:p%NumOuts) , STAT=ErrStat2 ) - IF ( ErrStat2 /= 0_IntKi ) THEN - CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the AeroDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) - RETURN - ENDIF - - ! Set index, name, and units for the time output channel: - - p%OutParam(0)%Indx = Time - p%OutParam(0)%Name = "Time" ! OutParam(0) is the time channel by default. - p%OutParam(0)%Units = "(s)" - p%OutParam(0)%SignM = 1 - - - ! Set index, name, and units for all of the output channels. - ! If a selected output channel is not available by this module set ErrStat = ErrID_Warn. - - DO I = 1,p%NumOuts - - p%OutParam(I)%Name = OutList(I) - OutListTmp = OutList(I) - - ! Reverse the sign (+/-) of the output channel if the user prefixed the - ! channel name with a "-", "_", "m", or "M" character indicating "minus". - - - CheckOutListAgain = .FALSE. - - IF ( INDEX( "-_", OutListTmp(1:1) ) > 0 ) THEN - p%OutParam(I)%SignM = -1 ! ex, "-TipDxc1" causes the sign of TipDxc1 to be switched. - OutListTmp = OutListTmp(2:) - ELSE IF ( INDEX( "mM", OutListTmp(1:1) ) > 0 ) THEN ! We'll assume this is a variable name for now, (if not, we will check later if OutListTmp(2:) is also a variable name) - CheckOutListAgain = .TRUE. - p%OutParam(I)%SignM = 1 - ELSE - p%OutParam(I)%SignM = 1 - END IF - - CALL Conv2UC( OutListTmp ) ! Convert OutListTmp to upper case - - - Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) - - - ! If it started with an "M" (CheckOutListAgain) we didn't find the value in our list (Indx < 1) - - IF ( CheckOutListAgain .AND. Indx < 1 ) THEN ! Let's assume that "M" really meant "minus" and then test again - p%OutParam(I)%SignM = -1 ! ex, "MTipDxc1" causes the sign of TipDxc1 to be switched. - OutListTmp = OutListTmp(2:) - - Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) - END IF - - - IF ( Indx > 0 ) THEN ! we found the channel name - p%OutParam(I)%Indx = ParamIndxAry(Indx) - IF ( InvalidOutput( ParamIndxAry(Indx) ) ) THEN ! but, it isn't valid for these settings - p%OutParam(I)%Units = "INVALID" - p%OutParam(I)%SignM = 0 - ELSE - p%OutParam(I)%Units = ParamUnitsAry(Indx) ! it's a valid output - END IF - ELSE ! this channel isn't valid - p%OutParam(I)%Indx = Time ! pick any valid channel (I just picked "Time" here because it's universal) - p%OutParam(I)%Units = "INVALID" - p%OutParam(I)%SignM = 0 ! multiply all results by zero - - CALL SetErrStat(ErrID_Fatal, TRIM(p%OutParam(I)%Name)//" is not an available output channel.",ErrStat,ErrMsg,RoutineName) - END IF - - END DO - - RETURN -END SUBROUTINE SetOutParam -!---------------------------------------------------------------------------------------------------------------------------------- -!End of code generated by Matlab script -!********************************************************************************************************************************** - - - -END MODULE AeroDyn_IO diff --git a/modules/aerodyn/AeroDynF8_Emre/AeroDyn_Registry.txt b/modules/aerodyn/AeroDynF8_Emre/AeroDyn_Registry.txt deleted file mode 100644 index 08e2d9f58..000000000 --- a/modules/aerodyn/AeroDynF8_Emre/AeroDyn_Registry.txt +++ /dev/null @@ -1,195 +0,0 @@ -################################################################################################################################### -# Registry for AeroDyn 15 in the FAST Modularization Framework -# This Registry file is used to create AeroDyn_Types which contains data used in the AeroDyn module. -# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. -# See the NWTC Programmer's Handbook for further information on the format/contents of this file. -# -# Entries are of the form -# -# -# Use ^ as a shortcut for the value in the same column from the previous line. -################################################################################################################################### -# File last committed $Date$ -# (File) Revision #: $Rev$ -# URL: $HeadURL$ -################################################################################################################################### -# ...... Include files (definitions from NWTC Library) ............................................................................ -include Registry_NWTC_Library.txt -usefrom AirfoilInfo_Registry.txt -usefrom BEMT_Registry.txt -usefrom UnsteadyAero_Registry.txt -usefrom AeroAcoustics_Registry.txt - -# ..... Initialization data ....................................................................................................... -# Define inputs that the initialization routine may need here: -typedef AeroDyn/AD InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - -typedef ^ InitInputType Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - -typedef ^ InitInputType IntKi NumBlades - - - "Number of blades on the turbine" -typedef ^ InitInputType CHARACTER(1024) RootName - - - "RootName for writing output files" - -typedef ^ InitInputType ReKi HubPosition {3} - - "X-Y-Z reference position of hub" m -typedef ^ InitInputType R8Ki HubOrientation {3}{3} - - "DCM reference orientation of hub" - -typedef ^ InitInputType ReKi BladeRootPosition {:}{:} - - "X-Y-Z reference position of each blade root (3 x NumBlades)" m -typedef ^ InitInputType R8Ki BladeRootOrientation {:}{:}{:} - - "DCM reference orientation of blade roots (3x3 x NumBlades)" - - -# Define outputs from the initialization routine here: -typedef ^ AD_BladeShape SiKi AirfoilCoords {:}{:}{:} - - "x-y coordinates for airfoils, relative to node" m -# Define outputs from the initialization routine here: -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - -typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - -typedef ^ InitOutputType ReKi AirDens - - - "Air density" kg/m^3 -typedef ^ InitOutputType AD_BladeShape BladeShape {:} - - "airfoil coordinates for each blade" m -typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - -typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_z {:} - - "Names of the constraint states used in linearization" - -typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - -typedef ^ InitOutputType LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - -typedef ^ InitOutputType LOGICAL RotFrame_z {:} - - "Flag that tells FAST/MBC3 if the constraint states used in linearization are in the rotating frame (not used for glue)" - -typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - - -# ..... Input file data ........................................................................................................... -# This is data defined in the Input File for this module (or could otherwise be passed in) -# ..... Blade Input file data ..................................................................................................... -typedef ^ AD_BladePropsType IntKi NumBlNds - - - "Number of blade nodes used in the analysis" - -typedef ^ AD_BladePropsType ReKi BlSpn {:} - - "Span at blade node" m -typedef ^ AD_BladePropsType ReKi BlCrvAC {:} - - "Curve at blade node" m -typedef ^ AD_BladePropsType ReKi BlSwpAC {:} - - "Sweep at blade node" m -typedef ^ AD_BladePropsType ReKi BlCrvAng {:} - - "Curve angle at blade node" radians -typedef ^ AD_BladePropsType ReKi BlTwist {:} - - "Twist at blade node" radians -typedef ^ AD_BladePropsType ReKi BlChord {:} - - "Chord at blade node" m -typedef ^ AD_BladePropsType IntKi BlAFID {:} - - "ID of Airfoil at blade node" - - -# ..... Primary Input file data ................................................................................................... -typedef ^ AD_InputFile DbKi DTAero - - - "Time interval for aerodynamic calculations {or "default"}" s -typedef ^ AD_InputFile IntKi WakeMod - - - "Type of wake/induction model {0=none, 1=BEMT}" - -typedef ^ AD_InputFile IntKi AFAeroMod - - - "Type of blade airfoil aerodynamics model {1=steady model, 2=Beddoes-Leishman unsteady model}" - -typedef ^ AD_InputFile IntKi TwrPotent - - - "Type tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - -typedef ^ AD_InputFile LOGICAL TwrShadow - - - "Calculate tower influence on wind based on downstream tower shadow?" - -typedef ^ AD_InputFile LOGICAL TwrAero - - - "Calculate tower aerodynamic loads?" flag -typedef ^ AD_InputFile Logical FrozenWake - - - "Flag that tells this module it should assume a frozen wake during linearization." - -typedef ^ AD_InputFile Logical CompAA - - - "Compute AeroAcoustic noise" flag -typedef ^ AD_InputFile CHARACTER(1024) AA_InputFile - - - "AeroAcoustics input file name" "quoted strings" -typedef ^ AD_InputFile ReKi AirDens - - - "Air density" kg/m^3 -typedef ^ AD_InputFile ReKi KinVisc - - - "Kinematic air viscosity" m^2/s -typedef ^ AD_InputFile ReKi SpdSound - - - "Speed of sound" m/s -typedef ^ AD_InputFile IntKi SkewMod - - - "Type of skewed-wake correction model {1=uncoupled, 2=Pitt/Peters, 3=coupled} [used only when WakeMod=1]" - -typedef ^ AD_InputFile LOGICAL TipLoss - - - "Use the Prandtl tip-loss model? [used only when WakeMod=1]" flag -typedef ^ AD_InputFile LOGICAL HubLoss - - - "Use the Prandtl hub-loss model? [used only when WakeMod=1]" flag -typedef ^ AD_InputFile LOGICAL TanInd - - - "Include tangential induction in BEMT calculations? [used only when WakeMod=1]" flag -typedef ^ AD_InputFile LOGICAL AIDrag - - - "Include the drag term in the axial-induction calculation? [used only when WakeMod=1]" flag -typedef ^ AD_InputFile LOGICAL TIDrag - - - "Include the drag term in the tangential-induction calculation? [used only when WakeMod=1 and TanInd=TRUE]" flag -typedef ^ AD_InputFile ReKi IndToler - - - "Convergence tolerance for BEM induction factors [used only when WakeMod=1]" - -typedef ^ AD_InputFile ReKi MaxIter - - - "Maximum number of iteration steps [used only when WakeMod=1]" - -typedef ^ AD_InputFile IntKi UAMod - - - "Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAreoMod=2]" - -typedef ^ AD_InputFile LOGICAL FLookup - - - "Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAreoMod=2]" flag -typedef ^ AD_InputFile ReKi InCol_Alfa - - - "The column in the airfoil tables that contains the angle of attack" - -typedef ^ AD_InputFile ReKi InCol_Cl - - - "The column in the airfoil tables that contains the lift coefficient" - -typedef ^ AD_InputFile ReKi InCol_Cd - - - "The column in the airfoil tables that contains the drag coefficient" - -typedef ^ AD_InputFile ReKi InCol_Cm - - - "The column in the airfoil tables that contains the pitching-moment coefficient; use zero if there is no Cm column" - -typedef ^ AD_InputFile ReKi InCol_Cpmin - - - "The column in the airfoil tables that contains the drag coefficient; use zero if there is no Cpmin column" - -typedef ^ AD_InputFile IntKi NumAFfiles - - - "Number of airfoil files used" - -typedef ^ AD_InputFile CHARACTER(1024) AFNames {:} - - "Airfoil file names (NumAF lines)" "quoted strings" -typedef ^ AD_InputFile LOGICAL UseBlCm - - - "Include aerodynamic pitching moment in calculations?" flag -#typedef ^ AD_InputFile IntKi NumBlNds - - - "Number of blade nodes used in the analysis" - -typedef ^ AD_InputFile AD_BladePropsType BladeProps {:} - - "blade property information from blade input files" - -typedef ^ AD_InputFile IntKi NumTwrNds - - - "Number of tower nodes used in the analysis" - -typedef ^ AD_InputFile ReKi TwrElev {:} - - "Elevation at tower node" m -typedef ^ AD_InputFile ReKi TwrDiam {:} - - "Diameter of tower at node" m -typedef ^ AD_InputFile ReKi TwrCd {:} - - "Coefficient of drag at tower node" - -typedef ^ AD_InputFile LOGICAL SumPrint - - - "Generate a summary file listing input options and interpolated properties to ".AD.sum"?" flag -typedef ^ AD_InputFile IntKi NBlOuts - - - "Number of blade node outputs [0 - 9]" - -typedef ^ AD_InputFile IntKi BlOutNd {9} - - "Blade nodes whose values will be output" - -typedef ^ AD_InputFile IntKi NTwOuts - - - "Number of tower node outputs [0 - 9]" - -typedef ^ AD_InputFile IntKi TwOutNd {9} - - "Tower nodes whose values will be output" - -typedef ^ AD_InputFile IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ AD_InputFile CHARACTER(ChanLen) OutList {:} - - "List of user-requested output channels" - - -# ..... States .................................................................................................................... -# Define continuous (differentiable) states here: -typedef ^ ContinuousStateType BEMT_ContinuousStateType BEMT - - - "Continuous states from the BEMT module" - -typedef ^ ContinuousStateType AA_ContinuousStateType AA - - - "Continuous states from the AA module" - - -# Define discrete (nondifferentiable) states here: -typedef ^ DiscreteStateType BEMT_DiscreteStateType BEMT - - - "Discrete states from the BEMT module" - -typedef ^ DiscreteStateType AA_DiscreteStateType AA - - - "Discrete states from the AA module" - - -# Define constraint states here: -typedef ^ ConstraintStateType BEMT_ConstraintStateType BEMT - - - "Constraint states from the BEMT module" - -typedef ^ ConstraintStateType AA_ConstraintStateType AA - - - "Constraint states from the AA module" - - -# Define "other" states here: -typedef ^ OtherStateType BEMT_OtherStateType BEMT - - - "OtherStates from the BEMT module" - -typedef ^ OtherStateType AA_OtherStateType AA - - - "OtherStates from the AA module" - - -# Define misc/optimization variables (any data that are not considered actual states) here: -typedef ^ MiscVarType BEMT_MiscVarType BEMT - - - "MiscVars from the BEMT module" - -typedef ^ MiscVarType BEMT_OutputType BEMT_y - - - "Outputs from the BEMT module" - -typedef ^ MiscVarType BEMT_InputType BEMT_u 2 - - "Inputs to the BEMT module" - -typedef ^ MiscVarType AA_MiscVarType AA - - - "MiscVars from the AA module" - -typedef ^ MiscVarType AA_OutputType AA_y - - - "Outputs from the AA module" - -typedef ^ MiscVarType AA_InputType AA_u - - - "Inputs to the AA module" - - -typedef ^ MiscVarType ReKi DisturbedInflow {:}{:}{:} - - "InflowOnBlade values modified by tower influence" m/s -typedef ^ MiscVarType ReKi WithoutSweepPitchTwist {:}{:}{:}{:} - - "Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles" - -typedef ^ MiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" - -typedef ^ MiscVarType ReKi W_Twr {:} - - "relative wind speed normal to the tower at node j" m/s -typedef ^ MiscVarType ReKi X_Twr {:} - - "local x-component of force per unit length of the jth node in the tower" m/s -typedef ^ MiscVarType ReKi Y_Twr {:} - - "local y-component of force per unit length of the jth node in the tower" m/s -typedef ^ MiscVarType ReKi Curve {:}{:} - - "curvature angle, saved for possible output to file" rad -typedef ^ MiscVarType ReKi TwrClrnc {:}{:} - - "Distance between tower (including tower radius) and blade node (not including blade width), saved for possible output to file" m -typedef ^ MiscVarType ReKi X {:}{:} - - "normal force per unit length (normal to the plane, not chord) of the jth node in the kth blade" N/m -typedef ^ MiscVarType ReKi Y {:}{:} - - "tangential force per unit length (tangential to the plane, not chord) of the jth node in the kth blade" N/m -typedef ^ MiscVarType ReKi M {:}{:} - - "pitching moment per unit length of the jth node in the kth blade" Nm/m -typedef ^ MiscVarType ReKi V_DiskAvg {3} - - "disk-average relative wind speed" m/s -typedef ^ MiscVarType ReKi V_dot_x - - - -typedef ^ MiscVarType 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)" - -typedef ^ MiscVarType MeshMapType B_L_2_H_P {:} - - "mapping data structure to map each bladeLoad output mesh to the MiscVar%HubLoad mesh" - -# ..... Parameters ................................................................................................................ -# Define parameters here: -# Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: -typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds -typedef ^ ParameterType IntKi WakeMod - - - "Type of wake/induction model {0=none, 1=BEMT}" - -typedef ^ ParameterType IntKi TwrPotent - - - "Type tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - -typedef ^ ParameterType LOGICAL TwrShadow - - - "Calculate tower influence on wind based on downstream tower shadow?" - -typedef ^ ParameterType LOGICAL TwrAero - - - "Calculate tower aerodynamic loads?" flag -typedef ^ ParameterType Logical FrozenWake - - - "Flag that tells this module it should assume a frozen wake during linearization." - -typedef ^ ParameterType Logical CompAA - - - "Compute AeroAcoustic noise" flag -typedef ^ ParameterType IntKi NumBlades - - - "Number of blades on the turbine" - -typedef ^ ParameterType IntKi NumBlNds - - - "Number of nodes on each blade" - -typedef ^ ParameterType IntKi NumTwrNds - - - "Number of nodes on the tower" - -typedef ^ ParameterType ReKi TwrDiam {:} - - "Diameter of tower at node" m -typedef ^ ParameterType ReKi TwrCd {:} - - "Coefficient of drag at tower node" - -typedef ^ ParameterType ReKi AirDens - - - "Air density" kg/m^3 -typedef ^ ParameterType ReKi KinVisc - - - "Kinematic air viscosity" m^2/s -typedef ^ ParameterType ReKi SpdSound - - - "Speed of sound" m/s -typedef ^ ParameterType AFI_ParameterType AFI - - - "AirfoilInfo parameters" -typedef ^ ParameterType BEMT_ParameterType BEMT - - - "Parameters for BEMT module" -typedef ^ ParameterType AA_ParameterType AA - - - "Parameters for AA module" -# parameters for output -typedef ^ ParameterType IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ ParameterType CHARACTER(1024) RootName - - - "RootName for writing output files" - -typedef ^ ParameterType OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - -typedef ^ ParameterType IntKi NBlOuts - - - "Number of blade node outputs [0 - 9]" - -typedef ^ ParameterType IntKi BlOutNd {9} - - "Blade nodes whose values will be output" - -typedef ^ ParameterType IntKi NTwOuts - - - "Number of tower node outputs [0 - 9]" - -typedef ^ ParameterType IntKi TwOutNd {9} - - "Tower nodes whose values will be output" - -typedef ^ ParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - -typedef ^ ParameterType ReKi du {:} - - "vector that determines size of perturbation for u (inputs)" -typedef ^ ParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - - -# ..... Inputs .................................................................................................................... -# Define inputs that are contained on the mesh here: -typedef ^ InputType MeshType TowerMotion - - - "motion on the tower" - -typedef ^ InputType MeshType HubMotion - - - "motion on the hub" - -typedef ^ InputType MeshType BladeRootMotion {:} - - "motion on each blade root" - -typedef ^ InputType MeshType BladeMotion {:} - - "motion on each blade" - -# Define inputs that are not on this mesh here: -typedef ^ InputType ReKi InflowOnBlade {:}{:}{:} "U,V,W at nodes on each blade (note if we change the requirement that NumNodes is the same for each blade, this will need to change)" m/s -typedef ^ InputType ReKi InflowOnTower {:}{:} "U,V,W at nodes on the tower" m/s - -# ..... Outputs ................................................................................................................... -# Define outputs that are contained on the mesh here: -typedef ^ OutputType MeshType TowerLoad - - - "loads on the tower" - -typedef ^ OutputType MeshType BladeLoad {:} - - "loads on each blade" - -# Define outputs that are not on this mesh here: -typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" diff --git a/modules/aerodyn/AeroDynF8_Emre/CMakeLists.txt b/modules/aerodyn/AeroDynF8_Emre/CMakeLists.txt deleted file mode 100644 index 0c5f93996..000000000 --- a/modules/aerodyn/AeroDynF8_Emre/CMakeLists.txt +++ /dev/null @@ -1,15 +0,0 @@ - - -add_subdirectory(AeroAcoustics) - -generate_f90types(AeroAcoustics_Registry.txt AeroAcoustics_Types.f90) -generate_f90types(AeroDyn_Registry.txt AeroDyn_Types.f90) -generate_f90types(AirfoilInfo_Registry.txt AirfoilInfo_Types.f90 -noextrap) -generate_f90types(BEMT_Registry.txt BEMT_Types.f90) -generate_f90types(UnsteadyAero_Registry.txt UnsteadyAero_Types.f90) - - -add_library(aerodyn AeroAcoustics_Types.f90 AeroDyn_Types.f90 AeroDyn.f90 AeroDyn_IO.f90 AirfoilInfo.f90 AirfoilInfo_Types.f90 BEMT.f90 BEMTUncoupled.f90 BEMT_Registry.txt BEMT_Types.f90 UnsteadyAero.f90 UnsteadyAero_Types.f90 fmin_fcn.f90 mod_root1dim.f90) - -target_link_libraries(aerodyn nwtclibs AeroAcoustics) - diff --git a/modules/aerodyn/CMakeLists.txt b/modules/aerodyn/CMakeLists.txt index 948de61db..bf349557a 100644 --- a/modules/aerodyn/CMakeLists.txt +++ b/modules/aerodyn/CMakeLists.txt @@ -13,19 +13,109 @@ # See the License for the specific language governing permissions and # limitations under the License. # -# AeroAcoustics -add_subdirectory(src/AeroAcoustics) generate_f90_types(src/AeroAcoustics_Registry.txt AeroAcoustics_Types.f90) generate_f90_types(src/AirfoilInfo_Registry.txt AirfoilInfo_Types.f90 -noextrap) - - generate_f90_types(src/AeroDyn_Registry.txt AeroDyn_Types.f90) generate_f90_types(src/BEMT_Registry.txt BEMT_Types.f90) generate_f90_types(src/DBEMT_Registry.txt DBEMT_Types.f90) generate_f90_types(src/UnsteadyAero_Registry.txt UnsteadyAero_Types.f90) -generate_f90_types(src/AeroDyn_Driver_Registry.txt - AeroDyn_Driver_Types.f90 -noextrap) +generate_f90_types(src/AeroDyn_Driver_Registry.txt AeroDyn_Driver_Types.f90 -noextrap) + +# TNO +set(TNO_SOURCES + src/AeroAcoustics/TNO/int1.f90 + src/AeroAcoustics/TNO/int2.f90 + src/AeroAcoustics/TNO/TNOMods.f90 + src/AeroAcoustics/TNO/pressure.f90 + src/AeroAcoustics/TNO/qk61.f +) +add_library(TNO ${TNO_SOURCES}) + +# TINoise +set(FULLGUIDATI_SOURCES + src/AeroAcoustics/TINoise/CDA0.f90 + src/AeroAcoustics/TINoise/CDI0.f90 + src/AeroAcoustics/TINoise/DEFGEO.f90 + src/AeroAcoustics/TINoise/DETCP.f90 + src/AeroAcoustics/TINoise/DETFIELD.f90 + src/AeroAcoustics/TINoise/DETSPL.f90 + src/AeroAcoustics/TINoise/DETSTR.f90 + src/AeroAcoustics/TINoise/DRM_ACU.f90 + src/AeroAcoustics/TINoise/DRM_AER.f90 + src/AeroAcoustics/TINoise/FLAT.f90 + src/AeroAcoustics/TINoise/FUNCS_LM.f90 + src/AeroAcoustics/TINoise/HANK0.f90 + src/AeroAcoustics/TINoise/HANK1.f90 + src/AeroAcoustics/TINoise/INICON.f90 + src/AeroAcoustics/TINoise/odeint.f90 + src/AeroAcoustics/TINoise/PRESOUR.f90 + src/AeroAcoustics/TINoise/READIN.f90 + src/AeroAcoustics/TINoise/RHSINT.f90 + src/AeroAcoustics/TINoise/rkck.f90 + src/AeroAcoustics/TINoise/rkqs.f90 + src/AeroAcoustics/TINoise/SETMATA.f90 + src/AeroAcoustics/TINoise/SETMAT.f90 + src/AeroAcoustics/TINoise/SETRHSA.f90 + src/AeroAcoustics/TINoise/SETRHS.f90 + src/AeroAcoustics/TINoise/SOLSEQA.f90 + src/AeroAcoustics/TINoise/SOLSEQ.f90 + src/AeroAcoustics/TINoise/SPL_E0A.f90 + src/AeroAcoustics/TINoise/SPL_E1A.f90 + src/AeroAcoustics/TINoise/SPL_EX1.f90 + src/AeroAcoustics/TINoise/SPL_EX2.f90 + src/AeroAcoustics/TINoise/SPL_EX3.f90 + src/AeroAcoustics/TINoise/SPL_EX.f90 + src/AeroAcoustics/TINoise/SPL_PA.f90 + src/AeroAcoustics/TINoise/SPL_P.f90 + src/AeroAcoustics/TINoise/SPL_PPA.f90 + src/AeroAcoustics/TINoise/SPL_PP.f90 + src/AeroAcoustics/TINoise/STREAM.f90 + src/AeroAcoustics/TINoise/TI_Noise.f90 + src/AeroAcoustics/TINoise/TINoiseMods.f90 + src/AeroAcoustics/TINoise/WAKE.f90 +) +add_library(FullGuidati ${FULLGUIDATI_SOURCES}) + +# Xfoil +set(Xfoil_SOURCES + src/AeroAcoustics/Xfoil/dplot_noise.f + src/AeroAcoustics/Xfoil/get_airfoil_coords.f + src/AeroAcoustics/Xfoil/naca.f + src/AeroAcoustics/Xfoil/plutil_noise.f + src/AeroAcoustics/Xfoil/profil.f + src/AeroAcoustics/Xfoil/sort.f + src/AeroAcoustics/Xfoil/spline.f + src/AeroAcoustics/Xfoil/userio.f + src/AeroAcoustics/Xfoil/xbl.f + src/AeroAcoustics/Xfoil/xblsys.f + src/AeroAcoustics/Xfoil/xfoil_noise.f + src/AeroAcoustics/Xfoil/xgdes_noise.f + src/AeroAcoustics/Xfoil/xgeom_noise.f + src/AeroAcoustics/Xfoil/xoper_noise.f + src/AeroAcoustics/Xfoil/xpanel.f + src/AeroAcoustics/Xfoil/xsolve.f + src/AeroAcoustics/Xfoil/xtcam_noise.f + src/AeroAcoustics/Xfoil/xutils.f + src/AeroAcoustics/Xfoil/xfoil_noise_mods.f90 + src/AeroAcoustics/Xfoil/XFOIL.INC + src/AeroAcoustics/Xfoil/XBL.INC + src/AeroAcoustics/Xfoil/CIRCLE.INC + src/AeroAcoustics/Xfoil/PINDEX.INC) +add_library(Xfoil ${Xfoil_SOURCES}) + + +# AeroAcoustics +set(AEROACOUSTIC_SOURCES + src/AeroAcoustics/AeroAcoustics.f90 + src/AeroAcoustics/AeroAcoustics_IO.f90 + + AeroAcoustics_Types.f90 + # this target shouldnt depend on airfoilinfo as this creates a circular reference + AirfoilInfo_Types.f90 +) +add_library(AeroAcoustics ${AEROACOUSTIC_SOURCES}) +target_link_libraries(AeroAcoustics nwtclibs FullGuidati TNO Xfoil) # AeroDyn lib set(AD_LIBS_SOURCES @@ -41,7 +131,6 @@ set(AD_LIBS_SOURCES # Autogenerated files AeroDyn_Types.f90 - AeroAcoustics_Types.f90 AirfoilInfo_Types.f90 BEMT_Types.f90 DBEMT_Types.f90 @@ -72,7 +161,7 @@ set(UA_DRIVER_SOURCES add_executable(unsteadyaero_driver ${UA_DRIVER_SOURCES}) target_link_libraries(unsteadyaero_driver aerodynlib nwtclibs versioninfolib ${CMAKE_DL_LIBS}) -install(TARGETS unsteadyaero_driver aerodyn_driver aerodynlib AeroAcoustics FullGuidati TNO +install(TARGETS unsteadyaero_driver aerodyn_driver aerodynlib AeroAcoustics FullGuidati TNO Xfoil EXPORT "${CMAKE_PROJECT_NAME}Libraries" RUNTIME DESTINATION bin LIBRARY DESTINATION lib diff --git a/modules/aerodyn/src/AeroAcoustics/AeroAcoustics.f90 b/modules/aerodyn/src/AeroAcoustics/AeroAcoustics.f90 index 90fec383e..bd1dfc8db 100644 --- a/modules/aerodyn/src/AeroAcoustics/AeroAcoustics.f90 +++ b/modules/aerodyn/src/AeroAcoustics/AeroAcoustics.f90 @@ -124,95 +124,7 @@ subroutine Cleanup() CALL AA_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2 ) IF ( UnEcho > 0 ) CLOSE( UnEcho ) end subroutine Cleanup - end subroutine AA_Init -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine validates the inputs from the AeroDyn input files. -SUBROUTINE ValidateInputData( InputFileData, NumBl, ErrStat, ErrMsg ) - type(AA_InputFile), intent(in) :: InputFileData !< All the data in the AeroDyn input file - integer(IntKi), intent(in) :: NumBl !< Number of blades - integer(IntKi), intent(out) :: ErrStat !< Error status - character(*), intent(out) :: ErrMsg !< Error message - ! local variables - integer(IntKi) :: k ! Blade number - integer(IntKi) :: j ! node number - character(*), parameter :: RoutineName = 'ValidateInputData' - ErrStat = ErrID_None - ErrMsg = "" - - if (NumBl > MaxBl .or. NumBl < 1) call SetErrStat( ErrID_Fatal, 'Number of blades must be between 1 and '//trim(num2lstr(MaxBl))//'.', ErrSTat, ErrMsg, RoutineName ) - if (InputFileData%DTAero <= 0.0) call SetErrStat ( ErrID_Fatal, 'DTAero must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - - if (InputFileData%IBLUNT /= IBLUNT_None .and. InputFileData%IBLUNT /= IBLUNT_BPM) then - call SetErrStat ( ErrID_Fatal, & - 'IBLUNT must '//trim(num2lstr(IBLUNT_None))//' (none) or '//trim(num2lstr(IBLUNT_BPM))//' (Bluntness noise calculated).', ErrStat, ErrMsg, RoutineName ) - endif - - if (InputFileData%ILAM /= ILAM_None .and. InputFileData%ilam /= ILAM_BPM) then - call SetErrStat ( ErrID_Fatal, 'ILAM must be '//trim(num2lstr(ILAM_None))//' No calculation '//& - trim(num2lstr(ILAM_BPM))//' (ILAM Calculated).', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%ITIP /= ITIP_None .and. InputFileData%ITIP /= ITIP_ON) then - call SetErrStat ( ErrID_Fatal, 'ITIP must be '//trim(num2lstr(ITIP_None))//' (Off) or '//& - trim(num2lstr(ITIP_On))//' (ITIP On).', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%ITRIP /= ITRIP_None .and. InputFileData%ITRIP /= ITRIP_Heavy .and. InputFileData%ITRIP /= ITRIP_Light) then - call SetErrStat ( ErrID_Fatal,'ITRIP must be '//trim(num2lstr(ITRIP_None))//' (none) or '//trim(num2lstr(ITRIP_Heavy))//& - ' (heavily tripped BL Calculation) or '//trim(num2lstr(ITRIP_Light))//' (lightly tripped BL)' ,ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%ITURB /= ITURB_None .and. InputFileData%ITURB /= ITURB_BPM .and. InputFileData%ITURB /= ITURB_TNO) then - call SetErrStat ( ErrID_Fatal, 'ITURB must be 0 (off) or 1 (BPM) or 2 (TNO) .', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%IInflow /= IInflow_None .and. InputFileData%IInflow /= IInflow_BPM & - .and. InputFileData%IInflow /= IInflow_FullGuidati .and. InputFileData%IInflow /= IInflow_SimpleGuidati ) then - call SetErrStat ( ErrID_Fatal, 'IInflow must be 0 (off) or 1 (only Amiet) or 2 (Full Guidati)'//& - 'or 3 (Simple Guidati).', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%TICalcMeth /= TICalc_Every .and. InputFileData%TICalcMeth /= TICalc_Interp ) then - call SetErrStat ( ErrID_Fatal, 'TICalcMeth must be '//trim(num2lstr(TICalc_Every))//' TICalc automatic or '//& - trim(num2lstr(TICalc_Interp))//' (TICalcMeth interp).', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%X_BLMethod /= X_BLMethod_BPM .and. InputFileData%X_BLMethod /= X_BLMethod_Xfoil) then - call SetErrStat ( ErrID_Fatal, 'X_BLMethod must be '//trim(num2lstr(X_BLMethod_BPM))//' X_BLMethod_ with BPM or '//& - trim(num2lstr(X_BLMethod_Xfoil))//' (X_BLMethod with Xfoil).', ErrStat, ErrMsg, RoutineName ) - end if - - - if (InputFileData%XfoilCall /= XfoilCall_Interp .and. InputFileData%XfoilCall /= XfoilCall_Every ) then - call SetErrStat ( ErrID_Fatal, 'XfoilCall must be '//trim(num2lstr(XfoilCall_Interp))//' for interpolation from pretabulated data or '//& - trim(num2lstr(XfoilCall_Every))//' for each step Xfoil call.', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%aweightflag /= AweightFlagOff .and. InputFileData%aweightflag /= AweightFlagOn ) then - call SetErrStat ( ErrID_Fatal, 'aweightflag must be '//trim(num2lstr(AweightFlagOn))//' for A-weighting on or '//& - trim(num2lstr(AweightFlagOff))//' for A-weighting off.', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%NrObsLoc <= 0.0) call SetErrStat ( ErrID_Fatal, 'Number of Observer Locations should be greater than zero', ErrStat, ErrMsg, RoutineName ) - - if (InputFileData%NrOutFile /= 0 .and. InputFileData%NrOutFile /= 1 .and. InputFileData%NrOutFile /= 2 .and. InputFileData%NrOutFile /= 3 & - .and. InputFileData%NrOutFile /= 4) then - call SetErrStat ( ErrID_Fatal, ' NrOutFile must be 0 or 1 or 2 or 3 or 4', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%LargeBinOutput /= 0 .and. InputFileData%LargeBinOutput /= 1 ) then - call SetErrStat ( ErrID_Fatal, ' LargeBinOutput must be 0 or 1', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%Comp_AA_After .eq.0 ) then - call SetErrStat ( ErrID_Fatal, ' Comp_AA_After variable in aeroacustics input must be more than 0', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%saveeach .eq. 0 ) then - call SetErrStat ( ErrID_Fatal, ' saveeach variable in aeroacustics input must be more than 0', ErrStat, ErrMsg, RoutineName ) - end if -END SUBROUTINE ValidateInputData !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets AeroAcoustics parameters for use during the simulation; these variables are not changed after AA_Init. subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) @@ -235,7 +147,7 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) !!Assign input fiel data to parameters p%DT = InputFileData%DTAero ! seconds p%AA_Bl_Prcntge = InputFileData%AA_Bl_Prcntge ! % - p%fsample = 1/p%DT ! Hz + p%fsample = 1/p%DT ! Hz p%total_sample = 2**( ceiling(log(1*p%fsample)/log(2.0d0)))! 1 stands for the 1 seconds. Every 1 second Vrel spectra will be calculated for the dissipation calculation (change if more needed & recompile ) p%total_sampleTI = 5/p%DT ! 10 seconds for TI sampling p%Comp_AA_After = InputFileData%Comp_AA_After @@ -253,7 +165,7 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) p%ROUND = InputFileData%ROUND p%alprat = InputFileData%ALPRAT p%NrOutFile = InputFileData%NrOutFile - p%delim = " " + p%delim = " " p%outFmt = "ES15.6E3" p%LargeBinOutput = InputFileData%LargeBinOutput p%NumBlNds = InitInp%NumBlNds @@ -264,7 +176,7 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) p%z0_AA = InputFileData%z0_AA p%dy_turb_in = InputFileData%dy_turb_in p%dz_turb_in = InputFileData%dz_turb_in - p%NrObsLoc = InputFileData%NrObsLoc + p%NrObsLoc = InputFileData%NrObsLoc call AllocAry(p%TI_Grid_In,size(InputFileData%TI_Grid_In,1), size(InputFileData%TI_Grid_In,2), 'p%TI_Grid_In', errStat2, errMsg2); if(Failed()) return p%TI_Grid_In=InputFileData%TI_Grid_In @@ -312,8 +224,8 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) ! set 1/3 octave band frequency as parameter and A weighting. CALL AllocAry( p%FreqList, 34, 'FreqList', ErrStat2, ErrMsg2); if(Failed()) return - p%FreqList = (/10.,12.5,16.,20.,25.,31.5,40.,50.,63.,80., & - 100.,125.,160.,200.,250.,315.,400.,500.,630.,800., & + p%FreqList = (/10.,12.5,16.,20.,25.,31.5,40.,50.,63.,80., & + 100.,125.,160.,200.,250.,315.,400.,500.,630.,800., & 1000.,1250.,1600.,2000.,2500.,3150.,4000.,5000.,6300.,8000., & 10000.,12500.,16000.,20000./) CALL AllocAry(p%Aweight, size(p%Freqlist), 'Aweight', ErrStat2, ErrMsg2); if(Failed()) return @@ -394,26 +306,14 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) ENDDO ENDDO - ! If Xfoil data needs to be tabulated this means p%XfoilCall=1 - IF( (p%X_BLMethod.eq.2) .and. (p%XfoilCall.eq.1) )THEN - ! call AllocAry( p%UListXfoil, 20, 'p%UListXfoil', errStat2, errMsg2 ) - ! DO i=1,size(p%UListXfoil) - ! p%UListXfoil(i)=1.0d0+i*5.0d0 - ! ENDDO - ! corresponding Rey Nrs=0.1e6,0.4e6,0.8e6,1.2e6,2.0e6,2.5e6,3.0e6',3.5e6,4.0e6,5.0e6,6.0e6,7.0e6,8.0e6,10.e6,15.e6,20.e6 - ! call AllocAry( p%ReListXfoil, size(p%UListXfoil), 'p%ReListXfoil', errStat2, errMsg2 ) - ! call AllocAry( p%AOAListXfoil, 35, 'p%AOAListXfoil', errStat2, errMsg2 ) - ! DO i=1,size(p%AOAListXfoil) - ! p%AOAListXfoil(i) = -3.0d0+i*0.50d0 - ! p%AOAListXfoil(i) = 3.0d0 - ! ENDDO - ! !p%AOAListXfoil = (/-3.0d0,-2.0d0,-1.0d0,0.0d0,1.0d0,2.0d0,3.0d0,4.0d0,5.0d0,6.0d0,8.0d0,10.0d0,12.0d0,14.0d0,16.0d0/) - ! p%AOAListXfoil = 3.0d0 + if( (p%X_BLMethod.eq.2) .and. ((p%XfoilCall.eq.XfoilCall_None).or.(p%XfoilCall.eq.XfoilCall_Tabulate)) ) then + + ! Copying inputdata list of AOA and Reynolds to parameters call AllocAry( p%AOAListXfoil, size(InputFileData%AoAListXfoil), 'p%AOAListXfoil', errStat2, errMsg2); if(Failed()) return - call AllocAry( p%ReListXfoil, size(InputFileData%ReListXfoil) , 'p%ReListXfoil' , errStat2, errMsg2); if(Failed()) return + call AllocAry( p%ReListXfoil, size(InputFileData%ReListXfoil) , 'p%ReListXfoil' , errStat2, errMsg2); if(Failed()) return p%AOAListXfoil=InputFileData%AoAListXfoil p%ReListXfoil=InputFileData%ReListXfoil - !! Allocate the suction and pressure side boundary layer parameters for Xfoil output - will be used as tabulated data + ! Allocate the suction and pressure side boundary layer parameters for Xfoil output - will be used as tabulated data call AllocAry(p%dstarall1 ,size(p%AOAListXfoil), size(p%ReListXfoil),size(p%AFInfo),'p%dstarall1' , errStat2, errMsg2); if(Failed()) return call AllocAry(p%dstarall2 ,size(p%AOAListXfoil), size(p%ReListXfoil),size(p%AFInfo),'p%dstarall2' , errStat2, errMsg2); if(Failed()) return call AllocAry(p%d99all1 ,size(p%AOAListXfoil), size(p%ReListXfoil),size(p%AFInfo),'p%d99all1' , errStat2, errMsg2); if(Failed()) return @@ -422,17 +322,37 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) call AllocAry(p%Cfall2 ,size(p%AOAListXfoil), size(p%ReListXfoil),size(p%AFInfo),'p%Cfall2' , errStat2, errMsg2); if(Failed()) return call AllocAry(p%EdgeVelRat1,size(p%AOAListXfoil), size(p%ReListXfoil),size(p%AFInfo),'p%EdgeVelRat1', errStat2, errMsg2); if(Failed()) return call AllocAry(p%EdgeVelRat2,size(p%AOAListXfoil), size(p%ReListXfoil),size(p%AFInfo),'p%EdgeVelRat2', errStat2, errMsg2); if(Failed()) return - ! Pre tabulate the the boundary layer data and set them as parameter. - ! CALL RUN_XFOIL_BL(p) - p%dstarall1 = InputFileData%Suct_DispThick - p%dstarall2 = InputFileData%Pres_DispThick - p%d99all1 = InputFileData%Suct_BLThick - p%d99all2 = InputFileData%Pres_BLThick - p%Cfall1 = InputFileData%Suct_Cf - p%Cfall2 = InputFileData%Pres_Cf - p%EdgeVelRat1 = InputFileData%Suct_EdgeVelRat - p%EdgeVelRat2 = InputFileData%Pres_EdgeVelRat - ENDIF ! If Xfoil data needs to be tabulated + p%dstarall1 =0.0_ReKi ! TODO, there is no guaranteee that xfoil returns something sensible if it didn't converge + p%dstarall2 =0.0_ReKi + p%d99all1 =0.0_ReKi + p%d99all2 =0.0_ReKi + p%Cfall1 =0.0_ReKi + p%Cfall2 =0.0_ReKi + p%EdgeVelRat1 =0.0_ReKi + p%EdgeVelRat2 =0.0_ReKi + + + if (p%XfoilCall.eq.XfoilCall_None) then + ! --- Xfoil data were read from files (XfoilCall=0), so we just copy what was read from the files + p%dstarall1 = InputFileData%Suct_DispThick + p%dstarall2 = InputFileData%Pres_DispThick + p%d99all1 = InputFileData%Suct_BLThick + p%d99all2 = InputFileData%Pres_BLThick + p%Cfall1 = InputFileData%Suct_Cf + p%Cfall2 = InputFileData%Pres_Cf + p%EdgeVelRat1 = InputFileData%Suct_EdgeVelRat + p%EdgeVelRat2 = InputFileData%Pres_EdgeVelRat + elseif (p%XfoilCall.eq.XfoilCall_Tabulate) then + ! --- Boudarly layer data is tabulaterd by calling Xfoil (XfoilCall=1) + CALL RUN_XFOIL_BL(p, ErrStat2, ErrMsg2) + if(Failed()) return + endif + ! Rewritting xfoil tables if requested + if(InputFileData%XfoilTabOut) then + call WriteXfoilTables(p, ErrStat2, ErrMsg2 ) + endif + if(Failed()) return + endif ! if xfoil data is tabulated ! If simplified guidati is on, calculate the airfoil thickness from input airfoil coordinates IF (p%IInflow .EQ. 3) THEN @@ -440,7 +360,7 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) call AllocAry(p%AFThickGuida,2,size(p%AFInfo), 'p%AFThickGuida', errStat2, errMsg2); if(Failed()) return p%AFThickGuida=0.0_Reki - DO k=1,size(p%AFInfo) ! for each airfoil interpolation + DO k=1,size(p%AFInfo) ! for each airfoil interpolation tri=.true.;tr=.true.; do i=2,size(p%AFInfo(k)%X_Coord) if ( (p%AFInfo(k)%X_Coord(i)+p%AFInfo(k)%Y_Coord(i)) .eq. 0) then @@ -465,7 +385,7 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) endif enddo - 174 tri=.true.;tr=.true.; + 174 tri=.true.;tr=.true.; do j=i,size(p%AFInfo(k)%X_Coord) if ( p%AFInfo(k)%X_Coord(j) .eq. 0.1) then val1=abs(p%AFInfo(k)%Y_Coord(j)) + abs(val1) @@ -496,7 +416,7 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) call AllocAry(p%rotorregionlimitsVert,ceiling(((p%toptip)-(p%bottip))/jumpreg), 'p%rotorregionlimitsVert', errStat2, errMsg2); if(Failed()) return do i=0,size(p%rotorregionlimitsVert)-1 p%rotorregionlimitsVert(i+1)=(p%bottip)+jumpreg*i - enddo + enddo !! for turbulence intensity calculations on the fly every 5 meter the whole rotor area is divided horizontally to store flow fields in each region jumpreg=7 lefttip = 2*maxval(p%BlSpn(:,1))+5 ! @@ -505,14 +425,14 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) do i=0,size(p%rotorregionlimitsHorz)-1 p%rotorregionlimitsHorz(i+1)=rightip+jumpreg*i enddo - jumpreg=60 ! 10 ! must be divisable to 360 + jumpreg=60 ! 10 ! must be divisable to 360 call AllocAry(p%rotorregionlimitsalph,INT((360/jumpreg)+1), 'p%rotorregionlimitsalph', errStat2, errMsg2); if(Failed()) return do i=0,size(p%rotorregionlimitsalph)-1 p%rotorregionlimitsalph(i+1)=jumpreg*i enddo jumpreg=5 call AllocAry( p%rotorregionlimitsrad, (CEILING( maxval(p%BlSpn(:,1))/jumpreg )+2), 'p%rotorregionlimitsrad', errStat2, errMsg2); if(Failed()) return - do i=1,size(p%rotorregionlimitsrad)-1 + do i=1,size(p%rotorregionlimitsrad)-1 p%rotorregionlimitsrad(i+1)=jumpreg*i enddo p%rotorregionlimitsrad(1)=0.0_reki @@ -713,7 +633,7 @@ subroutine Init_states(xd, p, errStat, errMsg) xd%allregcounter(k,ji) = 2.0_Reki ! xd%VxSqRegion(k,ji) = 0.0_ReKi ! xd%RegionTIDelete(k,ji) = 0.0_ReKi ! - xd%RegVxStor(1:size(xd%RegVxStor,1),k,ji)=0.0_reki + xd%RegVxStor(1:size(xd%RegVxStor,1),k,ji)=0.0_reki enddo enddo contains @@ -739,8 +659,8 @@ subroutine AA_UpdateStates( t, n, m, u, p, xd, errStat, errMsg ) REAL(ReKi),DIMENSION(p%NumBlNds,p%numBlades) :: TEMPSTD ! temporary standard deviation variable REAL(ReKi) :: tempsingle,tempmean,angletemp,abs_le_x ! temporary standard deviation variable integer(intKi) :: i,j,k,rco, y0_a,y1_a,z0_a,z1_a - logical :: exist - REAL(ReKi) :: yi_a,zi_a,yd_a,zd_a,c00_a,c10_a + logical :: exist + REAL(ReKi) :: yi_a,zi_a,yd_a,zd_a,c00_a,c10_a ErrStat = ErrID_None ErrMsg = "" @@ -759,25 +679,25 @@ subroutine AA_UpdateStates( t, n, m, u, p, xd, errStat, errMsg ) IF ((abs_le_x.lt.0).and.(m%LE_Location(2,j,i).lt.0)) THEN angletemp=180+ATAN( ABS( m%LE_Location(2,j,i)/abs_le_x ) ) * R2D_D ELSEIF ((abs_le_x.lt.0).and.(m%LE_Location(2,j,i).gt.0)) THEN - angletemp=180-ATAN( ABS( m%LE_Location(2,j,i)/abs_le_x ) ) * R2D_D + angletemp=180-ATAN( ABS( m%LE_Location(2,j,i)/abs_le_x ) ) * R2D_D ELSEIF ((abs_le_x.gt.0).and.(m%LE_Location(2,j,i).lt.0)) THEN angletemp=360-ATAN( ABS( m%LE_Location(2,j,i)/abs_le_x ) ) * R2D_D ELSEIF ((abs_le_x.gt.0).and.(m%LE_Location(2,j,i).gt.0)) THEN angletemp=ATAN( m%LE_Location(2,j,i)/abs_le_x ) * R2D_D - ELSE + ELSE print*, 'problem in angletemp Aeroacoustics module' ENDIF !abs_le_x=ABS(abs_le_x) - do k=1,size(p%rotorregionlimitsrad) + do k=1,size(p%rotorregionlimitsrad) IF (p%BlSpn(j,i)-p%rotorregionlimitsrad(k).lt.0) THEN ! it means location is in the k-1 region !print*, abs_le_x,p%rotorregionlimitsrad(k),k-1 GOTO 4758 - ENDIF + ENDIF enddo - 4758 do rco=1,size(p%rotorregionlimitsalph) + 4758 do rco=1,size(p%rotorregionlimitsalph) IF (angletemp-p%rotorregionlimitsalph(rco).lt.0) THEN ! it means location is in the k-1 region GOTO 9815 - ENDIF + ENDIF enddo 9815 xd%allregcounter(k-1,rco-1)=CEILING(xd%allregcounter(k-1,rco-1)+1.0_Reki) ! increase the sample amount in that specific 5 meter height vertical region tempsingle = sqrt( u%Inflow(1,j,i)**2+u%Inflow(2,j,i)**2+u%Inflow(3,j,i)**2 ) ! @@ -798,14 +718,14 @@ subroutine AA_UpdateStates( t, n, m, u, p, xd, errStat, errMsg ) IF (n .eq. 0) THEN open (123401,file='RegionTIDelete.bin',access='stream',form='unformatted',status='REPLACE') !open a binary file write(123401) Size(xd%RegionTIDelete,1) - write(123401) Size(xd%RegionTIDelete,2) + write(123401) Size(xd%RegionTIDelete,2) write(123401) xd%RegionTIDelete ELSE open (123401, file="RegionTIDelete.bin", access='stream',status="old", form='unformatted',position="append") - write(123401) xd%RegionTIDelete + write(123401) xd%RegionTIDelete ENDIF - close(123401) - ELSE ! interpolate from the user given ti values + close(123401) + ELSE! interpolate from the user given ti values do i=1,p%NumBlades do j=1,p%NumBlNds zi_a=ABS(m%LE_Location(3,j,i) - (FLOOR(p%HubHeight-maxval(p%BlSpn(:,1)))) ) /p%dz_turb_in @@ -819,7 +739,7 @@ subroutine AA_UpdateStates( t, n, m, u, p, xd, errStat, errMsg ) c00_a=(1.0_ReKi-yd_a)*p%TI_Grid_In(z0_a+1,y0_a+1)+yd_a*p%TI_Grid_In(z0_a+1,y1_a+1) c10_a=(1.0_ReKi-yd_a)*p%TI_Grid_In(z1_a+1,y0_a+1)+yd_a*p%TI_Grid_In(z1_a+1,y1_a+1) ! 2 points - xd%TIVx(j,i)=(1.0_ReKi-zd_a)*c00_a+zd_a*c10_a + xd%TIVx(j,i)=(1.0_ReKi-zd_a)*c00_a+zd_a*c10_a if (i.eq.p%NumBlades) then if (j.eq.p%NumBlNds) then endif @@ -1028,37 +948,36 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) REAL(ReKi) :: AlphaNoise ! REAL(ReKi) :: UNoise ! REAL(ReKi) :: elementspan ! - REAL(ReKi) :: addpow ! - REAL(ReKi),DIMENSION(p%NumBlNds) :: tempdel - REAL(ReKi),DIMENSION(p%NrObsLoc,p%NumBlNds,p%numBlades) :: OASPLTBLAll - REAL(ReKi),DIMENSION(p%NrObsLoc,p%NumBlNds,p%numBlades,size(p%FreqList)) :: ForMaxLoc + REAL(ReKi),DIMENSION(p%NumBlNds) ::tempdel + REAL(ReKi),DIMENSION(p%NrObsLoc,p%NumBlNds,p%numBlades) ::OASPLTBLAll + REAL(ReKi),DIMENSION(p%NrObsLoc,p%NumBlNds,p%numBlades,size(p%FreqList)) ::ForMaxLoc REAL(ReKi),DIMENSION(size(y%OASPL_Mech,1),size(p%FreqList),p%NrObsLoc,p%NumBlNds,p%numBlades) :: ForMaxLoc3 - REAL(ReKi),DIMENSION(size(p%FreqList),p%NrObsLoc,p%numBlades) :: SPL_Out - REAL(ReKi),DIMENSION(p%NumBlNds,p%numBlades) :: temp_dispthick - REAL(ReKi),DIMENSION(p%NumBlNds,p%numBlades) :: temp_dispthickchord - - real(ReKi) :: Ptotal - real(ReKi) :: PtotalLBL - real(ReKi) :: PtotalTBLP - real(ReKi) :: PtotalTBLS - real(ReKi) :: PtotalSep - real(ReKi) :: PtotalTBLAll - real(ReKi) :: PtotalBlunt - real(ReKi) :: PtotalTip - real(ReKi) :: PtotalInflow - real(ReKi) :: PLBL - real(ReKi) :: PTBLP - real(ReKi) :: PTBLS - real(ReKi) :: PTBLALH - real(ReKi) :: PTip - real(ReKi) :: PTI - real(ReKi) :: PBLNT,adforma - REAL(ReKi),DIMENSION(2) :: Cf ,d99, d_star - TYPE(FFT_DataType) :: FFT_Data !< the instance of the FFT module we're using - REAL(kind=4),DIMENSION(p%total_sample) :: spect_signal - REAL(kind=4),DIMENSION(p%total_sample/2) :: spectra - real(ReKi),ALLOCATABLE :: fft_freq(:) - integer(intKi) :: ErrStat2 + REAL(ReKi),DIMENSION(size(p%FreqList),p%NrObsLoc,p%numBlades) ::SPL_Out + REAL(ReKi),DIMENSION(p%NumBlNds,p%numBlades) ::temp_dispthick + REAL(ReKi),DIMENSION(p%NumBlNds,p%numBlades) ::temp_dispthickchord + + real(ReKi) :: Ptotal + real(ReKi) :: PtotalLBL + real(ReKi) :: PtotalTBLP + real(ReKi) :: PtotalTBLS + real(ReKi) :: PtotalSep + real(ReKi) :: PtotalTBLAll + real(ReKi) :: PtotalBlunt + real(ReKi) :: PtotalTip + real(ReKi) :: PtotalInflow + real(ReKi) :: PLBL + real(ReKi) :: PTBLP + real(ReKi) :: PTBLS + real(ReKi) :: PTBLALH + real(ReKi) :: PTip + real(ReKi) :: PTI + real(ReKi) :: PBLNT,adforma + REAL(ReKi),DIMENSION(2) :: Cf ,d99, d_star + TYPE(FFT_DataType) :: FFT_Data !< the instance of the FFT module we're using + REAL(kind=4),DIMENSION(p%total_sample) :: spect_signal + REAL(kind=4),DIMENSION(p%total_sample/2) :: spectra + real(ReKi),ALLOCATABLE :: fft_freq(:) + integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'CalcAeroAcousticsOutput' logical :: exist @@ -1075,7 +994,7 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) ENDDO;ENDDO;ENDDO DO K = 1,p%NrObsLoc; - y%DirectiviOutput(K) = 0.0_Reki + y%DirectiviOutput(K) = 0.0_Reki DO I=1,p%NumBlades;DO III=1,size(p%FreqList); y%SumSpecNoise(III,K,I) = 0.0_Reki ForMaxLoc(K,1:p%NumBlNds,I,III)=0.0_Reki @@ -1094,16 +1013,16 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) ENDDO !------------------- initialize FFT -------------------------! - !!! IF (m%speccou .eq. p%total_sample)THEN - !!! CALL InitFFT ( p%total_sample, FFT_Data, ErrStat=ErrStat2 ) - !!! CALL SetErrStat(ErrStat2, 'Error in InitFFT', ErrStat, ErrMsg, 'CalcAeroAcousticsOutput' ) - !!! CALL AllocAry( fft_freq, size(spect_signal)/2-1, 'fft_freq', ErrStat2, ErrMsg2 ) + !!!IF (m%speccou .eq. p%total_sample)THEN + !!!CALL InitFFT ( p%total_sample, FFT_Data, ErrStat=ErrStat2 ) + !!! CALL SetErrStat(ErrStat2, 'Error in InitFFT', ErrStat, ErrMsg, 'CalcAeroAcousticsOutput' ) + !!!CALL AllocAry( fft_freq, size(spect_signal)/2-1, 'fft_freq', ErrStat2, ErrMsg2 ) !!! CALL SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - !!! do liop=1,size(fft_freq) - !!! fft_freq(liop)=p%fsample*liop ! fRequncy x axis - !!! fft_freq(liop)=fft_freq(liop)/size(spect_signal) - !!! enddo - !!! ENDIF + !!!do liop=1,size(fft_freq) + !!! fft_freq(liop)=p%fsample*liop ! fRequncy x axis + !!! fft_freq(liop)=fft_freq(liop)/size(spect_signal) + !!!enddo + !!!ENDIF inquire(file="alpha.txt", exist=exist) @@ -1159,28 +1078,26 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) !------------------------------!!------------------------------!!------------------------------!!------------------------------! !------------------------------!!------------------------------!!------------------------------!!------------------------------! !--------Calculate Spectrum for dissipation calculation-------------------------! - ! IF (m%speccou .eq. p%total_sample)THEN - ! spect_signal=xd%VrelStore( 1:p%total_sample,J,I ) - ! CALL ApplyFFT_f( spect_signal, FFT_Data, ErrStat2 ) - ! IF (ErrStat2 /= ErrID_None ) THEN - ! CALL SetErrStat(ErrStat2, 'Error in ApplyFFT .', ErrStat, ErrMsg, 'CalcAeroAcousticsOutput' ) - ! ENDIF - ! cou=1 - ! DO liop=2,size(spect_signal)-1,2 - ! cou=cou+1 - ! spectra(cou) = spect_signal(liop)*spect_signal(liop) + spect_signal(1+liop)*spect_signal(1+liop) - ! ENDDO - ! spectra(1)=spect_signal(1)*spect_signal(1) - ! spectra=spectra/(size(spectra)*2) - ! m%speccou=0 - ! ENDIF - - ! TODO: Handle degenerate case where Vrel = 0.0 (DONE) + !IF (m%speccou .eq. p%total_sample)THEN + !spect_signal=xd%VrelStore( 1:p%total_sample,J,I ) + ! CALL ApplyFFT_f( spect_signal, FFT_Data, ErrStat2 ) + ! IF (ErrStat2 /= ErrID_None ) THEN + ! CALL SetErrStat(ErrStat2, 'Error in ApplyFFT .', ErrStat, ErrMsg, 'CalcAeroAcousticsOutput' ) + ! ENDIF + !cou=1 + !O liop=2,size(spect_signal)-1,2 + !cou=cou+1 + !spectra(cou) = spect_signal(liop)*spect_signal(liop) + spect_signal(1+liop)*spect_signal(1+liop) + !ENDDO + !spectra(1)=spect_signal(1)*spect_signal(1) + !spectra=spectra/(size(spectra)*2) + ! m%speccou=0 + !ENDIF + Unoise = u%Vrel(J,I) IF (EqualRealNos(Unoise,0.0_ReKi)) then - Unoise = 0.1 + Unoise = 0.1 ! TODO TODO a value consistent with the test above should be used ENDIF - ! TODO: Handle degenerate case where BlSpn = 0.0 (DONE) ! solved by variable 'elementspan' and loop over 2 IF (J .EQ. p%NumBlNds) THEN elementspan = (p%BlSpn(J,I)-p%BlSpn(J-1,I))/2 ELSE @@ -1190,18 +1107,17 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) !--------Xfoil Boundary Layer Either Every Step Calculate or Interpolate from pretabulated-------------------------! IF (p%X_BLMethod .EQ. 2) THEN - IF (p%XfoilCall .eq. 1) THEN + IF ((p%XfoilCall==XfoilCall_None) .or. (p%XfoilCall==XfoilCall_Tabulate)) THEN call BL_Param_Interp(p,m,Unoise,AlphaNoise,p%BlChord(J,I),p%BlAFID(J,I), errStat2, errMsg2) - temp_dispthick(J,I)= m%d99Var(1) - m%d99Var = m%d99Var*p%BlChord(J,I) - m%dstarVar = m%dstarVar*p%BlChord(J,I) + temp_dispthick(J,I) = m%d99Var(1) + m%d99Var = m%d99Var*p%BlChord(J,I) + m%dstarVar = m%dstarVar*p%BlChord(J,I) temp_dispthickchord(J,I)=m%d99Var(1) - !call BL_Param_Interp(p,m,Unoise,AlphaNoise,0.22860d0,p%BlAFID(J,I), errStat2, errMsg2) - ! m%d99Var = m%d99Var*0.22860d0 - ! m%dstarVar = m%dstarVar*0.22860d0 - ELSEIF (p%XfoilCall .eq. 2) THEN - !CALL XFOIL_BL_SINGLE(p,m,p%BlAFID(J,I),p%BlChord(J,I),UNoise,AlphaNoise) - !CALL XFOIL_BL_SINGLE(p,m,p%BlAFID(J,I),0.22860d0,63.920d0,3.0d0) + ELSEIF (p%XfoilCall .eq. XfoilCall_Every) THEN + CALL XFOIL_BL_SINGLE(p,m,p%BlAFID(J,I),p%BlChord(J,I),UNoise,AlphaNoise, ErrStat2, ErrMsg2) + ELSE + call SetErrStat( ErrID_Fatal, 'XfoilCall not handled correctly. Contact developper', ErrStat, ErrMsg, RoutineName ) + return ENDIF ENDIF @@ -1214,8 +1130,6 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) CALL LBLVS(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & elementspan,m%rTEtoObserve(K,J,I), & p,m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLLBL,errStat2,errMsg2) - ! CALL LBLVS(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0, & - ! p,m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLLBL,errStat2,errMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ENDIF !--------Turbulent Boundary Layer Trailing Edge Noise----------------------------! @@ -1223,8 +1137,6 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) CALL TBLTE(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & elementspan,m%rTEtoObserve(K,J,I), p, j,i,k,m%d99Var(2),m%dstarVar(1),m%dstarVar(2),p%StallStart(J,I), & m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,errStat2,errMsg2 ) - ! CALL TBLTE(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0, & - ! p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),p%StallStart(J,I),m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,errStat2,errMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (p%ITURB .EQ. 2) THEN m%SPLP=0.0_ReKi;m%SPLS=0.0_ReKi;m%SPLTBL=0.0_ReKi; @@ -1232,10 +1144,6 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) CALL TBLTE_TNO(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & elementspan,m%rTEtoObserve(K,J,I),m%CfVar,m%d99var,m%EdgeVelVar ,p, & m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,errStat2 ,errMsg2) - !Nafnoise check - ! m%CfVar(1) = 0.0003785760d0;m%CfVar(2) = 0.001984380d0; m%d99var(1)= 0.01105860d0; m%d99var(2)= 0.007465830d0;m%EdgeVelVar(1)=1.000d0;m%EdgeVelVar(2)=m%EdgeVelVar(1); - ! CALL TBLTE_TNO(3.0_Reki,0.22860_Reki,63.9200_Reki,90.00_Reki,90.0_Reki,0.5090_Reki,1.220_Reki, & - ! m%CfVar,m%d99var,m%EdgeVelVar, p, m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,errStat2 ,errMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ENDIF ENDIF @@ -1244,8 +1152,6 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) CALL BLUNT(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & elementspan,m%rTEtoObserve(K,J,I),p%TEThick(J,I),p%TEAngle(J,I), & p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLBLUNT,errStat2,errMsg2 ) - ! CALL BLUNT(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0, & - ! p%TEThick(J,I),p%TEAngle(J,I),p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLBLUNT,errStat2,errMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ENDIF !--------Tip Noise--------------------------------------------------------------! @@ -1255,27 +1161,23 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ENDIF !--------Inflow Turbulence Noise ------------------------------------------------! - ! important checks to be done inflow tubulence inputs + ! important checks to be done inflow tubulence inputs IF (p%IInflow.gt.0) then ! Amiet's Inflow Noise Model is Calculated as long as InflowNoise is On CALL InflowNoise(AlphaNoise,p%BlChord(J,I),Unoise,m%ChordAngleLE(K,J,I),m%SpanAngleLE(K,J,I),& elementspan,m%rLEtoObserve(K,J,I),xd%MeanVxVyVz(J,I),xd%TIVx(J,I),m%LE_Location(3,J,I),0.050,xd%TIVx(J,I),p,m%SPLti,errStat2,errMsg2 ) - ! CALL InflowNoise(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0, & - ! xd%MeanVrel(J,I),0.050d0,0.050d0,p,m%SPLti,errStat2,errMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! If Guidati model (simplified or full version) is also on then the 'SPL correction' to Amiet's model will be added + ! If Guidati model (simplified or full version) is also on then the 'SPL correction' to Amiet's model will be added IF ( p%IInflow .EQ. 2 ) THEN - ! CALL FullGuidati(3.0d0,63.920d0,0.22860d0,0.5090d0,1.220d0,90.0d0,90.0d0,xd%MeanVrel(J,I),xd%TIVrel(J,I), & - ! p,p%BlAFID(J,I),m%SPLTIGui,errStat2 ) CALL FullGuidati(AlphaNoise,UNoise,p%BlChord(J,I),elementspan,m%rLEtoObserve(K,J,I), & m%ChordAngleLE(K,J,I),m%SpanAngleLE(K,J,I),xd%MeanVrel(J,I),xd%TIVrel(J,I), & p,p%BlAFID(J,I),m%SPLTIGui,errStat2,errMsg2 ) + write(*,*)'FullGuidati: EBRA: SplTi appears unset. TODO' CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) m%SPLti=m%SPLti+m%SPLTIGui+10 ! +10 is fudge factor to match NLR data ELSEIF ( p%IInflow .EQ. 3 ) THEN CALL Simple_Guidati(UNoise,p%BlChord(J,I),p%AFThickGuida(2,p%BlAFID(J,I)), & p%AFThickGuida(1,p%BlAFID(J,I)),p,m%SPLTIGui,errStat2,errMsg2 ) - ! CALL Simple_Guidati(UNoise,0.22860d0,0.120d0,0.020d0,p,m%SPLTIGui,errStat2,errMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) m%SPLti=m%SPLti+m%SPLTIGui+10 ! +10 is fudge factor to match NLR data @@ -1349,9 +1251,9 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) y%SumSpecNoise(III,K,I) = Ptotal + y%SumSpecNoise(III,K,I) y%DirectiviOutput(K) = Ptotal + y%DirectiviOutput(K) - ! IF (y%SumSpecNoise(III,K,I) .EQ. 0.) y%SumSpecNoise(III,K,I)=1 + ! IF (y%SumSpecNoise(III,K,I) .EQ. 0.) y%SumSpecNoise(III,K,I)=1 - IF (y%DirectiviOutput(K) .EQ. 0.) y%DirectiviOutput(K) =1 ! + IF (y%DirectiviOutput(K) .EQ. 0.) y%DirectiviOutput(K) =1 ! IF (y%SumSpecNoiseSep(1,K,III) .EQ. 0.) y%SumSpecNoiseSep(1,K,III) =1 ! LBL IF (y%SumSpecNoiseSep(2,K,III) .EQ. 0.) y%SumSpecNoiseSep(2,K,III) =1 ! TBLP IF (y%SumSpecNoiseSep(3,K,III) .EQ. 0.) y%SumSpecNoiseSep(3,K,III) =1 ! TBLS @@ -1363,14 +1265,14 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) ForMaxLoc(K,J,I,III) = 10.*LOG10(y%SumSpecNoise(III,K,I)) - IF (p%AweightFlag.eq.1) THEN - IF (m%SPLLBL(III) .NE. 0.) ForMaxLoc3(1,III,K,J,I) = m%SPLLBL(III)+p%Aweight(III) ! LBL - IF (m%SPLP(III) .NE. 0.) ForMaxLoc3(2,III,K,J,I) = m%SPLP(III)+p%Aweight(III) ! TBLP - IF (m%SPLS(III) .NE. 0.) ForMaxLoc3(3,III,K,J,I) = m%SPLS(III)+p%Aweight(III) ! TBLS - IF (m%SPLALPH(III) .NE. 0.) ForMaxLoc3(4,III,K,J,I) = m%SPLALPH(III)+p%Aweight(III) ! Sep - IF (m%SPLBLUNT(III).NE. 0.) ForMaxLoc3(5,III,K,J,I) = m%SPLBLUNT(III)+p%Aweight(III) ! Blunt - IF (m%SPLTIP(III) .NE. 0.) ForMaxLoc3(6,III,K,J,I) = m%SPLTIP(III)+p%Aweight(III) ! Tip - IF (m%SPLti(III) .NE. 0.) ForMaxLoc3(7,III,K,J,I) = m%SPLti(III) +p%Aweight(III) ! Inflow + IF (p%AweightFlag) THEN + IF (m%SPLLBL(III) .NE. 0.) ForMaxLoc3(1,III,K,J,I) = m%SPLLBL(III) + p%Aweight(III) ! LBL + IF (m%SPLP(III) .NE. 0.) ForMaxLoc3(2,III,K,J,I) = m%SPLP(III) + p%Aweight(III) ! TBLP + IF (m%SPLS(III) .NE. 0.) ForMaxLoc3(3,III,K,J,I) = m%SPLS(III) + p%Aweight(III) ! TBLS + IF (m%SPLALPH(III) .NE. 0.) ForMaxLoc3(4,III,K,J,I) = m%SPLALPH(III) + p%Aweight(III) ! Sep + IF (m%SPLBLUNT(III).NE. 0.) ForMaxLoc3(5,III,K,J,I) = m%SPLBLUNT(III) + p%Aweight(III) ! Blunt + IF (m%SPLTIP(III) .NE. 0.) ForMaxLoc3(6,III,K,J,I) = m%SPLTIP(III) + p%Aweight(III) ! Tip + IF (m%SPLti(III) .NE. 0.) ForMaxLoc3(7,III,K,J,I) = m%SPLti(III) + p%Aweight(III) ! Inflow ELSE ForMaxLoc3(1,III,K,J,I) = m%SPLLBL(III) ! LBL ForMaxLoc3(2,III,K,J,I) = m%SPLP(III) ! TBLP @@ -1410,14 +1312,12 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) DO I = 1,p%numBlades DO K = 1,p%NrObsLoc DO III=1,size(p%FreqList) - addpow=10*log10(4*pi*m%rTEtoObserve(K,J,I)*m%rTEtoObserve(K,J,I)) - IF (y%SumSpecNoise(III,K,I) .EQ. 0.) y%SumSpecNoise(III,K,I)=1 - IF (p%AweightFlag.eq.1) THEN + IF (y%SumSpecNoise(III,K,I) .EQ. 0.) y%SumSpecNoise(III,K,I)=1 + IF (p%AweightFlag) THEN y%SumSpecNoise(III,K,I) = 10.*LOG10(y%SumSpecNoise(III,K,I))+p%Aweight(III) ELSE y%SumSpecNoise(III,K,I) = 10.*LOG10(y%SumSpecNoise(III,K,I)) ENDIF - ! y%SumSpecNoise(III,K,I) = 10.*LOG10(y%SumSpecNoise(III,K,I))+addpow !this is the equation used for sound power level !SPLw(f)=SPL(f)+10*log10(4*pi*dis**2); ENDDO ENDDO ENDDO @@ -1447,7 +1347,7 @@ SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) ENDDO ENDDO !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - IF (p%LargeBinOutput.eq.1) THEN + IF (p%LargeBinOutput) THEN IF (m%filesopen.eq.0) THEN open (12340,file='ForMaxLoc3.bin',access='stream',form='unformatted',status='REPLACE') !open a binary file write(12340) Size(ForMaxLoc3,1) @@ -1596,27 +1496,27 @@ SUBROUTINE LBLVS(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,SPLLAM, END SUBROUTINE LBLVS !==================================================================================================================================! SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,jj,ii,kk,d99Var2,dstarVar1,dstarVar2,StallVal,SPLP,SPLS,SPLALPH,SPLTBL,errStat,errMsg) - REAL(ReKi), INTENT(IN ) :: ALPSTAR ! AOA (deg) - REAL(ReKi), INTENT(IN ) :: C ! Chord Length (m) - REAL(ReKi), INTENT(IN ) :: U ! Unoise (m/s) - REAL(ReKi), INTENT(IN ) :: THETA ! DIRECTIVITY ANGLE (deg) - REAL(ReKi), INTENT(IN ) :: PHI ! DIRECTIVITY ANGLE (deg) - REAL(ReKi), INTENT(IN ) :: L ! SPAN (m) - REAL(ReKi), INTENT(IN ) :: R ! SOURCE TO OBSERVER DISTANCE (m) - REAL(ReKi), INTENT(IN ) :: d99Var2 ! - REAL(ReKi), INTENT(IN ) :: dstarVar1 ! - REAL(ReKi), INTENT(IN ) :: dstarVar2 ! - REAL(ReKi), INTENT(IN ) :: StallVal ! - INTEGER(IntKi), INTENT( IN) :: jj ! Error status of the operation - INTEGER(IntKi), INTENT( IN) :: ii ! Error status of the operation - - INTEGER(IntKi), INTENT( IN) :: kk ! Error status of the operation + REAL(ReKi), INTENT(IN ) :: ALPSTAR ! AOA(deg) + REAL(ReKi), INTENT(IN ) :: C ! Chord Length (m) + REAL(ReKi), INTENT(IN ) :: U ! Unoise(m/s) + REAL(ReKi), INTENT(IN ) :: THETA ! DIRECTIVITY ANGLE (deg) + REAL(ReKi), INTENT(IN ) :: PHI ! DIRECTIVITY ANGLE (deg) + REAL(ReKi), INTENT(IN ) :: L ! SPAN(m) + REAL(ReKi), INTENT(IN ) :: R ! SOURCE TO OBSERVER DISTANCE (m) + REAL(ReKi), INTENT(IN ) :: d99Var2 ! + REAL(ReKi), INTENT(IN ) :: dstarVar1 ! + REAL(ReKi), INTENT(IN ) :: dstarVar2 ! + REAL(ReKi), INTENT(IN ) :: StallVal ! + INTEGER(IntKi), INTENT( IN) :: jj ! Error status of the operation + INTEGER(IntKi), INTENT( IN) :: ii ! Error status of the operation + + INTEGER(IntKi), INTENT( IN) :: kk ! Error status of the operation TYPE(AA_ParameterType), INTENT(IN ) :: p ! Noise Module Parameters - REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLP ! SOUND PRESSURE LEVEL DUE TO PRESSURE SIDE OF AIRFOIL (db) - REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLS ! SOUND PRESSURE LEVEL DUE TO SUCTION SIDE OF AIRFOIL (db) - REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLTBL ! TOTAL SOUND PRESSURE LEVEL DUE TO TBLTE MECHANISM (db) - REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLALPH ! SOUND PRESSURE LEVEL DUE TO ANGLE OF ATTACK CONTRIBUTION (db) - INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLP ! SOUND PRESSURE LEVEL DUE TO PRESSURE SIDE OF AIRFOIL (db) + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLS ! SOUND PRESSURE LEVEL DUE TO SUCTION SIDE OF AIRFOIL (db) + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLTBL ! TOTAL SOUND PRESSURE LEVEL DUE TO TBLTE MECHANISM (db) + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLALPH ! SOUND PRESSURE LEVEL DUE TO ANGLE OF ATTACK CONTRIBUTION (db) + INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None integer(intKi) :: ErrStat2 ! temporary Error status character(ErrMsgLen) :: ErrMsg2 ! temporary Error message @@ -1659,9 +1559,9 @@ SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,jj,ii,kk,d99Var2,dstarVar1,dstarVar real(ReKi) :: BETA ! USED IN 'B' COMPUTATION --- real(ReKi) :: GAMMA0 ! USED IN 'B' COMPUTATION --- real(ReKi) :: BETA0 ! USED IN 'B' COMPUTATION --- - real(ReKi) :: K1 ! AMPLITUDE FUNCTION (DB) - real(ReKi) :: K2 ! AMPLITUDE FUNCTION (DB) - real(ReKi) :: P1 ! PRESSURE SIDE PRESSURE (NT/M2) + real(ReKi) :: K1 ! AMPLITUDE FUNCTION (DB) + real(ReKi) :: K2 ! AMPLITUDE FUNCTION (DB) + real(ReKi) :: P1 ! PRESSURE SIDE PRESSURE (NT/M2) real(ReKi) :: P2 ! SUCTION SIDE PRESSURE (NT/M2) real(ReKi) :: P4 ! PRESSURE FROM ANGLE OF ATTACK CONTRIBUTION (NT/M2) real(ReKi) :: M ! MACH NUMBER @@ -1671,7 +1571,7 @@ SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,jj,ii,kk,d99Var2,dstarVar1,dstarVar real(ReKi) :: DBARH ! HIGH FREQUENCY DIRECTIVITY --- real(ReKi) :: DBARL ! LOW FREQUENCY DIRECTIVITY --- - integer(intKi) :: I ! I A generic index for DO loops. + integer(intKi) :: I ! I A generic index for DO loops. LOGICAL :: SWITCH !!LOGICAL FOR COMPUTATION OF ANGLE OF ATTACK CONTRIBUTION @@ -1691,7 +1591,7 @@ SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,jj,ii,kk,d99Var2,dstarVar1,dstarVar ENDIF ! Compute directivity function CALL DIRECTL(M,THETA,PHI,DBARL,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL DIRECTH(M,THETA,PHI,DBARH,errStat2,errMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! IF (DBARH <= 0) THEN @@ -1828,7 +1728,7 @@ SUBROUTINE TIPNOIS(ALPHTIP,ALPRAT2,C,U ,THETA,PHI, R,p,SPLTIP, errStat, errMsg) REAL(ReKi) :: UM ! MAXIMUM VELOCITY METERS/SEC REAL(ReKi) :: L ! CHARACTERISTIC LENGTH FOR TIP METERS REAL(ReKi) :: TERM ! SCALING TERM --- - integer(intKi) :: I !I A generic index for DO loops. + integer(intKi) :: I !I A generic index for DO loops. ErrStat = ErrID_None ErrMsg = "" IF (alphtip.eq.0.) THEN @@ -1908,23 +1808,23 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,MeanVNoise,TINoise,LE REAL(ReKi) :: tinooisess ! nafnoise REAL(ReKi) :: L_Gammas ! nafnoise - INTEGER(intKi) :: I !I A generic index for DO loops. + INTEGER(intKi) :: I !I A generic index for DO loops. ErrStat = ErrID_None ErrMsg = "" !!!--- NAF NOISE IDENTICAL - Mach = U/p%SpdSound + Mach = U/p%SpdSound ! This part is recently added for height and surface roughness dependent estimation of turbulence intensity and turbulence scales - !%Lturb=300*(Z/300)^(0.46+0.074*log(p%z0_aa)); !% Gives larger length scale - Lturb=25.d0*LE_Location**(0.35)*p%z0_aa**(-0.063) !% Gives smaller length scale - L_Gammas=0.24+0.096*log10(p%z0_aa)+0.016*(log10(p%z0_aa))**2; !% Can be computed or just give it a value. -! tinooisess=L_Gammas*log(30.d0/p%z0_aa)/log(LE_Location/p%z0_aa) !% F.E. 16% is 0.16 which is the correct input for SPLhIgh, no need to divide 100 +!%Lturb=300*(Z/300)^(0.46+0.074*log(p%z0_aa)); !% Gives larger length scale +Lturb=25.d0*LE_Location**(0.35)*p%z0_aa**(-0.063) !% Gives smaller length scale +L_Gammas=0.24+0.096*log10(p%z0_aa)+0.016*(log10(p%z0_aa))**2; !% Can be computed or just give it a value. +!tinooisess=L_Gammas*log(30.d0/p%z0_aa)/log(LE_Location/p%z0_aa) !% F.E. 16% is 0.16 which is the correct input for SPLhIgh, no need to divide 100 tinooisess=TINoise -! Lturb=50 -! tinooisess=0.1 - !Ums = (tinooisess*U)**2 - !Ums = (tinooisess*8)**2 +!Lturb=50 +!tinooisess=0.1 +!Ums = (tinooisess*U)**2 +!Ums = (tinooisess*8)**2 CALL DIRECTL(Mach,THETA,PHI,DBARL,errStat2,errMsg2) !yes, assume that noise is low-freq in nature because turbulence length scale is large - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL DIRECTH(Mach,THETA,PHI,DBARH,errStat2,errMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (DBARH <= 0) THEN @@ -1949,59 +1849,59 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,MeanVNoise,TINoise,LE ! SPLhigh = 10.*LOG10(p%AirDens*p%AirDens*p%SpdSound**4*LTurb*(d/2.)/ & ! (RObs*RObs)*(Mach**5)*tinooisess*tinooisess*(Khat**3)* & ! (1+Khat**2)**(-7./3.)*Directivity) + 78.4 -!! SPLhigh = 10.*LOG10(LTurb*(d/2.)/ & +!! SPLhigh = 10.*LOG10(LTurb*(d/2.)/ & !! (RObs*RObs)*(Mach**5)*tinooisess*tinooisess*(WaveNumber**3) & !! *(1+WaveNumber**2)**(-7./3.)*Directivity) + 181.3 ! SPLhigh = SPLhigh + 10.*LOG10(1+ 9.0*ALPSTAR*ALPSTAR) ! Sears = 1/(2.*PI*Kbar/Beta2+1/(1+2.4*Kbar/Beta2)) -!! Sears = 1/(2.*PI*WaveNumber/Beta2+1/(1+2.4*WaveNumber/Beta2)) +!! Sears = 1/(2.*PI*WaveNumber/Beta2+1/(1+2.4*WaveNumber/Beta2)) ! LFC = 10*Sears*Mach*Kbar*Kbar/Beta2 -!! LFC = 10*Sears*Mach*WaveNumber*WaveNumber/Beta2 +!! LFC = 10*Sears*Mach*WaveNumber*WaveNumber/Beta2 !! IF (mu<(PI/4.0)) THEN -!! SPLti(I) = SPLhigh + 10.*ALOG10(LFC) -!! ELSE -!! SPLti(I) = SPLhigh -!! ENDIF -! SPLti(I) = SPLhigh + 10.*LOG10(LFC/(1+LFC)) +!! SPLti(I) = SPLhigh + 10.*ALOG10(LFC) +!! ELSE +!! SPLti(I) = SPLhigh +!! ENDIF +! SPLti(I) = SPLhigh + 10.*LOG10(LFC/(1+LFC)) ! ENDDO !!Wei Jun Zhu et al - !Modeling of Aerodynamically Generated Noise From Wind Turbines 2005 paper - Beta2 = 1.d0-Mach**2; ! corresponding line: Bsq = 1.d0 - Ma**2; + Beta2 = 1.d0-Mach**2; ! corresponding line: Bsq = 1.d0 - Ma**2; DO I=1,size(p%FreqList) - WaveNumber = PI*p%FreqList(I)*p%SpdSound/U !corresponding line: K = pi*Freq(i)*c/Vrel; - Sears = (2.d0*PI*WaveNumber/Beta2 + (1.d0+2.4d0*WaveNumber/Beta2)**(-1))**(-1); - ! corresponding line: Ssq = (2.d0*pi*K/Bsq + (1.d0+2.4d0*K/Bsq)**(-1))**(-1); - LFC = 10.d0 * Sears*Mach*WaveNumber**2*Beta2**(-1); - ! corresponding line: LFC = 10.d0 * Ssq*Ma*K**2*Bsq**(-1); - SPLti(I)=(p%AirDens*p%AirDens*p%SpdSound*p%SpdSound*Lturb*d)/(2*RObs*RObs) -! SPLti(I)=SPLti(I)*(Mach**3)*(MeanVnoise**2)*(tinooisess**2) - SPLti(I)=SPLti(I)*(Mach**3)*(tinooisess**2) -! SPLti(I)=SPLti(I)*(Mach**3)*ufluct**2 - SPLti(I)=(SPLti(I)*(WaveNumber**3)) / ((1+WaveNumber**2)**(7/3)) - SPLti(I)=SPLti(I)*DBARH - SPLti(I)=10*log10(SPLti(I))+58.4 - SPLti(I) = SPLti(I) + 10.*LOG10(LFC/(1+LFC)) -! SPLti(I)=10.d0*log10(DBARH*p%AirDens**2*p%SpdSound**2*Lturb*d/2.0*Mach**3*tinooisess**2* & -! WaveNumber**3*(1.d0+WaveNumber**2)**(-7.d0/3.d0)/RObs**2)+58.4d0 + 10.d0*log10(LFC/(1+LFC)) - ! corresponding line: SPLti(i)=10.d0*log10(Di_hi_fr*Density**2*co**2*Tbscale*L/2.0*Ma + WaveNumber = PI*p%FreqList(I)*p%SpdSound/U !corresponding line: K = pi*Freq(i)*c/Vrel; + Sears = (2.d0*PI*WaveNumber/Beta2 + (1.d0+2.4d0*WaveNumber/Beta2)**(-1))**(-1); + ! corresponding line: Ssq = (2.d0*pi*K/Bsq + (1.d0+2.4d0*K/Bsq)**(-1))**(-1); + LFC = 10.d0 * Sears*Mach*WaveNumber**2*Beta2**(-1); + ! corresponding line: LFC = 10.d0 * Ssq*Ma*K**2*Bsq**(-1); + SPLti(I)=(p%AirDens*p%AirDens*p%SpdSound*p%SpdSound*Lturb*d)/(2*RObs*RObs) +! SPLti(I)=SPLti(I)*(Mach**3)*(MeanVnoise**2)*(tinooisess**2) + SPLti(I)=SPLti(I)*(Mach**3)*(tinooisess**2) +! SPLti(I)=SPLti(I)*(Mach**3)*ufluct**2 + SPLti(I)=(SPLti(I)*(WaveNumber**3)) / ((1+WaveNumber**2)**(7/3)) + SPLti(I)=SPLti(I)*DBARH + SPLti(I)=10*log10(SPLti(I))+58.4 + SPLti(I) = SPLti(I) + 10.*LOG10(LFC/(1+LFC)) +! SPLti(I)=10.d0*log10(DBARH*p%AirDens**2*p%SpdSound**2*Lturb*d/2.0*Mach**3*tinooisess**2* & +!WaveNumber**3*(1.d0+WaveNumber**2)**(-7.d0/3.d0)/RObs**2)+58.4d0 + 10.d0*log10(LFC/(1+LFC)) + ! corresponding line: SPLti(i)=10.d0*log10(Di_hi_fr*Density**2*co**2*Tbscale*L/2.0*Ma ! & **3*Tbinten**2*K**3*(1.d0+K**2)**(-7.d0/3.d0)/Distance**2)+58.4d0 ! & + 10.d0*log10(LFC/(1+LFC)); !% ver2.! -! Kh = 8.d0*pi*p%FreqList(i)*Lturb/(3.d0*U); +! Kh = 8.d0*pi*p%FreqList(i)*Lturb/(3.d0*U); ! SPLti(i) = 10*log10(DBARH*Lturb*0.5*d*Mach**5*tinooisess**2*Kh**3*(1+Kh**2)**(-7/3)/RObs**2) +& ! 10*log10(10**18.13) + 10*log10(DBARH*LFC/(1+LFC)); - ENDDO +ENDDO !!Buck&Oerlamans&Palo - !Experimental validation of a wind turbine turbulent inflow noise prediction code 2016 paper - !DO I=1,size(p%FreqList) +!DO I=1,size(p%FreqList) ! IF (p%FreqList(I) <= Frequency_cutoff) THEN ! Directivity = DBARL ! ELSE ! Directivity = DBARH ! ENDIF - ! WaveNumber = 2.0*PI*p%FreqList(I)/U ! (K) + ! WaveNumber = 2.0*PI*p%FreqList(I)/U ! (K) ! Kbar = WaveNumber*Chord/2.0 ! Khat = WaveNumber/Ke ! SPLhigh = ( (p%AirDens**2) * (p%SpdSound**2) *d ) / (2*RObs*RObs) - ! SPLhigh = SPLhigh * (Mach**3) * (dissip**(2/3)) * (WaveNumber**(-5/3)) * Directivity +! SPLhigh = SPLhigh * (Mach**3) * (dissip**(2/3)) * (WaveNumber**(-5/3)) * Directivity ! SPLhigh = 10.*LOG10(SPLhigh) + 77.6 ! Sears = 1/(2.*PI*Kbar/Beta2+1/(1+2.4*Kbar/Beta2)) ! LFC = 10*Sears*(1+9.0*ALPSTAR*ALPSTAR)*Mach*Kbar*Kbar/Beta2 @@ -2011,15 +1911,15 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,MeanVNoise,TINoise,LE ! double commented lines are from FAST v4.0 aeroacoustics module. But Nafnoise version is used see above !! Mach = U/p%SpdSound !! -!! IF (TINoise > 0) THEN -!! Ums = (TINoise*MeanVNoise/100.)**2 ! mean square turbulence level -!! ELSE -!! SPLti = 0. -!! RETURN -!! ENDIF +!!IF (TINoise > 0) THEN +!! Ums = (TINoise*MeanVNoise/100.)**2 ! mean square turbulence level +!!ELSE +!! SPLti = 0. +!! RETURN +!!ENDIF !! -!! LTurb=60 -!! LTurb=0.06 +!! LTurb=60 +!! LTurb=0.06 !!! temporarily commented !!! IF (FASTHH < 30.0) THEN !!! LTurb = 3.5*0.7*FASTHH ! Prediction sensitive to this parameter! @@ -2032,11 +1932,11 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,MeanVNoise,TINoise,LE !!! Calculate directivity...? !!!!! ---------------------------- !! CALL DIRECTL(Mach,THETA,PHI,DBARL,errStat2,errMsg2) !yes, assume that noise is low-freq in nature because turbulence length scale is large -!! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) +!! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !! CALL DIRECTH(Mach,THETA,PHI,DBARH,errStat2,errMsg2) -!! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) +!! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !! IF (DBARH <= 0) THEN -!! SPLti = 0. +!! SPLti = 0. !! RETURN !! ENDIF !! @@ -2065,22 +1965,22 @@ SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,MeanVNoise,TINoise,LE END SUBROUTINE InflowNoise !==================================================================================================== SUBROUTINE BLUNT(ALPSTAR,C,U ,THETA,PHI,L,R,H,PSI,p,d99Var2,dstarVar1,dstarVar2,SPLBLUNT,errStat,errMsg) - REAL(ReKi), INTENT(IN ) :: ALPSTAR ! AOA - REAL(ReKi), INTENT(IN ) :: C ! Chord Length - REAL(ReKi), INTENT(IN ) :: U ! Unoise - REAL(ReKi), INTENT(IN ) :: THETA ! DIRECTIVITY ANGLE --- - REAL(ReKi), INTENT(IN ) :: PHI ! DIRECTIVITY ANGLE --- - REAL(ReKi), INTENT(IN ) :: L ! SPAN METERS - REAL(ReKi), INTENT(IN ) :: R ! SOURCE TO OBSERVER DISTANCE METERS - REAL(ReKi), INTENT(IN ) :: H ! TRAILING EDGE BLUNTNESS METERS - REAL(ReKi), INTENT(IN ) :: PSI ! TRAILING EDGE ANGLE DEGREES - REAL(ReKi), INTENT(IN ) :: d99Var2 ! - REAL(ReKi), INTENT(IN ) :: dstarVar1 ! - REAL(ReKi), INTENT(IN ) :: dstarVar2 ! - TYPE(AA_ParameterType), INTENT(IN ) :: p ! Parameters - REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLBLUNT ! - INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation - character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None + REAL(ReKi), INTENT(IN ) :: ALPSTAR ! AOA + REAL(ReKi), INTENT(IN ) :: C ! Chord Length + REAL(ReKi), INTENT(IN ) :: U ! Unoise + REAL(ReKi), INTENT(IN ) :: THETA ! DIRECTIVITY ANGLE --- + REAL(ReKi), INTENT(IN ) :: PHI ! DIRECTIVITY ANGLE --- + REAL(ReKi), INTENT(IN ) :: L ! SPAN METERS + REAL(ReKi), INTENT(IN ) :: R ! SOURCE TO OBSERVER DISTANCE METERS + REAL(ReKi), INTENT(IN ) :: H ! TRAILING EDGE BLUNTNESS METERS + REAL(ReKi), INTENT(IN ) :: PSI ! TRAILING EDGE ANGLE DEGREES + REAL(ReKi), INTENT(IN ) :: d99Var2 ! + REAL(ReKi), INTENT(IN ) :: dstarVar1 ! + REAL(ReKi), INTENT(IN ) :: dstarVar2 ! + TYPE(AA_ParameterType), INTENT(IN ) :: p ! Parameters + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLBLUNT ! + INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation + character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None ! Local variables integer(intKi) :: ErrStat2 ! temporary Error status character(ErrMsgLen) :: ErrMsg2 ! temporary Error message @@ -2169,7 +2069,7 @@ SUBROUTINE BLUNT(ALPSTAR,C,U ,THETA,PHI,L,R,H,PSI,p,d99Var2,dstarVar1,dstarVar2, ! SPLBLUNT(I) = G4 + G5(I) + SCALE ! OLD VERSION END ! NEW VERSION START - G5Sum = 10**(G5(I)/10)+G5Sum ! to be subtracted + G5Sum = 10**(G5(I)/10)+G5Sum ! to be subtracted SPLBLUNT(I) = G4 + G5(I) + SCALE - 10*log10(1/G5Sum) ! equation mentioned there is plus but it is stated subtract, thus ''- 10*log10(1/G5Sum)'' ! NEW VERSION END end do @@ -2214,8 +2114,8 @@ END SUBROUTINE G5Comp !==================================================================================================== !> This subroutine defines the curve fit corresponding to the a-curve for the minimum allowed reynolds number. SUBROUTINE AMIN(A,AMINA) - REAL(ReKi), INTENT(IN ) :: A ! - REAL(ReKi), INTENT(OUT ) :: AMINA ! + REAL(ReKi), INTENT(IN ) :: A ! + REAL(ReKi), INTENT(OUT ) :: AMINA ! REAL(ReKi) :: X1 X1 = ABS(A) IF (X1 .LE. .204) AMINA=SQRT(67.552-886.788*X1**2.)-8.219 @@ -2225,8 +2125,8 @@ END SUBROUTINE AMIN !==================================================================================================== !> This subroutine defines the curve fit corresponding to the a-curve for the maximum allowed reynolds number. SUBROUTINE AMAX(A,AMAXA) - REAL(ReKi), INTENT(IN ) :: A ! - REAL(ReKi), INTENT(OUT ) :: AMAXA ! + REAL(ReKi), INTENT(IN ) :: A ! + REAL(ReKi), INTENT(OUT ) :: AMAXA ! REAL(ReKi) :: X1 X1 = ABS(A) IF (X1 .LE. .13)AMAXA=SQRT(67.552-886.788*X1**2.)-8.219 @@ -2236,8 +2136,8 @@ END SUBROUTINE AMAX !==================================================================================================== !> This subroutine defines the curve fit corresponding to the b-curve for the minimum allowed reynolds number. SUBROUTINE BMIN(B,BMINB) - REAL(ReKi), INTENT(IN ) :: B ! - REAL(ReKi), INTENT(OUT ) :: BMINB ! + REAL(ReKi), INTENT(IN ) :: B ! + REAL(ReKi), INTENT(OUT ) :: BMINB ! REAL(ReKi) :: X1 X1 = ABS(B) IF (X1 .LE. .13)BMINB=SQRT(16.888-886.788*X1**2.)-4.109 @@ -2389,25 +2289,25 @@ END SUBROUTINE DirectL !=============================== Full Guidati Model Inflow Turbulence Noise - Addition ==========================================! !==================================================================================================================================! SUBROUTINE FullGuidati(ALPSTAR,U,Chords,d,RObs,THETA,PHI,MeanVNoise,TINoise,p,whichairfoil,SPLti,errStat,errMsgn) - USE Atmosphere - USE TINoiseGeneric - USE TINoiseGeo - USE TINoiseInput - USE TICoords - USE AirfoilParams - USE TI_Guidati - REAL(R8Ki), INTENT(IN ) :: ALPSTAR !< AOA (deg) - REAL(R8Ki), INTENT(IN ) :: Chords !< Chord Length - REAL(R8Ki), INTENT(IN ) :: U !< - REAL(R8Ki), INTENT(IN ) :: d !< element span - REAL(R8Ki), INTENT(IN ) :: RObs !< distance to observer - REAL(R8Ki), INTENT(IN ) :: THETA !< - REAL(R8Ki), INTENT(IN ) :: PHI !< Spanwise directivity angle - REAL(R8Ki), INTENT(IN ) :: MeanVNoise !< - REAL(R8Ki), INTENT(IN ) :: TINoise !< + USE Atmosphere, only: nu, rho, co + USE TINoiseGeneric, only: mach_ti, csound, pi2 + USE TINoiseGeo, only: alfa + USE TINoiseInput, only: npath, nfreq, freq_in, chord, dpath, alpha_in + USE TICoords, only: n_in, x_ti, y_ti + USE AirfoilParams, only: aofa, a_chord + !USE TI_Guidati + REAL(ReKi), INTENT(IN ) :: ALPSTAR !< AOA (deg) + REAL(Reki), INTENT(IN ) :: Chords !< Chord Length + REAL(ReKi), INTENT(IN ) :: U !< + REAL(ReKi), INTENT(IN ) :: d !< element span + REAL(ReKi), INTENT(IN ) :: RObs !< distance to observer + REAL(ReKi), INTENT(IN ) :: THETA !< + REAL(ReKi), INTENT(IN ) :: PHI !< Spanwise directivity angle + REAL(ReKi), INTENT(IN ) :: MeanVNoise !< + REAL(ReKi), INTENT(IN ) :: TINoise !< integer(intKi), INTENT(IN ) :: whichairfoil !< whichairfoil TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters - REAL(R8Ki),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLti !< + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLti !< INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation character(*), INTENT( OUT) :: errMsgn !< Error message if ErrStat /= ErrID_None ! local variables @@ -2417,14 +2317,15 @@ SUBROUTINE FullGuidati(ALPSTAR,U,Chords,d,RObs,THETA,PHI,MeanVNoise,TINoise,p,wh integer(intKi) :: loop1 ! temporary ErrStat = ErrID_None ErrMsgn = "" - + SPLti=0.0_R8Ki ! EBRA: NOTE, this does not seem to be set TODO TODO TODO TODO FIGURE THIS OUT + ! NOTE: Type conversions might occur rho = p%AirDens co = p%SpdSound nu = p%KinVisc aofa = ALPSTAR a_chord = Chords - npath = 40 ! Number of Streamlines (Guidati full model) - dpath = 0.005 ! Distance between streamlines (Guidati full model) + npath = 40 ! Number of Streamlines (Guidati full model) + dpath = 0.005 ! Distance between streamlines (Guidati full model) mach_ti = U / co CALL INICON ! Instead of calling readin routine the necessary variables are assigned within this subroutine @@ -2443,20 +2344,20 @@ SUBROUTINE FullGuidati(ALPSTAR,U,Chords,d,RObs,THETA,PHI,MeanVNoise,TINoise,p,wh CALL DEFGEO CALL DRM_AER CALL DRM_ACU -END SUBROUTINE FullGuidati +END SUBROUTINE FullGuidati !==================================================================================================================================! !=============================== Simplified Guidati Inflow Turbulence Noise Addition =============================================! !==================================================================================================================================! ! Uses simple correction for turbulent inflow noise from Moriarty et. al 2005 SUBROUTINE Simple_Guidati(U,Chord,thick_10p,thick_1p,p,SPLti,errStat,errMsg) - REAL(ReKi), INTENT(IN ) :: U ! Vrel - REAL(ReKi), INTENT(IN ) :: Chord ! Chord Length - REAL(ReKi), INTENT(IN ) :: thick_10p ! - REAL(ReKi), INTENT(IN ) :: thick_1p ! - TYPE(AA_ParameterType), INTENT(IN ) :: p ! Parameters - REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLti ! - INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation - character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None + REAL(ReKi), INTENT(IN ) :: U ! Vrel + REAL(ReKi), INTENT(IN ) :: Chord ! Chord Length + REAL(ReKi), INTENT(IN ) :: thick_10p ! + REAL(ReKi), INTENT(IN ) :: thick_1p ! + TYPE(AA_ParameterType), INTENT(IN ) :: p ! Parameters + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLti ! + INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation + character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None ! local variables integer(intKi) :: ErrStat2 ! temporary Error status character(ErrMsgLen) :: ErrMsg2 ! temporary Error message @@ -2471,8 +2372,8 @@ SUBROUTINE Simple_Guidati(U,Chord,thick_10p,thick_1p,p,SPLti,errStat,errMsg) slope = 1.123*TI_Param + 5.317*TI_Param*TI_Param do loop1 =1,size(p%FreqList) SPLti(loop1) = -slope*(2*PI*p%FreqList(loop1)*chord/U + 5.0d0) - enddo -END SUBROUTINE Simple_Guidati + enddo +END SUBROUTINE Simple_Guidati !==================================================================================================================================! !================================ Turbulent Boundary Layer Trailing Edge Noise ====================================================! !=================================================== TNO START ====================================================================! @@ -2482,21 +2383,21 @@ SUBROUTINE TBLTE_TNO(ALPSTAR,C,U,THETA,PHI,D,R,Cfall,d99all,EdgeVelAll,p,SPLP,SP USE Wavenumber USE BLParams USE AirfoilParams - REAL(R8Ki), INTENT(IN ) :: ALPSTAR !< AOA (deg) - REAL(R8Ki), INTENT(IN ) :: C !< Chord Length (m) - REAL(R8Ki), INTENT(IN ) :: U !< Unoise (m/s) - REAL(R8Ki), INTENT(IN ) :: THETA !< DIRECTIVITY ANGLE (deg) - REAL(R8Ki), INTENT(IN ) :: PHI !< DIRECTIVITY ANGLE (deg) - REAL(R8Ki), INTENT(IN ) :: D !< SPAN (m) - REAL(R8Ki), INTENT(IN ) :: R !< SOURCE TO OBSERVER DISTANCE (m) - REAL(R8Ki),DIMENSION(2), INTENT(IN ) :: Cfall !< Skin friction coefficient (-) - REAL(R8Ki),DIMENSION(2), INTENT(IN ) :: d99all !< - REAL(R8Ki),DIMENSION(2), INTENT(IN ) :: EdgeVelAll !< + REAL(ReKi), INTENT(IN ) :: ALPSTAR !< AOA (deg) + REAL(ReKi), INTENT(IN ) :: C !< Chord Length (m) + REAL(ReKi), INTENT(IN ) :: U !< Unoise (m/s) + REAL(ReKi), INTENT(IN ) :: THETA !< DIRECTIVITY ANGLE (deg) + REAL(ReKi), INTENT(IN ) :: PHI !< DIRECTIVITY ANGLE (deg) + REAL(ReKi), INTENT(IN ) :: D !< SPAN (m) + REAL(ReKi), INTENT(IN ) :: R !< SOURCE TO OBSERVER DISTANCE (m) + REAL(ReKi),DIMENSION(2), INTENT(IN ) :: Cfall !< Skin friction coefficient (-) + REAL(ReKi),DIMENSION(2), INTENT(IN ) :: d99all !< + REAL(ReKi),DIMENSION(2), INTENT(IN ) :: EdgeVelAll !< TYPE(AA_ParameterType), INTENT(IN ) :: p !< Noise Module Parameters - REAL(R8Ki),DIMENSION(size(p%FreqList)), INTENT(IN ) :: SPLALPH !< SOUND PRESSURE LEVEL DUE TO ANGLE OF ATTACK CONTRIBUTION (db) - REAL(R8Ki),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLP !< SOUND PRESSURE LEVEL DUE TO PRESSURE SIDE OF AIRFOIL (db) - REAL(R8Ki),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLS !< SOUND PRESSURE LEVEL DUE TO SUCTION SIDE OF AIRFOIL (db) - REAL(R8Ki),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLTBL !< TOTAL SOUND PRESSURE LEVEL DUE TO TBLTE MECHANISM (db) + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT(IN ) :: SPLALPH !< SOUND PRESSURE LEVEL DUE TO ANGLE OF ATTACK CONTRIBUTION (db) + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLP !< SOUND PRESSURE LEVEL DUE TO PRESSURE SIDE OF AIRFOIL (db) + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLS !< SOUND PRESSURE LEVEL DUE TO SUCTION SIDE OF AIRFOIL (db) + REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLTBL !< TOTAL SOUND PRESSURE LEVEL DUE TO TBLTE MECHANISM (db) INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation character(*), INTENT( OUT) :: errMsgn !< Error message if ErrStat /= ErrID_None ! Local variables @@ -2534,49 +2435,42 @@ SUBROUTINE TBLTE_TNO(ALPSTAR,C,U,THETA,PHI,D,R,Cfall,d99all,EdgeVelAll,p,SPLP,SP epsrel = 1e-10 !relative accuracy band_ratio = 2.**(1./3.) ! Reynolds number and mach number - Mach = SNGL(U / p%SpdSound) - co = SNGL(p%SpdSound) + Mach = real(U / p%SpdSound) + co = real(p%SpdSound ) ! Directivity function CALL DIRECTH(REAL(Mach),THETA,PHI,DBARH,errStat2,errMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsgn, RoutineName ) - - Cf =SNGL(Cfall) - d99 =SNGL(d99all) - edgevel =SNGL(ABS(EdgeVelAll)) - ! rho = 1.225000e0; nu= 1.4529e-5 - rho = SNGL(p%AirDens); nu = SNGL(p%KinVisc) + ! Type conversions + Cf = real(Cfall ) + d99 = real(d99all ) + edgevel = real(ABS(EdgeVelAll)) + rho = real(p%AirDens) + nu = real(p%KinVisc) do i_omega = 1,n_freq omega = 2.*pi*freq(i_omega) - !integration limits a = 0.0e0 b = 10*omega/(Mach*co) - ! Convert to third octave band_width = freq(i_omega)*(sqrt(band_ratio)-1./sqrt(band_ratio)) - ISSUCTION = .TRUE. - IF (Cf(1) .LT. 0.) THEN write(*,*) 'Suction Cf is less than zero, Cf = ',Cf(1) write(*,*) 'Using BPM' ELSE CALL qk61(int2,a,b,answer,abserr,resabs,resasc) Spectrum = D/(4.*pi*R**2.)*answer - SPL_suction = 10*log10(Spectrum*DBARH/2.e-5/2.e-5) SPLS(i_omega) = SPL_suction + 10*log10(band_width) ENDIF ISSUCTION = .FALSE. - IF (Cf(2) .LT. 0.) THEN write(*,*) 'Pressure Cf is less than zero, Cf = ',Cf(1) write(*,*) 'Using BPM' ELSE CALL qk61(int2,a,b,answer,abserr,resabs,resasc) - Spectrum = D/(4.*pi*R**2.)*answer SPL_press = 10*log10(Spectrum*DBARH/2.e-5/2.e-5) SPLP(i_omega) = SPL_press + 10*log10(band_width) @@ -2591,163 +2485,143 @@ SUBROUTINE TBLTE_TNO(ALPSTAR,C,U,THETA,PHI,D,R,Cfall,d99all,EdgeVelAll,p,SPLP,SP P4 = 10.**(SPLALPH(i_omega) / 10.) SPLTBL(i_omega) = 10. * LOG10(P1 + P2 + P4) enddo - ! DO i_omega=1,size(p%FreqList) - ! print*, p%FreqList(i_omega),SPLP(i_omega),SPLS(i_omega),SPLALPH(i_omega) - ! ENDDO END SUBROUTINE TBLTE_TNO !==================================================================================================================================! !================================================= XFOIL BL SINGLE RUN ============================================================! -!SUBROUTINE XFOIL_BL_SINGLE(p,m,whichairfoil,ChordChord,Unoise,AlphaNoise) -! USE XfoilAirfoilParams -! USE XfoilBLParams -! TYPE(AA_ParameterType), INTENT(IN ) :: p ! Parameters -! TYPE(AA_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables -! integer(intKi), INTENT(IN ) :: whichairfoil ! whichairfoil -! REAL(kind=8), INTENT(IN ) :: Unoise ! Unoise -! REAL(kind=8), INTENT(IN ) :: ChordChord ! Chord Length -! REAL(kind=8), INTENT(IN ) :: AlphaNoise ! deg -!! INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation -!! CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None -! INTEGER(intKi) :: ErrStat2 ! temporary Error status -! CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message -! character(*), parameter :: RoutineName = 'XFOIL_BL_SINGLE' -! INTEGER*4 :: itrip,wr_loop -! REAL(ReKi) :: co,U,rho,nu -! -! !ErrStat = ErrID_None -! !ErrMsg = "" -! a_chord=ChordChord -! U=Unoise -! aofa=AlphaNoise -! -! co = p%SpdSound !337.75590d0 -! nu = p%KinVisc !1.4529e-5 -! rho = p%AirDens !1.225000 -! -! ITRIP = 0 -! -! airfoil='NotUsed.dat' ! not used just in case -! ISNACA=.FALSE. -! -! NB_AFMODULE=size(p%AFInfo(whichairfoil)%X_Coord)-1 -! IF(allocated(XB_AFMODULE)) DEALLOCATE(XB_AFMODULE) -! ALLOCATE(XB_AFMODULE(NB_AFMODULE)) -! ! call AllocAry( XB_AFMODULE, NB_AFMODULE, 'XB_AFMODULE', ErrStat2, ErrMsg2 ) -! !call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) -! XB_AFMODULE=p%AFInfo(whichairfoil)%X_Coord(2:NB_AFMODULE+1) -! IF(allocated(yB_AFMODULE)) DEALLOCATE(YB_AFMODULE) -! ALLOCATE(YB_AFMODULE(NB_AFMODULE)) -! ! call AllocAry( YB_AFMODULE, NB_AFMODULE, 'YB_AFMODULE', ErrStat2, ErrMsg2 ) -! !call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) -! YB_AFMODULE=p%AFInfo(whichairfoil)%Y_Coord(2:NB_AFMODULE+1) -! IF( p%ITRIP .GT. 0) THEN -! ISTRIPPED = .TRUE. -! xtrup=0.02 -! xtrlo=0.1 -! -! ELSE -! ISTRIPPED = .FALSE. -! ENDIF -! CALL get_airfoil_coords -! -! -! Mach=U/p%SpdSound -! Re = U*a_chord/p%KinVisc -! -! CALL xfoil_noise -! d99 = d99*a_chord -! d_star = d_star*a_chord -! -! m%dstarVar(1) = d_star(1) -! m%dstarVar(2) = d_star(2) -! -! m%d99Var(1) = d99(1) -! m%d99Var(2) = d99(2) -! -! m%CfVar(1) = Cf(1) -! m%CfVar(2) = Cf(2) -! -!END SUBROUTINE XFOIL_BL_SINGLE -! -! +SUBROUTINE XFOIL_BL_SINGLE(p,m,whichairfoil,ChordChord,Unoise,AlphaNoise, ErrStat, ErrMsg) + !EBRA: Compute BL parameters for a single airfoil, at a single angle of attack and speed + USE XfoilAirfoilParams, only: XB_AFMODULE, YB_AFMODULE, ISTRIPPED, ISNACA, NB_AFMODULE + USE XfoilAirfoilParams, only: a_chord, aofa, airfoil, Mach, Re, xtrup, xtrlo + USE XfoilBLParams, only: Cf, d99, d_star + TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(AA_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables + integer(intKi), INTENT(IN ) :: whichairfoil !< whichairfoil + REAL(ReKi), INTENT(IN ) :: Unoise !< Unoise + REAL(ReKi), INTENT(IN ) :: ChordChord !< Chord Length + REAL(ReKi), INTENT(IN ) :: AlphaNoise !< deg + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(intKi) :: ErrStat2 ! temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = 'XFOIL_BL_SINGLE' + + write(*,*) '>>>XFOIL_BL_SINGLE' + ErrStat = ErrID_None + ErrMsg = "" + + ! --- Setting Xfoil parameters needed for computation + a_chord = ChordChord + aofa = AlphaNoise + Mach = Unoise/p%SpdSound + Re = Unoise*a_chord/p%KinVisc + airfoil = 'NotUsed.dat' + ISNACA = .FALSE. + if( p%ITRIP .GT. 0) then + ISTRIPPED = .TRUE. + xtrup = 0.02 + xtrlo = 0.1 + else + ISTRIPPED = .FALSE. + xtrup = 0.00 ! added by ebra + xtrlo = 0.00 + endif + + ! --- Allocating airfoil coordinates + NB_AFMODULE=size(p%AFInfo(whichairfoil)%X_Coord)-1 + if (allocated(XB_AFMODULE)) deallocate(XB_AFMODULE) + if (allocated(YB_AFMODULE)) deallocate(YB_AFMODULE) + call AllocAry( XB_AFMODULE, NB_AFMODULE, 'XB_AFMODULE', ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, errMsg2, errStat, errMsg, RoutineName ) + call AllocAry( YB_AFMODULE, NB_AFMODULE, 'YB_AFMODULE', ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, errMsg2, errStat, errMsg, RoutineName ) + + XB_AFMODULE=p%AFInfo(whichairfoil)%X_Coord(2:NB_AFMODULE+1) + YB_AFMODULE=p%AFInfo(whichairfoil)%Y_Coord(2:NB_AFMODULE+1) + + CALL get_airfoil_coords() + + !--- Compute d99, Cf and d_star and store it + CALL xfoil_noise() ! From Xfoil/xfoil_noise + d99 = d99*a_chord + d_star = d_star*a_chord + m%dstarVar(1) = d_star(1) + m%dstarVar(2) = d_star(2) + m%d99Var(1) = d99(1) + m%d99Var(2) = d99(2) + m%CfVar(1) = Cf(1) + m%CfVar(2) = Cf(2) + +END SUBROUTINE XFOIL_BL_SINGLE !!==================================================================================================================================! !!================================================= XFOIL BL PRETABULATE ===========================================================! !!==================================================================================================================================! -! SUBROUTINE RUN_XFOIL_BL(p) -! USE XfoilAirfoilParams -! USE XfoilBLParams -! TYPE(AA_ParameterType), INTENT(INOUT) :: p ! Parameters -!! INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation -!! CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None -! -! INTEGER(intKi) :: ErrStat2 ! temporary Error status -! CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message -! character(*), parameter :: RoutineName = ' RUN_XFOIL_BL' -! INTEGER*4 :: nr_airfoil,loop1,loop2,loop3,itrip,wr_loop -! REAL(kind=4) :: co,U,rho,nu -! !ErrStat = ErrID_None -! !ErrMsg = "" -! -! co = p%SpdSound !337.75590d0 -! nu = p%KinVisc !1.4529e-5 -! rho = p%AirDens !1.225000 -! ITRIP = 1 -! a_chord = 1 -!! U_all = 63.9200 -!! aoa_all = 3 -! a_chord= 0.2286 -! -! DO loop1=1,size(p%AFInfo) -! -! airfoil='NotUsed.dat' ! not used just in case -! xtrup=0.02 -! xtrlo=0.1 -! ISNACA=.FALSE. -! -! NB_AFMODULE=size(p%AFInfo(loop1)%X_Coord)-1 -! IF(allocated(XB_AFMODULE)) DEALLOCATE(XB_AFMODULE) -! ALLOCATE(XB_AFMODULE(NB_AFMODULE)) -!! call AllocAry( XB_AFMODULE, NB_AFMODULE, 'XB_AFMODULE', ErrStat2, ErrMsg2 ) -! !call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) -! XB_AFMODULE=p%AFInfo(loop1)%X_Coord(2:NB_AFMODULE+1) ! starts from 2 first value is aerod center -! IF(allocated(yB_AFMODULE)) DEALLOCATE(YB_AFMODULE) -! ALLOCATE(YB_AFMODULE(NB_AFMODULE)) -! ! call AllocAry( YB_AFMODULE, NB_AFMODULE, 'YB_AFMODULE', ErrStat2, ErrMsg2 ) -! !call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) -! YB_AFMODULE=p%AFInfo(loop1)%Y_Coord(2:NB_AFMODULE+1) ! starts from 2 first value is aerod center -! IF( p%ITRIP .GT. 0) THEN -! ISTRIPPED = .TRUE. -! ELSE -! ISTRIPPED = .FALSE. -! ENDIF -! -! -! CALL get_airfoil_coords -! -! DO loop2=1,size(p%UListXfoil) -! DO loop3=1,size(p%AOAListXfoil) -! U = p%UListXfoil(loop2) -! aofa = p%AOAListXfoil(loop3) -! Mach=U/p%SpdSound -! Re = U*a_chord/p%KinVisc -! p%ReListXfoil(loop2)=Re -! CALL xfoil_noise -! ! d99 = d99*a_chord -! ! d_star = d_star*a_chord -! ! print*,'d_star,d99,cf',d_star,d99,cf -! -! !write (10,*) d_star,d99,cf -! p%dstarall1(loop3,loop2,loop1)=d_star(1) -! p%dstarall2(loop3,loop2,loop1)=d_star(2) -! p%d99all1(loop3,loop2,loop1) =d99(1) -! p%d99all2(loop3,loop2,loop1) =d99(2) -! p%Cfall1(loop3,loop2,loop1) =Cf(1) -! p%Cfall2(loop3,loop2,loop1) =Cf(2) -! ENDDO -! ENDDO -! ENDDO -! END SUBROUTINE RUN_XFOIL_BL +SUBROUTINE RUN_XFOIL_BL(p,ErrStat,ErrMsg) + ! EBRA: Computes boundarly layer parametesr D99, Cf and d_star for all airfoils and all speed and angle of attacks requested + USE XfoilAirfoilParams, only: XB_AFMODULE, YB_AFMODULE, ISTRIPPED, ISNACA, NB_AFMODULE + USE XfoilAirfoilParams, only: a_chord, aofa, airfoil, Mach, Re, xtrup, xtrlo + USE XfoilBLParams, only: d99, Cf, d_star + type(AA_ParameterType), INTENT(INOUT) :: p !< Parameters + integer(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + character(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + integer(intKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message + character(*), parameter :: RoutineName = ' RUN_XFOIL_BL' + integer(IntKi) :: iAF,iRe,iAlpha,itrip + ErrStat = ErrID_None + ErrMsg = "" + print*,'>>>RUN_XFOIL_BL' + + do iAF=1,size(p%AFInfo) ! Loop on airfoils + ! --- Setting Xfoil parameters needed for computation + airfoil = 'NotUsed.dat' + Mach = 0.1 ! TODO + a_chord = 1 ! TODO + xtrup = 0.02 + xtrlo = 0.1 + ISNACA = .FALSE. + if( p%ITRIP .GT. 0) then + ISTRIPPED = .TRUE. + else + ISTRIPPED = .FALSE. + endif + + ! --- Allocate airfoil coordinates + NB_AFMODULE=size(p%AFInfo(iAF)%X_Coord)-1 + if (allocated(XB_AFMODULE)) deallocate(XB_AFMODULE) + if (allocated(YB_AFMODULE)) deallocate(YB_AFMODULE) + call AllocAry( XB_AFMODULE, NB_AFMODULE, 'XB_AFMODULE', ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call AllocAry( YB_AFMODULE, NB_AFMODULE, 'YB_AFMODULE', ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + XB_AFMODULE=p%AFInfo(iAF)%X_Coord(2:NB_AFMODULE+1) ! starts from 2 first value is aerod center + YB_AFMODULE=p%AFInfo(iAF)%Y_Coord(2:NB_AFMODULE+1) ! starts from 2 first value is aerod center + + CALL get_airfoil_coords() + ! --- Loop on velocities and angle of attack to compute BL params + do iRe=1,size(p%ReListXfoil) + do iAlpha=1,size(p%AOAListXfoil) + ! --- Setting Xfoil parameters needed for computation + !d_star=0 + d99=0 + !Cf=0 + aofa = p%AOAListXfoil(iAlpha) + Re = p%ReListXfoil(iRe) + print'(A,I0,A,F15.0,A,F9.2)','Calling Xfoil for airfoil ',iAF, ' Re=',Re, ' Alpha=',aofa + !--- Compute d99, Cf and d_star and store it + CALL xfoil_noise() ! From Xfoil/xfoil_noise + p%dstarall1(iAlpha,iRe,iAF)= d_star(1) + p%dstarall2(iAlpha,iRe,iAF)= d_star(2) + p%d99all1 (iAlpha,iRe,iAF)= d99 (1) + p%d99all2 (iAlpha,iRe,iAF)= d99 (2) + p%Cfall1 (iAlpha,iRe,iAF)= Cf (1) + p%Cfall2 (iAlpha,iRe,iAF)= Cf (2) + !print'(A,6F12.4)','d*,d99,Cf',d_star,d99,Cf + enddo + enddo + + enddo +END SUBROUTINE RUN_XFOIL_BL !==================================================================================================== SUBROUTINE BL_Param_Interp(p,m,U,AlphaNoise,C,whichairfoil, errStat, errMsg) TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters @@ -2761,6 +2635,8 @@ SUBROUTINE BL_Param_Interp(p,m,U,AlphaNoise,C,whichairfoil, errStat, errMsg) character(*), parameter :: RoutineName = 'BL_Param_Interp' REAL(ReKi) :: redif1,redif2,aoadif1,aoadif2,xx1,xx2,RC INTEGER(intKi) :: loop1,loop2 + ErrStat = ErrID_None + ErrMsg = "" !!!! this if is not used but if necessary two sets of tables can be populated for tripped and untripped cases RC = U * C/p%KinVisc ! REYNOLDS NUMBER BASED ON CHORD @@ -2812,7 +2688,7 @@ SUBROUTINE BL_Param_Interp(p,m,U,AlphaNoise,C,whichairfoil, errStat, errMsg) if (loop2 .eq. (size(p%AOAListXfoil)-1) ) then if (AlphaNoise .gt. p%AOAListXfoil(size(p%AOAListXfoil))) then - print*, 'Warning AeroAcoustics Module - Angle of attack (AoA) range is not in the user input of Xfoil table' + print*, 'Warning AeroAcoustics Module - Angle of attack (AoA) range is not in the user input of Xfoil table' print*, 'Airfoil AoA ',AlphaNoise,' Using the closest AoA ',p%AOAListXfoil(loop2+1) m%dStarVar (1) = ( p%dstarall1 (loop2+1,loop1+1,whichairfoil)*redif2 + p%dstarall1 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) m%dStarVar (2) = ( p%dstarall2 (loop2+1,loop1+1,whichairfoil)*redif2 + p%dstarall2 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) @@ -2823,7 +2699,7 @@ SUBROUTINE BL_Param_Interp(p,m,U,AlphaNoise,C,whichairfoil, errStat, errMsg) m%EdgeVelVar(1) = ( p%EdgeVelRat1(loop2+1,loop1+1,whichairfoil)*redif2 + p%EdgeVelRat1(loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) m%EdgeVelVar(2) = ( p%EdgeVelRat2(loop2+1,loop1+1,whichairfoil)*redif2 + p%EdgeVelRat2(loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) elseif (AlphaNoise .lt. p%AOAListXfoil(1)) then - print*, 'Warning AeroAcoustics Module - Angle of attack (AoA) range is not in the user input of Xfoil table' + print*, 'Warning AeroAcoustics Module - Angle of attack (AoA) range is not in the user input of Xfoil table' print*, 'Airfoil AoA ',AlphaNoise,' Using the closest AoA ',p%AOAListXfoil(1) m%dStarVar(1) = ( p%dstarall1 (1,loop1+1,whichairfoil)*redif2 + p%dstarall1 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) m%dStarVar(2) = ( p%dstarall2 (1,loop1+1,whichairfoil)*redif2 + p%dstarall2 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) @@ -2835,10 +2711,37 @@ SUBROUTINE BL_Param_Interp(p,m,U,AlphaNoise,C,whichairfoil, errStat, errMsg) m%EdgeVelVar(2) = ( p%EdgeVelRat2(1,loop1+1,whichairfoil)*redif2 + p%EdgeVelRat2(1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) endif endif - enddo - endif - enddo + enddo + endif + enddo END SUBROUTINE BL_Param_Interp + +SUBROUTINE Aero_Tests() + !--------Laminar Boundary Layer Vortex Shedding Noise----------------------------! + !CALL LBLVS(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & + ! elementspan,m%rTEtoObserve(K,J,I), & + ! p,m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLLBL,ErrStat2,errMsg2) + !--------Turbulent Boundary Layer Trailing Edge Noise----------------------------! + !CALL TBLTE(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0, & + ! p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),p%StallStart(J,I),m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,ErrStat2,errMsg2 ) + !m%SPLP=0.0_ReKi;m%SPLS=0.0_ReKi;m%SPLTBL=0.0_ReKi; + !m%EdgeVelVar(1)=1.000d0;m%EdgeVelVar(2)=m%EdgeVelVar(1); + !m%CfVar(1) = 0.0003785760d0;m%CfVar(2) = 0.001984380d0;m%d99var(1)= 0.01105860d0; m%d99var(2)= 0.007465830d0;m%EdgeVelVar(1)=1.000d0;m%EdgeVelVar(2)=m%EdgeVelVar(1); + !CALL TBLTE_TNO(3.0_Reki,0.22860_Reki,63.9200_Reki,90.00_Reki,90.0_Reki,0.5090_Reki,1.220_Reki, & + ! m%CfVar,m%d99var,m%EdgeVelVar, p, m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,ErrStat2 ,errMsg2) + !--------Blunt Trailing Edge Noise----------------------------------------------! + !CALL BLUNT(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0,& + ! p%TEThick(J,I),p%TEAngle(J,I),p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLBLUNT,ErrStat2,errMsg2 ) + !--------Tip Noise--------------------------------------------------------------! + !CALL TIPNOIS(AlphaNoise,p%ALpRAT,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & + ! m%rTEtoObserve(K,J,I), p, m%SPLTIP,ErrStat2,errMsg2) + !--------Inflow Turbulence Noise ------------------------------------------------! + !CALL InflowNoise(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0, & + ! xd%MeanVrel(J,I),0.050d0,0.050d0,p,m%SPLti,ErrStat2,errMsg2 ) + !CALL FullGuidati(3.0d0,63.920d0,0.22860d0,0.5090d0,1.220d0,90.0d0,90.0d0,xd%MeanVrel(J,I),xd%TIVrel(J,I), & + ! p,p%BlAFID(J,I),m%SPLTIGui,ErrStat2 ) + !CALL Simple_Guidati(UNoise,0.22860d0,0.120d0,0.020d0,p,m%SPLTIGui,ErrStat2,errMsg2 ) +END SUBROUTINE END MODULE AeroAcoustics diff --git a/modules/aerodyn/src/AeroAcoustics/AeroAcoustics_BKP.f90 b/modules/aerodyn/src/AeroAcoustics/AeroAcoustics_BKP.f90 deleted file mode 100644 index aab9ba6b5..000000000 --- a/modules/aerodyn/src/AeroAcoustics/AeroAcoustics_BKP.f90 +++ /dev/null @@ -1,3773 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2015-2016 National Renewable Energy Laboratory -! -! This file is part of AeroAcoustics. -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -! -!********************************************************************************************************************************** -! File last committed: $Date: 2016-04-07 10:43:27 -0600 (Thu, 07 Apr 2016) $ -! (File) Revision #: $Rev: 211 $ -!********************************************************************************************************************************** -module AeroAcoustics - - use NWTC_Library - use AeroAcoustics_Types - use AeroAcoustics_IO - use NWTC_LAPACK - USE NWTC_FFTPACK - implicit none - - private - ! ..... Public Subroutines ................................................................................................... - public :: AA_Init ! Initialization routine - public :: AA_End ! Ending routine (includes clean up) - public :: AA_UpdateStates ! Loose coupling routine for solving for constraint states, integrating - ! continuous states, and updating discrete states - public :: AA_CalcOutput ! Routine for computing outputs -!! public :: AA_CalcConstrStateResidual ! Tight coupling routine for returning the constraint state residual - - contains -!---------------------------------------------------------------------------------------------------------------------------------- -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is called at the start of the simulation to perform initialization steps. -!! The parameters are set here and not changed during the simulation. -!! The initial states and initial guess for the input are defined. -subroutine AA_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut, ErrStat, ErrMsg ) -!.................................................................................................................................. - type(AA_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine - type(AA_InputType), intent( out) :: u !< An initial guess for the input; input mesh must be defined - type(AA_ParameterType), intent( out) :: p !< Parameters - type(AA_ContinuousStateType), intent( out) :: x !< Initial continuous states - type(AA_DiscreteStateType), intent( out) :: xd !< Initial discrete states - type(AA_ConstraintStateType), intent( out) :: z !< Initial guess of the constraint states - type(AA_OtherStateType), intent( out) :: OtherState !< Initial other states - type(AA_OutputType), intent( out) :: y !< Initial system outputs (outputs are not calculated; - !! only the output mesh is initialized) - type(AA_MiscVarType), intent( out) :: m !< Initial misc/optimization variables - real(DbKi), intent(inout) :: interval !< Coupling interval in seconds: the rate that - !! (1) AA_UpdateStates() is called in loose coupling & - !! (2) AA_UpdateDiscState() is called in tight coupling. - !! Input is the suggested time from the glue code; - !! Output is the actual coupling interval that will be used - !! by the glue code. - type(AA_InitOutputType), intent( out) :: InitOut !< Output for initialization routine - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - ! Local variables - integer(IntKi) :: i ! loop counter - integer(IntKi) :: errStat2 ! temporary error status of the operation - character(ErrMsgLen) :: errMsg2 ! temporary error message - type(AA_InputFile) :: InputFileData ! Data stored in the module's input file - integer(IntKi) :: UnEcho ! Unit number for the echo file - character(*), parameter :: RoutineName = 'AA_Init' - - ! Initialize variables for this routine - errStat = ErrID_None - errMsg = "" - UnEcho = -1 - ! Initialize the NWTC Subroutine Library - call NWTC_Init( EchoLibVer=.FALSE. ) - ! Display the module information - call DispNVD( AA_Ver ) - - !bjj: note that we haven't validated p%NumBlades before using it below! - p%NumBlades = InitInp%NumBlades ! need this before reading the AD input file so that we know how many blade files to read - p%RootName = TRIM(InitInp%RootName)//'.NN' - - ! Read the primary AeroAcoustics input file in AeroAcoustics_IO - call ReadInputFiles( InitInp%InputFile, InputFileData, interval, p%RootName, p%NumBlades, UnEcho, ErrStat2, ErrMsg2 ) - if (Failed()) return - - ! Validate the inputs - call ValidateInputData(InputFileData, p%NumBlades, ErrStat2, ErrMsg2); if (Failed()) return - - ! Validate Initialization Input data ( not found in the AeroAcoustics input file ) - if (InitInp%AirDens <= 0.0) call SetErrStat ( ErrID_Fatal, 'The air density (AirDens) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - if (InitInp%KinVisc <= 0.0) call SetErrStat ( ErrID_Fatal, 'The kinesmatic viscosity (KinVisc) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - if (InitInp%SpdSound <= 0.0) call SetErrStat ( ErrID_Fatal, 'The speed of sound (SpdSound) must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - if (Failed()) return - - ! Define parameters - call SetParameters( InitInp, InputFileData, p, ErrStat2, ErrMsg2 ); if(Failed()) return - ! Define and initialize inputs - call Init_u( u, p, InputFileData, InitInp, errStat2, errMsg2 ); if(Failed()) return - - ! Define outputs here - call Init_y(y, u, p, errStat2, errMsg2); if(Failed()) return - - ! Initialize states and misc vars - call Init_MiscVars(m, p, u, y, errStat2, errMsg2); if(Failed()) return - call Init_States(xd, p, errStat2, errMsg2); if(Failed()) return - - ! Define initialization output here - call AA_SetInitOut(p, InputFileData, InitOut, errStat2, errMsg2); if(Failed()) return - call AA_InitializeOutputFile(p, InputFileData,InitOut,errStat2, errMsg2); if(Failed()) return - call Cleanup() - -contains - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - if (Failed) call Cleanup() - end function Failed - - subroutine Cleanup() - CALL AA_DestroyInputFile( InputFileData, ErrStat2, ErrMsg2 ) - IF ( UnEcho > 0 ) CLOSE( UnEcho ) - end subroutine Cleanup - -end subroutine AA_Init -!---------------------------------------------------------------------------------------------------------------------------------- -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine validates the inputs from the AeroDyn input files. -SUBROUTINE ValidateInputData( InputFileData, NumBl, ErrStat, ErrMsg ) -!.................................................................................................................................. - type(AA_InputFile), intent(in) :: InputFileData !< All the data in the AeroDyn input file - integer(IntKi), intent(in) :: NumBl !< Number of blades - integer(IntKi), intent(out) :: ErrStat !< Error status - character(*), intent(out) :: ErrMsg !< Error message - ! local variables - integer(IntKi) :: k ! Blade number - integer(IntKi) :: j ! node number - character(*), parameter :: RoutineName = 'ValidateInputData' - - ErrStat = ErrID_None - ErrMsg = "" - - if (NumBl > MaxBl .or. NumBl < 1) call SetErrStat( ErrID_Fatal, 'Number of blades must be between 1 and '//trim(num2lstr(MaxBl))//'.', ErrSTat, ErrMsg, RoutineName ) - if (InputFileData%DTAero <= 0.0) call SetErrStat ( ErrID_Fatal, 'DTAero must be greater than zero.', ErrStat, ErrMsg, RoutineName ) - - if (InputFileData%IBLUNT /= IBLUNT_None .and. InputFileData%IBLUNT /= IBLUNT_BPM) then - print*, 'Your value IBLUNT in AeroAcousticsInput.dat is ', InputFileData%IBLUNT - call SetErrStat ( ErrID_Fatal, & - 'IBLUNT must '//trim(num2lstr(IBLUNT_None))//' (none) or '//trim(num2lstr(IBLUNT_BPM))//' (Bluntness noise calculated).', ErrStat, ErrMsg, RoutineName ) - endif - - if (InputFileData%ILAM /= ILAM_None .and. InputFileData%ilam /= ILAM_BPM) then - call SetErrStat ( ErrID_Fatal, 'ILAM must be '//trim(num2lstr(ILAM_None))//' No calculation '//& - trim(num2lstr(ILAM_BPM))//' (ILAM Calculated).', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%ITIP /= ITIP_None .and. InputFileData%ITIP /= ITIP_ON) then - print*, 'Your value ITIP in AeroAcousticsInput.dat is ', InputFileData%ITIP - call SetErrStat ( ErrID_Fatal, 'ITIP must be '//trim(num2lstr(ITIP_None))//' (Off) or '//& - trim(num2lstr(ITIP_On))//' (ITIP On).', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%ITRIP /= ITRIP_None .and. InputFileData%ITRIP /= ITRIP_Heavy .and. InputFileData%ITRIP /= ITRIP_Light) then - print*, 'Your value ITRIP in AeroAcousticsInput.dat is ', InputFileData%ITRIP - call SetErrStat ( ErrID_Fatal,'ITRIP must be '//trim(num2lstr(ITRIP_None))//' (none) or '//trim(num2lstr(ITRIP_Heavy))//& - ' (heavily tripped BL Calculation) or '//trim(num2lstr(ITRIP_Light))//' (lightly tripped BL)' ,ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%ITURB /= ITURB_None .and. InputFileData%ITURB /= ITURB_BPM .and. InputFileData%ITURB /= ITURB_TNO) then - print*, 'Your value ITURB in AeroAcousticsInput.dat is ', InputFileData%ITURB - call SetErrStat ( ErrID_Fatal, 'ITURB must be 0 (off) or 1 (BPM) or 2 (TNO) .', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%IInflow /= IInflow_None .and. InputFileData%IInflow /= IInflow_BPM & - .and. InputFileData%IInflow /= IInflow_FullGuidati .and. InputFileData%IInflow /= IInflow_SimpleGuidati ) then - print*, 'Your value IInflow in AeroAcousticsInput.dat is ', InputFileData%IInflow - call SetErrStat ( ErrID_Fatal, 'IInflow must be 0 (off) or 1 (only Amiet) or 2 (Full Guidati)'//& - 'or 3 (Simple Guidati).', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%TICalcMeth /= TICalc_Every .and. InputFileData%TICalcMeth /= TICalc_Interp ) then - print*, 'Your value TICalcMeth in AeroAcousticsInput.dat is ', InputFileData%TICalcMeth - call SetErrStat ( ErrID_Fatal, 'TICalcMeth must be '//trim(num2lstr(TICalc_Every))//' TICalc automatic or '//& - trim(num2lstr(TICalc_Interp))//' (TICalcMeth interp).', ErrStat, ErrMsg, RoutineName ) - end if - - - - if (InputFileData%X_BLMethod /= X_BLMethod_BPM .and. InputFileData%X_BLMethod /= X_BLMethod_Xfoil) then - print*, 'Your value X_BLMethod in AeroAcousticsInput.dat is ', InputFileData%X_BLMethod - call SetErrStat ( ErrID_Fatal, 'X_BLMethod must be '//trim(num2lstr(X_BLMethod_BPM))//' X_BLMethod_ with BPM or '//& - trim(num2lstr(X_BLMethod_Xfoil))//' (X_BLMethod with Xfoil).', ErrStat, ErrMsg, RoutineName ) - end if - - - if (InputFileData%XfoilCall /= XfoilCall_Interp .and. InputFileData%XfoilCall /= XfoilCall_Every ) then - print*, 'Your value XfoilCall in AeroAcousticsInput.dat is ', InputFileData%XfoilCall - call SetErrStat ( ErrID_Fatal, 'XfoilCall must be '//trim(num2lstr(XfoilCall_Interp))//' for interpolation from pretabulated data or '//& - trim(num2lstr(XfoilCall_Every))//' for each step Xfoil call.', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%aweightflag /= AweightFlagOff .and. InputFileData%aweightflag /= AweightFlagOn ) then - print*, 'Your value aweightflag in AeroAcousticsInput.dat is ', InputFileData%aweightflag - call SetErrStat ( ErrID_Fatal, 'aweightflag must be '//trim(num2lstr(AweightFlagOn))//' for A-weighting on or '//& - trim(num2lstr(AweightFlagOff))//' for A-weighting off.', ErrStat, ErrMsg, RoutineName ) - end if - - - if (InputFileData%NrObsLoc <= 0.0) call SetErrStat ( ErrID_Fatal, 'Number of Observer Locations should be greater than zero', ErrStat, ErrMsg, RoutineName ) - - if (InputFileData%NrOutFile /= 0 .and. InputFileData%NrOutFile /= 1 .and. InputFileData%NrOutFile /= 2 .and. InputFileData%NrOutFile /= 3 & - .and. InputFileData%NrOutFile /= 4) then - call SetErrStat ( ErrID_Fatal, ' NrOutFile must be 0 or 1 or 2 or 3 or 4', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%LargeBinOutput /= 0 .and. InputFileData%LargeBinOutput /= 1 ) then - call SetErrStat ( ErrID_Fatal, ' LargeBinOutput must be 0 or 1', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%Comp_AA_After .eq.0 ) then - call SetErrStat ( ErrID_Fatal, ' Comp_AA_After variable in aeroacustics input must be more than 0', ErrStat, ErrMsg, RoutineName ) - end if - - if (InputFileData%saveeach .eq. 0 ) then - call SetErrStat ( ErrID_Fatal, ' saveeach variable in aeroacustics input must be more than 0', ErrStat, ErrMsg, RoutineName ) - end if -END SUBROUTINE ValidateInputData -!---------------------------------------------------------------------------------------------------------------------------------- -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine sets AeroAcoustics parameters for use during the simulation; these variables are not changed after AA_Init. -subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) - TYPE(AA_InitInputType), intent(IN ) :: InitInp !< Input data for initialization routine, out is needed because of copy below - TYPE(AA_InputFile), INTENT(IN ) :: InputFileData !< Data stored in the module's input file -- intent(out) only for move_alloc statements - TYPE(AA_ParameterType), INTENT(INOUT) :: p !< Parameters - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - - - ! Local variables - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - INTEGER(IntKi) :: simcou,coun ! simple loop counter - INTEGER(IntKi) :: I,J,whichairfoil,K - character(*), parameter :: RoutineName = 'SetParameters' - LOGICAL :: tr,tri,exist - REAL(ReKi) :: val1,val2,f2,f4,lefttip,rightip,jumpreg - - ! Initialize variables for this routine - - ErrStat = ErrID_None - ErrMsg = "" -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!Assign input fiel data to parameters -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - p%DT = InputFileData%DTAero ! seconds - p%AA_Bl_Prcntge = InputFileData%AA_Bl_Prcntge ! % - p%fsample = 1/p%DT ! Hz - p%total_sample = 2**( ceiling(log(1*p%fsample)/log(2.0d0)))! 1 stands for the 1 seconds. Every 1 second Vrel spectra will be calculated for the dissipation calculation (change if more needed & recompile ) - p%total_sampleTI = 5/p%DT ! 10 seconds for TI sampling - p%Comp_AA_After = InputFileData%Comp_AA_After - p%saveeach = InputFileData%saveeach - p%IBLUNT = InputFileData%IBLUNT - p%ILAM = InputFileData%ILAM - p%ITIP = InputFileData%ITIP - p%ITRIP = InputFileData%ITRIP - p%ITURB = InputFileData%ITURB - p%IInflow = InputFileData%IInflow - p%X_BLMethod = InputFileData%X_BLMethod - p%XfoilCall = InputFileData%XfoilCall - p%TICalcMeth = InputFileData%TICalcMeth - p%AweightFlag = InputFileData%AweightFlag - p%ROUND = InputFileData%ROUND - p%alprat = InputFileData%ALPRAT - p%NrOutFile = InputFileData%NrOutFile - p%delim = " " - p%outFmt = "ES15.6E3" - p%LargeBinOutput = InputFileData%LargeBinOutput - p%NumBlNds = InitInp%NumBlNds - p%AirDens = InitInp%AirDens - p%KinVisc = InitInp%KinVisc - p%SpdSound = InitInp%SpdSound - p%HubHeight = InitInp%HubHeight - p%z0_AA = InputFileData%z0_AA - p%dy_turb_in = InputFileData%dy_turb_in - p%dz_turb_in = InputFileData%dz_turb_in - - p%NrObsLoc = InputFileData%NrObsLoc - - - - call AllocAry( p%TI_Grid_In,size(InputFileData%TI_Grid_In,1), size(InputFileData%TI_Grid_In,2), 'p%TI_Grid_In', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - p%TI_Grid_In=InputFileData%TI_Grid_In - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!Copy AFInfo into AA module -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! TODO Allocate AFInfo and AFindx variables (DONE AND DONE) - ALLOCATE ( p%AFInfo( size(InitInp%AFInfo) ), STAT=ErrStat2 ) - IF ( ErrStat2 /= 0 ) THEN - CALL SetErrStat ( ErrID_Fatal, 'Error allocating memory for the InitInp%AFInfo array.', ErrStat2, ErrMsg2, RoutineName ) - RETURN - ENDIF - - do i=1,size(InitInp%AFInfo) - call AFI_Copyafinfotype( InitInp%AFInfo(i), p%AFInfo(i), MESH_NEWCOPY, errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - end do - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!Check 1 -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - tri=.true. - IF( (p%ITURB.eq.2) .or. (p%IInflow.gt.1) )then - ! if tno is on or one of the guidati models is on, check if we have airfoil coordinates - DO k=1,size(p%AFInfo) ! if any of the airfoil coordinates are missing change calucaltion method - IF( (size(p%AFInfo(k)%X_Coord) .lt. 5) .or. (size(p%AFInfo(k)%Y_Coord).lt.5) )then - IF (tri) then ! Print the message for once only - print*, 'Airfoil coordinates are missing: If Full or Simplified Guidati or Xfoil Bl Calculation is on coordinates are needed ' - print*, 'Calculation methods enforced as BPM for TBLTE and only Amiet for inflow ' - p%ITURB = 1 - p%IInflow = 1 - tri=.false. - ENDIF - ENDIF - ENDDO - ENDIF -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!Check 2 -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! if passed the first check and if tno or full guidati model is still on, turn on Xfoil boundary layer caluclation - IF( (p%ITURB.eq.2) .or. (p%IInflow.eq.2) )then - p%X_BLMethod=2 - ENDIF -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!Check 3 -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! if boundary layer is tripped then laminar b.l. vortex shedding mechanism is turned off - IF( p%ITRIP.gt.0 )then - p%ILAM=0 - ENDIF - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!set 1/3 octave band frequency as parameter and A weighting. -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - CALL AllocAry( p%FreqList, 34, 'FreqList', ErrStat2, ErrMsg2) - p%FreqList = (/10.,12.5,16.,20.,25.,31.5,40.,50.,63.,80., & - 100.,125.,160.,200.,250.,315.,400.,500.,630.,800., & - 1000.,1250.,1600.,2000.,2500.,3150.,4000.,5000.,6300.,8000., & - 10000.,12500.,16000.,20000./) - CALL AllocAry( p%Aweight, size(p%Freqlist), 'Aweight', ErrStat2, ErrMsg2) - Do I=1,size(p%Freqlist) - f2 = p%Freqlist(I)**2; - f4 = p%Freqlist(I)**4; - p%Aweight(I)= 10 * log(1.562339 * f4 / ((f2 + 107.65265**2) & - * (f2 + 737.86223 **2))) / log(10.0_Reki) & - + 10 * log(2.242881E+16 * f4 / ((f2 + 20.598997**2)**2 & - * (f2 + 12194.22**2)**2)) / log(10.0_Reki) - enddo -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!Observer Locations -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call AllocAry( p%ObsX, p%NrObsLoc, 'p%ObsX', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( p%ObsY, p%NrObsLoc, 'p%ObsY', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( p%ObsZ, p%NrObsLoc, 'p%ObsZ', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - p%ObsX = InputFileData%ObsX - p%ObsY = InputFileData%ObsY - p%ObsZ = InputFileData%ObsZ -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!Blade Characteristics chord,span,trailing edge angle and thickness,airfoil ID for each segment -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call AllocAry( p%TEThick, p%NumBlNds, p%NumBlades, 'p%TEThick', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - call AllocAry( p%TEAngle, p%NumBlNds, p%NumBlades, 'p%TEAngle', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - call AllocAry( p%StallStart, p%NumBlNds, p%NumBlades, 'p%StallStart', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - do i=1,p%NumBlades - p%TEThick(:,i) = InputFileData%BladeProps(i)%TEThick(:) ! - p%TEAngle(:,i) = InputFileData%BladeProps(i)%TEAngle(:) ! - p%StallStart(:,i) = InputFileData%BladeProps(i)%StallStart(:) ! - end do - - call AllocAry( p%BlSpn, p%NumBlNds, p%NumBlades, 'p%BlSpn', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - p%BlSpn = InitInp%BlSpn - - call AllocAry( p%BlChord, p%NumBlNds, p%NumBlades, 'p%BlChord', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - p%BlChord = InitInp%BlChord - - - call AllocAry( p%BlAFID, p%NumBlNds,p%numBlades, 'p%BlAFID', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - p%BlAFID=InitInp%BlAFID - - call AllocAry( p%AerCent, 2, p%NumBlNds, p%NumBlades, 'p%AerCent', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - do j=p%NumBlNds,2,-1 - IF ( p%BlSpn(j,1) .lt. p%BlSpn(p%NumBlNds,1)*(100-p%AA_Bl_Prcntge)/100 )THEN ! assuming - p%startnode=j - GO TO 9875 - ENDIF - enddo - - 9875 IF (p%startnode.lt.2) THEN - p%startnode=2 - ENDIF - print*, 'AeroAcoustics Module is using the blade nodes starting from ' ,p%startnode,' Radius in meter ',p%BlSpn(p%startnode,1) -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!AerodYnamic center extraction for each segment -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! TODO: Extract the aerodynamic center from InitInp%AFInfo(f)%X_Coord(1) and InitInp%AFInfo(f)%Y_Coord(1) - !p%AerCent = InputFileData%BladeProps(1)%AerCent - - DO i=1,p%numBlades - DO j=1,p%NumBlNds - whichairfoil = p%BlAFID(j,i) ! just a temporary variable for clear coding - ! airfoil coordinates read by AeroDyn. First value is the aerodynamic center - p%AerCent(1,J,I) = p%AFInfo(whichairfoil)%X_Coord(1) ! assigned here corresponding airfoil. - p%AerCent(2,J,I) = p%AFInfo(whichairfoil)%Y_Coord(1) ! assigned here corresponding airfoil. - ENDDO - ENDDO -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! Dimensionalize Leading and trailing edge coordinates for later usage -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - call AllocAry( p%AFTeCo, 3, p%NumBlNds,p%numBlades, 'p%AFTeCo', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - p%AFTeCo=0.0_Reki - ! TODO (DONE) - - call AllocAry( p%AFLeCo, 3, p%NumBlNds,p%numBlades, 'p%AFLeCo', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - p%AFLeCo=0.0_Reki - - !TODO (DONE) - -! Normalized Leading edge coordinates (0,0,0) -! Normalized Trailing edge coordinates (1,0,0) -- > changed to 0,1,0 - DO i=1,p%numBlades - DO j=1,p%NumBlNds - p%AFLeCo(1,j,i) = ( 0.0_Reki - p%AerCent(1,J,I) ) * p%BlChord(j,i) ! (x_LE - x_AC) *Chord - p%AFLeCo(2,j,i) = ( 0.0_Reki - p%AerCent(2,J,I) ) * p%BlChord(j,i) ! (y_LE - y_AC) *Chord - p%AFLeCo(3,j,i) = ( 0.0_Reki - 0.0_Reki ) * p%BlChord(j,i) ! this is always zero at the moment ( kept for 3d consistency ) - - p%AFTeCo(1,j,i) = ( 0.0_Reki - p%AerCent(1,J,I) ) * p%BlChord(j,i) ! (x_TE - x_AC) *Chord - p%AFTeCo(2,j,i) = ( 1.0_Reki - p%AerCent(2,J,I) ) * p%BlChord(j,i) ! (y_TE - y_AC) *Chord - p%AFTeCo(3,j,i) = ( 0.0_Reki - 0.0_Reki ) * p%BlChord(j,i) ! this is always zero at the moment ( kept for 3d consistency ) - ENDDO - ENDDO - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! FULL BLADE rotation delete once all rotations are checekd -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! call AllocAry( p%FullBladeShape, 3, p%NumBlNds,p%numBlades,400 ,'p%FullBladeShape', errStat2, errMsg2 ) -! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) -! if (ErrStat >= AbortErrLev) RETURN -! p%FullBladeShape=0.0_Reki -! DO k=1,size(p%AFInfo(whichairfoil)%X_Coord) -! DO i=1,p%numBlades -! DO j=1,p%NumBlNds -! whichairfoil = p%BlAFID(j,i) ! just a temporary variable for clear coding -! p%FullBladeShape(1,j,i,k) = ( p%AFInfo(whichairfoil)%Y_Coord(k) - p%AerCent(1,J,I) ) * p%BlChord(j,i) ! (x_LE - x_AC) *Chord -! p%FullBladeShape(2,j,i,k) = ( p%AFInfo(whichairfoil)%X_Coord(k) - p%AerCent(2,J,I) ) * p%BlChord(j,i) ! (y_LE - y_AC) *Chord -! p%FullBladeShape(3,j,i,k) = ( 0.0_Reki - 0.0_Reki ) * p%BlChord(j,i) ! this is always zero at the moment ( kept for 3d consistency ) -! ENDDO -! ENDDO -! ENDDO - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! If Xfoil data needs to be tabulated this means p%XfoilCall=1 -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -IF( (p%X_BLMethod.eq.2) .and. (p%XfoilCall.eq.1) )THEN -!! call AllocAry( p%UListXfoil, 20, 'p%UListXfoil', errStat2, errMsg2 ) -!! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) -!! if (ErrStat >= AbortErrLev) RETURN -!! DO i=1,size(p%UListXfoil) -!! p%UListXfoil(i)=1.0d0+i*5.0d0 -!! ENDDO -!!!corresponding Rey Nrs=0.1e6,0.4e6,0.8e6,1.2e6,2.0e6,2.5e6,3.0e6',3.5e6,4.0e6,5.0e6,6.0e6,7.0e6,8.0e6,10.e6,15.e6,20.e6 -!! call AllocAry( p%ReListXfoil, size(p%UListXfoil), 'p%ReListXfoil', errStat2, errMsg2 ) -!! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) -!! if (ErrStat >= AbortErrLev) RETURN -!! -!! call AllocAry( p%AOAListXfoil, 35, 'p%AOAListXfoil', errStat2, errMsg2 ) -!! call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) -!! if (ErrStat >= AbortErrLev) RETURN -!! DO i=1,size(p%AOAListXfoil) -!! p%AOAListXfoil(i)=-3.0d0+i*0.50d0 -!! p%AOAListXfoil(i)=3.0d0 -!! ENDDO -!! !p%AOAListXfoil = (/-3.0d0,-2.0d0,-1.0d0,0.0d0,1.0d0,2.0d0,3.0d0,4.0d0,5.0d0,6.0d0, & -!! ! 8.0d0,10.0d0,12.0d0,14.0d0,16.0d0/) -!!! p%AOAListXfoil = 3.0d0 - call AllocAry( p%AOAListXfoil, size(InputFileData%AoAListXfoil), 'p%AOAListXfoil', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - p%AOAListXfoil=InputFileData%AoAListXfoil - call AllocAry( p%ReListXfoil, size(InputFileData%ReListXfoil), 'p%ReListXfoil', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - p%ReListXfoil=InputFileData%ReListXfoil -!! Allocate the suction and pressure side boundary layer parameters for Xfoil output - will be used as tabulated data - call AllocAry( p%dstarall1,size(p%AOAListXfoil), size(p%ReListXfoil),size(p%AFInfo),'p%dstarall1', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - call AllocAry( p%dstarall2,size(p%AOAListXfoil), size(p%ReListXfoil),size(p%AFInfo),'p%dstarall2', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - call AllocAry( p%d99all1,size(p%AOAListXfoil), size(p%ReListXfoil),size(p%AFInfo), 'p%d99all1', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - call AllocAry( p%d99all2,size(p%AOAListXfoil), size(p%ReListXfoil),size(p%AFInfo), 'p%d99all2', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - call AllocAry( p%Cfall1,size(p%AOAListXfoil), size(p%ReListXfoil),size(p%AFInfo), 'p%Cfall1', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - call AllocAry( p%Cfall2,size(p%AOAListXfoil), size(p%ReListXfoil),size(p%AFInfo), 'p%Cfall2', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call AllocAry( p%EdgeVelRat1,size(p%AOAListXfoil), size(p%ReListXfoil),size(p%AFInfo), 'p%EdgeVelRat1', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - call AllocAry( p%EdgeVelRat2,size(p%AOAListXfoil), size(p%ReListXfoil),size(p%AFInfo), 'p%EdgeVelRat2', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN -! Pre tabulate the the boundary layer data and set them as parameter. -! CALL RUN_XFOIL_BL(p) -!!! call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -p%dstarall1 = InputFileData%Suct_DispThick -p%dstarall2 = InputFileData%Pres_DispThick -p%d99all1 = InputFileData%Suct_BLThick -p%d99all2 = InputFileData%Pres_BLThick -p%Cfall1 = InputFileData%Suct_Cf -p%Cfall2 = InputFileData%Pres_Cf -p%EdgeVelRat1 = InputFileData%Suct_EdgeVelRat -p%EdgeVelRat2 = InputFileData%Pres_EdgeVelRat - - -ENDIF ! If Xfoil data needs to be tabulated - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!! If simplified guidati is on, calculate the airfoil thickness from input airfoil coordinates -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - IF (p%IInflow .EQ. 3) THEN -! Calculate the Thickness @ 1% chord and @ 10% chord (normalized thickness) - call AllocAry( p%AFThickGuida,2,size(p%AFInfo), 'p%AFThickGuida', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - p%AFThickGuida=0.0_Reki - - DO k=1,size(p%AFInfo) ! for each airfoil interpolation - tri=.true.;tr=.true.; - do i=2,size(p%AFInfo(k)%X_Coord) - if ( (p%AFInfo(k)%X_Coord(i)+p%AFInfo(k)%Y_Coord(i)) .eq. 0) then - !print*,i - goto 174 - endif - if ( p%AFInfo(k)%X_Coord(i) .eq. 0.1) then - val1=p%AFInfo(k)%Y_Coord(i) - elseif ( (p%AFInfo(k)%X_Coord(i) .lt. 0.1) .and. (tri) ) then - val1=( abs(p%AFInfo(k)%X_Coord(i-1)-0.1)*p%AFInfo(k)%Y_Coord(i) + & - abs(p%AFInfo(k)%X_Coord(i)-0.1)*p%AFInfo(k)%Y_Coord(i-1))/ & - (abs(p%AFInfo(k)%X_Coord(i-1)-0.1)+abs(p%AFInfo(k)%X_Coord(i)-0.1)) - - tri=.false. - elseif (p%AFInfo(k)%X_Coord(i) .eq. 0.01) then - val2=p%AFInfo(k)%Y_Coord(i) - elseif ( (p%AFInfo(k)%X_Coord(i) .lt. 0.01) .and. (tr) ) then - val2=( abs(p%AFInfo(k)%X_Coord(i-1)-0.01)*p%AFInfo(k)%Y_Coord(i) + & - abs(p%AFInfo(k)%X_Coord(i)-0.01)*p%AFInfo(k)%Y_Coord(i-1))/ & - (abs(p%AFInfo(k)%X_Coord(i-1)-0.01)+abs(p%AFInfo(k)%X_Coord(i)-0.01)) - tr=.false. - endif - - enddo - - 174 tri=.true.;tr=.true.; - do j=i,size(p%AFInfo(k)%X_Coord) - if ( p%AFInfo(k)%X_Coord(j) .eq. 0.1) then - val1=abs(p%AFInfo(k)%Y_Coord(j)) + abs(val1) - elseif ( (p%AFInfo(k)%X_Coord(j) .gt. 0.1) .and. (tri) ) then - val1=abs(val1)+abs((abs(p%AFInfo(k)%X_Coord(j-1)-0.1)*p%AFInfo(k)%Y_Coord(j)+ & - abs(p%AFInfo(k)%X_Coord(j)-0.1)*p%AFInfo(k)%Y_Coord(j-1))/& - (abs(p%AFInfo(k)%X_Coord(j-1)-0.1)+abs(p%AFInfo(k)%X_Coord(j)-0.1))); - tri=.false. - elseif (p%AFInfo(k)%X_Coord(j) .eq. 0.01) then - val2=abs(p%AFInfo(k)%Y_Coord(j)) + abs(val2) - elseif ( (p%AFInfo(k)%X_Coord(j) .gt. 0.01) .and. (tr) ) then - val2=abs(val2)+abs((abs(p%AFInfo(k)%X_Coord(j-1)-0.01)*p%AFInfo(k)%Y_Coord(j)+ & - abs(p%AFInfo(k)%X_Coord(j)-0.01)*p%AFInfo(k)%Y_Coord(j-1))/& - (abs(p%AFInfo(k)%X_Coord(j-1)-0.01)+abs(p%AFInfo(k)%X_Coord(j)-0.01))); - tr=.false. - endif - enddo - - p%AFThickGuida(1,k)=val2 ! 1 % chord thickness - p%AFThickGuida(2,k)=val1 ! 10 % chord thickness - ENDDO -ENDIF ! If simplified guidati is on, calculate the airfoil thickness - -!! for turbulence intensity calculations on the fly every 5 meter the whole rotor area is divided vertically to store flow fields in each region - jumpreg=7 - p%toptip = CEILING(p%HubHeight+maxval(p%BlSpn(:,1)))+2 !Top Tip Height = Hub height plus radius - p%bottip = FLOOR(p%HubHeight-maxval(p%BlSpn(:,1)))-2 !Bottom Tip Height = Hub height minus radius - call AllocAry( p%rotorregionlimitsVert,ceiling(((p%toptip)-(p%bottip))/jumpreg), 'p%rotorregionlimitsVert', errStat2, errMsg2 ) - do i=0,size(p%rotorregionlimitsVert)-1 - p%rotorregionlimitsVert(i+1)=(p%bottip)+jumpreg*i - enddo - - -!! for turbulence intensity calculations on the fly every 5 meter the whole rotor area is divided horizontally to store flow fields in each region - jumpreg=7 - lefttip = 2*maxval(p%BlSpn(:,1))+5 ! - rightip = 0 ! - call AllocAry( p%rotorregionlimitsHorz,ceiling(((lefttip)-(rightip))/jumpreg), 'p%rotorregionlimitsHorz', errStat2, errMsg2 ) - do i=0,size(p%rotorregionlimitsHorz)-1 - p%rotorregionlimitsHorz(i+1)=rightip+jumpreg*i - enddo - - - - jumpreg=60 ! 10 ! must be divisable to 360 - call AllocAry( p%rotorregionlimitsalph,INT((360/jumpreg)+1), 'p%rotorregionlimitsalph', errStat2, errMsg2 ) - do i=0,size(p%rotorregionlimitsalph)-1 - p%rotorregionlimitsalph(i+1)=jumpreg*i - enddo - jumpreg=5 - call AllocAry( p%rotorregionlimitsrad, (CEILING( maxval(p%BlSpn(:,1))/jumpreg )+2), 'p%rotorregionlimitsrad', errStat2, errMsg2 ) - do i=1,size(p%rotorregionlimitsrad)-1 - p%rotorregionlimitsrad(i+1)=jumpreg*i - enddo - p%rotorregionlimitsrad(1)=0.0_reki - p%rotorregionlimitsrad(size(p%rotorregionlimitsrad)-1)=p%rotorregionlimitsrad(size(p%rotorregionlimitsrad)-1)+3 -! call AllocAry( p%rotorregionlimitsrad, 5, 'p%rotorregionlimitsrad', errStat2, errMsg2 ) -! p%rotorregionlimitsrad(1)=0.0_reki -! p%rotorregionlimitsrad(2)=6.0_reki -! p%rotorregionlimitsrad(3)=14.0_reki -! p%rotorregionlimitsrad(4)=22.0_reki -! p%rotorregionlimitsrad(5)=26.0_reki - print*, 'p%rotorregionlimitsrad', p%rotorregionlimitsrad - print*, 'p%rotorregionlimitsalph', p%rotorregionlimitsalph - -end subroutine SetParameters -!---------------------------------------------------------------------------------------------------------------------------------- -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes AeroAcoustics module input array variables for use during the simulation. -subroutine Init_u( u, p, InputFileData, InitInp, errStat, errMsg ) - - type(AA_InputType), intent( out) :: u !< Input data - type(AA_ParameterType), intent(in ) :: p !< Parameters - - type(AA_InputFile), intent(in ) :: InputFileData !< Data stored in the module's input file - type(AA_InitInputType), intent(in ) :: InitInp !< Input data for AD initialization routine - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None -!local variables - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'Init_u' - - call AllocAry( u%AoANoise, p%NumBlNds,p%numBlades, 'u%AoANoise', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - u%AoANoise=0.0_Reki - - call AllocAry( u%Vrel, p%NumBlNds,p%numBlades, 'u%Vrel', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - u%Vrel=0.0_Reki - - call AllocAry( u%RotLtoG, 3, 3, p%NumBlNds,p%numBlades, 'u%RotLtoG', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - u%RotLtoG=0.0_Reki - - call AllocAry( u%AeroCent_G, 3, p%NumBlNds,p%numBlades, 'u%AeroCent_G', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - u%AeroCent_G=0.0_Reki - - call AllocAry( u%Inflow, 3_IntKi, p%NumBlNds, p%numBlades, 'u%Inflow', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - u%Inflow=0.0_Reki - - - -end subroutine Init_u -!---------------------------------------------------------------------------------------------------------------------------------- -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes AeroAcoustics output array variables for use during the simulation. -subroutine Init_y(y, u, p, errStat, errMsg) - type(AA_OutputType), intent( out) :: y !< Module outputs - type(AA_InputType), intent(inout) :: u !< Module inputs -- intent(out) because of mesh sibling copy - type(AA_ParameterType), intent(inout) :: p !< Parameters - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - - ! Local variables - integer(intKi) :: k ! loop counter for blades - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'Init_y' - - ! Initialize variables for this routine - - errStat = ErrID_None - errMsg = "" - - p%numOuts= p%NrObsLoc+p%NumBlNds*p%NumBlades*p%NrObsLoc ! we start calculating from node number 2 that is why - call AllocAry( y%WriteOutput, p%numOuts, 'y%WriteOutput', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - y%WriteOutput=0.0_reki - - call AllocAry( y%OASPL, p%NrObsLoc,p%NumBlNds,p%NumBlades, 'y%OASPL', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - y%OASPL=0.0_reki - -! 7 noise mechanisms that is why times seven - call AllocAry( y%OASPL_Mech, 7, p%NrObsLoc,p%NumBlNds,p%NumBlades, 'y%OASPL_Mech', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - y%OASPL_Mech=0.0_reki - - p%NumOutsForSep=p%NumBlNds*p%NumBlades*p%NrObsLoc*size(y%OASPL_Mech,1) ! 7 noise mechanisms that is why times seven - call AllocAry( y%WriteOutputSep, p%NumOutsForSep, 'y%WriteOutputSep', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - y%WriteOutputSep=0.0_reki - - call AllocAry( y%SumSpecNoise, size(p%FreqList),p%NrObsLoc, p%NumBlades,'y%SumSpecNoise', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - y%SumSpecNoise=0.0_reki - - p%NumOutsForPE= p%NrObsLoc*size(p%Freqlist)*p%NumBlades*4 - call AllocAry( y%WriteOutputForPE, p%numOutsForPE, 'y%WriteOutputForPE', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - y%WriteOutputForPE=0.0_reki - - call AllocAry( y%SumSpecNoiseSep, 7, p%NrObsLoc,size(p%FreqList), 'y%SumSpecNoiseSep', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - y%SumSpecNoiseSep=0.0_reki - - call AllocAry( y%WriteOutputSepFreq,size(y%SumSpecNoiseSep,1)*size(y%SumSpecNoiseSep,2) & - *size(y%SumSpecNoiseSep,3), 'y%WriteOutputSepFreq', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - y%WriteOutputSepFreq=0.0_reki - - call AllocAry( y%DirectiviOutput,p%NrObsLoc, 'y%DirectiviOutput', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - y%DirectiviOutput=0.0_reki - - call AllocAry( y%OutLECoords, 3, size(p%FreqList),p%NrObsLoc, p%NumBlades,'y%OutLECoords', errStat2, errMsg2 ) - call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - if (ErrStat >= AbortErrLev) RETURN - y%OutLECoords=0.0_reki - - - -end subroutine Init_y - -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes (allocates) the misc variables for use during the simulation. -subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) - type(AA_MiscVarType), intent(inout) :: m !< misc/optimization data (not defined in submodules) - type(AA_ParameterType), intent(in ) :: p !< Parameters - type(AA_InputType), intent(inout) :: u !< input for HubMotion mesh (create sibling mesh here) - type(AA_OutputType), intent(in ) :: y !< output (create mapping between output and otherstate mesh here) - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - - ! Local variables - integer(intKi) :: k - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'Init_MiscVars' - - ! Initialize variables for this routine - - errStat = ErrID_None - errMsg = "" - - call AllocAry( m%ChordAngleLE, p%NrObsLoc, p%NumBlNds, p%numBlades, 'ChordAngleLE', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%ChordAngleLE=0.0_ReKi - call AllocAry( m%SpanAngleLE, p%NrObsLoc, p%NumBlNds, p%numBlades, 'SpanAngleLE', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%SpanAngleLE=0.0_ReKi - call AllocAry( m%ChordAngleTE, p%NrObsLoc, p%NumBlNds, p%numBlades, 'ChordAngleTE', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%ChordAngleTE=0.0_ReKi - call AllocAry( m%SpanAngleTE, p%NrObsLoc, p%NumBlNds, p%numBlades, 'SpanAngleTE', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%SpanAngleTE=0.0_ReKi - call AllocAry( m%rTEtoObserve, p%NrObsLoc, p%NumBlNds, p%numBlades, 'rTEtoObserve', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%rTEtoObserve=0.0_ReKi - call AllocAry( m%rLEtoObserve, p%NrObsLoc, p%NumBlNds, p%numBlades, 'rLEtoObserve', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%rLEtoObserve=0.0_ReKi - call AllocAry( m%SPLLBL, size(p%FreqList), 'SPLLBL', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%SPLLBL=0.0_ReKi - call AllocAry( m%SPLP, size(p%FreqList), 'SPLP', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%SPLP=0.0_ReKi - call AllocAry( m%SPLS, size(p%FreqList), 'SPLS', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%SPLS=0.0_ReKi - call AllocAry( m%SPLALPH, size(p%FreqList),'SPLALPH', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%SPLALPH=0.0_ReKi - call AllocAry( m%SPLTBL, size(p%FreqList), 'SPLTBL', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%SPLTBL=0.0_ReKi - call AllocAry( m%SPLBLUNT, size(p%FreqList), 'SPLBLUNT', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%SPLBLUNT=0.0_ReKi - call AllocAry( m%SPLTIP, size(p%FreqList), 'SPLTIP', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%SPLTIP=0.0_ReKi - call AllocAry( m%SPLTI, size(p%FreqList), 'SPLTI', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%SPLTI=0.0_ReKi - call AllocAry( m%SPLTIGui, size(p%FreqList), 'SPLTIGui', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%SPLTIGui=0.0_ReKi - - call AllocAry( m%CfVar, 2, 'CfVar', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%CfVar=0.0_ReKi - call AllocAry( m%d99Var, 2, 'd99Var', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%d99Var=0.0_ReKi - call AllocAry( m%dstarVar, 2, 'dstarVar', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%dstarVar=0.0_ReKi - call AllocAry( m%EdgeVelVar, 2, 'EdgeVelVar', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%EdgeVelVar=0.0_ReKi - - - - call AllocAry( m%LE_Location, 3, p%NumBlNds, p%numBlades, 'LE_Location', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - m%LE_Location=0.0_ReKi - - - m%speccou=0 - - - m%filesopen=0 - -end subroutine Init_MiscVars -!---------------------------------------------------------------------------------------------------------------------------------- -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine initializes (allocates) the misc variables for use during the simulation. -subroutine Init_states(xd, p, errStat, errMsg) - type(AA_DiscreteStateType), intent(inout) :: xd ! - type(AA_ParameterType), intent(in ) :: p !< Parameters - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - - ! Local variables - integer(intKi) :: k,ji - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'Init_DiscrStates' - - ! Initialize variables for this routine - - errStat = ErrID_None - errMsg = "" - - call AllocAry( xd%MeanVrel, p%NumBlNds, p%numBlades, 'xd%MeanVrel', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( xd%VrelSq, p%NumBlNds, p%numBlades, 'xd%VrelSq', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( xd%TIVrel, p%NumBlNds, p%numBlades, 'xd%TIVrel', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( xd%MeanVxVyVz, p%NumBlNds, p%numBlades, 'xd%MeanVxVyVz', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( xd%TIVx, p%NumBlNds, p%numBlades, 'xd%TIVx', ErrStat2, ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( xd%VxSq, p%NumBlNds, p%numBlades, 'xd%VxSq', ErrStat2, ErrMsg2 ) ! plus two just in case - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( xd%VrelStore, p%total_sample+1, p%NumBlNds, p%numBlades,'xd%VrelStore', ErrStat2, ErrMsg2 ) ! plus one just in case - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - - DO ji=1,size(xd%MeanVrel,2) - DO k=1,size(xd%MeanVrel,1) - xd%VrelSq (k,ji) = 0.0_ReKi ! Relative Velocity Squared for TI calculation (on the fly) - xd%MeanVrel (k,ji) = 0.0_ReKi ! Relative Velocity Mean calculation (on the fly) - xd%TIVrel(k,ji) = 0.0_ReKi ! Turbulence Intensity (for on the fly calculation) - xd%MeanVxVyVz (k,ji) = 0.0_ReKi ! - xd%TIVx (k,ji) = 0.0_ReKi ! - xd%VxSq (k,ji) = 0.0_ReKi ! - xd%VrelStore (1:size(xd%VrelStore,1),k,ji) = 0.0_ReKi ! - ENDDO - ENDDO - - - - !call AllocAry(xd%RegVxStor,p%total_sampleTI,size(p%rotorregionlimitsVert)-1,size(p%rotorregionlimitsHorz)-1,'xd%Vxst',ErrStat2,ErrMsg2) ! plus one just in case - call AllocAry(xd%RegVxStor,p%total_sampleTI,size(p%rotorregionlimitsrad)-1,size(p%rotorregionlimitsalph)-1,'xd%Vxst',ErrStat2,ErrMsg2) ! plus one just in case - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) -! call AllocAry(xd%allregcounter,size(p%rotorregionlimitsVert)-1,size(p%rotorregionlimitsHorz)-1,'xd%allregcounter',ErrStat2,ErrMsg2 ) - call AllocAry(xd%allregcounter,size(p%rotorregionlimitsrad)-1,size(p%rotorregionlimitsalph)-1,'xd%allregcounter',ErrStat2,ErrMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) -! call AllocAry(xd%VxSqRegion,size(p%rotorregionlimitsVert)-1,size(p%rotorregionlimitsHorz)-1,'xd%VxSqRegion', ErrStat2, ErrMsg2) - call AllocAry(xd%VxSqRegion,size(p%rotorregionlimitsrad)-1,size(p%rotorregionlimitsalph)-1,'xd%VxSqRegion', ErrStat2, ErrMsg2) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) -! call AllocAry(xd%RegionTIDelete,size(p%rotorregionlimitsVert)-1,size(p%rotorregionlimitsHorz)-1,'xd%RegionTIDelete', ErrStat2, ErrMsg2) - call AllocAry(xd%RegionTIDelete,size(p%rotorregionlimitsrad)-1,size(p%rotorregionlimitsalph)-1,'xd%RegionTIDelete', ErrStat2, ErrMsg2) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - - - - - DO ji=1,size(xd%allregcounter,2) - DO k=1,size(xd%allregcounter,1) - xd%allregcounter(k,ji) = 2.0_Reki ! - xd%VxSqRegion(k,ji) = 0.0_ReKi ! - xd%RegionTIDelete(k,ji) = 0.0_ReKi ! - xd%RegVxStor(1:size(xd%RegVxStor,1),k,ji)=0.0_reki - ENDDO - ENDDO - - - -end subroutine Init_states -!.................................................................................................................................. -!---------------------------------------------------------------------------------------------------------------------------------- -subroutine AA_UpdateStates( t, n, m, u, p, xd, errStat, errMsg ) - - - real(DbKi), intent(in ) :: t !< Current simulation time in seconds - integer(IntKi), intent(in ) :: n !< Current simulation time step n = 0,1,... - type(AA_InputType), intent(in ) :: u !< Inputs at utimes (out only for mesh record-keeping in ExtrapInterp routine) - TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters - type(AA_DiscreteStateType), intent(inout) :: xd !< Input: Discrete states at t; - type(AA_MiscVarType), intent(inout) :: m !< misc/optimization data - - integer(IntKi), intent( out) :: errStat !< Error status of the operation - character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None - - ! local variables - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'AA_UpdateStates' - REAL(ReKi),DIMENSION(p%NumBlNds,p%numBlades) :: TEMPSTD ! temporary standard deviation variable - REAL(ReKi) :: tempsingle,tempmean,angletemp,abs_le_x ! temporary standard deviation variable - integer(intKi) :: i,j,k,rco, y0_a,y1_a,z0_a,z1_a - logical :: exist - REAL(ReKi) :: yi_a,zi_a,yd_a,zd_a,c00_a,c10_a - - - - ErrStat = ErrID_None - ErrMsg = "" - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! cumulative mean and standard deviation, states are updated as Vrel changes at each time step -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! xd%MeanVrel = (u%Vrel + xd%MeanVrel*n) / (n+1) -! xd%VrelSq = u%Vrel**2 + xd%VrelSq - -! TEMPSTD = sqrt( (xd%VrelSq/(n+1)) - (xd%MeanVrel**2) ) -! xd%TIVrel = (TEMPSTD / xd%MeanVrel ) ! check inflow noise input for multiplication with 100 or not - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! cumulative mean and standard deviation, states are updated as Vx Vy Vz changes at each time step -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - TEMPSTD = sqrt( u%Inflow(1,:,:)**2+u%Inflow(2,:,:)**2+u%Inflow(3,:,:)**2 ) - xd%MeanVxVyVz = (TEMPSTD + xd%MeanVxVyVz*n) / (n+1) -! xd%VxSq = TEMPSTD**2 + xd%VxSq -! TEMPSTD = sqrt( (xd%VxSq/(n+1)) - (xd%MeanVxVyVz**2) ) -! xd%TIVx = (TEMPSTD / xd%MeanVxVyVz ) ! check inflow noise input for multiplication with 100 or not - - m%speccou= m%speccou+1 - !print*, 'time step',n,'m%speccou', m%speccou -! xd%VrelStore(m%speccou,:,:) = u%Vrel -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! cumulative mean and standard deviation, states are updated as Vx Vy Vz changes at each time step and there are regions divided vertically -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! do i=1,p%NumBlades -! do j=1,p%NumBlNds -! do k=1,size(p%rotorregionlimitsVert) -! IF (m%LE_Location(3,j,i)-p%rotorregionlimitsVert(k).lt.0) THEN ! it means location is in the k-1 region -! GOTO 4758 -! ENDIF -! enddo -! 4758 do rco=1,size(p%rotorregionlimitsHorz) -! IF ( (m%LE_Location(2,j,i)+maxval(p%BlSpn(:,1))-p%rotorregionlimitsHorz(rco)+2).lt.0) THEN ! it means location is in the k-1 region -! GOTO 9815 -! ENDIF -! enddo -! 9815 xd%allregcounter(k-1,rco-1)=CEILING(xd%allregcounter(k-1,rco-1)+1.0_Reki) ! increase the sample amount in that specific 5 meter height vertical region -! !print*, rco,k -! tempsingle = sqrt( u%Inflow(1,j,i)**2+u%Inflow(2,j,i)**2+u%Inflow(3,j,i)**2 ) ! -! xd%MeanVxVyVzRegion(k-1,rco-1)= (tempsingle + xd%MeanVxVyVzRegion(k-1,rco-1)*xd%allregcounter(k-1,rco-1)) / (xd%allregcounter(k-1,rco-1)+1) ! -!!!!!!!!!! with storage region dependent moving average and TI -! IF (INT(xd%allregcounter(k-1,rco-1)) .le. size(xd%RegVxStor,1)) THEN -! xd%RegVxStor(INT(xd%allregcounter(k-1,rco-1)),k-1,rco-1)=tempsingle -!! tempmean=SUM(xd%RegVxStor(1:INT(xd%allregcounter(k-1,rco-1)),k-1,rco-1)) -!! tempmean=tempmean/INT(xd%allregcounter(k-1,rco-1)) -!!! print*, k,rco,xd%allregcounter(k-1,rco-1),size(xd%RegVxStor,1) -!! xd%RegionTIDelete(k-1,rco-1)=SQRT((SUM((xd%RegVxStor(1:INT(xd%allregcounter(k-1,rco-1)),k-1,rco-1)-tempmean)**2)) / INT(xd%allregcounter(k-1,rco-1))) -!! xd%RegionTIDelete(k-1,rco-1)=xd%RegionTIDelete(k-1,rco-1)/tempmean -! xd%TIVx(j,i) = 0 -! xd%RegionTIDelete(k-1,rco-1)=0 -! ELSE -! xd%RegVxStor(mod(INT(xd%allregcounter(k-1,rco-1))-size(xd%RegVxStor,1),size(xd%RegVxStor,1)),k-1,rco-1)=tempsingle -! tempmean=SUM(xd%RegVxStor(:,k-1,rco-1)) -! tempmean=tempmean/size(xd%RegVxStor,1) -! xd%RegionTIDelete(k-1,rco-1)=SQRT((SUM((xd%RegVxStor(:,k-1,rco-1)-tempmean)**2)) / size(xd%RegVxStor,1) ) -! xd%RegionTIDelete(k-1,rco-1)=xd%RegionTIDelete(k-1,rco-1)/tempmean -! xd%TIVx(j,i) = xd%RegionTIDelete(k-1,rco-1) -! ENDIF -! -!!!!!!!!!! with storage region dependent moving average and TI -! -! xd%VxSqRegion(k-1,rco-1) = tempsingle**2 + xd%VxSqRegion(k-1,rco-1) -! tempsingle = sqrt(ABS((xd%VxSqRegion(k-1,rco-1)/(xd%allregcounter(k-1,rco-1)+1)) - (xd%MeanVxVyVzRegion(k-1,rco-1)**2))) -!! xd%TIVx(j,i) = tempsingle / xd%MeanVxVyVzRegion(k-1,rco-1) -!! xd%RegionTIDelete(k-1,rco-1)=tempsingle / xd%MeanVxVyVzRegion(k-1,rco-1) -! -! enddo -! enddo - - - IF( (p%TICalcMeth.eq.2) ) THEN - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! cumulative mean and standard deviation, states are updated as Vx Vy Vz changes at each time step and there are regions divided vertically -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - do i=1,p%NumBlades - do j=1,p%NumBlNds - abs_le_x=m%LE_Location(3,j,i)-p%hubheight - - - IF ((abs_le_x.lt.0).and.(m%LE_Location(2,j,i).lt.0)) THEN - angletemp=180+ATAN( ABS( m%LE_Location(2,j,i)/abs_le_x ) ) * R2D_D - ELSEIF ((abs_le_x.lt.0).and.(m%LE_Location(2,j,i).gt.0)) THEN - angletemp=180-ATAN( ABS( m%LE_Location(2,j,i)/abs_le_x ) ) * R2D_D - ELSEIF ((abs_le_x.gt.0).and.(m%LE_Location(2,j,i).lt.0)) THEN - angletemp=360-ATAN( ABS( m%LE_Location(2,j,i)/abs_le_x ) ) * R2D_D - ELSEIF ((abs_le_x.gt.0).and.(m%LE_Location(2,j,i).gt.0)) THEN - angletemp=ATAN( m%LE_Location(2,j,i)/abs_le_x ) * R2D_D - ELSE - print*, 'problem in angletemp Aeroacoustics module' - ENDIF - - !abs_le_x=ABS(abs_le_x) - - do k=1,size(p%rotorregionlimitsrad) - IF (p%BlSpn(j,i)-p%rotorregionlimitsrad(k).lt.0) THEN ! it means location is in the k-1 region - !print*, abs_le_x,p%rotorregionlimitsrad(k),k-1 - GOTO 4758 - ENDIF - enddo - 4758 do rco=1,size(p%rotorregionlimitsalph) - IF (angletemp-p%rotorregionlimitsalph(rco).lt.0) THEN ! it means location is in the k-1 region - GOTO 9815 - ENDIF - enddo - 9815 xd%allregcounter(k-1,rco-1)=CEILING(xd%allregcounter(k-1,rco-1)+1.0_Reki) ! increase the sample amount in that specific 5 meter height vertical region - tempsingle = sqrt( u%Inflow(1,j,i)**2+u%Inflow(2,j,i)**2+u%Inflow(3,j,i)**2 ) ! -! tempsingle = u%Vrel(j,i) ! -!!!!!!!!! with storage region dependent moving average and TI - IF (INT(xd%allregcounter(k-1,rco-1)) .lt. (size(xd%RegVxStor,1)+1)) THEN - xd%RegVxStor(INT(xd%allregcounter(k-1,rco-1)),k-1,rco-1)=tempsingle - xd%TIVx(j,i) = 0 - xd%RegionTIDelete(k-1,rco-1)=0 - ELSE - xd%RegVxStor((mod(INT(xd%allregcounter(k-1,rco-1))-size(xd%RegVxStor,1),size(xd%RegVxStor,1)))+1,k-1,rco-1)=tempsingle - tempmean=SUM(xd%RegVxStor(:,k-1,rco-1)) - tempmean=tempmean/size(xd%RegVxStor,1) - xd%RegionTIDelete(k-1,rco-1)=SQRT((SUM((xd%RegVxStor(:,k-1,rco-1)-tempmean)**2)) / size(xd%RegVxStor,1) ) -! xd%TIVx(j,i) = xd%RegionTIDelete(k-1,rco-1)/tempmean - xd%TIVx(j,i) = xd%RegionTIDelete(k-1,rco-1) ! only the fluctuation - ENDIF -!!!!!!!!! with storage region dependent moving average and TI - enddo - enddo - - IF (n .eq. 0) THEN - open (123401,file='RegionTIDelete.bin',access='stream',form='unformatted',status='REPLACE') !open a binary file - write(123401) Size(xd%RegionTIDelete,1) - write(123401) Size(xd%RegionTIDelete,2) - write(123401) xd%RegionTIDelete - ELSE - open (123401, file="RegionTIDelete.bin", access='stream',status="old", form='unformatted',position="append") - write(123401) xd%RegionTIDelete - ENDIF - - close(123401) - - !IF (n.lt.53900) THEn - !do, k=1,size(xd%allregcounter,1) - !print*, ( INT(xd%allregcounter(k,rco)), rco=1,size(xd%allregcounter,2) ) - !enddo - !print*, '*****************************************************' - !ENDIF - - - ELSE ! interpolate from the user given ti values - - do i=1,p%NumBlades - do j=1,p%NumBlNds - - zi_a=ABS(m%LE_Location(3,j,i) - (FLOOR(p%HubHeight-maxval(p%BlSpn(:,1)))) ) /p%dz_turb_in - - z0_a=floor(zi_a) - z1_a=ceiling(zi_a) - zd_a=zi_a-z0_a - - yi_a=ABS(m%LE_Location(2,j,i) + maxval(p%BlSpn(:,1)) ) /p%dy_turb_in - - y0_a=floor(yi_a) - y1_a=ceiling(yi_a) - yd_a=yi_a-y0_a - - c00_a=(1.0_ReKi-yd_a)*p%TI_Grid_In(z0_a+1,y0_a+1)+yd_a*p%TI_Grid_In(z0_a+1,y1_a+1) - c10_a=(1.0_ReKi-yd_a)*p%TI_Grid_In(z1_a+1,y0_a+1)+yd_a*p%TI_Grid_In(z1_a+1,y1_a+1) - - ! 2 points - xd%TIVx(j,i)=(1.0_ReKi-zd_a)*c00_a+zd_a*c10_a - - if (i.eq.p%NumBlades) then - if (j.eq.p%NumBlNds) then - - endif - endif - - enddo - - enddo - - ENDIF - -end subroutine AA_UpdateStates -!.................................................................................................................................. -!.................................................................................................................................. -!> This subroutine sets the initialization output data structure, which contains data to be returned to the calling program (e.g., -!! FAST or AeroAcoustics_Driver) -subroutine AA_SetInitOut(p, InputFileData, InitOut, errStat, errMsg) - - type(AA_InitOutputType), intent( out) :: InitOut ! output data - type(AA_InputFile), intent(in ) :: InputFileData ! input file data (for setting airfoil shape outputs) - type(AA_ParameterType), intent(in ) :: p ! Parameters - - integer(IntKi), intent( out) :: errStat ! Error status of the operation - character(*), intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None - - - ! Local variables - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'AA_SetInitOut' - - integer(IntKi) :: i, j, k,m,oi - integer(IntKi) :: NumCoords - - character(500) :: chanPrefix - - ! Initialize variables for this routine - - errStat = ErrID_None - errMsg = "" - - InitOut%AirDens = p%AirDens -!!!!! FIRST FILE HEADER,UNIT - call AllocAry( InitOut%WriteOutputHdr, p%numOuts, 'WriteOutputHdr', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return - - call AllocAry( InitOut%WriteOutputUnt, p%numOuts, 'WriteOutputUnt', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return - do j=1,p%NrObsLoc - InitOut%WriteOutputHdr(j)="_Obs"//trim(num2lstr(j)) - InitOut%WriteOutputUnt(j) = "SPL" - enddo - i=p%NrObsLoc - do j=1,p%NrObsLoc - do m=1,p%NumBlades - do k=1,p%NumBlNds - i=i+1 - InitOut%WriteOutputHdr(i) = "Bla"//trim(num2lstr(m))//"_Node"//trim(num2lstr(k))//"_Obs"//trim(num2lstr(j)) - InitOut%WriteOutputHdr(i)=trim(InitOut%WriteOutputHdr(i)) - InitOut%WriteOutputUnt(i) = "SPL" - enddo - enddo - enddo -!!!!!!!!!!! SECOND FILE HEADER,UNIT - call AllocAry( InitOut%WriteOutputHdrforPE, p%numOutsforPE, 'WriteOutputHdrforPE', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return - - call AllocAry( InitOut%WriteOutputUntforPE, p%numOutsforPE, 'WriteOutputUntforPE', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return - - i=0 - do k=1,size(p%FreqList) - do j=1,p%NrObsLoc - do m=1,p%NumBlades - i=i+1 - InitOut%WriteOutputHdrforPE(i) = "F"//trim(num2lstr(p%FreqList(k)))//"Obs"//trim(num2lstr(j))//"Bl"//trim(num2lstr(m)) - InitOut%WriteOutputUntforPE(i) = "SPowLev" - do oi=1,3 - i=i+1 - InitOut%WriteOutputHdrforPE(i) = "F"//trim(num2lstr(p%FreqList(k)))//"Obs"//trim(num2lstr(j))//"Bl"//trim(num2lstr(m)) - InitOut%WriteOutputUntforPE(i) = "Coord"//trim(num2lstr(oi)) - enddo - enddo - end do - enddo -!!!!!!!!!!! THIRD FILE HEADER,UNIT - call AllocAry( InitOut%WriteOutputHdrSep, p%NumOutsForSep, 'WriteOutputHdrSep', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return - - call AllocAry( InitOut%WriteOutputUntSep, p%NumOutsForSep, 'WriteOutputUntSep', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return - - i=0 -do j=1,p%NrObsLoc - do m=1,p%NumBlades - do k=1,p%NumBlNds - do oi=1,7 - i=i+1 - InitOut%WriteOutputHdrSep(i) = "Bla"//trim(num2lstr(m))//"_Node"//trim(num2lstr(k))//"_Obs"//trim(num2lstr(j))//"_Type"//trim(num2lstr(oi)) - InitOut%WriteOutputHdrSep(i)=trim(InitOut%WriteOutputHdrSep(i)) - InitOut%WriteOutputUntSep(i) = "SPL" - enddo - enddo - enddo - enddo -!!!!!!!!!!! FOURTH FILE HEADER,UNIT - call AllocAry( InitOut%WriteOutputHdrSepFreq,size(p%FreqList)*p%NrObsLoc*7, 'InitOut%WriteOutputHdrSepFreq', errStat2, errMsg2) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return - - call AllocAry( InitOut%WriteOutputUntSepFreq,size(p%FreqList)*p%NrObsLoc*7, 'InitOut%WriteOutputUntSepFreq', errStat2, errMsg2 ) - call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - if (ErrStat >= AbortErrLev) return - - i=0 - do k=1,size(p%FreqList) - do j=1,p%NrObsLoc - do oi=1,7 - i=i+1 - InitOut%WriteOutputHdrSepFreq(i) = "F"//trim(num2lstr(p%FreqList(k)))//"Obs"//trim(num2lstr(j))//"_Type"//trim(num2lstr(oi)) - InitOut%WriteOutputUntSepFreq(i) = "SPL" - end do - end do - enddo - - InitOut%Ver = AA_Ver - InitOut%delim = " " - - -end subroutine AA_SetInitOut -!---------------------------------------------------------------------------------------------------------------------------------- -!---------------------------------------------------------------------------------------------------------------------------------- -subroutine AA_InitializeOutputFile(p, InputFileData,InitOut,errStat, errMsg) - type(AA_InputFile), intent(in ) :: InputFileData !< All the data in the AeroDyn input file - type(AA_ParameterType) , intent(inout) :: p - type(AA_InitOutputType), intent(in ) :: InitOut ! output data - - integer(IntKi) , intent(inout) :: errStat ! Status of error message - character(*) , intent(inout) :: errMsg ! Error message if ErrStat /= ErrID_None - ! locals - integer(IntKi) :: i - integer(IntKi) :: numOuts - character(200) :: frmt ! A string to hold a format specifier - character(15) :: tmpStr ! temporary string to print the time output as text - - - -!!!!!!!!!!!!!!!!!!!!!!! FIRST FILE - IF (InputFileData%NrOutFile .gt.0) THEN - - call GetNewUnit( p%unOutFile, ErrStat, ErrMsg ) - if ( ErrStat >= AbortErrLev ) then - p%unOutFile = -1 - return - end if - - - call OpenFOutFile ( p%unOutFile, trim(InputFileData%AAOutFile(1)), ErrStat, ErrMsg ) - if ( ErrStat >= AbortErrLev ) return - - write (p%unOutFile,'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using AA ' - write (p%unOutFile,'(1X,A)') trim(GetNVD(InitOut%ver)) - numOuts = size(InitOut%WriteOutputHdr) - !...................................................... - ! Write the names of the output parameters on one line: - !...................................................... - - call WrFileNR ( p%unOutFile, ' Time ' ) - - do i=1,NumOuts - call WrFileNR ( p%unOutFile, InitOut%delim//InitOut%WriteOutputHdr(i) ) - end do ! i - - write (p%unOutFile,'()') - !...................................................... - ! Write the units of the output parameters on one line: - !...................................................... - - call WrFileNR ( p%unOutFile, ' (s) ' ) - - do i=1,NumOuts - call WrFileNR ( p%unOutFile, InitOut%delim//InitOut%WriteOutputUnt(i) ) - end do ! i - - write (p%unOutFile,'()') - - write( p%unOutFile, '(I5)' ) p%numBlades - write( p%unOutFile, '(I5)' ) p%NumBlNds - write( p%unOutFile, '(I5)' ) p%NrObsLoc - - - ENDIF - -!!!!!!!!!!!!!!!!!!!!!!! SECOND FILE - IF (InputFileData%NrOutFile .gt. 1) THEN - - call GetNewUnit( p%unOutFile2, ErrStat, ErrMsg ) - if ( ErrStat >= AbortErrLev ) then - p%unOutFile = -1 - return - end if - - - call OpenFOutFile ( p%unOutFile2, trim(InputFileData%AAOutFile(2)), ErrStat, ErrMsg ) - if ( ErrStat >= AbortErrLev ) return - - write (p%unOutFile2,'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using AA ' - write (p%unOutFile2,'(1X,A)') trim(GetNVD(InitOut%Ver)) - - numOuts = size(InitOut%WriteOutputHdrforPE) - !...................................................... - ! Write the names of the output parameters on one line: - !...................................................... - call WrFileNR ( p%unOutFile2, ' Time ' ) - - do i=1,NumOuts - call WrFileNR ( p%unOutFile2, InitOut%delim//InitOut%WriteOutputHdrforPE(i) ) - end do ! i - - write (p%unOutFile2,'()') - !...................................................... - ! Write the units of the output parameters on one line: - !...................................................... - - call WrFileNR ( p%unOutFile2, ' (s) ' ) - - do i=1,NumOuts - call WrFileNR ( p%unOutFile2, InitOut%delim//InitOut%WriteOutputUntforPE(i) ) - end do ! i - - write (p%unOutFile2,'()') - write( p%unOutFile2, '(I5)' ) p%NumBlades - write( p%unOutFile2, '(I5)' ) size(p%FreqList) - write( p%unOutFile2, '(I5)' ) p%NrObsLoc - -! write( p%unOutFile2, '(F20.2)' ) p%FreqList - frmt = '"'//p%delim//'"'//trim(p%outFmt) ! format for array elements from individual modules - - call WrNumAryFileNR ( p%unOutFile2, p%FreqList, frmt, errStat, errMsg ) - if ( errStat >= AbortErrLev ) return - write (p%unOutFile2,'()') - - ENDIF -!!!!!!!!!!!!!!!!!!!!!!! THIRD FILE - IF (InputFileData%NrOutFile .gt. 2) THEN - - call GetNewUnit( p%unOutFile3, ErrStat, ErrMsg ) - if ( ErrStat >= AbortErrLev ) then - p%unOutFile = -1 - return - end if - - - call OpenFOutFile ( p%unOutFile3, trim(InputFileData%AAOutFile(3)), ErrStat, ErrMsg ) - if ( ErrStat >= AbortErrLev ) return - - write (p%unOutFile3,'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using AA ' - write (p%unOutFile3,'(1X,A)') trim(GetNVD(InitOut%Ver)) - - numOuts = size(InitOut%WriteOutputHdrSep) - !...................................................... - ! Write the names of the output parameters on one line: - !...................................................... - call WrFileNR ( p%unOutFile3, "1-LBL 2-TBLPres 3-TBLSuc 4-Sep 5-BLUNT 6-TIP 7-Inflow") - write (p%unOutFile3,'()') - call WrFileNR ( p%unOutFile3, ' Time ' ) - - do i=1,NumOuts - call WrFileNR ( p%unOutFile3, InitOut%delim//InitOut%WriteOutputHdrSep(i) ) - end do ! i - - write (p%unOutFile3,'()') - - !...................................................... - ! Write the units of the output parameters on one line: - !...................................................... - - call WrFileNR ( p%unOutFile3, ' (s) ' ) - - do i=1,NumOuts - call WrFileNR ( p%unOutFile3, InitOut%delim//InitOut%WriteOutputUntSep(i) ) - end do ! i - - write (p%unOutFile3,'()') - write( p%unOutFile3, '(I5)' ) p%numBlades - write( p%unOutFile3, '(I5)' ) p%NumBlNds - write( p%unOutFile3, '(I5)' ) p%NrObsLoc - - ENDIF -!!!!!!!!!!!!!!!!!!!!!!! FOURTH FILE - IF (InputFileData%NrOutFile .gt. 3) THEN - - call GetNewUnit( p%unOutFile4, ErrStat, ErrMsg ) - if ( ErrStat >= AbortErrLev ) then - p%unOutFile = -1 - return - end if - - - call OpenFOutFile ( p%unOutFile4, trim(InputFileData%AAOutFile(4)), ErrStat, ErrMsg ) - if ( ErrStat >= AbortErrLev ) return - - write (p%unOutFile4,'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using AA ' - write (p%unOutFile4,'(1X,A)') trim(GetNVD(InitOut%Ver)) - - numOuts = size(InitOut%WriteOutputHdrSepFreq) - !...................................................... - ! Write the names of the output parameters on one line: - !...................................................... - call WrFileNR ( p%unOutFile4, "1-LBL 2-TBLPres 3-TBLSuc 4-Sep 5-BLUNT 6-TIP 7-Inflow") - write (p%unOutFile4,'()') - call WrFileNR ( p%unOutFile4, ' Time ' ) - - do i=1,NumOuts - call WrFileNR ( p%unOutFile4, InitOut%delim//InitOut%WriteOutputHdrSepFreq(i) ) - end do ! i - - write (p%unOutFile4,'()') - - !...................................................... - ! Write the units of the output parameters on one line: - !...................................................... - - call WrFileNR ( p%unOutFile4, ' (s) ' ) - - do i=1,NumOuts - call WrFileNR ( p%unOutFile4, InitOut%delim//InitOut%WriteOutputUntSepFreq(i) ) - end do ! i - - write (p%unOutFile4,'()') - write( p%unOutFile4, '(I5)' ) p%numBlades - write( p%unOutFile4, '(I5)' ) p%NumBlNds - write( p%unOutFile4, '(I5)' ) p%NrObsLoc - - ENDIF - - -end subroutine AA_InitializeOutputFile -!---------------------------------------------------------------------------------------------------------------------------------- - -subroutine AA_WriteOutputLine(y, t, p, errStat, errMsg) - - real(DbKi) , intent(in ) :: t ! simulation time (s) - type(AA_OutputType) , intent(in ) :: y - type(AA_ParameterType) , intent(in ) :: p - integer(IntKi) , intent(inout) :: errStat ! Status of error message - character(*) , intent(inout) :: errMsg ! Error message if ErrStat /= ErrID_None - - ! Local variables. - - character(200) :: frmt ! A string to hold a format specifier - character(15) :: tmpStr ! temporary string to print the time output as text - integer :: numOuts - - errStat = ErrID_None - errMsg = '' - !!!!! FIRST FILE - IF (p%NrOutFile .gt. 0) THEN - numOuts = size(y%WriteOutput) - frmt = '"'//p%delim//'"'//trim(p%outFmt) ! format for array elements from individual modules - - ! time - write( tmpStr, '(F15.4)' ) t - call WrFileNR( p%unOutFile, tmpStr ) - call WrNumAryFileNR ( p%unOutFile, y%WriteOutput, frmt, errStat, errMsg ) - if ( errStat >= AbortErrLev ) return - - ! write a new line (advance to the next line) - write (p%unOutFile,'()') - ENDIF - - !!!!!! SECOND FILE - IF (p%NrOutFile .gt. 1) THEN - numOuts = size(y%WriteOutputforPE) - frmt = '"'//p%delim//'"'//trim(p%outFmt) ! format for array elements from individual modules - - ! time - write( tmpStr, '(F15.4)' ) t - call WrFileNR( p%unOutFile2, tmpStr ) - call WrNumAryFileNR ( p%unOutFile2, y%WriteOutputforPE, frmt, errStat, errMsg ) - if ( errStat >= AbortErrLev ) return - - ! write a new line (advance to the next line) - write (p%unOutFile2,'()') - ENDIF - - !!!!!! THIRD FILE - IF (p%NrOutFile .gt. 2) THEN - numOuts = size(y%WriteOutputSep) - frmt = '"'//p%delim//'"'//trim(p%outFmt) ! format for array elements from individual modules - ! time - write( tmpStr, '(F15.4)' ) t - call WrFileNR( p%unOutFile3, tmpStr ) - call WrNumAryFileNR ( p%unOutFile3, y%WriteOutputSep, frmt, errStat, errMsg ) - if ( errStat >= AbortErrLev ) return - - ! write a new line (advance to the next line) - write (p%unOutFile3,'()') - ENDIF - !!!!!! Fourth FILE - IF (p%NrOutFile .gt. 3) THEN - numOuts = size(y%WriteOutputSepFreq) - frmt = '"'//p%delim//'"'//trim(p%outFmt) ! format for array elements from individual modules - ! time - write( tmpStr, '(F15.4)' ) t - call WrFileNR( p%unOutFile4, tmpStr ) - call WrNumAryFileNR ( p%unOutFile4, y%WriteOutputSepFreq, frmt, errStat, errMsg ) - if ( errStat >= AbortErrLev ) return - - ! write a new line (advance to the next line) - write (p%unOutFile4,'()') - ENDIF - - -end subroutine AA_WriteOutputLine -!---------------------------------------------------------------------------------------------------------------------------------- -!> This routine is called at the end of the simulation. -subroutine AA_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) -!.................................................................................................................................. - - TYPE(AA_InputType), INTENT(INOUT) :: u !< System inputs - TYPE(AA_ParameterType), INTENT(INOUT) :: p !< Parameters - TYPE(AA_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states - TYPE(AA_DiscreteStateType), INTENT(INOUT) :: xd !< Discrete states - TYPE(AA_ConstraintStateType), INTENT(INOUT) :: z !< Constraint states - TYPE(AA_OtherStateType), INTENT(INOUT) :: OtherState !< Other states - TYPE(AA_OutputType), INTENT(INOUT) :: y !< System outputs - TYPE(AA_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" - - - ! Place any last minute operations or calculations here: - - - ! Close files here: - - - - ! Destroy the input data: - - CALL AA_DestroyInput( u, ErrStat, ErrMsg ) - - - ! Destroy the parameter data: - - CALL AA_DestroyParam( p, ErrStat, ErrMsg ) - - - ! Destroy the state data: - - CALL AA_DestroyContState( x, ErrStat, ErrMsg ) - CALL AA_DestroyDiscState( xd, ErrStat, ErrMsg ) - CALL AA_DestroyConstrState( z, ErrStat, ErrMsg ) - CALL AA_DestroyOtherState( OtherState, ErrStat, ErrMsg ) - CALL AA_DestroyMisc( m, ErrStat, ErrMsg ) - - ! Destroy the output data: - - CALL AA_DestroyOutput( y, ErrStat, ErrMsg ) - - - - -END SUBROUTINE AA_End - - -!> Routine for computing outputs, used in both loose and tight coupling. -!! This subroutine is used to compute the output channels (motions and loads) and place them in the WriteOutput() array. -!! The descriptions of the output channels are not given here. Please see the included OutListParameters.xlsx sheet for -!! for a complete description of each output parameter. -subroutine AA_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg) -! NOTE: no matter how many channels are selected for output, all of the outputs are calcalated -! All of the calculated output channels are placed into the m%AllOuts(:), while the channels selected for outputs are -! placed in the y%WriteOutput(:) array. -!.................................................................................................................................. - - REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds - TYPE(AA_InputType), INTENT(IN ) :: u !< Inputs at Time t - TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AA_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t - TYPE(AA_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t - TYPE(AA_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t - TYPE(AA_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(AA_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- - type(AA_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - - - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - integer(intKi) :: i - REAL(ReKi) :: nt !< timestep increment - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'AA_CalcOutput' - - - ErrStat = ErrID_None - ErrMsg = "" - ! assume integer divide is possible - nt = t/p%DT - call CalcObserve(p,m,u,xd,nt,errStat2, errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (nt.gt.p%Comp_AA_after) THEN - IF (mod(nt,p%saveeach).eq.0) THEN - - call CalcAeroAcousticsOutput(u,p,m,xd,y,errStat2,errMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call Calc_WriteOutput( p, u, m, y, ErrStat2, ErrMsg2 ) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - call AA_WriteOutputLine(y, t, p, ErrStat2, ErrMsg2) - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ENDIF - ENDIF -end subroutine AA_CalcOutput -!---------------------------------------------------------------------------------------------------------------------------------- -!----------------------------------------------------------------------------------------------------------------------------------! -SUBROUTINE CalcObserve(p,m,u,xd,nt,errStat,errMsg) - - IMPLICIT NONE - TYPE(AA_DiscreteStateType), INTENT(IN ) :: xd ! discrete state type - TYPE(AA_ParameterType), intent(in ) :: p ! Parameters - TYPE(AA_InputType), intent(in ) :: u !< NN Inputs at Time - TYPE(AA_MiscVarType), intent(inout) :: m !< misc/optimization data (not defined in submodules) - REAL(ReKi), INTENT(IN ) :: nt !DELETE LATER - INTEGER(IntKi), intent( out) :: errStat ! Error status of the operation - CHARACTER(*), intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None - - ! Local variables. - REAL(ReKi) :: RLEObserve (3) ! position vector from leading edge to observer in trailing edge coordinate system - REAL(ReKi) :: BladeObserve (3) ! position vector from leading edge to observer in trailing edge coordinate system - REAL(ReKi) :: RTEObserve (3) ! position vector from trailing edge to observer in trailing edge coordinate system - REAL(ReKi) :: RTEObservereal (3) ! location of trailing edge in global coordinate system - REAL(ReKi) :: RLEObservereal (3) ! location of leading edge in global coordinate system - REAL(ReKi) :: LocalToGlobal(3,3) ! trasnformation matrix - REAL(ReKi) :: RObserveInt(3) ! RObserve in the internal coordinate system - REAL(ReKi) :: rSLE (3) ! Distance from tower base to leading edge in trailing edge coordinate system - REAL(ReKi) :: rSTE (3) ! Distance from tower base to trailing edge in trailing edge coordinate system - REAL(ReKi) :: timeLE ! Time of sound propagation from leading edge to observer - REAL(ReKi) :: timeTE ! Time of sound propagation from trailing edge to observer - REAL(ReKi) :: tmpR (3) ! temporary distance vector - REAL(ReKi) :: UConvect (3) ! convection velocity of noise source in trailing edge coordinate system - - INTEGER(intKi) :: I ! I A generic index for DO loops. - INTEGER(intKi) :: J ! J A generic index for DO loops. - INTEGER(intKi) :: K ! K A generic index for DO loops. - INTEGER(intKi) :: cou ! K A generic index for DO loops. - - - INTEGER(intKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), parameter :: RoutineName = 'CalcObserveDist' - LOGICAL :: exist - - ErrStat = ErrID_None - ErrMsg = "" - -! Old version (FAST v4.0) is commented -! Transform RObserve to the internal a coordinate system -!RObserveInt (1) = RObserve (1) -!RObserveInt (2) = RObserve (3) + PtfmRef -!RObserveInt (3) =-RObserve (2) - - DO I = 1,p%numBlades - DO J = 1,p%NumBlNds - !! ! Calculate position vector of trailing edge from tower base in trailing edge coordinate system -!! rSTE (1) = DOT_PRODUCT(te1(J,I,:),rS(J,I,:)) -!! rSTE (2) = DOT_PRODUCT(te2(J,I,:),rS(J,I,:)) + 0.75*Chord(I) -!! rSTE (3) = DOT_PRODUCT(te3(J,I,:),rS(J,I,:)) -!! -!! ! Calculate position vector of leading edge from tower base in trailing edge coordinate system -!! rSLE (1) = rSTE (1) -!! rSLE (2) = rSTE (2) - Chord(I) -!! rSLE (3) = rSTE (3) -!! -!! ! Calculate position vector of observer from tower base in trailing edge coordinate system -!! tmpR (1) = DOT_PRODUCT(te1(J,I,:),RObserveInt) -!! tmpR (2) = DOT_PRODUCT(te2(J,I,:),RObserveInt) -!! tmpR (3) = DOT_PRODUCT(te3(J,I,:),RObserveInt) -!! -!! ! Calculate position vector from leading and trailing edge to observer in trailing edge coordinate system -!! RTEObserve = tmpR-rSTE -!! RLEObserve = tmpR-rSLE - -!================================================================ -! (DONE) TODO: Restructure based on new inputs: RotLtoG(3,3,numNodes, numBlades) and AeroCent_G(3,numNodes, numBlades) -! - -! Transpose the matrix RotLtoG - LocalToGlobal = TRANSPOSE(u%RotLtoG(:,:,J,I)) - RTEObservereal = MATMUL(LocalToGlobal, p%AFTeCo(:,J,I)) + u%AeroCent_G(:,J,I) - RLEObservereal = MATMUL(LocalToGlobal, p%AFLeCo(:,J,I)) + u%AeroCent_G(:,J,I) - - - m%LE_Location(1,J,I) = RLEObservereal(1) ! - m%LE_Location(2,J,I) = RLEObservereal(2) ! - m%LE_Location(3,J,I) = RLEObservereal(3) ! the height of leading edge - !m%LE_Location(1,J,I) = u%AeroCent_G(1,J,I) ! - !m%LE_Location(2,J,I) = u%AeroCent_G(2,J,I) ! - !m%LE_Location(3,J,I) = u%AeroCent_G(3,J,I) ! the height of leading edge - - IF (nt.gt.p%Comp_AA_after) THEN - IF ( (mod(nt,p%saveeach).eq.0) ) THEN - - inquire(file="RTEObserve.txt", exist=exist) - if (exist) then - open(1254, file="RTEObserve.txt", status="old", position="append", action="write") - else - open(1254, file="RTEObserve.txt", status="new", action="write") - end if - write(1254, *) RTEObservereal - close(1254) - - inquire(file="RLEObserve.txt", exist=exist) - if (exist) then - open(1254, file="RLEObserve.txt", status="old", position="append", action="write") - else - open(1254, file="RLEObserve.txt", status="new", action="write") - end if - write(1254, *) RLEObservereal - close(1254) - -!!! this part is full blade rotation if a visulatization of all nodes of the blades are desired: see p%FullBladeShape - -! print*, 'saving blade',nt -! DO cou=1,size(p%FullBladeShape,4) -! BladeObserve=MATMUL(LocalToGlobal, p%FullBladeShape(:,j,i,cou) ) + u%AeroCent_G(:,J,I) -! inquire(file="BladeObserve.txt", exist=exist) -! if (exist) then -! open(1254, file="BladeObserve.txt", status="old", position="append", action="write") -! else -! open(1254, file="BladeObserve.txt", status="new", action="write") -! end if -! write(1254, *) BladeObserve -! close(1254) -! ENDDO - - - DO K = 1,p%NrObsLoc - - RTEObserve(1)=ABS(p%Obsx(K)-RTEObservereal(1)) - RTEObserve(2)=ABS(p%Obsy(K)-RTEObservereal(2)) - RTEObserve(3)=ABS(p%Obsz(K)-RTEObservereal(3)) - - RLEObserve(1)=ABS(p%Obsx(K)-RLEObservereal(1)) - RLEObserve(2)=ABS(p%Obsy(K)-RLEObservereal(2)) - RLEObserve(3)=ABS(p%Obsz(K)-RLEObservereal(3)) - -! (DONE) TODO : End rework -!================================================================ -!! -!! ! Calculate convection velocity of noise source -!! ! Assumes noise source convects at some constant times the mean wind speed, approximately accounts for -!! ! induction velocity and change in convection velocity as noise propagates to observer (likely on the ground) -!! UConvect (1) = te1(J,I,1)*0.8*MeanVNoise -!! UConvect (2) = te2(J,I,1)*0.8*MeanVNoise -!! UConvect (3) = te3(J,I,1)*0.8*MeanVNoise - UConvect (1) = 0.8*xd%MeanVxVyVz(J,I) - UConvect (2) = 0.8*xd%MeanVxVyVz(J,I) - UConvect (3) = 0.8*xd%MeanVxVyVz(J,I) -!! -!! ! Calculate time of noise propagation to observer - timeTE = SQRT (RTEObserve(1)**2+RTEObserve(2)**2+RTEObserve(3)**2)/p%SpdSound - timeLE = SQRT (RLEObserve(1)**2+RLEObserve(2)**2+RLEObserve(3)**2)/p%SpdSound -!! -!! ! Calculate position vector from leading and trailing edge to observer in retarded trailing edge coordinate system -!! RTEObserve = RTEObserve-UConvect*timeTE -!! RLEObserve = RLEObserve-UConvect*timeLE ! coerect the bug not RTE RLE -!! -!! ! Calculate inputs into noise subroutines - m%rTEtoObserve(K,J,I) = SQRT (RTEObserve(1)**2+RTEObserve(2)**2+RTEObserve(3)**2) - m%rLEtoObserve(K,J,I) = SQRT (RLEObserve(1)**2+RLEObserve(2)**2+RLEObserve(3)**2) - - m%ChordAngleTE(K,J,I) = ACOS (RTEObserve(2)/SQRT(RTEObserve(1)**2+RTEObserve(2)**2+RTEObserve(3)**2))*R2D ! theta - m%SpanAngleTE(K,J,I) = ACOS (RTEObserve(3)/SQRT(RTEObserve(1)**2+RTEObserve(3)**2))*R2D !phi - IF (m%SpanAngleTE(K,J,I)< 0) m%SpanAngleTE(K,J,I)= 180+m%SpanAngleTE(K,J,I) - IF (m%ChordAngleTE(K,J,I)< 0) m%ChordAngleTE(K,J,I)= 180+m%ChordAngleTE(K,J,I) - - m%ChordAngleLE(K,J,I) = ACOS (RLEObserve(2)/SQRT(RLEObserve(1)**2+RLEObserve(2)**2+RLEObserve(3)**2))*R2D - m%SpanAngleLE(K,J,I) = ACOS (RLEObserve(3)/SQRT(RLEObserve(1)**2+RLEObserve(3)**2))*R2D - IF (m%SpanAngleLE(K,J,I)< 0) m%SpanAngleLE(K,J,I)= 180+m%SpanAngleLE(K,J,I) - IF (m%ChordAngleLE(K,J,I)< 0) m%ChordAngleLE(K,J,I)= 180+m%ChordAngleLE(K,J,I) - - ENDDO !K - - ENDIF ! every Xth time step or so.. - ENDIF ! only if the time step is more than user input value run this part - - ENDDO !J - ENDDO !I - - - - - -RETURN -END SUBROUTINE CalcObserve -!----------------------------------------------------------------------------------------------------------------------------------! -SUBROUTINE CalcAeroAcousticsOutput(u,p,m,xd,y,errStat,errMsg) - - IMPLICIT NONE - - TYPE(AA_InputType), INTENT(IN ) :: u !< Inputs at Time t - TYPE(AA_OutputType), INTENT(INOUT) :: y ! - TYPE(AA_ParameterType), INTENT(IN ) :: p ! Parameters - TYPE(AA_MiscVarType), INTENT(INOUT) :: m !< misc/optimization data (not defined in submodules) - TYPE(AA_DiscreteStateType), INTENT(IN ) :: xd ! discrete state type - integer(IntKi), INTENT( OUT) :: errStat ! Error status of the operation - character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None - - - ! Local variables. - - integer(intKi) :: III !III A generic index for DO loops. - integer(intKi) :: I !I A generic index for DO loops. - integer(intKi) :: J !J A generic index for DO loops. - integer(intKi) :: K,liop,cou ,JTEMP !K A generic index for DO loops. - integer(intKi) :: oi !K A generic index for DO loops. - REAL(ReKi) :: AlphaNoise ! - REAL(ReKi) :: UNoise ! - REAL(ReKi) :: elementspan ! - REAL(ReKi) :: addpow ! - REAL(ReKi),DIMENSION(p%NumBlNds) :: tempdel - REAL(ReKi),DIMENSION(p%NrObsLoc,p%NumBlNds,p%numBlades) :: OASPLTBLAll - REAL(ReKi),DIMENSION(p%NrObsLoc,p%NumBlNds,p%numBlades,size(p%FreqList)) :: ForMaxLoc - REAL(ReKi),DIMENSION(size(y%OASPL_Mech,1),size(p%FreqList),p%NrObsLoc,p%NumBlNds,p%numBlades) :: ForMaxLoc3 - REAL(ReKi),DIMENSION(size(p%FreqList),p%NrObsLoc,p%numBlades) :: SPL_Out - REAL(ReKi),DIMENSION(p%NumBlNds,p%numBlades) :: temp_dispthick - REAL(ReKi),DIMENSION(p%NumBlNds,p%numBlades) :: temp_dispthickchord - - real(ReKi) :: Ptotal - real(ReKi) :: PtotalLBL - real(ReKi) :: PtotalTBLP - real(ReKi) :: PtotalTBLS - real(ReKi) :: PtotalSep - real(ReKi) :: PtotalTBLAll - real(ReKi) :: PtotalBlunt - real(ReKi) :: PtotalTip - real(ReKi) :: PtotalInflow - real(ReKi) :: PLBL - real(ReKi) :: PTBLP - real(ReKi) :: PTBLS - real(ReKi) :: PTBLALH - real(ReKi) :: PTip - real(ReKi) :: PTI - real(ReKi) :: PBLNT,adforma - REAL(ReKi),DIMENSION(2) :: Cf ,d99, d_star - - TYPE(FFT_DataType) :: FFT_Data !< the instance of the FFT module we're using - REAL(kind=4),DIMENSION(p%total_sample) :: spect_signal - REAL(kind=4),DIMENSION(p%total_sample/2) :: spectra - real(ReKi),ALLOCATABLE :: fft_freq(:) - - integer(intKi) :: ErrStat2 - character(ErrMsgLen) :: ErrMsg2 - character(*), parameter :: RoutineName = 'CalcAeroAcousticsOutput' - logical :: exist - - ErrStat = ErrID_None - ErrMsg = "" - - -!------------------- Fill with zeros -------------------------! - DO I = 1,p%numBlades;DO J = 1,p%NumBlNds;DO K = 1,p%NrObsLoc; - y%OASPL(k,j,i) = 0.0_Reki - DO oi=1,size(y%OASPL_Mech,1) - y%OASPL_Mech(oi,k,j,i)= 0.0_Reki - ENDDO; - ENDDO;ENDDO;ENDDO - - DO K = 1,p%NrObsLoc; - y%DirectiviOutput(K) = 0.0_Reki - DO I=1,p%NumBlades;DO III=1,size(p%FreqList); - y%SumSpecNoise(III,K,I) = 0.0_Reki - ForMaxLoc(K,1:p%NumBlNds,I,III)=0.0_Reki - DO oi=1,size(y%OASPL_Mech,1) - y%SumSpecNoiseSep(oi,K,III) = 0.0_Reki - ForMaxLoc3(oi,III,K,1:p%NumBlNds,I)=0.0_Reki - m%SPLLBL(III)=0.0_Reki - m%SPLP(III)=0.0_Reki - m%SPLS(III)=0.0_Reki - m%SPLALPH(III)=0.0_Reki - m%SPLBLUNT(III)=0.0_Reki - m%SPLTIP(III)=0.0_Reki - m%SPLti(III)=0.0_Reki - ENDDO - ENDDO;ENDDO - ENDDO - - - - -!------------------- initialize FFT -------------------------! -!!! IF (m%speccou .eq. p%total_sample)THEN -!!! CALL InitFFT ( p%total_sample, FFT_Data, ErrStat=ErrStat2 ) -!!! CALL SetErrStat(ErrStat2, 'Error in InitFFT', ErrStat, ErrMsg, 'CalcAeroAcousticsOutput' ) -!!! CALL AllocAry( fft_freq, size(spect_signal)/2-1, 'fft_freq', ErrStat2, ErrMsg2 ) -!!! CALL SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) -!!! do liop=1,size(fft_freq) -!!! fft_freq(liop)=p%fsample*liop ! fRequncy x axis -!!! fft_freq(liop)=fft_freq(liop)/size(spect_signal) -!!! enddo -!!! ENDIF - - - inquire(file="alpha.txt", exist=exist) - if (exist) then - open(1254, file="alpha.txt", status="old", position="append", action="write") - else - open(1254, file="alpha.txt", status="new", action="write") - end if - write(1254, *) u%AoANoise* R2D_D - close(1254) - - inquire(file="TIVrel.txt", exist=exist) - if (exist) then - open(1254, file="TIVrel.txt", status="old", position="append", action="write") - else - open(1254, file="TIVrel.txt", status="new", action="write") - end if - write(1254, *) xd%TIVrel - close(1254) - - inquire(file="TIVx.txt", exist=exist) - if (exist) then - open(1254, file="TIVx.txt", status="old", position="append", action="write") - else - open(1254, file="TIVx.txt", status="new", action="write") - end if - write(1254, *) xd%TIVx - close(1254) - - inquire(file="Inflow1.txt", exist=exist) - if (exist) then - open(1254, file="Inflow1.txt", status="old", position="append", action="write") - else - open(1254, file="Inflow1.txt", status="new", action="write") - end if - write(1254, *) u%Inflow(1,:,:) - close(1254) - - - inquire(file="Vrel.txt", exist=exist) - if (exist) then - open(1254, file="Vrel.txt", status="old", position="append", action="write") - else - open(1254, file="Vrel.txt", status="new", action="write") - end if - write(1254, *) u%Vrel - close(1254) - - - - DO I = 1,p%numBlades - DO J = p%startnode,p%NumBlNds ! starts loop from startnode. -!------------------------------!!------------------------------!!------------------------------!!------------------------------! -!------------------------------!!------------------------------!!------------------------------!!------------------------------! -!------------------------------!!------------------------------!!------------------------------!!------------------------------! -!--------Calculate Spectrum for dissipation calculation-------------------------! -! IF (m%speccou .eq. p%total_sample)THEN -! spect_signal=xd%VrelStore( 1:p%total_sample,J,I ) -! CALL ApplyFFT_f( spect_signal, FFT_Data, ErrStat2 ) -! IF (ErrStat2 /= ErrID_None ) THEN -! CALL SetErrStat(ErrStat2, 'Error in ApplyFFT .', ErrStat, ErrMsg, 'CalcAeroAcousticsOutput' ) -! ENDIF -! cou=1 -! DO liop=2,size(spect_signal)-1,2 -! cou=cou+1 -! spectra(cou) = spect_signal(liop)*spect_signal(liop) + spect_signal(1+liop)*spect_signal(1+liop) -! ENDDO -! spectra(1)=spect_signal(1)*spect_signal(1) -! spectra=spectra/(size(spectra)*2) -! m%speccou=0 -! ENDIF - -! TODO: Handle degenerate case where Vrel = 0.0 (DONE) - Unoise = u%Vrel(J,I) - IF (EqualRealNos(Unoise,0.0_ReKi)) then - Unoise = 0.1 - ENDIF -! TODO: Handle degenerate case where BlSpn = 0.0 (DONE) ! solved by variable 'elementspan' and loop over 2 - IF (J .EQ. p%NumBlNds) THEN - elementspan = (p%BlSpn(J,I)-p%BlSpn(J-1,I))/2 - ELSE - elementspan = (p%BlSpn(J,I)-p%BlSpn(J-1,I))/2 + (p%BlSpn(J+1,I)-p%BlSpn(J,I))/2 - ENDIF - AlphaNoise= u%AoANoise(J,I) * R2D_D - -!--------Xfoil Boundary Layer Either Every Step Calculate or Interpolate from pretabulated-------------------------! - IF (p%X_BLMethod .EQ. 2) THEN - IF (p%XfoilCall .eq. 1) THEN - call BL_Param_Interp(p,m,Unoise,AlphaNoise,p%BlChord(J,I),p%BlAFID(J,I), errStat2, errMsg2) - temp_dispthick(J,I)= m%d99Var(1) - m%d99Var = m%d99Var*p%BlChord(J,I) - m%dstarVar = m%dstarVar*p%BlChord(J,I) - temp_dispthickchord(J,I)=m%d99Var(1) - !call BL_Param_Interp(p,m,Unoise,AlphaNoise,0.22860d0,p%BlAFID(J,I), errStat2, errMsg2) - ! m%d99Var = m%d99Var*0.22860d0 - ! m%dstarVar = m%dstarVar*0.22860d0 - ELSEIF (p%XfoilCall .eq. 2) THEN - !CALL XFOIL_BL_SINGLE(p,m,p%BlAFID(J,I),p%BlChord(J,I),UNoise,AlphaNoise) - !CALL XFOIL_BL_SINGLE(p,m,p%BlAFID(J,I),0.22860d0,63.920d0,3.0d0) - ENDIF - ENDIF - -!------------------------------!!------------------------------!!------------------------------!!------------------------------! -!------------------------------!!------------------------------!!------------------------------!!------------------------------! -!------------------------------!!------------------------------!!------------------------------!!------------------------------! - - DO K = 1,p%NrObsLoc - - -!--------Laminar Boundary Layer Vortex Shedding Noise----------------------------! - IF ( (p%ILAM .EQ. 1) .AND. (p%ITRIP .EQ. 0) ) THEN - CALL LBLVS(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & - elementspan,m%rTEtoObserve(K,J,I), & - p,m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLLBL,errStat2,errMsg2) -! CALL LBLVS(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0, & -! p,m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLLBL,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ENDIF -!--------Turbulent Boundary Layer Trailing Edge Noise----------------------------! - IF ( (p%ITURB .EQ. 1) .or. (p%ITURB .EQ. 2) ) THEN - CALL TBLTE(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & - elementspan,m%rTEtoObserve(K,J,I), p, j,i,k,m%d99Var(2),m%dstarVar(1),m%dstarVar(2),p%StallStart(J,I), & - m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,errStat2,errMsg2 ) -! CALL TBLTE(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0, & -! p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),p%StallStart(J,I),m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,errStat2,errMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (p%ITURB .EQ. 2) THEN - m%SPLP=0.0_ReKi;m%SPLS=0.0_ReKi;m%SPLTBL=0.0_ReKi; - m%EdgeVelVar(1)=1.000d0;m%EdgeVelVar(2)=m%EdgeVelVar(1); - CALL TBLTE_TNO(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & - elementspan,m%rTEtoObserve(K,J,I),m%CfVar,m%d99var,m%EdgeVelVar ,p, & - m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,errStat2 ,errMsg2) - -!Nafnoise check -! m%CfVar(1) = 0.0003785760d0;m%CfVar(2) = 0.001984380d0; m%d99var(1)= 0.01105860d0; m%d99var(2)= 0.007465830d0;m%EdgeVelVar(1)=1.000d0;m%EdgeVelVar(2)=m%EdgeVelVar(1); -! CALL TBLTE_TNO(3.0_Reki,0.22860_Reki,63.9200_Reki,90.00_Reki,90.0_Reki,0.5090_Reki,1.220_Reki, & -! m%CfVar,m%d99var,m%EdgeVelVar, p, m%SPLP,m%SPLS,m%SPLALPH,m%SPLTBL,errStat2 ,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ENDIF - ENDIF -!--------Blunt Trailing Edge Noise----------------------------------------------! - IF ( p%IBLUNT .EQ. 1 ) THEN - CALL BLUNT(AlphaNoise,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & - elementspan,m%rTEtoObserve(K,J,I),p%TEThick(J,I),p%TEAngle(J,I), & - p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLBLUNT,errStat2,errMsg2 ) -! CALL BLUNT(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0, & -! p%TEThick(J,I),p%TEAngle(J,I),p, m%d99Var(2),m%dstarVar(1),m%dstarVar(2),m%SPLBLUNT,errStat2,errMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ENDIF -!--------Tip Noise--------------------------------------------------------------! - IF ( (p%ITIP .EQ. 1) .AND. (J .EQ. p%NumBlNds) ) THEN - CALL TIPNOIS(AlphaNoise,p%ALpRAT,p%BlChord(J,I),UNoise,m%ChordAngleTE(K,J,I),m%SpanAngleTE(K,J,I), & - m%rTEtoObserve(K,J,I), p, m%SPLTIP,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ENDIF -!--------Inflow Turbulence Noise ------------------------------------------------! -! important checks to be done inflow tubulence inputs - IF (p%IInflow.gt.0) then -! Amiet's Inflow Noise Model is Calculated as long as InflowNoise is On - CALL InflowNoise(AlphaNoise,p%BlChord(J,I),Unoise,m%ChordAngleLE(K,J,I),m%SpanAngleLE(K,J,I),& - elementspan,m%rLEtoObserve(K,J,I),xd%MeanVxVyVz(J,I),xd%TIVx(J,I),m%LE_Location(3,J,I),0.050,xd%TIVx(J,I),p,m%SPLti,errStat2,errMsg2 ) -! CALL InflowNoise(3.0d0,0.22860d0,63.920d0,90.0d0,90.0d0,0.5090d0,1.220d0, & -! xd%MeanVrel(J,I),0.050d0,0.050d0,p,m%SPLti,errStat2,errMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) -! If Guidati model (simplified or full version) is also on then the 'SPL correction' to Amiet's model will be added - IF ( p%IInflow .EQ. 2 ) THEN -! CALL FullGuidati(3.0d0,63.920d0,0.22860d0,0.5090d0,1.220d0,90.0d0,90.0d0,xd%MeanVrel(J,I),xd%TIVrel(J,I), & -! p,p%BlAFID(J,I),m%SPLTIGui,errStat2 ) - CALL FullGuidati(AlphaNoise,UNoise,p%BlChord(J,I),elementspan,m%rLEtoObserve(K,J,I), & - m%ChordAngleLE(K,J,I),m%SpanAngleLE(K,J,I),xd%MeanVrel(J,I),xd%TIVrel(J,I), & - p,p%BlAFID(J,I),m%SPLTIGui,errStat2,errMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%SPLti=m%SPLti+m%SPLTIGui+10 ! +10 is fudge factor to match NLR data - ELSEIF ( p%IInflow .EQ. 3 ) THEN - CALL Simple_Guidati(UNoise,p%BlChord(J,I),p%AFThickGuida(2,p%BlAFID(J,I)), & - p%AFThickGuida(1,p%BlAFID(J,I)),p,m%SPLTIGui,errStat2,errMsg2 ) -! CALL Simple_Guidati(UNoise,0.22860d0,0.120d0,0.020d0,p,m%SPLTIGui,errStat2,errMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - m%SPLti=m%SPLti+m%SPLTIGui+10 ! +10 is fudge factor to match NLR data - - ENDIF - ENDIF -!----------------------------------------------------------------------------------------------------------------------------------! -! ADD IN THIS SEGMENT'S CONTRIBUTION ON A MEAN-SQUARE -! PRESSURE BASIS -!----------------------------------------------------------------------------------------------------------------------------------! - Ptotal = 0.0_ReKi - PtotalLBL= 0.0_ReKi - PtotalTBLP= 0.0_ReKi - PtotalTBLS= 0.0_ReKi - PtotalSep= 0.0_ReKi - PtotalTBLAll = 0.0_ReKi - PtotalBlunt= 0.0_ReKi - PtotalTip= 0.0_ReKi - PtotalInflow= 0.0_ReKi - PLBL= 0.0_ReKi - PTBLP= 0.0_ReKi - PTBLS= 0.0_ReKi - PTBLALH= 0.0_ReKi - PTip= 0.0_ReKi - PTI= 0.0_ReKi - PBLNT= 0.0_ReKi - - DO III=1,size(p%FreqList) - - IF ( (p%ILAM .EQ. 1) .AND. (p%ITRIP .EQ. 0) ) THEN - PLBL = 10.0_ReKi**(m%SPLLBL(III)/10.0_ReKi) - PtotalLBL = PtotalLBL + PLBL - Ptotal = Ptotal + PLBL - y%SumSpecNoiseSep(1,K,III) = PLBL + y%SumSpecNoiseSep(1,K,III) - ENDIF - - IF ( p%ITURB .GT. 0 ) THEN - PTBLP = 10.0_ReKi**(m%SPLP(III)/10.0_ReKi) - PTBLS = 10.0_ReKi**(m%SPLS(III)/10.0_ReKi) - PTBLALH = 10.0_ReKi**(m%SPLALPH(III)/10.0_ReKi) - PtotalTBLP = PtotalTBLP + PTBLP - PtotalTBLS = PtotalTBLS + PTBLS - PtotalSep = PtotalSep + PTBLALH - Ptotal = Ptotal + PTBLP + PTBLS + PTBLALH - PtotalTBLAll = PtotalTBLAll + 10.0_ReKi**(m%SPLTBL(III)/10.0_ReKi) - y%SumSpecNoiseSep(2,K,III) = PTBLP + y%SumSpecNoiseSep(2,K,III) - y%SumSpecNoiseSep(3,K,III) = PTBLS + y%SumSpecNoiseSep(3,K,III) - y%SumSpecNoiseSep(4,K,III) = PTBLALH + y%SumSpecNoiseSep(4,K,III) - ENDIF - - IF ( p%IBLUNT .GT. 0 ) THEN - PBLNT = 10.0_ReKi**(m%SPLBLUNT(III)/10.0_ReKi) - PtotalBlunt = PtotalBlunt + PBLNT - Ptotal = Ptotal + PBLNT - y%SumSpecNoiseSep(5,K,III) = PBLNT + y%SumSpecNoiseSep(5,K,III) - ENDIF - - IF ( (p%ITIP .GT. 0) .AND. (J .EQ. p%NumBlNds) ) THEN - PTip = 10.0_ReKi**(m%SPLTIP(III)/10.0_ReKi) - PtotalTip = PtotalTip + PTip - Ptotal = Ptotal + PTip - y%SumSpecNoiseSep(6,K,III) = PTip + y%SumSpecNoiseSep(6,K,III) - ENDIF - - IF ( (p%IInflow .GT. 0) ) THEN - PTI = 10.0_ReKi**(m%SPLti(III)/10.0_ReKi) - PtotalInflow = PtotalInflow + PTI - Ptotal = Ptotal + PTI - y%SumSpecNoiseSep(7,K,III) = PTI + y%SumSpecNoiseSep(7,K,III) - ENDIF - - y%SumSpecNoise(III,K,I) = Ptotal + y%SumSpecNoise(III,K,I) - y%DirectiviOutput(K) = Ptotal + y%DirectiviOutput(K) - -! IF (y%SumSpecNoise(III,K,I) .EQ. 0.) y%SumSpecNoise(III,K,I)=1 - - IF (y%DirectiviOutput(K) .EQ. 0.) y%DirectiviOutput(K) =1 ! - IF (y%SumSpecNoiseSep(1,K,III) .EQ. 0.) y%SumSpecNoiseSep(1,K,III) =1 ! LBL - IF (y%SumSpecNoiseSep(2,K,III) .EQ. 0.) y%SumSpecNoiseSep(2,K,III) =1 ! TBLP - IF (y%SumSpecNoiseSep(3,K,III) .EQ. 0.) y%SumSpecNoiseSep(3,K,III) =1 ! TBLS - IF (y%SumSpecNoiseSep(4,K,III) .EQ. 0.) y%SumSpecNoiseSep(4,K,III) =1 ! Sep - IF (y%SumSpecNoiseSep(5,K,III) .EQ. 0.) y%SumSpecNoiseSep(5,K,III) =1 ! Blunt - IF (y%SumSpecNoiseSep(6,K,III) .EQ. 0.) y%SumSpecNoiseSep(6,K,III) =1 ! Tip - IF (y%SumSpecNoiseSep(7,K,III) .EQ. 0.) y%SumSpecNoiseSep(7,K,III) =1 ! Inflow - !!print*, p%FreqList(III),10*log10(y%SumSpecNoiseSep(7,K,III)) - ForMaxLoc(K,J,I,III) = 10.*LOG10(y%SumSpecNoise(III,K,I)) - - - - IF (p%AweightFlag.eq.1) THEN - IF (m%SPLLBL(III) .NE. 0.) ForMaxLoc3(1,III,K,J,I) = m%SPLLBL(III)+p%Aweight(III) ! LBL - IF (m%SPLP(III) .NE. 0.) ForMaxLoc3(2,III,K,J,I) = m%SPLP(III)+p%Aweight(III) ! TBLP - IF (m%SPLS(III) .NE. 0.) ForMaxLoc3(3,III,K,J,I) = m%SPLS(III)+p%Aweight(III) ! TBLS - IF (m%SPLALPH(III) .NE. 0.) ForMaxLoc3(4,III,K,J,I) = m%SPLALPH(III)+p%Aweight(III) ! Sep - IF (m%SPLBLUNT(III).NE. 0.) ForMaxLoc3(5,III,K,J,I) = m%SPLBLUNT(III)+p%Aweight(III) ! Blunt - IF (m%SPLTIP(III) .NE. 0.) ForMaxLoc3(6,III,K,J,I) = m%SPLTIP(III)+p%Aweight(III) ! Tip - IF (m%SPLti(III) .NE. 0.) ForMaxLoc3(7,III,K,J,I) = m%SPLti(III) +p%Aweight(III) ! Inflow - ELSE - ForMaxLoc3(1,III,K,J,I) = m%SPLLBL(III) ! LBL - ForMaxLoc3(2,III,K,J,I) = m%SPLP(III) ! TBLP - ForMaxLoc3(3,III,K,J,I) = m%SPLS(III) ! TBLS - ForMaxLoc3(4,III,K,J,I) = m%SPLALPH(III) ! Sep - ForMaxLoc3(5,III,K,J,I) = m%SPLBLUNT(III) ! Blunt - ForMaxLoc3(6,III,K,J,I) = m%SPLTIP(III) ! Tip - ForMaxLoc3(7,III,K,J,I) = m%SPLti(III) ! Inflow - ENDIF - - - - ENDDO ! III = 1, size(p%FreqList) - - - IF (p%NrOutFile .gt. 2) THEN - IF (PtotalLBL .NE. 0.) y%OASPL_Mech(1,K,J,I) = 10.*LOG10(PtotalLBL); ! LBL - IF (PtotalTBLP .NE. 0.) y%OASPL_Mech(2,K,J,I) = 10.*LOG10(PtotalTBLP); ! TBLP - IF (PtotalTBLS .NE. 0.) y%OASPL_Mech(3,K,J,I) = 10.*LOG10(PtotalTBLS); ! TBLS - IF (PtotalSep .NE. 0.) y%OASPL_Mech(4,K,J,I) = 10.*LOG10(PtotalSep) ; ! Sep - IF (PtotalTBLAll .NE. 0.) OASPLTBLAll(K,J,I) = 10.*LOG10(PtotalTBLAll); ! not taken - IF (PtotalBlunt .NE. 0.) y%OASPL_Mech(5,K,J,I) = 10.*LOG10(PtotalBlunt); ! Blunt - IF (PtotalTip .NE. 0.) y%OASPL_Mech(6,K,J,I) = 10.*LOG10(PtotalTip); ! Tip - IF (PtotalInflow .NE. 0.) y%OASPL_Mech(7,K,J,I) = 10.*LOG10(PtotalInflow); ! Inflow - ENDIF - - IF (Ptotal .NE. 0.) y%OASPL(K,J,I) = 10.*LOG10(Ptotal) - - ENDDO - - - ENDDO - ENDDO - - - - - - IF (p%NrOutFile .gt. 3) THEN - y%SumSpecNoiseSep = 10.*LOG10(y%SumSpecNoiseSep) - ENDIF - - IF (p%NrOutFile .gt. 0) THEN - y%DirectiviOutput = 10.*LOG10(y%DirectiviOutput) - ENDIF - - IF (p%NrOutFile .gt. 1) THEN - DO I = 1,p%numBlades - DO K = 1,p%NrObsLoc - DO III=1,size(p%FreqList) - addpow=10*log10(4*pi*m%rTEtoObserve(K,J,I)*m%rTEtoObserve(K,J,I)) - IF (y%SumSpecNoise(III,K,I) .EQ. 0.) y%SumSpecNoise(III,K,I)=1 - IF (p%AweightFlag.eq.1) THEN - y%SumSpecNoise(III,K,I) = 10.*LOG10(y%SumSpecNoise(III,K,I))+p%Aweight(III) - ELSE - y%SumSpecNoise(III,K,I) = 10.*LOG10(y%SumSpecNoise(III,K,I)) - ENDIF -! y%SumSpecNoise(III,K,I) = 10.*LOG10(y%SumSpecNoise(III,K,I))+addpow !this is the equation used for sound power level !SPLw(f)=SPL(f)+10*log10(4*pi*dis**2); - ENDDO - ENDDO - ENDDO - ENDIF - - - - - DO I = 1,p%numBlades - DO K = 1,p%NrObsLoc - DO III=1,size(p%FreqList) - SPL_Out(III,K,I)=0.0_Reki - DO J = 1,p%NumBlNds - tempdel(J)=0.0_Reki - DO oi=1,7 - IF (ForMaxLoc3(oi,III,K,J,I) .ne. 0) THEN - adforma=10.0_ReKi**(ForMaxLoc3(oi,III,K,J,I)/10.0_ReKi) - tempdel(J) = tempdel(J) + adforma - SPL_Out(III,K,I) = SPL_Out(III,K,I) + adforma - ENDIF - ENDDO - tempdel(J)=10*LOG10(tempdel(J)) - ENDDO - SPL_Out(III,K,I)=10*LOG10(SPL_Out(III,K,I)) - JTEMP=maxloc(tempdel,1) - y%OutLECoords(1,III,K,I)=m%LE_Location(1,JTEMP,I) ! the coordinates of that node (x) are stored and written to a file for coupling with propagation model - y%OutLECoords(2,III,K,I)=m%LE_Location(2,JTEMP,I) ! the coordinates of that node (y) are stored and written to a file for coupling with propagation model - y%OutLECoords(3,III,K,I)=m%LE_Location(3,JTEMP,I) ! the coordinates of that node (z) are stored and written to a file for coupling with propagation model - ENDDO - ENDDO - ENDDO -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - IF (p%LargeBinOutput.eq.1) THEN - IF (m%filesopen.eq.0) THEN - open (12340,file='ForMaxLoc3.bin',access='stream',form='unformatted',status='REPLACE') !open a binary file - write(12340) Size(ForMaxLoc3,1) - write(12340) Size(ForMaxLoc3,2) - write(12340) Size(ForMaxLoc3,3) - write(12340) Size(ForMaxLoc3,4) - write(12340) Size(ForMaxLoc3,5) - write(12340) ForMaxLoc3 - ELSE - open (12340, file="ForMaxLoc3.bin", access='stream',status="old", form='unformatted',position="append") - write(12340) ForMaxLoc3 - ENDIF - close(12340) - ENDIF -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - IF (m%filesopen.eq.0) THEN - open (54218,file='SourceLoc.bin',access='stream',form='unformatted',status='REPLACE') !open a binary file - write(54218) Size(y%OutLECoords,1) - write(54218) Size(y%OutLECoords,2) - write(54218) Size(y%OutLECoords,3) - write(54218) Size(y%OutLECoords,4) - write(54218) y%OutLECoords - - open (25684,file='SPL_Out.bin',access='stream',form='unformatted',status='REPLACE') !open a binary file - write(25684) Size(SPL_Out,1) - write(25684) Size(SPL_Out,2) - write(25684) Size(SPL_Out,3) - write(25684) SPL_Out - m%filesopen=1 - ELSE - open (54218, file="SourceLoc.bin", access='stream',status="old", form='unformatted',position="append") - write(54218) y%OutLECoords - - open (25684, file="SPL_Out.bin", access='stream',status="old", form='unformatted',position="append") - write(25684) SPL_Out - ENDIF - - - close(54218) - close(25684) - - inquire(file="tempdispthick.txt", exist=exist) - if (exist) then - open(1254, file="tempdispthick.txt", status="old", position="append", action="write") - else - open(1254, file="tempdispthick.txt", status="new", action="write") - end if - write(1254, *) temp_dispthick - close(1254) - - inquire(file="tempdispthickchord.txt", exist=exist) - if (exist) then - open(1254, file="tempdispthickchord.txt", status="old", position="append", action="write") - else - open(1254, file="tempdispthickchord.txt", status="new", action="write") - end if - write(1254, *) temp_dispthickchord - close(1254) - - -RETURN -END SUBROUTINE CalcAeroAcousticsOutput -!==================================================================================================================================! -!==================================================================================================================================! - SUBROUTINE LBLVS(ALPSTAR,C,U,THETA,PHI,L,R,p,d99Var2,dstarVar1,dstarVar2,SPLLAM,errStat,errMsg) - - REAL(ReKi), INTENT(IN ) :: ALPSTAR ! AOA - REAL(ReKi), INTENT(IN ) :: C ! Chord Length - REAL(ReKi), INTENT(IN ) :: U ! Unoise FREESTREAM VELOCITY METERS/SEC - REAL(ReKi), INTENT(IN ) :: THETA ! DIRECTIVITY ANGLE DEGREES - REAL(ReKi), INTENT(IN ) :: PHI ! DIRECTIVITY ANGLE DEGREES - REAL(ReKi), INTENT(IN ) :: L ! SPAN METERS - REAL(ReKi), INTENT(IN ) :: R ! OBSERVER DISTANCE FROM SEGMENT METERS - REAL(ReKi), INTENT(IN ) :: d99Var2 ! - REAL(ReKi), INTENT(IN ) :: dstarVar1 ! - REAL(ReKi), INTENT(IN ) :: dstarVar2 ! - TYPE(AA_ParameterType), INTENT(IN ) :: p ! Noise module Parameters - - REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLLAM ! - INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation - character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None - - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'LBLVS' - - ! Local variables - !!!real(ReKi) :: STPRIM(size(p%FreqList)) !EB_DTU does not need to be a vector - real(ReKi) :: STPRIM ! STROUHAL NUMBER BASED ON PRESSURE SIDE BOUNDARY LAYER THICKNESS --- - real(ReKi) :: M ! MACH NUMBER - real(ReKi) :: RC ! REYNOLDS NUMBER BASED ON CHORD - real(ReKi) :: DELTAP ! PRESSURE SIDE BOUNDARY LAYER THICKNESS METERS - real(ReKi) :: DSTRS ! SUCTION SIDE BOUNDARY LAYER DISPLACEMENT THICKNESS METERS - real(ReKi) :: DSTRP ! PRESSURE SIDE BOUNDARY LAYER DISPLACEMENT THICKNESS METERS - real(ReKi) :: DBARH ! HIGH FREQUENCY DIRECTIVITY --- - real(ReKi) :: ST1PRIM ! REFERENCE STROUHAL NUMBER --- - real(ReKi) :: STPKPRM ! PEAK STROUHAL NUMBER --- - real(ReKi) :: RC0 ! REFERENCE REYNOLDS NUMBER --- - real(ReKi) :: D ! REYNOLDS NUMBER RATIO --- - real(ReKi) :: G1 ! SOUND PRESSURE LEVEL FUNCTION DB - real(ReKi) :: G2 ! OVERALL SOUND PRESSURE LEVEL FUNCTION DB - real(ReKi) :: G3 ! OVERALL SOUND PRESSURE LEVEL FUNCTION DB - real(ReKi) :: E ! STROUHAL NUMBER RATIO --- - real(ReKi) :: SCALE ! GEOMETRIC SCALING TERM - integer(intKi) :: I ! I A generic index for DO loops. - - ErrStat = ErrID_None - ErrMsg = "" - -!!! COMPUTE REYNOLDS NUMBER AND MACH NUMBER -!!! --------------------------------------- - M = U / p%SpdSound ! MACH NUMBER - RC = U * C/p%KinVisc ! REYNOLDS NUMBER BASED ON CHORD - -!!! COMPUTE BOUNDARY LAYER THICKNESSES -!!! ---------------------------------- - IF (p%X_BLMethod .eq. 2) THEN - DELTAP = d99Var2 - DSTRS = dstarVar1 - DSTRP = dstarVar2 - ELSE - CALL THICK(C,M,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ENDIF - !print*, DELTAP,DSTRS,DSTRP -!!! COMPUTE DIRECTIVITY FUNCTION -!!! ---------------------------- - CALL DIRECTH(M,THETA,PHI,DBARH,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - IF (DBARH <= 0) THEN - SPLLAM = 0. - RETURN - ENDIF -!!! COMPUTE REFERENCE STROUHAL NUMBER -!!! --------------------------------- - IF (RC .LE. 1.3E+05) ST1PRIM = .18 - IF((RC .GT. 1.3E+05).AND.(RC.LE.4.0E+05))ST1PRIM=.001756*RC**.3931 - IF (RC .GT. 4.0E+05) ST1PRIM = .28 - - STPKPRM = 10.**(-.04*ALPSTAR) * ST1PRIM - -!!! COMPUTE REFERENCE REYNOLDS NUMBER -!!! --------------------------------- - IF (ALPSTAR .LE. 3.0) RC0=10.**(.215*ALPSTAR+4.978) - IF (ALPSTAR .GT. 3.0) RC0=10.**(.120*ALPSTAR+5.263) -!!! COMPUTE PEAK SCALED SPECTRUM LEVEL -!!! ---------------------------------- - D = RC / RC0 - - IF (D .LE. .3237) G2=77.852*LOG10(D)+15.328 - IF ((D .GT. .3237).AND.(D .LE. .5689)) & - G2 = 65.188*LOG10(D) + 9.125 - IF ((D .GT. .5689).AND.(D .LE. 1.7579)) & - G2 = -114.052 * LOG10(D)**2. - IF ((D .GT. 1.7579).AND.(D .LE. 3.0889)) & - G2 = -65.188*LOG10(D)+9.125 - IF (D .GT. 3.0889) G2 =-77.852*LOG10(D)+15.328 - - G3 = 171.04 - 3.03 * ALPSTAR - - SCALE = 10. * LOG10(DELTAP*M**5*DBARH*L/R**2) - -!!! COMPUTE SCALED SOUND PRESSURE LEVELS FOR EACH STROUHAL NUMBER -!!! ------------------------------------------------------------- - DO I=1,SIZE(p%FreqList) - - STPRIM = p%FreqList(I) * DELTAP / U - - E = STPRIM / STPKPRM - - IF (E .LT. .5974) G1=39.8*LOG10(E)-11.12 - IF ((E .GE. .5974).AND.(E .LE. .8545)) & - G1 = 98.409 * LOG10(E) + 2.0 - IF ((E .GE. .8545).AND.(E .LT. 1.17)) & - G1 = -5.076+SQRT(2.484-506.25*(LOG10(E))**2.) - IF ((E .GE. 1.17).AND.(E .LT. 1.674)) & - G1 = -98.409 * LOG10(E) + 2.0 - IF (E .GE. 1.674) G1=-39.80*LOG10(E)-11.12 - - SPLLAM(I) = G1 + G2 + G3 + SCALE - !!!print*,p%FreqList(I),SPLLAM(I) - ENDDO -END SUBROUTINE LBLVS -!==================================================================================================================================! -SUBROUTINE TBLTE(ALPSTAR,C,U,THETA,PHI,L,R,p,jj,ii,kk,d99Var2,dstarVar1,dstarVar2,StallVal,SPLP,SPLS,SPLALPH,SPLTBL,errStat,errMsg) - REAL(ReKi), INTENT(IN ) :: ALPSTAR ! AOA (deg) - REAL(ReKi), INTENT(IN ) :: C ! Chord Length (m) - REAL(ReKi), INTENT(IN ) :: U ! Unoise (m/s) - REAL(ReKi), INTENT(IN ) :: THETA ! DIRECTIVITY ANGLE (deg) - REAL(ReKi), INTENT(IN ) :: PHI ! DIRECTIVITY ANGLE (deg) - REAL(ReKi), INTENT(IN ) :: L ! SPAN (m) - REAL(ReKi), INTENT(IN ) :: R ! SOURCE TO OBSERVER DISTANCE (m) - REAL(ReKi), INTENT(IN ) :: d99Var2 ! - REAL(ReKi), INTENT(IN ) :: dstarVar1 ! - REAL(ReKi), INTENT(IN ) :: dstarVar2 ! - REAL(ReKi), INTENT(IN ) :: StallVal ! - INTEGER(IntKi), INTENT( IN) :: jj ! Error status of the operation - INTEGER(IntKi), INTENT( IN) :: ii ! Error status of the operation - - INTEGER(IntKi), INTENT( IN) :: kk ! Error status of the operation - TYPE(AA_ParameterType), INTENT(IN ) :: p ! Noise Module Parameters - REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLP ! SOUND PRESSURE LEVEL DUE TO PRESSURE SIDE OF AIRFOIL (db) - REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLS ! SOUND PRESSURE LEVEL DUE TO SUCTION SIDE OF AIRFOIL (db) - REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLTBL ! TOTAL SOUND PRESSURE LEVEL DUE TO TBLTE MECHANISM (db) - REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLALPH ! SOUND PRESSURE LEVEL DUE TO ANGLE OF ATTACK CONTRIBUTION (db) - INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation - character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'TBLTE' - ! Local variables - real(ReKi) :: STP ! PRESSURE SIDE STROUHAL NUMBER --- - real(ReKi) :: STS ! SUCTION SIDE STROUHAL NUMBER --- - real(ReKi) :: DSTRS ! SUCTION SIDE DISPLACEMENT THICKNESS METERS - real(ReKi) :: DSTRP ! PRESSURE SIDE DISPLACEMENT THICKNESS METERS - real(ReKi) :: RDSTRS ! REYNOLDS NUMBER BASED ON SUCTION SIDE DISPLACEMENT THICKNESS - real(ReKi) :: RDSTRP ! REYNOLDS NUMBER BASED ON PRESSURE SIDE DISPLACEMENT THICKNESS - real(ReKi) :: ST1 ! PEAK STROUHAL NUMBER --- - real(ReKi) :: ST2 ! PEAK STROUHAL NUMBER --- - real(ReKi) :: ST1PRIM ! PEAK STROUHAL NUMBER --- - real(ReKi) :: A0 ! FUNCTION USED IN 'A' CALCULATION - real(ReKi) :: A02 ! FUNCTION USED IN 'A' CALCULATION - real(ReKi) :: ARA0 ! INTERPOLATION FACTOR - real(ReKi) :: ARA02 ! INTERPOLATION FACTOR - real(ReKi) :: B0 ! FUNCTION USED IN 'B' CALCULATION - real(ReKi) :: BMINB0 ! MINIMUM 'B' EVALUATED AT B0 DB - real(ReKi) :: BMINB ! MINIMUM 'B' EVALUATED AT B DB - real(ReKi) :: BMAXB0 ! MAXIMUM 'B' EVALUATED AT B0 DB - real(ReKi) :: BMAXB ! MAXIMUM 'B' EVALUATED AT B DB - real(ReKi) :: BRB0 ! INTERPOLATION FACTOR DB - real(ReKi) :: STPEAK ! PEAK STROUHAL NUMBER --- - real(ReKi) :: AMINA ! MINIMUM 'A' CURVE EVALUATED AT STROUHAL NUMBER RATIO DB - real(ReKi) :: AMINB ! MINIMUM 'A' CURVE EVALUATED AT B DB - real(ReKi) :: AMAXA ! MAXIMUM 'A' CURVE EVALUATED AT STROUHAL NUMBER RATIO (DB) - real(ReKi) :: AMAXB ! MAXIMUM 'A' CURVE EVALUATED AT B DB - real(ReKi) :: AMINA0 ! MAXIMUM 'B' EVALUATED AT B0 DB - real(ReKi) :: AMINA02 ! MINIMUM 'A' CURVE EVALUATED AT A02 DB - real(ReKi) :: AMAXA0 ! MAXIMUM 'A' CURVE EVALUATED AT A0 DB - real(ReKi) :: AMAXA02 ! MAXIMUM 'A' CURVE EVALUATED AT A02 DB - real(ReKi) :: A ! STROUHAL NUMBER RATIO --- - real(ReKi) :: B ! STROUHAL NUMBER RATIO --- - real(ReKi) :: AA ! 'A' SPECTRUM SHAPE EVALUATED AT STROUHAL NUMBER RATIO DB - real(ReKi) :: BB ! 'B' SPECTRUM SHAPE EVALUATED AT STROUHAL NUMBER RATIO DB - real(ReKi) :: DELK1 ! CORRECTION TO AMPLITUDE FUNCTION DB - real(ReKi) :: GAMMA ! USED IN 'B' COMPUTATION --- - real(ReKi) :: BETA ! USED IN 'B' COMPUTATION --- - real(ReKi) :: GAMMA0 ! USED IN 'B' COMPUTATION --- - real(ReKi) :: BETA0 ! USED IN 'B' COMPUTATION --- - real(ReKi) :: K1 ! AMPLITUDE FUNCTION (DB) - real(ReKi) :: K2 ! AMPLITUDE FUNCTION (DB) - real(ReKi) :: P1 ! PRESSURE SIDE PRESSURE (NT/M2) - real(ReKi) :: P2 ! SUCTION SIDE PRESSURE (NT/M2) - real(ReKi) :: P4 ! PRESSURE FROM ANGLE OF ATTACK CONTRIBUTION (NT/M2) - real(ReKi) :: M ! MACH NUMBER - real(ReKi) :: RC ! REYNOLDS NUMBER BASED ON CHORD - real(ReKi) :: DELTAP ! PRESSURE SIDE BOUNDARY LAYER THICKNESS METERS - real(ReKi) :: XCHECK ! USED TO CHECK FOR ANGLE OF ATTACK CONTRIBUTION - real(ReKi) :: DBARH ! HIGH FREQUENCY DIRECTIVITY --- - real(ReKi) :: DBARL ! LOW FREQUENCY DIRECTIVITY --- - - integer(intKi) :: I ! I A generic index for DO loops. - - LOGICAL :: SWITCH !!LOGICAL FOR COMPUTATION OF ANGLE OF ATTACK CONTRIBUTION - - ErrStat = ErrID_None - ErrMsg = "" - ! Compute reynolds number and mach number - M = U / p%SpdSound - RC = U * C/p%KinVisc - ! Compute boundary layer thicknesses - IF (p%X_BLMethod .eq. 2) THEN - DELTAP = d99Var2 - DSTRS = dstarVar1 - DSTRP = dstarVar2 - ELSE - CALL THICK(C,M,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ENDIF - ! Compute directivity function - CALL DIRECTL(M,THETA,PHI,DBARL,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL DIRECTH(M,THETA,PHI,DBARH,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! IF (DBARH <= 0) THEN - ! SPLP = 0. - ! SPLS = 0. - ! SPLALPH = 0. - ! RETURN - ! ENDIF - ! Calculate the reynolds numbers based on pressure and suction displacement thickness - RDSTRS = DSTRS * U / p%KinVisc - RDSTRP = DSTRP * U / p%KinVisc - ! Determine peak strouhal numbers to be used for 'a' and 'b' curve calculations - ST1 = .02 * M ** (-.6) - ! corrected with respect to the Suzlon document Contact Pat Moriarty for further. added 4 lines below.(EB_DTU) - IF (ALPSTAR .LE. 1.33) ST2 = ST1 - IF ((ALPSTAR .GT. 1.33).AND.(ALPSTAR .LE. 12.5)) ST2 = ST1*10.**(.0054*(ALPSTAR-1.33)**2.) - IF (ALPSTAR .GT. 12.5) ST2 = 4.72 * ST1 - ST1PRIM = (ST1+ST2)/2. - CALL A0COMP(RC,A0) - CALL A0COMP(3.*RC,A02) - ! Evaluate minimum and maximum 'a' curves at a0 - CALL AMIN(A0,AMINA0) - CALL AMAX(A0,AMAXA0) - CALL AMIN(A02,AMINA02) - CALL AMAX(A02,AMAXA02) - ! Compute 'a' max/min ratio - ARA0 = (20. + AMINA0) / (AMINA0 - AMAXA0) - ARA02 = (20. + AMINA02)/ (AMINA02- AMAXA02) - ! Compute b0 to be used in 'b' curve calculations - IF (RC .LT. 9.52E+04) B0 = .30 - IF ((RC .GE. 9.52E+04).AND.(RC .LT. 8.57E+05)) & - B0 = (-4.48E-13)*(RC-8.57E+05)**2. + .56 - IF (RC .GE. 8.57E+05) B0 = .56 - ! Evaluate minimum and maximum 'b' curves at b0 - CALL BMIN(B0,BMINB0) - CALL BMAX(B0,BMAXB0) - ! Compute 'b' max/min ratio - BRB0 = (20. + BMINB0) / (BMINB0 - BMAXB0) - - ! For each center frequency, compute an 'a' prediction for the pressure side - STPEAK = ST1 - IF (RC .LT. 2.47E+05) K1 = -4.31 * LOG10(RC) + 156.3 - IF((RC .GE. 2.47E+05).AND.(RC .LE. 8.0E+05)) K1 = -9.0 * LOG10(RC) + 181.6 - IF (RC .GT. 8.0E+05) K1 = 128.5 - IF (RDSTRP .LE. 5000.) DELK1 = -ALPSTAR*(5.29-1.43*LOG10(RDSTRP)) - IF (RDSTRP .GT. 5000.) DELK1 = 0.0 - - GAMMA = 27.094 * M + 3.31 - BETA = 72.650 * M + 10.74 - GAMMA0 = 23.430 * M + 4.651 - BETA0 =-34.190 * M - 13.820 - - IF (ALPSTAR .LE. (GAMMA0-GAMMA)) K2 = -1000.0 - IF ((ALPSTAR.GT.(GAMMA0-GAMMA)).AND.(ALPSTAR.LE.(GAMMA0+GAMMA))) & - K2=SQRT(BETA**2.-(BETA/GAMMA)**2.*(ALPSTAR-GAMMA0)**2.)+BETA0 - IF (ALPSTAR .GT. (GAMMA0+GAMMA)) K2 = -12.0 - K2 = K2 + K1 - ! Check for 'a' computation for suction side - XCHECK = GAMMA0 - SWITCH = .FALSE. - !older version: - ! IF ((ALPSTAR .GE. XCHECK).OR.(ALPSTAR .GT. 12.5))SWITCH=.TRUE. - ! newer version - IF ((ALPSTAR .GE. XCHECK).OR.(ALPSTAR .GT. StallVal))SWITCH=.TRUE. - DO I=1,size(p%FreqList) - STP= p%FreqList(I) * DSTRP / U - A = LOG10( STP / STPEAK ) - CALL AMIN(A,AMINA) - CALL AMAX(A,AMAXA) - AA = AMINA + ARA0 * (AMAXA - AMINA) - - SPLP(I)=AA+K1-3.+10.*LOG10(DSTRP*M**5.*DBARH*L/R**2.)+DELK1 - STS = p%FreqList(I) * DSTRS / U - - IF (.NOT. SWITCH) THEN - A = LOG10( STS / ST1PRIM ) - CALL AMIN(A,AMINA) - CALL AMAX(A,AMAXA) - AA = AMINA + ARA0 * (AMAXA - AMINA) - SPLS(I) = AA+K1-3.+10.*LOG10(DSTRS*M**5.*DBARH* L/R**2.) - ! 'B' CURVE COMPUTATION - ! B = ABS(LOG10(STS / ST2)) - B = LOG10(STS / ST2) ! abs not needed absolute taken in the AMAX,AMIN - CALL BMIN(B,BMINB) - CALL BMAX(B,BMAXB) - BB = BMINB + BRB0 * (BMAXB-BMINB) - SPLALPH(I)=BB+K2+10.*LOG10(DSTRS*M**5.*DBARH*L/R**2.) - ELSE - ! The 'a' computation is dropped if 'switch' is true - SPLS(I) = 10.*LOG10(DSTRS*M**5.*DBARL*L/R**2.) - ! SPLP(I) = 0.0 + 10.*LOG10(DSTRS*M**5.*DBARL*L/R**2.) ! changed the line below because the SPLP should be calculatd with DSTRP not with DSTRS - SPLP(I) = 10.*LOG10(DSTRP*M**5.*DBARL*L/R**2.) ! this is correct - ! B = ABS(LOG10(STS / ST2)) - B = LOG10(STS / ST2) ! abs not needed absolute taken in the AMAX,AMIN - CALL AMIN(B,AMINB) - CALL AMAX(B,AMAXB) - BB = AMINB + ARA02 * (AMAXB-AMINB) - SPLALPH(I)=BB+K2+10.*LOG10(DSTRS*M**5.*DBARL*L/R**2.) - ENDIF - ! Sum all contributions from 'a' and 'b' on both pressure and suction side on a mean-square pressure basis - IF (SPLP(I) .LT. -100.) SPLP(I) = -100. - IF (SPLS(I) .LT. -100.) SPLS(I) = -100. - IF (SPLALPH(I) .LT. -100.) SPLALPH(I) = -100. - - P1 = 10.**(SPLP(I) / 10.) - P2 = 10.**(SPLS(I) / 10.) - P4 = 10.**(SPLALPH(I) / 10.) - SPLTBL(I) = 10. * LOG10(P1 + P2 + P4) - ENDDO -END SUBROUTINE TBLTE -!==================================================================================================================================! -SUBROUTINE TIPNOIS(ALPHTIP,ALPRAT2,C,U ,THETA,PHI, R,p,SPLTIP, errStat, errMsg) - REAL(ReKi), INTENT(IN ) :: ALPHTIP !< AOA - REAL(ReKi), INTENT(IN ) :: ALPRAT2 !< TIP LIFT CURVE SLOPE --- - REAL(ReKi), INTENT(IN ) :: C !< Chord Length - REAL(ReKi), INTENT(IN ) :: U !< FREESTREAM VELOCITY METERS/SEC - REAL(ReKi), INTENT(IN ) :: THETA !< DIRECTIVITY ANGLE DEGREES - REAL(ReKi), INTENT(IN ) :: PHI !< DIRECTIVITY ANGLE DEGREES - REAL(ReKi), INTENT(IN ) :: R !< SOURCE TO OBSERVER DISTANCE METERS - TYPE(AA_ParameterType) , INTENT(IN ) :: p !< Parameters - REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLTIP !< - INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation - character(*), INTENT( OUT) :: errMsg !< Error message if ErrStat /= ErrID_None - ! local variables - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'tipnoise' - REAL(ReKi) :: M ! MACH NUMBER --- - REAL(ReKi) :: MM ! MAXIMUM MACH NUMBER --- - REAL(ReKi) :: ALPTIPP ! CORRECTED TIP ANGLE OF ATTACK DEGREES - REAL(ReKi) :: DBARH ! DIRECTIVITY --- - REAL(ReKi) :: SCALE ! SCALING TERM --- - REAL(ReKi) :: STPP ! STROUHAL NUMBER --- - REAL(ReKi) :: UM ! MAXIMUM VELOCITY METERS/SEC - REAL(ReKi) :: L ! CHARACTERISTIC LENGTH FOR TIP METERS - REAL(ReKi) :: TERM ! SCALING TERM --- - integer(intKi) :: I !I A generic index for DO loops. - ErrStat = ErrID_None - ErrMsg = "" - IF (alphtip.eq.0.) THEN - SPLTIP= 0 - RETURN - ELSEIF (alphtip.lt.0.) THEN - ! alphtip = ABS (alphtip) ! (EB_DTU) NOT possible to change inten(in) variable, INSTEAD - ! ALPTIPP is equal to abs(alphtip) - see next equation - ENDIF - !! used to be ALPTIPP = ALPHTIP * ALPRAT2 - ALPTIPP = ABS(ALPHTIP) * ALPRAT2 - M = U / p%SpdSound ! MACH NUMBER - ! Compute directivity function - CALL DIRECTH(M,THETA,PHI,DBARH,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (p%ROUND) THEN - L = .008 * ALPTIPP * C - ELSE - IF (ABS(ALPTIPP) .LE. 2.) THEN - L = (.023 + .0169*ALPTIPP) * C - ELSE - L = (.0378 + .0095*ALPTIPP) * C - ENDIF - ENDIF - MM = (1. + .036*ALPTIPP) * M - UM = MM * p%SpdSound - TERM = M*M*MM**3.*L**2.*DBARH/R**2. - IF (TERM .NE. 0.0) THEN - SCALE = 10.*LOG10(TERM) - ELSE - SCALE = 0.0 - ENDIF - DO I=1,size(p%FreqList) - STPP = p%FreqList(I) * L / UM - SPLTIP(I) = 126.-30.5*(LOG10(STPP)+.3)**2. + SCALE - ENDDO -END SUBROUTINE TipNois -!==================================================================================================================================! -SUBROUTINE InflowNoise(AlphaNoise,Chord,U,THETA,PHI,d,RObs,MeanVNoise,TINoise,LE_Location,dissip,ufluct,p,SPLti,errStat,errMsg) - REAL(ReKi), INTENT(IN ) :: AlphaNoise ! AOA - REAL(ReKi), INTENT(IN ) :: Chord ! Chord Length - REAL(ReKi), INTENT(IN ) :: U ! - REAL(ReKi), INTENT(IN ) :: d ! element span - REAL(ReKi), INTENT(IN ) :: RObs ! distance to observer - REAL(ReKi), INTENT(IN ) :: THETA ! - REAL(ReKi), INTENT(IN ) :: PHI ! Spanwise directivity angle - REAL(ReKi), INTENT(IN ) :: MeanVNoise ! - REAL(ReKi), INTENT(IN ) :: TINoise ! - REAL(ReKi), INTENT(IN ) :: LE_Location ! - REAL(ReKi), INTENT(IN ) :: dissip ! - REAL(ReKi), INTENT(IN ) :: ufluct ! - TYPE(AA_ParameterType), INTENT(IN ) :: p ! Parameters - REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLti ! - INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation - character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'InflowNoise' -! local variables - REAL(ReKi) :: Beta2 ! Prandtl-Glauert correction factor - REAL(ReKi) :: DBARH ! High-frequency directivity correction factor - REAL(ReKi) :: DBARL ! Low-frequency directivity correction factor - REAL(ReKi) :: Directivity ! Directivity correction factor - REAL(ReKi) :: Frequency_cutoff ! Cutoff frequency between - REAL(ReKi) :: LFC ! low-frequency correction factor - REAL(ReKi) :: LTurb ! turbulence length scale (isotropic integral scale parameter from IEC standard (Von Karman)) - REAL(ReKi) :: Mach ! local mach number - REAL(ReKi) :: Sears ! Sears function - REAL(ReKi) :: SPLhigh ! predicted high frequency sound pressure level - REAL(ReKi) :: Ums ! mean square turbulence level - REAL(ReKi) :: WaveNumber ! wave number - non-dimensional frequency - REAL(ReKi) :: Kbar ! nafnoise - REAL(ReKi) :: khat,Kh ! nafnoise - REAL(ReKi) :: ke ! nafnoise - REAL(ReKi) :: alpstar ! nafnoise - REAL(ReKi) :: mu ! nafnoise - REAL(ReKi) :: tinooisess ! nafnoise - REAL(ReKi) :: L_Gammas ! nafnoise - - INTEGER(intKi) :: I !I A generic index for DO loops. - ErrStat = ErrID_None - ErrMsg = "" - !!!--- NAF NOISE IDENTICAL - Mach = U/p%SpdSound -! This part is recently added for height and surface roughness dependent estimation of turbulence intensity and turbulence scales - !%Lturb=300*(Z/300)^(0.46+0.074*log(p%z0_aa)); !% Gives larger length scale - Lturb=25.d0*LE_Location**(0.35)*p%z0_aa**(-0.063) !% Gives smaller length scale - L_Gammas=0.24+0.096*log10(p%z0_aa)+0.016*(log10(p%z0_aa))**2; !% Can be computed or just give it a value. -! tinooisess=L_Gammas*log(30.d0/p%z0_aa)/log(LE_Location/p%z0_aa) !% F.E. 16% is 0.16 which is the correct input for SPLhIgh, no need to divide 100 - tinooisess=TINoise -! Lturb=50 -! tinooisess=0.1 - !Ums = (tinooisess*U)**2 - !Ums = (tinooisess*8)**2 - CALL DIRECTL(Mach,THETA,PHI,DBARL,errStat2,errMsg2) !yes, assume that noise is low-freq in nature because turbulence length scale is large - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL DIRECTH(Mach,THETA,PHI,DBARH,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (DBARH <= 0) THEN - SPLti = 0. - RETURN - ENDIF -!! Nafnoise source code version see belo -! Frequency_cutoff = 10*U/PI/Chord -! Ke = 3.0/(4.0*LTurb) -! Beta2 = 1-Mach*Mach -! ALPSTAR = AlphaNoise*PI/180. -! DO I=1,size(p%FreqList) -! IF (p%FreqList(I) <= Frequency_cutoff) THEN -! Directivity = DBARL -! ELSE -! Directivity = DBARH -! ENDIF -! WaveNumber = 2.0*PI*p%FreqList(I)/U -! Kbar = WaveNumber*Chord/2.0 -! Khat = WaveNumber/Ke -! mu = Mach*WaveNumber*Chord/2.0/Beta2 -! SPLhigh = 10.*LOG10(p%AirDens*p%AirDens*p%SpdSound**4*LTurb*(d/2.)/ & -! (RObs*RObs)*(Mach**5)*tinooisess*tinooisess*(Khat**3)* & -! (1+Khat**2)**(-7./3.)*Directivity) + 78.4 -!! SPLhigh = 10.*LOG10(LTurb*(d/2.)/ & -!! (RObs*RObs)*(Mach**5)*tinooisess*tinooisess*(WaveNumber**3) & -!! *(1+WaveNumber**2)**(-7./3.)*Directivity) + 181.3 -! SPLhigh = SPLhigh + 10.*LOG10(1+ 9.0*ALPSTAR*ALPSTAR) -! Sears = 1/(2.*PI*Kbar/Beta2+1/(1+2.4*Kbar/Beta2)) -!! Sears = 1/(2.*PI*WaveNumber/Beta2+1/(1+2.4*WaveNumber/Beta2)) -! LFC = 10*Sears*Mach*Kbar*Kbar/Beta2 -!! LFC = 10*Sears*Mach*WaveNumber*WaveNumber/Beta2 -!! IF (mu<(PI/4.0)) THEN -!! SPLti(I) = SPLhigh + 10.*ALOG10(LFC) -!! ELSE -!! SPLti(I) = SPLhigh -!! ENDIF -! SPLti(I) = SPLhigh + 10.*LOG10(LFC/(1+LFC)) -! ENDDO -!!Wei Jun Zhu et al - !Modeling of Aerodynamically Generated Noise From Wind Turbines 2005 paper - Beta2 = 1.d0-Mach**2; ! corresponding line: Bsq = 1.d0 - Ma**2; - DO I=1,size(p%FreqList) - WaveNumber = PI*p%FreqList(I)*p%SpdSound/U !corresponding line: K = pi*Freq(i)*c/Vrel; - Sears = (2.d0*PI*WaveNumber/Beta2 + (1.d0+2.4d0*WaveNumber/Beta2)**(-1))**(-1); - ! corresponding line: Ssq = (2.d0*pi*K/Bsq + (1.d0+2.4d0*K/Bsq)**(-1))**(-1); - LFC = 10.d0 * Sears*Mach*WaveNumber**2*Beta2**(-1); - ! corresponding line: LFC = 10.d0 * Ssq*Ma*K**2*Bsq**(-1); - SPLti(I)=(p%AirDens*p%AirDens*p%SpdSound*p%SpdSound*Lturb*d)/(2*RObs*RObs) -! SPLti(I)=SPLti(I)*(Mach**3)*(MeanVnoise**2)*(tinooisess**2) - SPLti(I)=SPLti(I)*(Mach**3)*(tinooisess**2) -! SPLti(I)=SPLti(I)*(Mach**3)*ufluct**2 - SPLti(I)=(SPLti(I)*(WaveNumber**3)) / ((1+WaveNumber**2)**(7/3)) - SPLti(I)=SPLti(I)*DBARH - SPLti(I)=10*log10(SPLti(I))+58.4 - SPLti(I) = SPLti(I) + 10.*LOG10(LFC/(1+LFC)) -! SPLti(I)=10.d0*log10(DBARH*p%AirDens**2*p%SpdSound**2*Lturb*d/2.0*Mach**3*tinooisess**2* & -! WaveNumber**3*(1.d0+WaveNumber**2)**(-7.d0/3.d0)/RObs**2)+58.4d0 + 10.d0*log10(LFC/(1+LFC)) - ! corresponding line: SPLti(i)=10.d0*log10(Di_hi_fr*Density**2*co**2*Tbscale*L/2.0*Ma -! & **3*Tbinten**2*K**3*(1.d0+K**2)**(-7.d0/3.d0)/Distance**2)+58.4d0 -! & + 10.d0*log10(LFC/(1+LFC)); - !% ver2.! -! Kh = 8.d0*pi*p%FreqList(i)*Lturb/(3.d0*U); -! SPLti(i) = 10*log10(DBARH*Lturb*0.5*d*Mach**5*tinooisess**2*Kh**3*(1+Kh**2)**(-7/3)/RObs**2) +& -! 10*log10(10**18.13) + 10*log10(DBARH*LFC/(1+LFC)); - ENDDO -!!Buck&Oerlamans&Palo - !Experimental validation of a wind turbine turbulent inflow noise prediction code 2016 paper - !DO I=1,size(p%FreqList) - ! IF (p%FreqList(I) <= Frequency_cutoff) THEN - ! Directivity = DBARL - ! ELSE - ! Directivity = DBARH - ! ENDIF - ! WaveNumber = 2.0*PI*p%FreqList(I)/U ! (K) - ! Kbar = WaveNumber*Chord/2.0 - ! Khat = WaveNumber/Ke - ! SPLhigh = ( (p%AirDens**2) * (p%SpdSound**2) *d ) / (2*RObs*RObs) - ! SPLhigh = SPLhigh * (Mach**3) * (dissip**(2/3)) * (WaveNumber**(-5/3)) * Directivity - ! SPLhigh = 10.*LOG10(SPLhigh) + 77.6 - ! Sears = 1/(2.*PI*Kbar/Beta2+1/(1+2.4*Kbar/Beta2)) - ! LFC = 10*Sears*(1+9.0*ALPSTAR*ALPSTAR)*Mach*Kbar*Kbar/Beta2 - ! SPLti(I) = SPLhigh + 10.*LOG10(LFC/(1+LFC)) - !ENDDO - -! double commented lines are from FAST v4.0 aeroacoustics module. But Nafnoise version is used see above -!! Mach = U/p%SpdSound -!! -!! IF (TINoise > 0) THEN -!! Ums = (TINoise*MeanVNoise/100.)**2 ! mean square turbulence level -!! ELSE -!! SPLti = 0. -!! RETURN -!! ENDIF -!! -!! LTurb=60 -!! LTurb=0.06 -!!! temporarily commented -!!! IF (FASTHH < 30.0) THEN -!!! LTurb = 3.5*0.7*FASTHH ! Prediction sensitive to this parameter! -!!! ELSE -!!! LTurb = 3.5*21. -!!! ENDIF -!! -!!!LTurb = LTurb/100 -!! -!!! Calculate directivity...? -!!!!! ---------------------------- -!! CALL DIRECTL(Mach,THETA,PHI,DBARL,errStat2,errMsg2) !yes, assume that noise is low-freq in nature because turbulence length scale is large -!! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) -!! CALL DIRECTH(Mach,THETA,PHI,DBARH,errStat2,errMsg2) -!! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) -!! IF (DBARH <= 0) THEN -!! SPLti = 0. -!! RETURN -!! ENDIF -!! -!! Frequency_cutoff = 10*U/PI/Chord -!! -!! IF (DBARL <= 0.) THEN -!! SPLti = 0. -!! RETURN -!! ENDIF -!! -!!DO I=1,size(p%FreqList) -!! IF (p%FreqList(I) <= Frequency_cutoff) THEN -!! Directivity = DBARL -!! ELSE -!! Directivity = DBARH -!! ENDIF -!! WaveNumber = PI*p%FreqList(I)*Chord/U -!! Beta2 = 1-Mach*Mach -!! SPLhigh = 10.*LOG10(p%AirDens*p%AirDens*p%SpdSound*p%SpdSound*LTurb*(d/2.)/(RObs*RObs)*(Mach**3)*Ums* & -!! (WaveNumber**3)*(1+WaveNumber**2)**(-7./3.)*Directivity) + 58.4 -!! Sears = 1/(2*PI*WaveNumber/Beta2+1/(1+2.4*WaveNumber/Beta2)) -!! LFC = 10*Sears*Mach*WaveNumber*WaveNumber/Beta2 -!! SPLti(I) = SPLhigh + 10.*LOG10(LFC/(1+LFC)) -!! -!!ENDDO -END SUBROUTINE InflowNoise -!==================================================================================================== -SUBROUTINE BLUNT(ALPSTAR,C,U ,THETA,PHI,L,R,H,PSI,p,d99Var2,dstarVar1,dstarVar2,SPLBLUNT,errStat,errMsg) - REAL(ReKi), INTENT(IN ) :: ALPSTAR ! AOA - REAL(ReKi), INTENT(IN ) :: C ! Chord Length - REAL(ReKi), INTENT(IN ) :: U ! Unoise - REAL(ReKi), INTENT(IN ) :: THETA ! DIRECTIVITY ANGLE --- - REAL(ReKi), INTENT(IN ) :: PHI ! DIRECTIVITY ANGLE --- - REAL(ReKi), INTENT(IN ) :: L ! SPAN METERS - REAL(ReKi), INTENT(IN ) :: R ! SOURCE TO OBSERVER DISTANCE METERS - REAL(ReKi), INTENT(IN ) :: H ! TRAILING EDGE BLUNTNESS METERS - REAL(ReKi), INTENT(IN ) :: PSI ! TRAILING EDGE ANGLE DEGREES - REAL(ReKi), INTENT(IN ) :: d99Var2 ! - REAL(ReKi), INTENT(IN ) :: dstarVar1 ! - REAL(ReKi), INTENT(IN ) :: dstarVar2 ! - TYPE(AA_ParameterType), INTENT(IN ) :: p ! Parameters - REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLBLUNT ! - INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation - character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None - ! Local variables - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'BLUNT' - real(ReKi) :: STPPP ! STROUHAL NUMBER --- - real(ReKi) :: M ! MACH NUMBER --- - real(ReKi) :: RC ! REYNOLDS NUMBER BASED ON CHORD --- - integer(intKi) :: I ! I A generic index for DO loops. - real(ReKi) :: DELTAP ! PRESSURE SIDE BOUNDARY LAYER THICKNESS METERS - real(ReKi) :: DSTRS ! SUCTION SIDE DISPLACEMENT THICKNESS METERS - real(ReKi) :: DSTRP ! PRESSURE SIDE DISPLACEMENT THICKNESS METERS - real(ReKi) :: DBARH ! HIGH FREQUENCY DIRECTIVITY --- - real(ReKi) :: DSTRAVG ! AVERAGE DISPLACEMENT THICKNESS METERS - real(ReKi) :: HDSTAR ! BLUNTNESS OVER AVERAGE DISPLACEMENT THICKNESS --- - real(ReKi) :: DSTARH ! AVERAGE DISPLACEMENT THICKNESS OVER TRAILING EDGE BLUNTNESS --- - real(ReKi) :: ATERM ! USED TO COMPUTE PEAK STROUHAL NO. --- - real(ReKi) :: STPEAK ! PEAK STROUHAL NUMBER --- - real(ReKi) :: ETA ! RATIO OF STROUHAL NUMBERS --- - real(ReKi) :: HDSTARL ! MINIMUM ALLOWED VALUE OF HDSTAR --- - real(ReKi) :: G514 ! G5 EVALUATED AT PSI=14.0 DB - real(ReKi) :: HDSTARP ! MODIFIED VALUE OF HDSTAR --- - real(ReKi) :: G50 ! G5 EVALUATED AT PSI=0.0 DB - real(ReKi) :: G4 ! SCALED SPECTRUM LEVEL DB - ! real(ReKi) :: G5 ! SPECTRUM SHAPE FUNCTION DB - REAL(ReKi),DIMENSION(size(p%FreqList)) :: G5 ! SPECTRUM SHAPE FUNCTION DB ! corrected (EB_DTU) - real(ReKi) :: G5Sum ! SPECTRUM SHAPE FUNCTION DB - real(ReKi) :: F4TEMP ! G5 EVALUATED AT MINIMUM HDSTARP DB - real(ReKi) :: SCALE ! SCALING FACTOR --- - - ErrStat = ErrID_None - ErrMsg = "" - - ! Reynolds number and mach number - M = U / p%SpdSound - RC = U * C/p%KinVisc - ! Compute boundary layer thicknesses - IF (p%X_BLMethod .eq. 2) THEN - DELTAP = d99Var2 - DSTRS = dstarVar1 - DSTRP = dstarVar2 - ELSE - CALL THICK(C,M,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ENDIF - ! Compute average displacement thickness - DSTRAVG = (DSTRS + DSTRP) / 2. - HDSTAR = H / DSTRAVG - DSTARH = 1. /HDSTAR - ! Compute directivity function - CALL DIRECTH(M,THETA,PHI,DBARH,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (DBARH <= 0) THEN - SPLBLUNT = 0. - RETURN - ENDIF - ! Compute peak strouhal number - ATERM = .212 - .0045 * PSI - IF (HDSTAR .GE. .2) & - STPEAK = ATERM / (1.+.235*DSTARH-.0132*DSTARH**2.) ! this is what it used to be in nafnoise and fast noise module - !! STPEAK = ATERM / (1+0.235*(DSTARH)**(-1)-0.0132*DSTARH**(-2)) ! check if this one is correct (EB_DTU) - IF (HDSTAR .LT. .2) & - STPEAK = .1 * HDSTAR + .095 - .00243 * PSI - ! Compute scaled spectrum level - IF (HDSTAR .LE. 5.) G4=17.5*LOG10(HDSTAR)+157.5-1.114*PSI - IF (HDSTAR .GT. 5.) G4=169.7 - 1.114 * PSI - ! For each frequency, compute spectrum shape referenced to 0 db - SCALE = 10. * LOG10(M**5.5*H*DBARH*L/R**2.) - G5Sum=0.0_Reki - DO I=1,SIZE(p%FreqList) - STPPP = p%FreqList(I) * H / U - ETA = LOG10(STPPP/STPEAK) - HDSTARL = HDSTAR - CALL G5COMP(HDSTARL,ETA,G514,errStat2,errMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - HDSTARP = 6.724 * HDSTAR **2.-4.019*HDSTAR+1.107 - CALL G5COMP(HDSTARP,ETA,G50,errStat2,errMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - G5(I) = G50 + .0714 * PSI * (G514-G50) - IF (G5(I) .GT. 0.) G5(I) = 0. - !!! SCALE = 10. * LOG10(M**5.5*H*DBARH*L/R**2.) ! moved out of frequency loop, nothing frequency dependent (EB_DTU) - ! This part is changed with respect to Suzlon document. contact Pat Moriarty for futher info.(EB_DTU) - ! OLD VERSION START (if desired uncomment everything within old version and comment new version two lines) - ! CALL G5COMP(0.250d0,ETA,F4TEMP,errStat2,errMsg2 ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! IF (G5(I) .GT. F4TEMP) G5 = F4TEMP - ! SPLBLUNT(I) = G4 + G5(I) + SCALE - ! OLD VERSION END - ! NEW VERSION START - G5Sum = 10**(G5(I)/10)+G5Sum ! to be subtracted - SPLBLUNT(I) = G4 + G5(I) + SCALE - 10*log10(1/G5Sum) ! equation mentioned there is plus but it is stated subtract, thus ''- 10*log10(1/G5Sum)'' - ! NEW VERSION END - end do -END SUBROUTINE Blunt -!==================================================================================================== -SUBROUTINE G5COMP(HDSTAR,ETA,G5,errStat,errMsg) - REAL(ReKi), INTENT(IN ) :: HDSTAR !< - REAL(ReKi), INTENT(IN ) :: ETA !< - REAL(ReKi), INTENT( OUT) :: G5 !< - INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: errMsg !< Error message if ErrStat /= ErrID_None - ! Local variables - INTEGER(intKi) :: ErrStat2 ! temporary Error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message - CHARACTER(*), parameter :: RoutineName = 'BLUNT' - real(ReKi) :: K - real(ReKi) :: M - real(ReKi) :: MU - real(ReKi) :: ETALIMIT - real(ReKi) :: ETA0 - ErrStat = ErrID_None - ErrMsg = "" - IF ( HDSTAR .LT. .25) MU = .1211 - IF ((HDSTAR .GT. .25).AND.(HDSTAR .LE. .62)) MU =-.2175*HDSTAR + .1755 - IF ((HDSTAR .GT. .62).AND.(HDSTAR .LT. 1.15)) MU =-.0308*HDSTAR + .0596 - IF ( HDSTAR .GE. 1.15) MU = .0242 - IF ( HDSTAR .LE. .02 ) M = 0.0 - IF ((HDSTAR .GE. .02 ).AND.(HDSTAR .LT. .5)) M = 68.724*HDSTAR - 1.35 - IF ((HDSTAR .GT. .5 ).AND.(HDSTAR .LE. .62)) M = 308.475*HDSTAR - 121.23 - IF ((HDSTAR .GT. .62 ).AND.(HDSTAR .LE. 1.15)) M = 224.811*HDSTAR - 69.354 - IF ((HDSTAR .GT. 1.15).AND.(HDSTAR .LT. 1.2)) M = 1583.28*HDSTAR - 1631.592 - IF ( HDSTAR .GT. 1.2 ) M = 268.344 - IF ( M .LT. 0.0 ) M = 0.0 - ETA0 = -SQRT((M*M*MU**4)/(6.25+M*M*MU*MU)) - K = 2.5*SQRT(1.-(ETA0/MU)**2.)-2.5-M*ETA0 - ETALIMIT = 0.03615995 - IF (ETA .LE. ETA0) G5 = M * ETA + K - IF((ETA.GT.ETA0).AND.(ETA .LE. 0.)) G5 = 2.5*SQRT(1.-(ETA/MU)**2.)-2.5 - IF((ETA.GT.0. ).AND.(ETA.LE.ETALIMIT)) G5 = SQRT(1.5625-1194.99*ETA**2.)-1.25 - IF (ETA.GT.ETALIMIT) G5 = -155.543 * ETA + 4.375 -END SUBROUTINE G5Comp -!==================================================================================================== -!> This subroutine defines the curve fit corresponding to the a-curve for the minimum allowed reynolds number. -SUBROUTINE AMIN(A,AMINA) - REAL(ReKi), INTENT(IN ) :: A ! - REAL(ReKi), INTENT(OUT ) :: AMINA ! - REAL(ReKi) :: X1 - X1 = ABS(A) - IF (X1 .LE. .204) AMINA=SQRT(67.552-886.788*X1**2.)-8.219 - IF((X1 .GT. .204).AND.(X1 .LE. .244))AMINA=-32.665*X1+3.981 - IF (X1 .GT. .244)AMINA=-142.795*X1**3.+103.656*X1**2.-57.757*X1+6.006 -END SUBROUTINE AMIN -!==================================================================================================== -!> This subroutine defines the curve fit corresponding to the a-curve for the maximum allowed reynolds number. -SUBROUTINE AMAX(A,AMAXA) - REAL(ReKi), INTENT(IN ) :: A ! - REAL(ReKi), INTENT(OUT ) :: AMAXA ! - REAL(ReKi) :: X1 - X1 = ABS(A) - IF (X1 .LE. .13)AMAXA=SQRT(67.552-886.788*X1**2.)-8.219 - IF((X1 .GT. .13).AND.(X1 .LE. .321))AMAXA=-15.901*X1+1.098 - IF (X1 .GT. .321)AMAXA=-4.669*X1**3.+3.491*X1**2.-16.699*X1+1.149 -END SUBROUTINE AMAX -!==================================================================================================== -!> This subroutine defines the curve fit corresponding to the b-curve for the minimum allowed reynolds number. -SUBROUTINE BMIN(B,BMINB) - REAL(ReKi), INTENT(IN ) :: B ! - REAL(ReKi), INTENT(OUT ) :: BMINB ! - REAL(ReKi) :: X1 - X1 = ABS(B) - IF (X1 .LE. .13)BMINB=SQRT(16.888-886.788*X1**2.)-4.109 - IF((X1 .GT. .13).AND.(X1 .LE. .145))BMINB=-83.607*X1+8.138 - IF (X1.GT..145)BMINB=-817.81*X1**3.+355.21*X1**2.-135.024*X1+10.619 -END SUBROUTINE BMin -!==================================================================================================== -!> Define the curve fit corresponding to the b-curve for the maximum allowed reynolds number. -SUBROUTINE BMAX(B,BMAXB) - REAL(ReKi), INTENT(IN ) :: B ! - REAL(ReKi), INTENT(OUT ) :: BMAXB ! - REAL(ReKi) :: X1 - X1 = ABS(B) - IF (X1 .LE. .1) BMAXB=SQRT(16.888-886.788*X1**2.)-4.109 - IF((X1 .GT. .1).AND.(X1 .LE. .187))BMAXB=-31.313*X1+1.854 - IF (X1.GT..187)BMAXB=-80.541*X1**3.+44.174*X1**2.-39.381*X1+2.344 -END SUBROUTINE BMax -!==================================================================================================== -!> Determine where the a-curve takes on a value of -20 db. -SUBROUTINE A0COMP(RC,A0) - REAL(ReKi), INTENT(IN ) :: RC ! - REAL(ReKi), INTENT(OUT ) :: A0 ! - IF (RC .LT. 9.52E+04) A0 = .57 - IF ((RC .GE. 9.52E+04).AND.(RC .LT. 8.57E+05)) & - A0 = (-9.57E-13)*(RC-8.57E+05)**2. + 1.13 - IF (RC .GE. 8.57E+05) A0 = 1.13 -END SUBROUTINE A0COMP -!==================================================================================================== -!> Compute zero angle of attack boundary layer thickness (meters) and reynolds number -SUBROUTINE THICK(C,M,RC,ALPSTAR,p,DELTAP,DSTRS,DSTRP,errStat,errMsg) -!! VARIABLE NAME DEFINITION UNITS -!! ------------- ---------- ----- -!! ALPSTAR ANGLE OF ATTACK DEGREES -!! C CHORD LENGTH METERS -!! C0 SPEED OF SOUND METERS/SEC -!! DELTA0 BOUNDARY LAYER THICKNESS AT -!! ZERO ANGLE OF ATTACK METERS -!! DELTAP PRESSURE SIDE BOUNDARY LAYER -!! THICKNESS METERS -!! DSTR0 DISPLACEMENT THICKNESS AT ZERO -!! ANGLE OF ATTACK METERS -!! DSTRP PRESSURE SIDE DISPLACEMENT -!! THICKNESS METERS -!! DSTRS SUCTION SIDE DISPLACEMENT -!! THICKNESS METERS -!! ITRIP TRIGGER FOR BOUNDARY LAYER TRIPPING --- -!! M MACH NUMBER --- -!! RC REYNOLDS NUMBER BASED ON CHORD --- -!! U FREESTREAM VELOCITY METERS/SEC -!! KinViscosity KINEMATIC VISCOSITY M2/SEC - REAL(ReKi), INTENT(IN ) :: ALPSTAR !< AOA - REAL(ReKi), INTENT(IN ) :: C !< Chord Length - REAL(ReKi), INTENT(IN ) :: RC !< RC= U*C/KinViscosity - REAL(ReKi), INTENT(IN ) :: M !< M = U/C0 - TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters - REAL(ReKi), INTENT( OUT) :: DELTAP !< - REAL(ReKi), INTENT( OUT) :: DSTRS !< - REAL(ReKi), INTENT( OUT) :: DSTRP !< - INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation - character(*), INTENT( OUT) :: errMsg !< Error message if ErrStat /= ErrID_None - ! Local variables - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'Thick' - real(ReKi) :: DELTA0 ! BOUNDARY LAYER THICKNESS AT ZERO ANGLE OF ATTACK METERS - real(ReKi) :: DSTR0 ! DISPLACEMENT THICKNESS AT ZERO ANGLE OF ATTACK METERS - ErrStat = ErrID_None - ErrMsg = "" - ! - DELTA0 = 10.**(1.6569-.9045*LOG10(RC)+.0596*LOG10(RC)**2.)*C - ! IF (p%ITRIP .EQ. 2) DELTA0 = .6 * DELTA0 ! corrected with respect to the Suzlon document Contact Pat Moriarty for further. added 2 lines below.(EB_DTU) - IF (p%ITRIP .GT. 0) DELTA0 = 10.**(1.892-0.9045*LOG(RC)+0.0596*LOG(RC)**2.)*C - IF (p%ITRIP .EQ. 2) DELTA0=.6*DELTA0 - ! Pressure side boundary layer thickness - DELTAP = 10.**(-.04175*ALPSTAR+.00106*ALPSTAR**2.)*DELTA0 - ! Compute zero angle of attack displacement thickness - IF ((p%ITRIP .EQ. 1) .OR. (p%ITRIP .EQ. 2)) THEN - IF (RC .LE. .3E+06) DSTR0 = .0601 * RC **(-.114)*C - IF (RC .GT. .3E+06) & - DSTR0=10.**(3.411-1.5397*LOG10(RC)+.1059*LOG10(RC)**2.)*C - IF (p%ITRIP .EQ. 2) DSTR0 = DSTR0 * .6 - ELSE - DSTR0=10.**(3.0187-1.5397*LOG10(RC)+.1059*LOG10(RC)**2.)*C - ENDIF - ! Pressure side displacement thickness - DSTRP = 10.**(-.0432*ALPSTAR+.00113*ALPSTAR**2.)*DSTR0 - ! IF (p%ITRIP .EQ. 3) DSTRP = DSTRP * 1.48 ! commented since itrip is never 3 check if meant 2.(EB_DTU) - ! Suction side displacement thickness - IF (p%ITRIP .EQ. 1) THEN - IF (ALPSTAR .LE. 5.) DSTRS=10.**(.0679*ALPSTAR)*DSTR0 - IF((ALPSTAR .GT. 5.).AND.(ALPSTAR .LE. 12.5)) & - DSTRS = .381*10.**(.1516*ALPSTAR)*DSTR0 - IF (ALPSTAR .GT. 12.5)DSTRS=14.296*10.**(.0258*ALPSTAR)*DSTR0 - ELSE - IF (ALPSTAR .LE. 7.5)DSTRS =10.**(.0679*ALPSTAR)*DSTR0 - IF((ALPSTAR .GT. 7.5).AND.(ALPSTAR .LE. 12.5)) & - DSTRS = .0162*10.**(.3066*ALPSTAR)*DSTR0 - IF (ALPSTAR .GT. 12.5) DSTRS = 52.42*10.**(.0258*ALPSTAR)*DSTR0 - ENDIF -END SUBROUTINE Thick -!==================================================================================================== -!> This subroutine computes the high frequency directivity function for the input observer location -SUBROUTINE DIRECTH(M,THETA,PHI,DBAR, errStat, errMsg) - REAL(ReKi), INTENT(IN ) :: THETA ! - REAL(ReKi), INTENT(IN ) :: PHI ! - REAL(ReKi), INTENT(IN ) :: M ! - REAL(ReKi), INTENT( OUT) :: DBAR ! - INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation - character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None - ! Local variables - character(*), parameter :: RoutineName = 'Directh' - real(ReKi) :: MC - real(ReKi) :: DEGRAD - real(ReKi) :: PHIR - real(ReKi) :: THETAR - ErrStat = ErrID_None - ErrMsg = "" - DEGRAD = .017453 - MC = .8 * M - THETAR = THETA * DEGRAD - PHIR = PHI * DEGRAD - DBAR = 2.*SIN(THETAR/2.)**2.*SIN(PHIR)**2./((1.+M*COS(THETAR))* (1.+(M-MC)*COS(THETAR))**2.) -END SUBROUTINE DirectH -!==================================================================================================== -!> This subroutine computes the high frequency directivity function for the input observer location -SUBROUTINE DIRECTL(M,THETA,PHI,DBAR, errStat, errMsg) - REAL(ReKi), INTENT(IN ) :: THETA !< - REAL(ReKi), INTENT(IN ) :: PHI !< - REAL(ReKi), INTENT(IN ) :: M !< - REAL(ReKi), INTENT( OUT) :: DBAR !< - INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation - character(*), INTENT( OUT) :: errMsg !< Error message if ErrStat /= ErrID_None - ! Local variables - character(*), parameter :: RoutineName = 'DirectL' - real(ReKi) :: MC - real(ReKi) :: DEGRAD - real(ReKi) :: PHIR - real(ReKi) :: THETAR - ErrStat = ErrID_None - ErrMsg = "" - ! This subroutine computes the low frequency directivity function for the input observer location - DEGRAD = .017453 - MC = .8 * M - THETAR = THETA * DEGRAD - PHIR = PHI * DEGRAD - DBAR = (SIN(THETAR)*SIN(PHIR))**2/(1.+M*COS(THETAR))**4 -END SUBROUTINE DirectL -!==================================================================================================================================! -!=============================== Full Guidati Model Inflow Turbulence Noise - Addition ==========================================! -!==================================================================================================================================! -SUBROUTINE FullGuidati(ALPSTAR,U,Chords,d,RObs,THETA,PHI,MeanVNoise,TINoise,p,whichairfoil,SPLti,errStat,errMsgn) - USE Atmosphere - USE TINoiseGeneric - USE TINoiseGeo - USE TINoiseInput - USE TICoords - USE AirfoilParams - USE TI_Guidati - REAL(R8Ki), INTENT(IN ) :: ALPSTAR !< AOA (deg) - REAL(R8Ki), INTENT(IN ) :: Chords !< Chord Length - REAL(R8Ki), INTENT(IN ) :: U !< - REAL(R8Ki), INTENT(IN ) :: d !< element span - REAL(R8Ki), INTENT(IN ) :: RObs !< distance to observer - REAL(R8Ki), INTENT(IN ) :: THETA !< - REAL(R8Ki), INTENT(IN ) :: PHI !< Spanwise directivity angle - REAL(R8Ki), INTENT(IN ) :: MeanVNoise !< - REAL(R8Ki), INTENT(IN ) :: TINoise !< - integer(intKi), INTENT(IN ) :: whichairfoil !< whichairfoil - TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters - REAL(R8Ki),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLti !< - INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation - character(*), INTENT( OUT) :: errMsgn !< Error message if ErrStat /= ErrID_None - ! local variables - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'FullGuidati' - integer(intKi) :: loop1 ! temporary - ErrStat = ErrID_None - ErrMsgn = "" - - rho = p%AirDens - co = p%SpdSound - nu = p%KinVisc - aofa = ALPSTAR - a_chord = Chords - npath = 40 ! Number of Streamlines (Guidati full model) - dpath = 0.005 ! Distance between streamlines (Guidati full model) - mach_ti = U / co - CALL INICON - ! Instead of calling readin routine the necessary variables are assigned within this subroutine - csound = co - chord = a_chord - alpha_in = aofa - alfa = alpha_in(1) * pi2 / 360.0d0 - nfreq = size(p%FreqList) - freq_in(1:size(p%FreqList)) = p%FreqList - x_ti = 0.0d0 - y_ti = 0.0d0 - n_in = size(p%AFInfo(whichairfoil)%X_Coord)-1 - x_ti(1:n_in)=p%AFInfo(whichairfoil)%X_Coord(2:n_in+1) ! starts from 2 first value is aerod center - y_ti(1:n_in)=p%AFInfo(whichairfoil)%Y_Coord(2:n_in+1) ! starts from 2 first value is aerod center - - CALL DEFGEO - CALL DRM_AER - CALL DRM_ACU -END SUBROUTINE FullGuidati -!==================================================================================================================================! -!=============================== Simplified Guidati Inflow Turbulence Noise Addition =============================================! -!==================================================================================================================================! -! Uses simple correction for turbulent inflow noise from Moriarty et. al 2005 -SUBROUTINE Simple_Guidati(U,Chord,thick_10p,thick_1p,p,SPLti,errStat,errMsg) - REAL(ReKi), INTENT(IN ) :: U ! Vrel - REAL(ReKi), INTENT(IN ) :: Chord ! Chord Length - REAL(ReKi), INTENT(IN ) :: thick_10p ! - REAL(ReKi), INTENT(IN ) :: thick_1p ! - TYPE(AA_ParameterType), INTENT(IN ) :: p ! Parameters - REAL(ReKi),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLti ! - INTEGER(IntKi), INTENT( OUT) :: errStat ! Error status of the operation - character(*), INTENT( OUT) :: errMsg ! Error message if ErrStat /= ErrID_None - ! local variables - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'Simple_Guidati' - INTEGER(intKi) :: loop1 ! temporary - REAL(ReKi) :: TI_Param ! Temporary variable thickness ratio dependent - REAL(ReKi) :: slope ! Temporary variable thickness ratio dependent - ErrStat = ErrID_None - ErrMsg = "" - - TI_Param = thick_1p + thick_10p - slope = 1.123*TI_Param + 5.317*TI_Param*TI_Param - do loop1 =1,size(p%FreqList) - SPLti(loop1) = -slope*(2*PI*p%FreqList(loop1)*chord/U + 5.0d0) - enddo -END SUBROUTINE Simple_Guidati -!==================================================================================================================================! -!================================ Turbulent Boundary Layer Trailing Edge Noise ====================================================! -!=================================================== TNO START ====================================================================! -SUBROUTINE TBLTE_TNO(ALPSTAR,C,U,THETA,PHI,D,R,Cfall,d99all,EdgeVelAll,p,SPLP,SPLS,SPLALPH,SPLTBL,errStat,errMsgn) - USE TNOConstants - USE Atmosphere - USE Wavenumber - USE BLParams - USE AirfoilParams - REAL(R8Ki), INTENT(IN ) :: ALPSTAR !< AOA (deg) - REAL(R8Ki), INTENT(IN ) :: C !< Chord Length (m) - REAL(R8Ki), INTENT(IN ) :: U !< Unoise (m/s) - REAL(R8Ki), INTENT(IN ) :: THETA !< DIRECTIVITY ANGLE (deg) - REAL(R8Ki), INTENT(IN ) :: PHI !< DIRECTIVITY ANGLE (deg) - REAL(R8Ki), INTENT(IN ) :: D !< SPAN (m) - REAL(R8Ki), INTENT(IN ) :: R !< SOURCE TO OBSERVER DISTANCE (m) - REAL(R8Ki),DIMENSION(2), INTENT(IN ) :: Cfall !< Skin friction coefficient (-) - REAL(R8Ki),DIMENSION(2), INTENT(IN ) :: d99all !< - REAL(R8Ki),DIMENSION(2), INTENT(IN ) :: EdgeVelAll !< - TYPE(AA_ParameterType), INTENT(IN ) :: p !< Noise Module Parameters - REAL(R8Ki),DIMENSION(size(p%FreqList)), INTENT(IN ) :: SPLALPH !< SOUND PRESSURE LEVEL DUE TO ANGLE OF ATTACK CONTRIBUTION (db) - REAL(R8Ki),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLP !< SOUND PRESSURE LEVEL DUE TO PRESSURE SIDE OF AIRFOIL (db) - REAL(R8Ki),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLS !< SOUND PRESSURE LEVEL DUE TO SUCTION SIDE OF AIRFOIL (db) - REAL(R8Ki),DIMENSION(size(p%FreqList)), INTENT( OUT) :: SPLTBL !< TOTAL SOUND PRESSURE LEVEL DUE TO TBLTE MECHANISM (db) - INTEGER(IntKi), INTENT( OUT) :: errStat !< Error status of the operation - character(*), INTENT( OUT) :: errMsgn !< Error message if ErrStat /= ErrID_None - ! Local variables - integer(intKi) :: ErrStat2 ! temporary Error status - character(ErrMsgLen) :: ErrMsg2 ! temporary Error message - character(*), parameter :: RoutineName = 'TBLTE_TNO' - REAL(kind=4) :: bound,a,b - REAL(kind=4) :: epsabs,epsrel - REAL(kind=4) :: answer - REAL(kind=4) :: abserr,resabs,resasc - REAL(kind=4) :: alist (limit),blist (limit),rlist (limit) - REAL(kind=4) :: elist (limit) - REAL(kind=4) :: freq(size(p%FreqList)) - REAL(kind=4) :: SPL_press,SPL_suction - REAL(kind=4) :: band_width,band_ratio - REAL(kind=4) :: Spectrum - REAL(ReKi) :: DBARH - REAL(kind=4) :: P1,P2,P4 - INTEGER (4) :: neval - INTEGER (4) :: ier - INTEGER (4) :: inf - INTEGER (4) :: iord (limit) - INTEGER (4) :: last - INTEGER (4) :: n_freq,i_low,i_hi - REAL(kind=4), EXTERNAL :: int2 - ! Init - n_freq = size(p%FreqList) - freq = p%FreqList - ErrStat = ErrID_None - ErrMsgn = "" - ! Body of TNO - bound = 0.0 !lower bound of integration - inf = 2 !-infinity to +infinity - epsabs = 1e-10 !absolute accuracy - epsrel = 1e-10 !relative accuracy - ! n_freq = NumBands - ! freq = Third_Octave - band_ratio = 2.**(1./3.) - ! Reynolds number and mach number - Mach = SNGL(U / p%SpdSound) - co = SNGL(p%SpdSound) - ! Directivity function - CALL DIRECTH(REAL(Mach),THETA,PHI,DBARH,errStat2,errMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsgn, RoutineName ) - - Cf =SNGL(Cfall) - d99 =SNGL(d99all) - edgevel =SNGL(ABS(EdgeVelAll)) - ! rho = 1.225000e0; nu= 1.4529e-5 - rho = SNGL(p%AirDens); nu = SNGL(p%KinVisc) - - do i_omega = 1,n_freq - omega = 2.*pi*freq(i_omega) - - !integration limits - a = 0.0e0 - b = 10*omega/(Mach*co) - - ! Convert to third octave - band_width = freq(i_omega)*(sqrt(band_ratio)-1./sqrt(band_ratio)) - - ISSUCTION = .TRUE. - - IF (Cf(1) .LT. 0.) THEN - write(*,*) 'Suction Cf is less than zero, Cf = ',Cf(1) - write(*,*) 'Using BPM' - ELSE - CALL qk61(int2,a,b,answer,abserr,resabs,resasc) - Spectrum = D/(4.*pi*R**2.)*answer - - SPL_suction = 10*log10(Spectrum*DBARH/2.e-5/2.e-5) - SPLS(i_omega) = SPL_suction + 10*log10(band_width) - ENDIF - - ISSUCTION = .FALSE. - - IF (Cf(2) .LT. 0.) THEN - write(*,*) 'Pressure Cf is less than zero, Cf = ',Cf(1) - write(*,*) 'Using BPM' - ELSE - CALL qk61(int2,a,b,answer,abserr,resabs,resasc) - - Spectrum = D/(4.*pi*R**2.)*answer - SPL_press = 10*log10(Spectrum*DBARH/2.e-5/2.e-5) - SPLP(i_omega) = SPL_press + 10*log10(band_width) - ENDIF - - ! Sum the noise sources SPLALPH is BPM value - IF (SPLP(i_omega) .LT. -100.) SPLP(i_omega) = -100. - IF (SPLS(i_omega) .LT. -100.) SPLS(i_omega) = -100. - - P1 = 10.**(SPLP(i_omega) / 10.) - P2 = 10.**(SPLS(i_omega) / 10.) - P4 = 10.**(SPLALPH(i_omega) / 10.) - SPLTBL(i_omega) = 10. * LOG10(P1 + P2 + P4) - enddo - ! DO i_omega=1,size(p%FreqList) - ! print*, p%FreqList(i_omega),SPLP(i_omega),SPLS(i_omega),SPLALPH(i_omega) - ! ENDDO -END SUBROUTINE TBLTE_TNO - -!==================================================================================================================================! -!================================================= XFOIL BL SINGLE RUN ============================================================! -!SUBROUTINE XFOIL_BL_SINGLE(p,m,whichairfoil,ChordChord,Unoise,AlphaNoise) -! USE XfoilAirfoilParams -! USE XfoilBLParams -! TYPE(AA_ParameterType), INTENT(IN ) :: p ! Parameters -! TYPE(AA_MiscVarType), INTENT(INOUT) :: m !< Initial misc/optimization variables -! integer(intKi), INTENT(IN ) :: whichairfoil ! whichairfoil -! REAL(kind=8), INTENT(IN ) :: Unoise ! Unoise -! REAL(kind=8), INTENT(IN ) :: ChordChord ! Chord Length -! REAL(kind=8), INTENT(IN ) :: AlphaNoise ! deg -!! INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation -!! CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None -! INTEGER(intKi) :: ErrStat2 ! temporary Error status -! CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message -! character(*), parameter :: RoutineName = 'XFOIL_BL_SINGLE' -! INTEGER*4 :: itrip,wr_loop -! REAL(ReKi) :: co,U,rho,nu -! -! !ErrStat = ErrID_None -! !ErrMsg = "" -! a_chord=ChordChord -! U=Unoise -! aofa=AlphaNoise -! -! co = p%SpdSound !337.75590d0 -! nu = p%KinVisc !1.4529e-5 -! rho = p%AirDens !1.225000 -! -! ITRIP = 0 -! -! airfoil='NotUsed.dat' ! not used just in case -! ISNACA=.FALSE. -! -! NB_AFMODULE=size(p%AFInfo(whichairfoil)%X_Coord)-1 -! IF(allocated(XB_AFMODULE)) DEALLOCATE(XB_AFMODULE) -! ALLOCATE(XB_AFMODULE(NB_AFMODULE)) -! ! call AllocAry( XB_AFMODULE, NB_AFMODULE, 'XB_AFMODULE', ErrStat2, ErrMsg2 ) -! !call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) -! XB_AFMODULE=p%AFInfo(whichairfoil)%X_Coord(2:NB_AFMODULE+1) -! IF(allocated(yB_AFMODULE)) DEALLOCATE(YB_AFMODULE) -! ALLOCATE(YB_AFMODULE(NB_AFMODULE)) -! ! call AllocAry( YB_AFMODULE, NB_AFMODULE, 'YB_AFMODULE', ErrStat2, ErrMsg2 ) -! !call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) -! YB_AFMODULE=p%AFInfo(whichairfoil)%Y_Coord(2:NB_AFMODULE+1) -! IF( p%ITRIP .GT. 0) THEN -! ISTRIPPED = .TRUE. -! xtrup=0.02 -! xtrlo=0.1 -! -! ELSE -! ISTRIPPED = .FALSE. -! ENDIF -! CALL get_airfoil_coords -! -! -! Mach=U/p%SpdSound -! Re = U*a_chord/p%KinVisc -! -! CALL xfoil_noise -! d99 = d99*a_chord -! d_star = d_star*a_chord -! -! m%dstarVar(1) = d_star(1) -! m%dstarVar(2) = d_star(2) -! -! m%d99Var(1) = d99(1) -! m%d99Var(2) = d99(2) -! -! m%CfVar(1) = Cf(1) -! m%CfVar(2) = Cf(2) -! -!END SUBROUTINE XFOIL_BL_SINGLE -! -! -!!==================================================================================================================================! -!!================================================= XFOIL BL PRETABULATE ===========================================================! -!!==================================================================================================================================! -! SUBROUTINE RUN_XFOIL_BL(p) -! USE XfoilAirfoilParams -! USE XfoilBLParams -! TYPE(AA_ParameterType), INTENT(INOUT) :: p ! Parameters -!! INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation -!! CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None -! -! INTEGER(intKi) :: ErrStat2 ! temporary Error status -! CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message -! character(*), parameter :: RoutineName = ' RUN_XFOIL_BL' -! INTEGER*4 :: nr_airfoil,loop1,loop2,loop3,itrip,wr_loop -! REAL(kind=4) :: co,U,rho,nu -! !ErrStat = ErrID_None -! !ErrMsg = "" -! -! co = p%SpdSound !337.75590d0 -! nu = p%KinVisc !1.4529e-5 -! rho = p%AirDens !1.225000 -! ITRIP = 1 -! a_chord = 1 -!! U_all = 63.9200 -!! aoa_all = 3 -! a_chord= 0.2286 -! -! DO loop1=1,size(p%AFInfo) -! -! airfoil='NotUsed.dat' ! not used just in case -! xtrup=0.02 -! xtrlo=0.1 -! ISNACA=.FALSE. -! -! NB_AFMODULE=size(p%AFInfo(loop1)%X_Coord)-1 -! IF(allocated(XB_AFMODULE)) DEALLOCATE(XB_AFMODULE) -! ALLOCATE(XB_AFMODULE(NB_AFMODULE)) -!! call AllocAry( XB_AFMODULE, NB_AFMODULE, 'XB_AFMODULE', ErrStat2, ErrMsg2 ) -! !call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) -! XB_AFMODULE=p%AFInfo(loop1)%X_Coord(2:NB_AFMODULE+1) ! starts from 2 first value is aerod center -! IF(allocated(yB_AFMODULE)) DEALLOCATE(YB_AFMODULE) -! ALLOCATE(YB_AFMODULE(NB_AFMODULE)) -! ! call AllocAry( YB_AFMODULE, NB_AFMODULE, 'YB_AFMODULE', ErrStat2, ErrMsg2 ) -! !call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) -! YB_AFMODULE=p%AFInfo(loop1)%Y_Coord(2:NB_AFMODULE+1) ! starts from 2 first value is aerod center -! IF( p%ITRIP .GT. 0) THEN -! ISTRIPPED = .TRUE. -! ELSE -! ISTRIPPED = .FALSE. -! ENDIF -! -! -! CALL get_airfoil_coords -! -! DO loop2=1,size(p%UListXfoil) -! DO loop3=1,size(p%AOAListXfoil) -! U = p%UListXfoil(loop2) -! aofa = p%AOAListXfoil(loop3) -! Mach=U/p%SpdSound -! Re = U*a_chord/p%KinVisc -! p%ReListXfoil(loop2)=Re -! CALL xfoil_noise -! ! d99 = d99*a_chord -! ! d_star = d_star*a_chord -! ! print*,'d_star,d99,cf',d_star,d99,cf -! -! !write (10,*) d_star,d99,cf -! p%dstarall1(loop3,loop2,loop1)=d_star(1) -! p%dstarall2(loop3,loop2,loop1)=d_star(2) -! p%d99all1(loop3,loop2,loop1) =d99(1) -! p%d99all2(loop3,loop2,loop1) =d99(2) -! p%Cfall1(loop3,loop2,loop1) =Cf(1) -! p%Cfall2(loop3,loop2,loop1) =Cf(2) -! ENDDO -! ENDDO -! ENDDO -! END SUBROUTINE RUN_XFOIL_BL -!==================================================================================================== -SUBROUTINE BL_Param_Interp(p,m,U,AlphaNoise,C,whichairfoil, errStat, errMsg) - TYPE(AA_ParameterType), INTENT(IN ) :: p !< Parameters - TYPE(AA_MiscVarType), INTENT(INOUT) :: m !< misc/optimization data (not defined in submodules) - REAL(ReKi), INTENT(IN ) :: U !< METERS/SEC - REAL(ReKi), INTENT(IN ) :: AlphaNoise !< Angle of Attack DEG - REAL(ReKi), INTENT(IN ) :: C !< Chord METERS - integer(intKi), INTENT(IN ) :: whichairfoil !< whichairfoil - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - character(*), parameter :: RoutineName = 'BL_Param_Interp' - REAL(ReKi) :: redif1,redif2,aoadif1,aoadif2,xx1,xx2,RC - INTEGER(intKi) :: loop1,loop2 - - !!!! this if is not used but if necessary two sets of tables can be populated for tripped and untripped cases - RC = U * C/p%KinVisc ! REYNOLDS NUMBER BASED ON CHORD - - DO loop1=1,size(p%ReListXfoil)-1 - IF ( (RC.le.p%ReListXfoil(loop1+1)) .and. (RC.gt.p%ReListXfoil(loop1)) ) then - redif1=abs(RC-p%ReListXfoil(loop1+1)) - redif2=abs(RC-p%ReListXfoil(loop1)) - DO loop2=1,size(p%AOAListXfoil)-1 - - if ( (AlphaNoise.le.p%AOAListXfoil(loop2+1)) .and. (AlphaNoise.gt.p%AOAListXfoil(loop2)) ) then - aoadif1=abs(AlphaNoise-p%AOAListXfoil(loop2+1)) - aoadif2=abs(AlphaNoise-p%AOAListXfoil(loop2)) - - xx1=( p%dstarall1(loop2,loop1+1,whichairfoil)*redif2+p%dstarall1(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - xx2=( p%dstarall1(loop2+1,loop1+1,whichairfoil)*redif2+p%dstarall1(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%dstarVar(1)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) - - xx1=( p%dstarall2(loop2,loop1+1,whichairfoil)*redif2+p%dstarall2(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - xx2=( p%dstarall2(loop2+1,loop1+1,whichairfoil)*redif2+p%dstarall2(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%dstarVar(2)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) - - xx1=( p%d99all1(loop2,loop1+1,whichairfoil)*redif2+p%d99all1(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - xx2=( p%d99all1(loop2+1,loop1+1,whichairfoil)*redif2+p%d99all1(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%d99Var(1)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) - - xx1=( p%d99all2(loop2,loop1+1,whichairfoil)*redif2+p%d99all2(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - xx2=( p%d99all2(loop2+1,loop1+1,whichairfoil)*redif2+p%d99all2(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%d99Var(2)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) - - xx1=( p%Cfall1(loop2,loop1+1,whichairfoil)*redif2+p%Cfall1(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - xx2=( p%Cfall1(loop2+1,loop1+1,whichairfoil)*redif2+p%Cfall1(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%CfVar(1)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) - - xx1=( p%Cfall2(loop2,loop1+1,whichairfoil)*redif2+p%Cfall2(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - xx2=( p%Cfall2(loop2+1,loop1+1,whichairfoil)*redif2+p%Cfall2(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%CfVar(2)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) - - xx1=( p%EdgeVelRat1(loop2,loop1+1,whichairfoil)*redif2+p%EdgeVelRat1(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - xx2=( p%EdgeVelRat1(loop2+1,loop1+1,whichairfoil)*redif2+p%EdgeVelRat1(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%EdgeVelVar(1)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) - - xx1=( p%EdgeVelRat2(loop2,loop1+1,whichairfoil)*redif2+p%EdgeVelRat2(loop2,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - xx2=( p%EdgeVelRat2(loop2+1,loop1+1,whichairfoil)*redif2+p%EdgeVelRat2(loop2+1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%EdgeVelVar(2)=(xx1*aoadif1+xx2*aoadif2) / (aoadif1+aoadif2) - - return ! We exit the routine ! - endif - if (loop2 .eq. (size(p%AOAListXfoil)-1) ) then - - if (AlphaNoise .gt. p%AOAListXfoil(size(p%AOAListXfoil))) then - print*, 'Warning AeroAcoustics Module - Angle of attack (AoA) range is not in the user input of Xfoil table' - print*, 'Airfoil AoA ',AlphaNoise,' Using the closest AoA ',p%AOAListXfoil(loop2+1) - m%dStarVar (1) = ( p%dstarall1 (loop2+1,loop1+1,whichairfoil)*redif2 + p%dstarall1 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) - m%dStarVar (2) = ( p%dstarall2 (loop2+1,loop1+1,whichairfoil)*redif2 + p%dstarall2 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) - m%d99Var (1) = ( p%d99all1 (loop2+1,loop1+1,whichairfoil)*redif2 + p%d99all1 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) - m%d99Var (2) = ( p%d99all2 (loop2+1,loop1+1,whichairfoil)*redif2 + p%d99all2 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) - m%CfVar (1) = ( p%Cfall1 (loop2+1,loop1+1,whichairfoil)*redif2 + p%Cfall1 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) - m%CfVar (2) = ( p%Cfall2 (loop2+1,loop1+1,whichairfoil)*redif2 + p%Cfall2 (loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) - m%EdgeVelVar(1) = ( p%EdgeVelRat1(loop2+1,loop1+1,whichairfoil)*redif2 + p%EdgeVelRat1(loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) - m%EdgeVelVar(2) = ( p%EdgeVelRat2(loop2+1,loop1+1,whichairfoil)*redif2 + p%EdgeVelRat2(loop2+1,loop1,whichairfoil)*redif1 )/(redif1+redif2) - elseif (AlphaNoise .lt. p%AOAListXfoil(1)) then - print*, 'Warning AeroAcoustics Module - Angle of attack (AoA) range is not in the user input of Xfoil table' - print*, 'Airfoil AoA ',AlphaNoise,' Using the closest AoA ',p%AOAListXfoil(1) - m%dStarVar(1) = ( p%dstarall1 (1,loop1+1,whichairfoil)*redif2 + p%dstarall1 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%dStarVar(2) = ( p%dstarall2 (1,loop1+1,whichairfoil)*redif2 + p%dstarall2 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%d99Var(1) = ( p%d99all1 (1,loop1+1,whichairfoil)*redif2 + p%d99all1 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%d99Var(2) = ( p%d99all2 (1,loop1+1,whichairfoil)*redif2 + p%d99all2 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%CfVar(1) = ( p%Cfall1 (1,loop1+1,whichairfoil)*redif2 + p%Cfall1 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%CfVar(2) = ( p%Cfall2 (1,loop1+1,whichairfoil)*redif2 + p%Cfall2 (1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%EdgeVelVar(1) = ( p%EdgeVelRat1(1,loop1+1,whichairfoil)*redif2 + p%EdgeVelRat1(1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - m%EdgeVelVar(2) = ( p%EdgeVelRat2(1,loop1+1,whichairfoil)*redif2 + p%EdgeVelRat2(1,loop1,whichairfoil)*redif1 ) / (redif1+redif2) - endif - endif - enddo - endif - enddo -END SUBROUTINE BL_Param_Interp - -END MODULE AeroAcoustics - diff --git a/modules/aerodyn/src/AeroAcoustics/AeroAcoustics_IO.f90 b/modules/aerodyn/src/AeroAcoustics/AeroAcoustics_IO.f90 index 9163622cb..fa0a173b8 100644 --- a/modules/aerodyn/src/AeroAcoustics/AeroAcoustics_IO.f90 +++ b/modules/aerodyn/src/AeroAcoustics/AeroAcoustics_IO.f90 @@ -76,13 +76,14 @@ MODULE AeroAcoustics_IO integer(intKi), parameter :: X_BLMethod_BPM = 1 ! integer(intKi), parameter :: X_BLMethod_Xfoil = 2 ! - integer(intKi), parameter :: XfoilCall_Interp = 1 ! interpolate from pretabulated - integer(intKi), parameter :: XfoilCall_Every = 2 ! call xfoil for each each time step + integer(intKi), parameter :: XfoilCall_None = 0 ! interpolate from pretabulated + integer(intKi), parameter :: XfoilCall_Tabulate = 1 ! call xfoil for each each time step + integer(intKi), parameter :: XfoilCall_Every = 2 ! call xfoil for each each time step integer(intKi), parameter :: TICalc_Interp = 1 ! interpolate from pretabulated integer(intKi), parameter :: TICalc_Every = 2 ! calculate ti automatically - integer(intKi), parameter :: ITURB_None = 0 ! TBLTE noise is not calculated + integer(intKi), parameter :: ITURB_None = 0 ! TBLTE noise is not calculated integer(intKi), parameter :: ITURB_BPM = 1 ! TBLTE noise is calculated with BPM integer(intKi), parameter :: ITURB_TNO = 2 ! TBLTE noise is calculated with TNO @@ -90,9 +91,6 @@ MODULE AeroAcoustics_IO integer(intKi), parameter :: IInflow_BPM = 1 ! IInflow noise is calculated with BPM integer(intKi), parameter :: IInflow_FullGuidati = 2 ! IInflow noise is calculated with FullGuidati integer(intKi), parameter :: IInflow_SimpleGuidati = 3 ! IInflow noise is calculated with SimpleGuidati - - integer(intKi), parameter :: AweightFlagOn = 1 ! - integer(intKi), parameter :: AweightFlagOff = 0 INTEGER(IntKi), PARAMETER :: MaxOutPts = 1103 contains @@ -115,7 +113,6 @@ SUBROUTINE ReadInputFiles( InputFileName, InputFileData, Default_DT, OutFileRoot INTEGER(IntKi) :: ErrStat2 ! The error status code CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred CHARACTER(1024) :: AABlFile(MaxBl) ! File that contains the blade information (specified in the primary input file) - LOGICAL :: NotReadYet ! CHARACTER(*), PARAMETER :: RoutineName = 'ReadInputFiles' ! initialize values: ErrStat = ErrID_None @@ -123,8 +120,7 @@ SUBROUTINE ReadInputFiles( InputFileName, InputFileData, Default_DT, OutFileRoot UnEcho = -1 InputFileData%DTAero = Default_DT ! the glue code's suggested DT for the module (may be overwritten in ReadPrimaryFile()) - ! get the primary/platform input-file data - ! sets UnEcho, AABlFile + ! Reads the module input-file data CALL ReadPrimaryFile( InputFileName, InputFileData, AABlFile, OutFileRoot, UnEcho, ErrStat2, ErrMsg2 ) if(Failed()) return @@ -141,21 +137,28 @@ SUBROUTINE ReadInputFiles( InputFileName, InputFileData, Default_DT, OutFileRoot if(Failed()) return end do - NotReadYet=.true. - IF( (InputFileData%XfoilCall.eq.1) .and. (InputFileData%ITURB.eq.2) ) THEN - CALL ReadXfoilTables( InputFileName,InputFileData, InputFileData%BladeProps(1)%NumBlNds, ErrStat2, ErrMsg2 ) - if(Failed()) return - NotReadYet=.false. - ENDIF + if (InputFileData%XfoilCall.eq.XfoilCall_None) then + if ((InputFileData%ITURB.eq.2) .or. (InputFileData%X_BLMethod.eq.2)) then + ! We need to read the xfoil tables + CALL ReadXfoilTables( InputFileName,InputFileData, InputFileData%BladeProps(1)%NumBlNds, ErrStat2, ErrMsg2 ) + if (Failed())return + endif + elseif (InputFileData%XfoilCall.eq.XfoilCall_Tabulate) then + ! We need to generate the tables with Xfoil + ! Creating a "linspace" array of Angle of attack: AoA = linspace(alpha_min, alpha_max, n_alpha) + ! Note Reynolds array already read from input file + CALL AllocAry( InputFileData%AoAListXfoil, int(InputFileData%AlphaLinsp(3)), 'InputFileData%AoAListXfoil', ErrStat2, ErrMsg2); if(Failed()) return + do i = 1,int(InputFileData%AlphaLinsp(3)) + InputFileData%AoAListXfoil(i) = InputFileData%AlphaLinsp(1) + (i-1) * (InputFileData%AlphaLinsp(2)-InputFileData%AlphaLinsp(1))/(int(InputFileData%AlphaLinsp(3))-1) + enddo + else + ! We'll call Xfoil all the time + endif - IF( (InputFileData%XfoilCall.eq.1) .and. (InputFileData%X_BLMethod.eq.2) .and. (NotReadYet) ) THEN - CALL ReadXfoilTables( InputFileName,InputFileData, InputFileData%BladeProps(1)%NumBlNds, ErrStat2, ErrMsg2 ) - if(Failed()) return - ENDIF - IF( (InputFileData%TICalcMeth.eq.1) ) THEN + IF( (InputFileData%TICalcMeth.eq.1) ) THEN CALL REadTICalcTables(InputFileName,InputFileData, ErrStat2, ErrMsg2); if(Failed()) return - ENDIF + ENDIF CONTAINS logical function Failed() @@ -188,6 +191,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, AABlFile, OutFileRoot, Un character(1024) :: FTitle ! "File Title": the 2nd line of the input file, which contains a description of its contents character(200) :: Line ! Temporary storage of a line from the input file (to compare with "default") character(*), parameter :: RoutineName = 'ReadPrimaryFile' + integer(IntKi) :: n ! dummy integer ! Initialize some variables: ErrStat = ErrID_None ErrMsg = "" @@ -251,27 +255,32 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, AABlFile, OutFileRoot, Un READ( Line, *, IOSTAT=IOS) InputFileData%DTAero CALL CheckIOS ( IOS, InputFile, 'DTAero', NumType, ErrStat2, ErrMsg2 ); call check END IF - CALL ReadVar( UnIn, InputFile, InputFileData%Comp_AA_After, "Comp_AA_After", "Comp_AA_After", ErrStat2, ErrMsg2, UnEc); call check - CALL ReadVar( UnIn, InputFile, InputFileData%saveeach , "saveeach", "saveeach", ErrStat2, ErrMsg2, UnEc); call check - CALL ReadVar( UnIn, InputFile, InputFileData%IBLUNT , "IBLUNT", "FLAG TO COMPUTE BLUNTNESS NOISE {} (-)", ErrStat2, ErrMsg2, UnEc); call check - CALL ReadVar( UnIn, InputFile, InputFileData%ILAM , "ILAM", "FLAG TO COMPUTE LBL NOISE {} (-)", ErrStat2, ErrMsg2, UnEc); call check - CALL ReadVar( UnIn, InputFile, InputFileData%ITIP , "ITIP", "FLAG TO COMPUTE TIP NOISE {} (-)", ErrStat2, ErrMsg2, UnEc); call check - CALL ReadVar( UnIn, InputFile, InputFileData%ITRIP , "ITRIP", "FLAG TO TRIP BOUNDARY LAYER {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} (-)", ErrStat2, ErrMsg2, UnEc); call check - - ! ITURB - FLAG TO COMPUTE TBLTE NOISE - CALL ReadVar( UnIn, InputFile, InputFileData%ITURB , "ITURB", "FLAG TO COMPUTE TBLTE NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} (-)", ErrStat2, ErrMsg2, UnEc); call check - CALL ReadVar( UnIn, InputFile, InputFileData%IInflow , "IInflow", "FLAG TO COMPUTE Turbulent Inflow NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} (-)", ErrStat2, ErrMsg2, UnEc); call check - CALL ReadVar( UnIn, InputFile, InputFileData%X_BLMethod , "X_BLMethod", "Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Xfoil", ErrStat2, ErrMsg2, UnEc); call check - CALL ReadVar( UnIn, InputFile, InputFileData%XfoilCall , "XfoilCall", "Integer describing Xfoil calls, = 1 Interpolate from pretabulated = 2 Call Xfoil for each node etc", ErrStat2, ErrMsg2, UnEc); call check - CALL ReadVar( UnIn, InputFile, InputFileData%TICalcMeth , "TICalcMeth", "Integer describing TICalcMeth, = 1 Interpolate from pretabulated = 2 calculate on the fly", ErrStat2, ErrMsg2, UnEc); call check - CALL ReadVar( UnIn, InputFile, InputFileData%ROUND, "ROUND", "LOGICAL INDICATING ROUNDED TIP", ErrStat2, ErrMsg2, UnEc); call check - CALL ReadVar( UnIn, InputFile, InputFileData%ALPRAT, "ALPRAT", "TIP LIFT CURVE SLOPE and (Default = 1.0)", ErrStat2, ErrMsg2, UnEc); call check - ! AA_Bl_Prcntge - The calculations will be carried out for the nodes that are within the user input percntage value. - ! i.e. AA_Bl_Prcntge=60 means;Starting from tip 60% percent of the blade will be contributing to the overall noise levels. - CALL ReadVar( UnIn, InputFile, InputFileData%AA_Bl_Prcntge, "AA_Bl_Prcntge", "-", ErrStat2, ErrMsg2, UnEc); call check - ! surface roughness - CALL ReadVar( UnIn, InputFile, InputFileData%z0_AA, "z0_AA", "-", ErrStat2, ErrMsg2, UnEc); call check - CALL ReadVar( UnIn, InputFile, InputFileData%aweightflag, "aweightflag", "Integer describing a weighting", ErrStat2, ErrMsg2, UnEc); call check + CALL ReadVar(UnIn,InputFile,InputFileData%Comp_AA_After,"AAStart" ,"" ,ErrStat2,ErrMsg2,UnEc); call check + CALL ReadVar(UnIn,InputFile,InputFileData%saveeach ,"SaveEach" ,"" ,ErrStat2,ErrMsg2,UnEc); call check + CALL ReadVar(UnIn,InputFile,InputFileData%IBLUNT ,"BluntMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check + CALL ReadVar(UnIn,InputFile,InputFileData%ILAM ,"LamMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check + CALL ReadVar(UnIn,InputFile,InputFileData%ITIP ,"TipMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check + CALL ReadVar(UnIn,InputFile,InputFileData%ITRIP ,"TripMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check + CALL ReadVar(UnIn,InputFile,InputFileData%ITURB ,"TurbMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check ! ITURB - TBLTE NOISE + CALL ReadVar(UnIn,InputFile,InputFileData%IInflow ,"InflowMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check + CALL ReadVar(UnIn,InputFile,InputFileData%X_BLMethod ,"BLMod" ,"" ,ErrStat2,ErrMsg2,UnEc); call check + CALL ReadVar(UnIn,InputFile,InputFileData%XfoilCall ,"XfoilCall" ,"" ,ErrStat2,ErrMsg2,UnEc); call check + CALL ReadVar(UnIn,InputFile,InputFileData%NReListBL ,"NReListBL" ,"" ,ErrStat2,ErrMsg2,UnEc); call check + if (InputFileData%NReListBL<=0) then + CALL AllocAry( InputFileData%ReListXfoil,0, 'ReListXfoil', ErrStat2, ErrMsg2); call check + CALL ReadCom(UnIn,InputFile,'ReListBL', ErrStat2, ErrMsg2,UnEc); call check + else + CALL AllocAry(InputFileData%ReListXfoil, InputFileData%NReListBL, 'ReListXfoil', ErrStat2, ErrMsg2); call check + CALL ReadAry(UnIn,InputFile,InputFileData%ReListXfoil, InputFileData%NReListBL, 'ReListBL', "", ErrStat2,ErrMsg2,UnEc); call check + InputFileData%ReListXfoil=InputFileData%ReListXfoil*10**6 ! Input is in million + endif + CALL ReadAry(UnIn,InputFile,InputFileData%AlphaLinsp, 3,"AlphaLinsp" ,"", ErrStat2,ErrMsg2,UnEc); call check + CALL ReadVar(UnIn,InputFile,InputFileData%TICalcMeth ,"TICalcMeth" ,"" ,ErrStat2,ErrMsg2,UnEc); call check + CALL ReadVar(UnIn,InputFile,InputFileData%ROUND ,"RoundTip" ,"" ,ErrStat2,ErrMsg2,UnEc); call check + CALL ReadVar(UnIn,InputFile,InputFileData%ALPRAT ,"ALPRAT" ,"" ,ErrStat2,ErrMsg2,UnEc); call check + CALL ReadVar(UnIn,InputFile,InputFileData%AA_Bl_Prcntge,"BldPrcnt" ,"-",ErrStat2,ErrMsg2,UnEc); call check + CALL ReadVar(UnIn,InputFile,InputFileData%z0_AA ,"SurfRoughness","" ,ErrStat2,ErrMsg2,UnEc); call check + CALL ReadVar(UnIn,InputFile,InputFileData%aweightflag ,"AWeighting" ,"" ,ErrStat2,ErrMsg2,UnEc); call check ! Return on error at end of section IF ( ErrStat >= AbortErrLev ) THEN @@ -307,7 +316,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, AABlFile, OutFileRoot, Un IF ( ErrStat >= AbortErrLev ) THEN CALL Cleanup() RETURN - END IF + END IF ENDDO CLOSE ( UnIn2 ) !----- end read from observer file @@ -329,19 +338,15 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, AABlFile, OutFileRoot, Un !----------- OUTPUTS ----------------------------------------------------------- CALL ReadCom( UnIn, InputFile, 'Section Header: Outputs', ErrStat2, ErrMsg2, UnEc); call check - - ! NrObsLoc - Nr of Observers (-): - CALL ReadVar( UnIn, InputFile, InputFileData%NrOutFile, "InputFileData%NrOutFile", "Nr of Output Files (-)", ErrStat2, ErrMsg2, UnEc); call check - - CALL AllocAry( InputFileData%AAOutFile,InputFileData%NrOutFile, 'InputFileData%AAOutFile', ErrStat2, ErrMsg2); call check - - CALL ReadVar ( UnIn, InputFile, InputFileData%AAOutFile(1), 'InputFileData%AAOutFile', 'Name of output file ', ErrStat2, ErrMsg2, UnEc ); call check - + CALL ReadVar( UnIn, InputFile, InputFileData%NrOutFile, "NrOutFile", "Nr of Output Files (-)", ErrStat2, ErrMsg2, UnEc); call check + CALL AllocAry( InputFileData%AAOutFile,InputFileData%NrOutFile, 'AAOutFile', ErrStat2, ErrMsg2); call check + CALL ReadVar ( UnIn, InputFile, InputFileData%AAOutFile(1), 'AAOutFile', 'Name of output file ', ErrStat2, ErrMsg2, UnEc ); call check DO I=InputFileData%NrOutFile,1,-1 ! one file name is given by the user and the XXFile1.out XXFile2.out XXFile3.out is generated IF ( PathIsRelative( InputFileData%AAOutFile(I) ) ) InputFileData%AAOutFile(I) = TRIM(PriPath)//TRIM(InputFileData%AAOutFile(1))//TRIM(Num2Lstr(I))//".out" ENDDO - CALL ReadVar ( UnIn, InputFile, InputFileData%LargeBinOutput, 'InputFileData%LargeBinOutput', 'Name of output file ', ErrStat2, ErrMsg2, UnEc ); call check + CALL ReadVar(UnIn,InputFile,InputFileData%LargeBinOutput,'LargeBinOutput','LargeBinOutput',ErrStat2,ErrMsg2,UnEc); call check + CALL ReadVar(UnIn,InputFile,InputFileData%XfoilTabOut ,'XfoilTabOut' ,'XfoilTabOut' ,ErrStat2,ErrMsg2,UnEc); call check ! Return on error at end of section IF ( ErrStat >= AbortErrLev ) THEN @@ -416,102 +421,99 @@ SUBROUTINE Cleanup() END SUBROUTINE Cleanup END SUBROUTINE ReadBladeInputs -SUBROUTINE ReadXfoilTables( InputFile,InputFileData, BldNodes, ErrStat, ErrMsg ) +SUBROUTINE ReadXfoilTables( InputFile,InputFileData, nAirfoils, ErrStat, ErrMsg ) ! Passed variables + character(*), intent(in) :: InputFile ! Name of the file containing the primary input data + type(AA_InputFile), intent(inout) :: InputFileData ! All the data in the Noise input file + integer(IntKi), intent(in) :: nAirfoils ! Number of Airfoil tables integer(IntKi), intent(out) :: ErrStat ! Error status character(*), intent(out) :: ErrMsg ! Error message - integer(IntKi), intent(in) :: BldNodes ! Error status - type(AA_InputFile), intent(inout) :: InputFileData ! All the data in the Noise input file - character(*), intent(in) :: InputFile ! Name of the file containing the primary input data ! Local variables: - integer(IntKi) :: I ! loop counter integer(IntKi) :: UnIn,UnIn2 ! Unit number for reading file - integer(IntKi) :: loop1 ! loop counter character(1024) :: FileName ! name of the files containing obesever location - integer(IntKi) :: ErrStat2, IOS,cou ! Temporary Error status + integer(IntKi) :: ErrStat2 ! Temporary Error status logical :: Echo ! Determines if an echo file should be written character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message character(1024) :: PriPath ! Path name of the primary file character(1024) :: FTitle ! "File Title": the 2nd line of the input file, which contains a description of its contents character(200) :: Line ! Temporary storage of a line from the input file (to compare with "default") character(*), parameter :: RoutineName = 'readxfoiltable' - integer(IntKi) :: sizeRe ! - integer(IntKi) :: sizeaoa ! - integer(IntKi) :: cou1,UnEc ! loop counter - real(DbKi),dimension(:,:),ALLOCATABLE :: temp1 + integer(IntKi) :: nRe, nAoA ! Number of Reynolds number and angle of attack listed + integer(IntKi) :: iAF , iRe, iAoA, iDummy, iBuffer ! loop counters + real(DbKi),dimension(:,:),ALLOCATABLE :: Buffer ! Initialize some variables: ErrStat = ErrID_None ErrMsg = "" CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - DO I=1,BldNodes - IF (InputFileData%ITRIP.eq.0) THEN - FileName = TRIM(PriPath)//'AirfoilsModified/BL/AF'//TRIM(Num2LStr(I))//'.txt' + do iAF=1,nAirfoils + if (InputFileData%ITRIP.eq.0) then + FileName = TRIM(PriPath)//'AirfoilsModified/BL/AF'//TRIM(Num2LStr(iAF))//'.txt' ELSE - FileName = TRIM(PriPath)//'AirfoilsModified/BL_TRIPPED/AF'//TRIM(Num2LStr(I))//'.txt' + FileName = TRIM(PriPath)//'AirfoilsModified/BL_TRIPPED/AF'//TRIM(Num2LStr(iAF))//'.txt' ENDIF + print*,'AeroAcoustics_IO: reading Xfoil table:'//trim(Filename) CALL GetNewUnit(UnIn, ErrStat2, ErrMsg2); if(Failed()) return CALL OpenFInpFile(UnIn, FileName, ErrStat2, ErrMsg2); if(Failed()) return - CALL ReadCom(UnIn, FileName, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc); if(Failed()) return - CALL ReadVar(UnIn, FileName, sizere, 'sizere', 'Echo flag', ErrStat2, ErrMsg2, UnEc); if(Failed()) return + CALL ReadCom(UnIn, FileName, 'Reynolds number List', ErrStat2, ErrMsg2); if(Failed()) return + CALL ReadVar(UnIn, FileName, nRe, 'nRe', 'nRe', ErrStat2, ErrMsg2); if(Failed()) return ! Allocations done only once! - IF (I .eq. 1) THEN - CALL AllocAry( InputFileData%ReListXfoil,sizere, 'InputFileData%ReListXfoil', ErrStat2, ErrMsg2); if(Failed()) return + if (iAF .eq. 1) then + if(allocated(InputFileData%ReListXfoil)) deallocate(InputFileData%ReListXfoil) + CALL AllocAry( InputFileData%ReListXfoil,nRe, 'InputFileData%ReListXfoil', ErrStat2, ErrMsg2); if(Failed()) return endif - - DO cou=1,sizere - CALL ReadVar( UnIn, FileName, InputFileData%ReListXfoil(cou), 'InputFileData%ReListXfoil','Echo flag', ErrStat2, ErrMsg2, UnEc); if(Failed()) return - ENDDO - CALL ReadCom(UnIn, FileName, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc); if(Failed()) return - CALL ReadVar(UnIn, FileName, sizeaoa, 'sizeaoa', 'Echo flag', ErrStat2, ErrMsg2, UnEc); if(Failed()) return + do iRe=1,nRe + CALL ReadVar( UnIn, FileName, InputFileData%ReListXfoil(iRe), 'InputFileData%ReListXfoil','ReListXfoil', ErrStat2, ErrMsg2); if(Failed()) return + enddo + CALL ReadCom(UnIn, FileName, '', ErrStat2, ErrMsg2); if(Failed()) return + CALL ReadVar(UnIn, FileName, nAoA, 'nAoA', 'nAoA', ErrStat2, ErrMsg2); if(Failed()) return ! Allocations done only once! - IF (I .eq. 1) THEN - CALL AllocAry( InputFileData%AoAListXfoil,sizeaoa, 'InputFileData%AoAListXfoil', ErrStat2, ErrMsg2); if(Failed()) return + if (iAF.eq. 1) then + CALL AllocAry( InputFileData%AoAListXfoil,nAoA, 'InputFileData%AoAListXfoil', ErrStat2, ErrMsg2); if(Failed()) return + CALL AllocAry(InputFileData%Pres_DispThick ,nAoA,nRe,nAirfoils,'InputFileData%Pres_DispThick' ,ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Suct_DispThick ,nAoA,nRe,nAirfoils,'InputFileData%Suct_DispThick' ,ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Pres_BLThick ,nAoA,nRe,nAirfoils,'InputFileData%Pres_BLThick' ,ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Suct_BLThick ,nAoA,nRe,nAirfoils,'InputFileData%Suct_BLThick' ,ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Pres_Cf ,nAoA,nRe,nAirfoils,'InputFileData%Pres_Cf' ,ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Suct_Cf ,nAoA,nRe,nAirfoils,'InputFileData%Suct_Cf' ,ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(InputFileData%Pres_EdgeVelRat,nAoA,nRe,nAirfoils,'InputFileData%Pres_EdgeVelRat',ErrStat2,ErrMsg2); if(Failed())return + CALL AllocAry(InputFileData%Suct_EdgeVelRat,nAoA,nRe,nAirfoils,'InputFileData%Suct_EdgeVelRat',ErrStat2,ErrMsg2); if (Failed())return + CALL AllocAry(Buffer,8,nAoA*nRe, 'Buffer', ErrStat2, ErrMsg2); if(Failed()) return endif - DO cou=1,sizeaoa - CALL ReadVar( UnIn, FileName, InputFileData%AoAListXfoil(cou), 'InputFileData%AoAListXfoil','Echo flag', ErrStat2, ErrMsg2, UnEc); if(Failed()) return - ENDDO - IF (I .eq. 1) THEN - CALL AllocAry(InputFileData%Pres_DispThick,sizeaoa,sizere, BldNodes,'InputFileData%Pres_DispThick', ErrStat2, ErrMsg2);if(Failed()) return - CALL AllocAry(InputFileData%Suct_DispThick,sizeaoa,sizere, BldNodes,'InputFileData%Suct_DispThick', ErrStat2, ErrMsg2);if(Failed()) return - CALL AllocAry(InputFileData%Pres_BLThick,sizeaoa,sizere, BldNodes,'InputFileData%Pres_BLThick', ErrStat2, ErrMsg2);if(Failed()) return - CALL AllocAry(InputFileData%Suct_BLThick,sizeaoa,sizere, BldNodes,'InputFileData%Suct_BLThick', ErrStat2, ErrMsg2);if(Failed()) return - CALL AllocAry(InputFileData%Pres_Cf,sizeaoa,sizere, BldNodes,'InputFileData%Pres_Cf', ErrStat2, ErrMsg2);if(Failed()) return - CALL AllocAry(InputFileData%Suct_Cf,sizeaoa,sizere, BldNodes,'InputFileData%Suct_Cf', ErrStat2, ErrMsg2);if(Failed()) return - CALL AllocAry(InputFileData%Pres_EdgeVelRat,sizeaoa,sizere, BldNodes,'InputFileData%Pres_EdgeVelRat', ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(InputFileData%Suct_EdgeVelRat,sizeaoa,sizere, BldNodes,'InputFileData%Suct_EdgeVelRat', ErrStat2, ErrMsg2);if(Failed()) return - CALL AllocAry( temp1,8,sizeaoa*sizere, 'InputFileData%Suct_Cf', ErrStat2, ErrMsg2); if(Failed()) return - ENDIF + ! Reading AoA + do iAoA=1,nAoA + CALL ReadVar( UnIn, FileName, InputFileData%AoAListXfoil(iAoA), 'InputFileData%AoAListXfoil','AoAListXfoil', ErrStat2, ErrMsg2); if(Failed()) return + enddo + ! 6 dummy lines + do iDummy=1,6 + CALL ReadCom( UnIn, FileName, '', ErrStat2, ErrMsg2); if(Failed()) return + enddo + ! Reading all values in an array + do iBuffer=1,size(Buffer,1) + read(UnIn,*) Buffer(iBuffer,:) ! TOdo error handling + enddo - DO cou1=1,6 - CALL ReadCom( UnIn, FileName, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc ); if(Failed()) return - ENDDO - - DO cou1=1,size(temp1,1) - read(UnIn,*) temp1(cou1,:) ! TODO error handling - ENDDO - - loop1=0 - DO cou1=1,sizeaoa - DO cou=1,sizere - loop1=loop1+1 - InputFileData%Pres_BLThick(cou1,cou,I) = temp1(1,loop1) - InputFileData%Pres_DispThick(cou1,cou,I) = temp1(2,loop1) - InputFileData%Pres_Cf(cou1,cou,I) = temp1(3,loop1) - InputFileData%Pres_EdgeVelRat(cou1,cou,I) = temp1(4,loop1) - InputFileData%Suct_BLThick(cou1,cou,I) = temp1(5,loop1) - InputFileData%Suct_DispThick(cou1,cou,I) = temp1(6,loop1) - InputFileData%Suct_Cf(cou1,cou,I) = temp1(7,loop1) - InputFileData%Suct_EdgeVelRat(cou1,cou,I) = temp1(8,loop1) - ENDDO - ENDDO + iBuffer=0 + do iAoA=1,nAoA + do iRe=1,nRe + iBuffer=iBuffer+1 + InputFileData%Pres_BLThick (iAoA,iRe,iAF)= Buffer(1,iBuffer) ! d99All2 + InputFileData%Pres_DispThick (iAoA,iRe,iAF)= Buffer(2,iBuffer) ! dStarAll2 + InputFileData%Pres_Cf (iAoA,iRe,iAF)= Buffer(3,iBuffer) ! CfAll2 + InputFileData%Pres_EdgeVelRat(iAoA,iRe,iAF)= Buffer(4,iBuffer) ! EdgeVelRat2 + InputFileData%Suct_BLThick (iAoA,iRe,iAF)= Buffer(5,iBuffer) ! d99All1 + InputFileData%Suct_DispThick (iAoA,iRe,iAF)= Buffer(6,iBuffer) ! dStarAll1 + InputFileData%Suct_Cf (iAoA,iRe,iAF)= Buffer(7,iBuffer) ! CfAll1 + InputFileData%Suct_EdgeVelRat(iAoA,iRe,iAF)= Buffer(8,iBuffer) ! EdgeVelRat1 + enddo + enddo !---------------------- END OF FILE ----------------------------------------- - ENDDO + enddo ! Loop on airfoils CALL Cleanup( ) CONTAINS logical function Failed() @@ -524,7 +526,77 @@ SUBROUTINE Cleanup() END SUBROUTINE Cleanup END SUBROUTINE ReadXfoilTables !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE REadTICalcTables( InputFile,InputFileData, ErrStat, ErrMsg ) +!> Writes Tabulated Xfoil Tables +SUBROUTINE WriteXfoilTables(p, ErrStat, ErrMsg ) + type(AA_ParameterType), INTENT(IN) :: p !< Parameters + integer(IntKi), intent(out) :: ErrStat ! Error status + character(*), intent(out) :: ErrMsg ! Error message + ! Local variables: + integer(IntKi) :: UnOut ! Unit number for output + character(1024) :: FileName ! Output filename + integer(IntKi) :: nRe, nAoA ! Number of Reynolds number and angle of attack listed + integer(IntKi) :: iAF , iRe, iAoA ! loop counters + ! Initialize some variables: + ErrStat = ErrID_None + ErrMsg = "" + + ! Writting to file + do iAF=1,size(p%dStarAll1,3) + write(FileName,'(A,I0,A)')'AF',iAF,'.txt' + call OpenFOutFile(UnOut,trim(FileName), ErrStat, ErrMsg) + if ( ErrStat >= AbortErrLev ) return + write(UnOut,'(A)') 'Reynolds number List' + write(UnOut,'(I0)') size(p%ReListXfoil) + do iRe=1,size(p%ReListXfoil) + write(UnOut,'(F13.1)') p%ReListXfoil(iRe) + enddo + write(UnOut,'(A)') 'Angle of Attack List' + write(UnOut,'(I0)') size(p%AoAListXfoil) + do iAoA=1,size(p%AoAListXfoil) + write(UnOut,'(F7.2)') p%AoAListXfoil(iAoA) + enddo + write(UnOut,'(A)') 'The 8 lines following this comment contain:' + write(UnOut,'(A)') ' - Line 1: PressureSide BLThick - Line 5: SuctionSide BLThick' + write(UnOut,'(A)') ' - Line 2: PressureSide DispThick - Line 6: SuctionSide DispThick' + write(UnOut,'(A)') ' - Line 3: PressureSide CF - Line 7: SuctionSide Cf' + write(UnOut,'(A)') ' - Line 4: PressureSide EdgeVelRat - Line 8: SuctionSide EdgeVelRat' + write(UnOut,'(A)') 'The values on a line are set with a loop on AoA (slowest index) followed with one on the Re (fastest index)' + do iAoA=1,size(p%dStarAll1,1); do iRe=1,size(p%dStarAll1,2) + write(UnOut,'(F10.6)', advance='no') p%d99All2(iAoA,iRe,iAF) ! Line 1 Pres_BLThick + enddo; enddo + write(UnOut,'(A)')'' + do iAoA=1,size(p%dStarAll1,1); do iRe=1,size(p%dStarAll1,2) + write(UnOut,'(F10.6)', advance='no') p%dStarAll2(iAoA,iRe,iAF) ! Line 2 Pres_DispThick + enddo; enddo + write(UnOut,'(A)')'' + do iAoA=1,size(p%dStarAll1,1); do iRe=1,size(p%dStarAll1,2) + write(UnOut,'(F10.6)', advance='no') p%CfAll2(iAoA,iRe,iAF) ! Line 3 Pres_CF + enddo; enddo + write(UnOut,'(A)')'' + do iAoA=1,size(p%dStarAll1,1); do iRe=1,size(p%dStarAll1,2) + write(UnOut,'(F10.6)', advance='no') p%EdgeVelRat2(iAoA,iRe,iAF) ! Line 4, Pres_EdgeVelRat + enddo; enddo + write(UnOut,'(A)')'' + do iAoA=1,size(p%dStarAll1,1); do iRe=1,size(p%dStarAll1,2) + write(UnOut,'(F10.6)', advance='no') p%d99All1(iAoA,iRe,iAF) ! Line 5, Suct_BLThick + enddo; enddo + write(UnOut,'(A)')'' + do iAoA=1,size(p%dStarAll1,1); do iRe=1,size(p%dStarAll1,2) + write(UnOut,'(F10.6)', advance='no') p%dStarAll1(iAoA,iRe,iAF)! Line 6, Suct_DispThick + enddo; enddo + write(UnOut,'(A)')'' + do iAoA=1,size(p%dStarAll1,1); do iRe=1,size(p%dStarAll1,2) + write(UnOut,'(F10.6)', advance='no') p%CfAll1(iAoA,iRe,iAF)! Line 7, Suct_Cf + enddo; enddo + write(UnOut,'(A)')'' + do iAoA=1,size(p%dStarAll1,1); do iRe=1,size(p%dStarAll1,2) + write(UnOut,'(F10.6)', advance='no') p%EdgeVelRat1(iAoA,iRe,iAF)! Line 8, Suct_EdgeVelRat + enddo; enddo + enddo ! Loop on number of airfoils + +END SUBROUTINE WriteXfoilTables +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE ReadTICalcTables(InputFile, InputFileData, ErrStat, ErrMsg) ! Passed variables integer(IntKi), intent(out) :: ErrStat ! Error status character(*), intent(out) :: ErrMsg ! Error message @@ -544,7 +616,7 @@ SUBROUTINE REadTICalcTables( InputFile,InputFileData, ErrStat, ErrMsg ) character(*), parameter :: RoutineName = 'REadTICalcTables' integer(IntKi) :: GridY ! integer(IntKi) :: GridZ ! - integer(IntKi) :: cou1,UnEc ! loop counter + integer(IntKi) :: cou1 ! Initialize some variables: ErrStat = ErrID_None ErrMsg = "" @@ -556,21 +628,21 @@ SUBROUTINE REadTICalcTables( InputFile,InputFileData, ErrStat, ErrMsg ) CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2); call check() CALL OpenFInpFile ( UnIn, FileName, ErrStat2, ErrMsg2 ); if(Failed()) return - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2, UnEc); call check - CALL ReadVar(UnIn, FileName, GridY, 'GridY', 'Echo flag', ErrStat2, ErrMsg2, UnEc); call check - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2, UnEc );call check - CALL ReadVar(UnIn, FileName, GridZ, 'GridZ', 'Echo flag', ErrStat2, ErrMsg2, UnEc); call check - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2, UnEc); call check - CALL ReadVar(UnIn, FileName, InputFileData%dy_turb_in, 'InputFileData%dy_turb_in', 'Echo flag', ErrStat2, ErrMsg2, UnEc); call check - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2, UnEc); call check - CALL ReadVar(UnIn, FileName, InputFileData%dz_turb_in, 'InputFileData%dz_turb_in', 'Echo flag', ErrStat2, ErrMsg2, UnEc); call check + CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check + CALL ReadVar(UnIn, FileName, GridY, 'GridY', 'Echo flag', ErrStat2, ErrMsg2); call check + CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2);call check + CALL ReadVar(UnIn, FileName, GridZ, 'GridZ', 'Echo flag', ErrStat2, ErrMsg2); call check + CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check + CALL ReadVar(UnIn, FileName, InputFileData%dy_turb_in, 'InputFileData%dy_turb_in', 'Echo flag', ErrStat2, ErrMsg2); call check + CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2); call check + CALL ReadVar(UnIn, FileName, InputFileData%dz_turb_in, 'InputFileData%dz_turb_in', 'Echo flag', ErrStat2, ErrMsg2); call check if(Failed()) return CALL AllocAry( InputFileData%TI_Grid_In,GridZ,GridY,'InputFileData%TI_Grid_In', ErrStat2, ErrMsg2); if(Failed()) return DO cou1=1,size(InputFileData%TI_Grid_In,1) read(UnIn,*) InputFileData%TI_Grid_In(cou1,:) - ENDDO + ENDDO !---------------------- END OF FILE ----------------------------------------- CALL Cleanup( ) @@ -587,6 +659,76 @@ SUBROUTINE Cleanup() IF (UnIn > 0) CLOSE ( UnIn ) END SUBROUTINE Cleanup END SUBROUTINE REadTICalcTables +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine validates the inputs from the AeroDyn input files. +SUBROUTINE ValidateInputData( InputFileData, NumBl, ErrStat, ErrMsg ) + type(AA_InputFile), intent(in) :: InputFileData !< All the data in the AeroDyn input file + integer(IntKi), intent(in) :: NumBl !< Number of blades + integer(IntKi), intent(out) :: ErrStat !< Error status + character(*), intent(out) :: ErrMsg !< Error message + ! local variables + integer(IntKi) :: k ! Blade number + integer(IntKi) :: j ! node number + character(*), parameter :: RoutineName = 'ValidateInputData' + ErrStat = ErrID_None + ErrMsg = "" + if (NumBl > MaxBl .or. NumBl < 1) call SetErrStat( ErrID_Fatal, 'Number of blades must be between 1 and '//trim(num2lstr(MaxBl))//'.', ErrSTat, ErrMsg, RoutineName ) + if (InputFileData%DTAero <= 0.0) call SetErrStat ( ErrID_Fatal, 'DTAero must be greater than zero.', ErrStat, ErrMsg, RoutineName ) + if (InputFileData%IBLUNT /= IBLUNT_None .and. InputFileData%IBLUNT /= IBLUNT_BPM) then + call SetErrStat ( ErrID_Fatal, & + 'IBLUNT must '//trim(num2lstr(IBLUNT_None))//' (none) or '//trim(num2lstr(IBLUNT_BPM))//' (Bluntness noise calculated).', ErrStat, ErrMsg, RoutineName ) + endif + if (InputFileData%ILAM /= ILAM_None .and. InputFileData%ilam /= ILAM_BPM) then + call SetErrStat ( ErrID_Fatal, 'ILAM must be '//trim(num2lstr(ILAM_None))//' No calculation '//& + trim(num2lstr(ILAM_BPM))//' (ILAM Calculated).', ErrStat, ErrMsg, RoutineName ) + end if + if (InputFileData%ITIP /= ITIP_None .and. InputFileData%ITIP /= ITIP_ON) then + call SetErrStat ( ErrID_Fatal, 'ITIP must be '//trim(num2lstr(ITIP_None))//' (Off) or '//& + trim(num2lstr(ITIP_On))//' (ITIP On).', ErrStat, ErrMsg, RoutineName ) + end if + if (InputFileData%ITRIP /= ITRIP_None .and. InputFileData%ITRIP /= ITRIP_Heavy .and. InputFileData%ITRIP /= ITRIP_Light) then + call SetErrStat ( ErrID_Fatal,'ITRIP must be '//trim(num2lstr(ITRIP_None))//' (none) or '//trim(num2lstr(ITRIP_Heavy))//& + ' (heavily tripped BL Calculation) or '//trim(num2lstr(ITRIP_Light))//' (lightly tripped BL)' ,ErrStat, ErrMsg, RoutineName ) + end if + if (InputFileData%ITURB /= ITURB_None .and. InputFileData%ITURB /= ITURB_BPM .and. InputFileData%ITURB /= ITURB_TNO) then + call SetErrStat ( ErrID_Fatal, 'ITURB must be 0 (off) or 1 (BPM) or 2 (TNO) .', ErrStat, ErrMsg, RoutineName ) + end if + if (InputFileData%IInflow /= IInflow_None .and. InputFileData%IInflow /= IInflow_BPM & + .and. InputFileData%IInflow /= IInflow_FullGuidati .and. InputFileData%IInflow /= IInflow_SimpleGuidati ) then + call SetErrStat ( ErrID_Fatal, 'IInflow must be 0 (off) or 1 (only Amiet) or 2 (Full Guidati)'//& + 'or 3 (Simple Guidati).', ErrStat, ErrMsg, RoutineName ) + end if + if (InputFileData%TICalcMeth /= TICalc_Every .and. InputFileData%TICalcMeth /= TICalc_Interp ) then + call SetErrStat ( ErrID_Fatal, 'TICalcMeth must be '//trim(num2lstr(TICalc_Every))//' TICalc automatic or '//& + trim(num2lstr(TICalc_Interp))//' (TICalcMeth interp).', ErrStat, ErrMsg, RoutineName ) + end if + + if (InputFileData%X_BLMethod /= X_BLMethod_BPM .and. InputFileData%X_BLMethod /= X_BLMethod_Xfoil) then + call SetErrStat ( ErrID_Fatal, 'X_BLMethod must be '//trim(num2lstr(X_BLMethod_BPM))//' X_BLMethod_ with BPM or '//& + trim(num2lstr(X_BLMethod_Xfoil))//' (X_BLMethod with Xfoil).', ErrStat, ErrMsg, RoutineName ) + end if + if (InputFileData%XfoilCall < 0 .or. InputFileData%XfoilCall > 2 ) then + call SetErrStat ( ErrID_Fatal, 'XfoilCall must be 0, 1, or 2.', ErrStat, ErrMsg, RoutineName ) + end if + if (InputFileData%XfoilCall==XfoilCall_Tabulate) then + if (size(InputFileData%ReListXfoil)<=0) then + call SetErrStat(ErrID_Fatal, 'When using `XfoilCall=1`, the Reynolds list `ReListBl` should not be empty', ErrStat, ErrMsg, RoutineName) + else if (int(InputFileData%AlphaLinsp(3))<=0) then + call SetErrStat(ErrID_Fatal, 'When using `XfoilCall=1`, the length of the "linear space" of angle of attacks `AlphaLinsp` should not be empty', ErrStat,ErrMsg, RoutineName) + endif + endif + if (InputFileData%NrObsLoc <= 0.0) call SetErrStat ( ErrID_Fatal, 'Number of Observer Locations should be greater than zero', ErrStat, ErrMsg, RoutineName ) + if (InputFileData%NrOutFile /= 0 .and. InputFileData%NrOutFile /= 1 .and. InputFileData%NrOutFile /= 2 .and. InputFileData%NrOutFile /= 3 & + .and. InputFileData%NrOutFile /= 4) then + call SetErrStat ( ErrID_Fatal, ' NrOutFile must be 0 or 1 or 2 or 3 or 4', ErrStat, ErrMsg, RoutineName ) + end if + if (InputFileData%Comp_AA_After .eq.0 ) then + call SetErrStat ( ErrID_Fatal, ' Comp_AA_After variable in aeroacustics input must be more than 0', ErrStat, ErrMsg, RoutineName ) + end if + if (InputFileData%saveeach .eq. 0 ) then + call SetErrStat ( ErrID_Fatal, ' saveeach variable in aeroacustics input must be more than 0', ErrStat, ErrMsg, RoutineName ) + end if +END SUBROUTINE ValidateInputData !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE AA_PrintSum( InputFileData, p, u, y, ErrStat, ErrMsg ) @@ -606,6 +748,8 @@ SUBROUTINE AA_PrintSum( InputFileData, p, u, y, ErrStat, ErrMsg ) CHARACTER(30) :: OutPFmt ! Format to print list of selected output channels to summary file CHARACTER(100) :: Msg ! temporary string for writing appropriate text to summary file ! Open the summary file and give it a heading. + ErrStat = ErrID_None + ErrMsg = "" RETURN END SUBROUTINE AA_PrintSum !.................................................................................................................................. @@ -661,7 +805,7 @@ subroutine AA_SetInitOut(p, InputFileData, InitOut, errStat, errMsg) InitOut%WriteOutputHdrforPE(i) = "F"//trim(num2lstr(p%FreqList(k)))//"Obs"//trim(num2lstr(j))//"Bl"//trim(num2lstr(m)) InitOut%WriteOutputUntforPE(i) = "Coord"//trim(num2lstr(oi)) enddo - enddo + enddo end do enddo ! THIRD FILE HEADER,UNIT @@ -947,7 +1091,7 @@ SUBROUTINE Calc_WriteOutput( p, u, m, y, ErrStat, ErrMsg ) ! InitOut%WriteOutputHdr(i) = "Bl "//trim(num2lstr(m))//" Nd "//trim(num2lstr(k))//" Obs "//trim(num2lstr(j)) ! InitOut%WriteOutputUnt(i) = "SPL" enddo - enddo + enddo enddo endif ! FOR THE SECOND OUTPUT FILE @@ -977,7 +1121,7 @@ SUBROUTINE Calc_WriteOutput( p, u, m, y, ErrStat, ErrMsg ) y%WriteOutputSep(counter) = y%OASPL_Mech(oi,k,j,i) enddo enddo - enddo + enddo enddo ENDIF ! FOR THE FOURTH OUTPUT FILE diff --git a/modules/aerodyn/src/AeroAcoustics/AeroAcoustics_IO_Bad.f90 b/modules/aerodyn/src/AeroAcoustics/AeroAcoustics_IO_Bad.f90 deleted file mode 100644 index 0b24ae91a..000000000 --- a/modules/aerodyn/src/AeroAcoustics/AeroAcoustics_IO_Bad.f90 +++ /dev/null @@ -1,804 +0,0 @@ -!********************************************************************************************************************************** -! LICENSING -! Copyright (C) 2015-2016 National Renewable Energy Laboratory -! -! This file is part of Noise. -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -! -!********************************************************************************************************************************** -! File last committed: $Date$ -! (File) Revision #: $Rev$ -! URL: $HeadURL$ -!********************************************************************************************************************************** -MODULE AeroAcoustics_IO - - use NWTC_Library - use AeroAcoustics_Types - - implicit none - - type(ProgDesc), parameter :: AA_Ver = ProgDesc( 'AeroAcoustics', 'v1.00.00', '18-Aug-2016' ) - character(*), parameter :: AA_Nickname = 'AA' - -! =================================================================================================== -! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" -! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these -! lines should be modified in the Matlab script and/or Excel worksheet as necessary. -! =================================================================================================== -! This code was generated by Write_ChckOutLst.m at 11-Mar-2016 14:45:58. - - ! Indices for computing output channels: - ! NOTES: - ! (1) These parameters are in the order stored in "OutListParameters.xlsx" - ! (2) Array AllOuts() must be dimensioned to the value of the largest output parameter - - ! Time: - - INTEGER(IntKi), PARAMETER :: Time = 0 - - ! Parameters related to output length (number of characters allowed in the output data headers): - - INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 - - INTEGER(IntKi), PARAMETER :: MaxBl = 3 ! Maximum number of blades allowed in simulation - - ! model identifiers - integer(intKi), parameter :: ModelUnknown = -1 - -! FLAG TO COMPUTE BLUNTNESS NOISE = 0 No, =1 Yes - integer(intKi), parameter :: IBLUNT_None = 0 - integer(intKi), parameter :: IBLUNT_BPM = 1 - -! FLAG TO COMPUTE Laminar Boundary Layer Noise = 0 No, =1 Yes - integer(intKi), parameter :: ILAM_None = 0 ! steady model - integer(intKi), parameter :: ILAM_BPM = 1 ! - -! FLAG TO COMPUTE Tip Noise = 0 No, =1 Yes - integer(intKi), parameter :: ITIP_None = 0 ! - integer(intKi), parameter :: ITIP_On = 1 ! - - integer(intKi), parameter :: ITRIP_None = 0 ! not tripped boundary layer - integer(intKi), parameter :: ITRIP_Heavy = 1 ! heavily tripped boundary layer - integer(intKi), parameter :: ITRIP_Light = 2 ! light tripped boundary layer - -! calculation method for boundary layer properties, = 1 BPM = 2 Xfoil - integer(intKi), parameter :: X_BLMethod_BPM = 1 ! - integer(intKi), parameter :: X_BLMethod_Xfoil = 2 ! - - integer(intKi), parameter :: XfoilCall_Interp = 1 ! interpolate from pretabulated - integer(intKi), parameter :: XfoilCall_Every = 2 ! call xfoil for each each time step - - integer(intKi), parameter :: TICalc_Interp = 1 ! interpolate from pretabulated - integer(intKi), parameter :: TICalc_Every = 2 ! calculate ti automatically - - integer(intKi), parameter :: ITURB_None = 0 ! TBLTE noise is not calculated - integer(intKi), parameter :: ITURB_BPM = 1 ! TBLTE noise is calculated with BPM - integer(intKi), parameter :: ITURB_TNO = 2 ! TBLTE noise is calculated with TNO - - integer(intKi), parameter :: IInflow_None = 0 ! IInflow noise is not calculated - integer(intKi), parameter :: IInflow_BPM = 1 ! IInflow noise is calculated with BPM - integer(intKi), parameter :: IInflow_FullGuidati = 2 ! IInflow noise is calculated with FullGuidati - integer(intKi), parameter :: IInflow_SimpleGuidati = 3 ! IInflow noise is calculated with SimpleGuidati - - integer(intKi), parameter :: AweightFlagOn = 1 ! - integer(intKi), parameter :: AweightFlagOff = 0 - - INTEGER(IntKi), PARAMETER :: MaxOutPts = 1103 -contains -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadInputFiles( InputFileName, InputFileData, Default_DT, OutFileRoot, NumBlades, UnEcho, ErrStat, ErrMsg ) - ! This subroutine reads the input file and stores all the data in the AA_InputFile structure. - ! It does not perform data validation. - !.................................................................................................................................. - ! Passed variables - REAL(DbKi), INTENT(IN) :: Default_DT ! The default DT (from glue code) - CHARACTER(*), INTENT(IN) :: InputFileName ! Name of the input file - CHARACTER(*), INTENT(IN) :: OutFileRoot ! The rootname of all the output files written by this routine. - TYPE(AA_InputFile), INTENT(OUT) :: InputFileData ! Data stored in the module's input file - INTEGER(IntKi), INTENT(OUT) :: UnEcho ! Unit number for the echo file - INTEGER(IntKi), INTENT(IN) :: NumBlades ! Number of blades for this model - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! The error status code - CHARACTER(*), INTENT(OUT) :: ErrMsg ! The error message, if an error occurred - ! local variables - INTEGER(IntKi) :: I - INTEGER(IntKi) :: ErrStat2 ! The error status code - CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred - CHARACTER(1024) :: AABlFile(MaxBl) ! File that contains the blade information (specified in the primary input file) - LOGICAL :: readinornot ! The error status code - CHARACTER(*), PARAMETER :: RoutineName = 'ReadInputFiles' - ! initialize values: - ErrStat = ErrID_None - ErrMsg = '' - UnEcho = -1 - InputFileData%DTAero = Default_DT ! the glue code's suggested DT for the module (may be overwritten in ReadPrimaryFile()) - - ! get the primary/platform input-file data - ! sets UnEcho, AABlFile - - CALL ReadPrimaryFile( InputFileName, InputFileData, AABlFile, OutFileRoot, UnEcho, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - ! get the blade input-file data - - ALLOCATE( InputFileData%BladeProps( NumBlades ), STAT = ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating memory for BladeProps.", ErrStat, ErrMsg, RoutineName) - CALL Cleanup() - RETURN - END IF - - do i = 1,NumBlades - ! TODO: Make AABlFile an array (DONE) - CALL ReadBladeInputs ( AABlFile(i), InputFileData%BladeProps(i), UnEcho, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName//TRIM(':Blade')//TRIM(Num2LStr(I))) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - end do - - readinornot=.true. - IF( (InputFileData%XfoilCall.eq.1) .and. (InputFileData%ITURB.eq.2) ) THEN - CALL ReadXfoilTables( InputFileName,InputFileData, InputFileData%BladeProps(1)%NumBlNds, ErrStat2, ErrMsg2 ) - readinornot=.false. - ENDIF - - IF( (InputFileData%XfoilCall.eq.1) .and. (InputFileData%X_BLMethod.eq.2) .and. (readinornot) ) THEN - CALL ReadXfoilTables( InputFileName,InputFileData, InputFileData%BladeProps(1)%NumBlNds, ErrStat2, ErrMsg2 ) - ENDIF - - IF( (InputFileData%TICalcMeth.eq.1) ) THEN - CALL REadTICalcTables(InputFileName,InputFileData, ErrStat2, ErrMsg2 ) - ENDIF - - CALL Cleanup ( ) - -CONTAINS - !............................................................................................................................... - SUBROUTINE Cleanup() - END SUBROUTINE Cleanup - -END SUBROUTINE ReadInputFiles -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, AABlFile, OutFileRoot, UnEc, ErrStat, ErrMsg ) - ! This routine reads in the primary Noise input file and places the values it reads in the InputFileData structure. - ! It opens and prints to an echo file if requested. - !.................................................................................................................................. - ! Passed variables - integer(IntKi), intent(out) :: UnEc ! I/O unit for echo file. If > 0, file is open for writing. - integer(IntKi), intent(out) :: ErrStat ! Error status - character(*), intent(out) :: AABlFile(MaxBl) ! name of the files containing blade inputs - - character(*), intent(in) :: InputFile ! Name of the file containing the primary input data - character(*), intent(out) :: ErrMsg ! Error message - character(*), intent(in) :: OutFileRoot ! The rootname of the echo file, possibly opened in this routine - - type(AA_InputFile), intent(inout) :: InputFileData ! All the data in the Noise input file - - ! Local variables: - real(ReKi) :: TmpAry(3) ! array to help read tower properties table - integer(IntKi) :: I ! loop counter - integer(IntKi) :: UnIn,UnIn2 ! Unit number for reading file - integer(IntKi) :: loop1 ! loop counter - character(1024) :: ObserverFile ! name of the files containing obesever location - integer(IntKi) :: ErrStat2, IOS,cou ! Temporary Error status - logical :: Echo ! Determines if an echo file should be written - character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message - character(1024) :: PriPath ! Path name of the primary file - character(1024) :: FTitle ! "File Title": the 2nd line of the input file, which contains a description of its contents - character(200) :: Line ! Temporary storage of a line from the input file (to compare with "default") - character(*), parameter :: RoutineName = 'ReadPrimaryFile' - - - ! Initialize some variables: - ErrStat = ErrID_None - ErrMsg = "" - - UnEc = -1 - Echo = .FALSE. - CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - ! Get an available unit number for the file. - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Open the Primary input file. - CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - ! Read the lines up/including to the "Echo" simulation control variable - ! If echo is FALSE, don't write these lines to the echo file. - ! If Echo is TRUE, rewind and write on the second try. - I = 1 !set the number of times we've read the file - DO - !----------- HEADER ------------------------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ReadStr( UnIn, InputFile, FTitle, 'FTitle', 'File Header: File Description (line 2)', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !----------- GENERAL OPTIONS ---------------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: General Options', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! Echo - Echo input to ".AD.ech". - CALL ReadVar( UnIn, InputFile, Echo, 'Echo', 'Echo flag', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (.NOT. Echo .OR. I > 1) EXIT !exit this loop - ! Otherwise, open the echo file, then rewind the input file and echo everything we've read - I = I + 1 ! make sure we do this only once (increment counter that says how many times we've read this file) - CALL OpenEcho ( UnEc, TRIM(OutFileRoot)//'.ech', ErrStat2, ErrMsg2, AA_Ver ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - IF ( UnEc > 0 ) WRITE (UnEc,'(/,A,/)') 'Data from '//TRIM(AA_Ver%Name)//' primary input file "'//TRIM( InputFile )//'":' - REWIND( UnIn, IOSTAT=ErrStat2 ) - IF (ErrStat2 /= 0_IntKi ) THEN - CALL SetErrStat( ErrID_Fatal, 'Error rewinding file "'//TRIM(InputFile)//'".', ErrStat, ErrMsg, RoutineName ) - CALL Cleanup() - RETURN - END IF - END DO - - IF (NWTC_VerboseLevel == NWTC_Verbose) THEN - CALL WrScr( ' Heading of the '//TRIM(AA_Ver%Name)//' input file: ' ) - CALL WrScr( ' '//TRIM( FTitle ) ) - END IF - - ! DTAero - Time interval for aerodynamic calculations {or default} (s): - Line = "" - CALL ReadVar( UnIn, InputFile, Line, "DTAero", "Time interval for aerodynamic calculations {or default} (s)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Conv2UC( Line ) - IF ( INDEX(Line, "DEFAULT" ) /= 1 ) THEN ! If it's not "default", read this variable; otherwise use the value already stored in InputFileData%DTAero - READ( Line, *, IOSTAT=IOS) InputFileData%DTAero - CALL CheckIOS ( IOS, InputFile, 'DTAero', NumType, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END IF - CALL ReadVar( UnIn, InputFile, InputFileData%Comp_AA_After, "Comp_AA_After", "Comp_AA_After", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ReadVar( UnIn, InputFile, InputFileData%saveeach, "saveeach", "saveeach", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! IBLUNT - FLAG TO COMPUTE BLUNTNESS NOISE - CALL ReadVar( UnIn, InputFile, InputFileData%IBLUNT, "IBLUNT", "FLAG TO COMPUTE BLUNTNESS NOISE {} (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! ILAM - FLAG TO COMPUTE LBL NOISE - CALL ReadVar( UnIn, InputFile, InputFileData%ILAM, "ILAM", "FLAG TO COMPUTE LBL NOISE {} (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! ITIP - FLAG TO COMPUTE TIP NOISE - CALL ReadVar( UnIn, InputFile, InputFileData%ITIP, "ITIP", "FLAG TO COMPUTE TIP NOISE {} (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! ITRIP - FLAG TO TRIP BOUNDARY LAYER - CALL ReadVar( UnIn, InputFile, InputFileData%ITRIP, "ITRIP", "FLAG TO TRIP BOUNDARY LAYER {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! ITURB - FLAG TO COMPUTE TBLTE NOISE - CALL ReadVar( UnIn, InputFile, InputFileData%ITURB, "ITURB", "FLAG TO COMPUTE TBLTE NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! - CALL ReadVar( UnIn, InputFile, InputFileData%IInflow, "IInflow", "FLAG TO COMPUTE Turbulent Inflow NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! - CALL ReadVar( UnIn, InputFile, InputFileData%X_BLMethod, "X_BLMethod", "Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Xfoil", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! - CALL ReadVar( UnIn, InputFile, InputFileData%XfoilCall, "XfoilCall", "Integer describing Xfoil calls, = 1 Interpolate from pretabulated = 2 Call Xfoil for each node etc", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ReadVar( UnIn, InputFile, InputFileData%TICalcMeth, "TICalcMeth", "Integer describing TICalcMeth, = 1 Interpolate from pretabulated = 2 calculate on the fly", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! ROUND - LOGICAL INDICATING ROUNDED TIP - CALL ReadVar( UnIn, InputFile, InputFileData%ROUND, "ROUND", "LOGICAL INDICATING ROUNDED TIP", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! ALPRAT - TIP LIFT CURVE SLOPE and (Default = 1.0) - CALL ReadVar( UnIn, InputFile, InputFileData%ALPRAT, "ALPRAT", "TIP LIFT CURVE SLOPE and (Default = 1.0)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! AA_Bl_Prcntge - The calculations will be carried out for the nodes that are within the user input percntage value. - ! i.e. AA_Bl_Prcntge=60 means;Starting from tip 60% percent of the blade will be contributing to the overall noise levels. - CALL ReadVar( UnIn, InputFile, InputFileData%AA_Bl_Prcntge, "AA_Bl_Prcntge", "-", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! surface roughness - CALL ReadVar( UnIn, InputFile, InputFileData%z0_AA, "z0_AA", "-", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ReadVar( UnIn, InputFile, InputFileData%aweightflag, "aweightflag", "Integer describing a weighting", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !----------- OBSERVER INPUT ------------------------------ - CALL ReadCom( UnIn, InputFile, 'Section Header: Observer Input ', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! NrObsLoc - Nr of Observers (-): - CALL ReadVar( UnIn, InputFile, InputFileData%NrObsLoc, "NrObsLoc", "Nr of Observers (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Observer location in tower-base coordinate X horizontal (m): - CALL AllocAry( InputFileData%ObsX,InputFileData%NrObsLoc, 'ObsX', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! READ( UnIn, *, IOStat=IOS ) InputFileData%ObsX - ! CALL CheckIOS( IOS, 'InputFileData%ObsX', 'InputFileData%ObsX', NumType, ErrStat2, ErrMsg2 ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Observer location in tower-base coordinate Y horizontal (m): - CALL AllocAry( InputFileData%ObsY,InputFileData%NrObsLoc, 'ObsY', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! READ( UnIn, *, IOStat=IOS ) InputFileData%ObsY - ! CALL CheckIOS( IOS, 'InputFileData%ObsY', 'InputFileData%ObsY', NumType, ErrStat2, ErrMsg2 ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Observer location in tower-base coordinate Z horizontal (m): - CALL AllocAry( InputFileData%ObsZ,InputFileData%NrObsLoc, 'ObsZ', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! READ( UnIn, *, IOStat=IOS ) InputFileData%ObsZ - ! CALL CheckIOS( IOS, 'InputFileData%ObsZ', 'InputFileData%ObsZ', NumType, ErrStat2, ErrMsg2 ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - !----- read from observer file - CALL ReadVar ( UnIn, InputFile, ObserverFile, ObserverFile, 'Name of file observer locations', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( PathIsRelative( ObserverFile ) ) ObserverFile = TRIM(PriPath)//TRIM(ObserverFile) - - CALL GetNewUnit( UnIn2, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - CALL OpenFInpFile ( UnIn2, ObserverFile, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) RETURN - - CALL ReadCom( UnIn2, InputFile, ' Header', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - DO cou=1,InputFileData%NrObsLoc - READ( UnIn2, *, IOStat=IOS ) InputFileData%ObsX(cou), InputFileData%ObsY(cou), InputFileData%ObsZ(cou) - CALL CheckIOS( IOS, ObserverFile, 'Obeserver Locations '//TRIM(Num2LStr(cou)), NumType, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! Return on error if we couldn't read this line - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - ENDDO - CLOSE ( UnIn2 ) - !----- end read from observer file - - !----------- ROTOR/BLADE PROPERTIES -------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Rotor/Blade Properties', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! AABlFile - Names of files containing distributed aerodynamic properties for each blade (see AA_BladeInputFile type): - DO I = 1,MaxBl - CALL ReadVar ( UnIn, InputFile, AABlFile(I), 'AABlFile('//TRIM(Num2Lstr(I))//')', 'Name of file containing distributed aerodynamic properties for blade '//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( PathIsRelative( AABlFile(I) ) ) AABlFile(I) = TRIM(PriPath)//TRIM(AABlFile(I)) - END DO - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - - !----------- OUTPUTS ----------------------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Outputs', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! NrObsLoc - Nr of Observers (-): - CALL ReadVar( UnIn, InputFile, InputFileData%NrOutFile, "InputFileData%NrOutFile", "Nr of Output Files (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL AllocAry( InputFileData%AAOutFile,InputFileData%NrOutFile, 'InputFileData%AAOutFile', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ReadVar ( UnIn, InputFile, InputFileData%AAOutFile(1), 'InputFileData%AAOutFile', 'Name of output file ', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - DO I=InputFileData%NrOutFile,1,-1 - ! one file name is given by the user and the XXFile1.out XXFile2.out XXFile3.out is generated - IF ( PathIsRelative( InputFileData%AAOutFile(I) ) ) InputFileData%AAOutFile(I) = TRIM(PriPath)//TRIM(InputFileData%AAOutFile(1))//TRIM(Num2Lstr(I))//".out" - ENDDO - - CALL ReadVar ( UnIn, InputFile, InputFileData%LargeBinOutput, 'InputFileData%LargeBinOutput', 'Name of output file ', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - ! Return on error at end of section - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - !---------------------- END OF FILE ----------------------------------------- - CALL Cleanup( ) - -CONTAINS - !............................................................................................................................... - SUBROUTINE Cleanup() - IF (UnIn > 0) CLOSE ( UnIn ) - END SUBROUTINE Cleanup - !............................................................................................................................... -END SUBROUTINE ReadPrimaryFile -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE ReadBladeInputs ( AABlFile, BladeKInputFileData, UnEc, ErrStat, ErrMsg ) - ! This routine reads a blade input file. - !.................................................................................................................................. - ! Passed variables: - TYPE(AA_BladePropsType), INTENT(INOUT) :: BladeKInputFileData ! Data for Blade K stored in the module's input file - CHARACTER(*), INTENT(IN) :: AABlFile ! Name of the blade input file data - INTEGER(IntKi), INTENT(IN) :: UnEc ! I/O unit for echo file. If present and > 0, write to UnEc - INTEGER(IntKi), INTENT(OUT) :: ErrStat ! Error status - CHARACTER(*), INTENT(OUT) :: ErrMsg ! Error message - ! Local variables: - INTEGER(IntKi) :: I ! A generic DO index. - INTEGER( IntKi ) :: UnIn ! Unit number for reading file - INTEGER(IntKi) :: ErrStat2 , IOS ! Temporary Error status - CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Err msg - CHARACTER(*), PARAMETER :: RoutineName = 'ReadBladeInputs' - ErrStat = ErrID_None - ErrMsg = "" - UnIn = -1 - ! Allocate space for these variables - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL OpenFInpFile ( UnIn, AABlFile, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( ErrStat >= AbortErrLev ) RETURN - ! -------------- HEADER ------------------------------------------------------- - ! Skip the header. - CALL ReadCom ( UnIn, AABlFile, 'unused blade file header line 1', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ReadCom ( UnIn, AABlFile, 'unused blade file header line 2', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! -------------- Blade properties table ------------------------------------------ - CALL ReadCom ( UnIn, AABlFile, 'Section header: Blade Properties', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - ! NumBlNds - Number of blade nodes used in the analysis (-): - CALL ReadVar( UnIn, AABlFile, BladeKInputFileData%NumBlNds, "NumBlNds", "Number of blade nodes used in the analysis (-)", ErrStat2, ErrMsg2, UnEc) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - CALL ReadCom ( UnIn, AABlFile, 'Table header: names', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL ReadCom ( UnIn, AABlFile, 'Table header: units', ErrStat2, ErrMsg2, UnEc ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( ErrStat>= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - ! allocate space for blade inputs: - CALL AllocAry( BladeKInputFileData%TEAngle, BladeKInputFileData%NumBlNds, 'TEAngle', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( BladeKInputFileData%TEThick, BladeKInputFileData%NumBlNds, 'TEThick', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( BladeKInputFileData%StallStart, BladeKInputFileData%NumBlNds, 'StallStart', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! Return on error if we didn't allocate space for the next inputs - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - DO I=1,BladeKInputFileData%NumBlNds - READ( UnIn, *, IOStat=IOS ) BladeKInputFileData%TEAngle(I), BladeKInputFileData%TEThick(I) , BladeKInputFileData%StallStart(I) - CALL CheckIOS( IOS, AABlFile, 'Blade properties row '//TRIM(Num2LStr(I)), NumType, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! Return on error if we couldn't read this line - IF ( ErrStat >= AbortErrLev ) THEN - CALL Cleanup() - RETURN - END IF - IF (UnEc > 0) THEN - WRITE( UnEc, "(6(F9.4,1x),I9)", IOStat=IOS) BladeKInputFileData%TEAngle(I), BladeKInputFileData%TEThick(I), BladeKInputFileData%StallStart(I) - END IF - END DO - ! -------------- END OF FILE -------------------------------------------- - CALL Cleanup() -CONTAINS - !............................................................................................................................... - SUBROUTINE Cleanup() - IF (UnIn > 0) CLOSE(UnIn) - END SUBROUTINE Cleanup -END SUBROUTINE ReadBladeInputs - -SUBROUTINE ReadXfoilTables( InputFile,InputFileData, BldNodes, ErrStat, ErrMsg ) - ! Passed variables - integer(IntKi), intent(out) :: ErrStat ! Error status - character(*), intent(out) :: ErrMsg ! Error message - integer(IntKi), intent(in) :: BldNodes ! Error status - type(AA_InputFile), intent(inout) :: InputFileData ! All the data in the Noise input file - character(*), intent(in) :: InputFile ! Name of the file containing the primary input data - ! Local variables: - integer(IntKi) :: I ! loop counter - integer(IntKi) :: UnIn,UnIn2 ! Unit number for reading file - integer(IntKi) :: loop1 ! loop counter - character(1024) :: FileName ! name of the files containing obesever location - integer(IntKi) :: ErrStat2, IOS,cou ! Temporary Error status - logical :: Echo ! Determines if an echo file should be written - character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message - character(1024) :: PriPath ! Path name of the primary file - character(1024) :: FTitle ! "File Title": the 2nd line of the input file, which contains a description of its contents - character(200) :: Line ! Temporary storage of a line from the input file (to compare with "default") - character(*), parameter :: RoutineName = 'readxfoiltable' - integer(IntKi) :: sizeRe ! - integer(IntKi) :: sizeaoa ! - integer(IntKi) :: cou1,UnEc ! loop counter - real(DbKi),dimension(:,:),ALLOCATABLE :: temp1 - ! Initialize some variables: - ErrStat = ErrID_None - ErrMsg = "" - - CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - DO I=1,BldNodes - IF (InputFileData%ITRIP.eq.0) THEN - FileName = TRIM(PriPath)//'AirfoilsModified/BL/AF'//TRIM(Num2LStr(I))//'.txt' - ELSE - FileName = TRIM(PriPath)//'AirfoilsModified/BL_TRIPPED/AF'//TRIM(Num2LStr(I))//'.txt' - ENDIF - - CALL GetNewUnit(UnIn, ErrStat2, ErrMsg2); if(Failed()) return - CALL OpenFInpFile(UnIn, FileName, ErrStat2, ErrMsg2); if(Failed()) return - - CALL ReadCom( UnIn, FileName, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc); - CALL ReadVar( UnIn, FileName, sizere, 'sizere', 'Echo flag', ErrStat2, ErrMsg2, UnEc);if(Failed()) return - CALL AllocAry( InputFileData%ReListXfoil,sizere, 'InputFileData%ReListXfoil', ErrStat2, ErrMsg2); if(Failed()) return - - DO cou=1,sizere - CALL ReadVar( UnIn, FileName, InputFileData%ReListXfoil(cou), 'InputFileData%ReListXfoil','Echo flag', ErrStat2, ErrMsg2, UnEc); if(Failed()) return - ENDDO - - CALL ReadCom( UnIn, FileName, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc);if(Failed()) return - CALL ReadVar( UnIn, FileName, sizeaoa, 'sizeaoa', 'Echo flag', ErrStat2, ErrMsg2, UnEc); if(Failed()) return - CALL AllocAry( InputFileData%AoAListXfoil,sizeaoa, 'InputFileData%AoAListXfoil', ErrStat2, ErrMsg2); if(Failed()) return - DO cou=1,sizeaoa - CALL ReadVar( UnIn, FileName, InputFileData%AoAListXfoil(cou), 'InputFileData%AoAListXfoil','Echo flag', ErrStat2, ErrMsg2, UnEc); if(Failed()) return - ENDDO - IF (I .eq. 1) THEN - CALL AllocAry(InputFileData%Pres_DispThick,sizeaoa,sizere, BldNodes,'InputFileData%Pres_DispThick', ErrStat2, ErrMsg2);if(Failed()) return - CALL AllocAry(InputFileData%Suct_DispThick,sizeaoa,sizere, BldNodes,'InputFileData%Suct_DispThick', ErrStat2, ErrMsg2);if(Failed()) return - CALL AllocAry(InputFileData%Pres_BLThick,sizeaoa,sizere, BldNodes,'InputFileData%Pres_BLThick', ErrStat2, ErrMsg2);if(Failed()) return - CALL AllocAry(InputFileData%Suct_BLThick,sizeaoa,sizere, BldNodes,'InputFileData%Suct_BLThick', ErrStat2, ErrMsg2);if(Failed()) return - CALL AllocAry(InputFileData%Pres_Cf,sizeaoa,sizere, BldNodes,'InputFileData%Pres_Cf', ErrStat2, ErrMsg2);if(Failed()) return - CALL AllocAry(InputFileData%Suct_Cf,sizeaoa,sizere, BldNodes,'InputFileData%Suct_Cf', ErrStat2, ErrMsg2);if(Failed()) return - CALL AllocAry(InputFileData%Pres_EdgeVelRat,sizeaoa,sizere, BldNodes,'InputFileData%Pres_EdgeVelRat', ErrStat2, ErrMsg2); if(Failed()) return - CALL AllocAry(InputFileData%Suct_EdgeVelRat,sizeaoa,sizere, BldNodes,'InputFileData%Suct_EdgeVelRat', ErrStat2, ErrMsg2);if(Failed()) return - CALL AllocAry(temp1,8,sizeaoa*sizere, 'InputFileData%Suct_Cf', ErrStat2, ErrMsg2) - ENDIF - - DO cou1=1,6 - CALL ReadCom( UnIn, FileName, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc ) - ENDDO - - DO cou1=1,size(temp1,1) - read(UnIn,*) temp1(cou1,:) - ENDDO - - loop1=0 - DO cou1=1,sizeaoa - DO cou=1,sizere - loop1=loop1+1 - InputFileData%Pres_BLThick(cou1,cou,I) = temp1(1,loop1) - InputFileData%Pres_DispThick(cou1,cou,I) = temp1(2,loop1) - InputFileData%Pres_Cf(cou1,cou,I) = temp1(3,loop1) - InputFileData%Pres_EdgeVelRat(cou1,cou,I) = temp1(4,loop1) - InputFileData%Suct_BLThick(cou1,cou,I) = temp1(5,loop1) - InputFileData%Suct_DispThick(cou1,cou,I) = temp1(6,loop1) - InputFileData%Suct_Cf(cou1,cou,I) = temp1(7,loop1) - InputFileData%Suct_EdgeVelRat(cou1,cou,I) = temp1(8,loop1) - ENDDO - ENDDO - !---------------------- END OF FILE ----------------------------------------- - ENDDO - CALL Cleanup( ) -CONTAINS - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - if(Failed) call cleanup() - end function Failed - SUBROUTINE Cleanup() - IF (UnIn > 0) CLOSE ( UnIn ) - END SUBROUTINE Cleanup -END SUBROUTINE ReadXfoilTables -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE REadTICalcTables( InputFile,InputFileData, ErrStat, ErrMsg ) - ! Passed variables - integer(IntKi), intent(out) :: ErrStat ! Error status - character(*), intent(out) :: ErrMsg ! Error message - type(AA_InputFile), intent(inout) :: InputFileData ! All the data in the Noise input file - character(*), intent(in) :: InputFile ! Name of the file containing the primary input data - ! Local variables: - integer(IntKi) :: I ! loop counter - integer(IntKi) :: UnIn,UnIn2 ! Unit number for reading file - integer(IntKi) :: loop1 ! loop counter - character(1024) :: FileName ! name of the files containing obesever location - integer(IntKi) :: ErrStat2, IOS,cou ! Temporary Error status - logical :: Echo ! Determines if an echo file should be written - character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message - character(1024) :: PriPath ! Path name of the primary file - character(1024) :: FTitle ! "File Title": the 2nd line of the input file, which contains a description of its contents - character(200) :: Line ! Temporary storage of a line from the input file (to compare with "default") - character(*), parameter :: RoutineName = 'REadTICalcTables' - integer(IntKi) :: GridY ! - integer(IntKi) :: GridZ ! - integer(IntKi) :: cou1,UnEc ! loop counter - ! Initialize some variables: - ErrStat = ErrID_None - ErrMsg = "" - - CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. - - FileName = TRIM(PriPath)//'TIGrid_In.txt' - - CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2); call check() - CALL OpenFInpFile ( UnIn, FileName, ErrStat2, ErrMsg2 ); if(Failed()) return - - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2, UnEc); call check - CALL ReadVar(UnIn, FileName, GridY, 'GridY', 'Echo flag', ErrStat2, ErrMsg2, UnEc); call check - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2, UnEc );call check - CALL ReadVar(UnIn, FileName, GridZ, 'GridZ', 'Echo flag', ErrStat2, ErrMsg2, UnEc); call check - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2, UnEc); call check - CALL ReadVar(UnIn, FileName, InputFileData%dy_turb_in, 'InputFileData%dy_turb_in', 'Echo flag', ErrStat2, ErrMsg2, UnEc); call check - CALL ReadCom(UnIn, FileName, 'Text Line', ErrStat2, ErrMsg2, UnEc); call check - CALL ReadVar(UnIn, FileName, InputFileData%dz_turb_in, 'InputFileData%dz_turb_in', 'Echo flag', ErrStat2, ErrMsg2, UnEc); call check - if(Failed()) return - - CALL AllocAry( InputFileData%TI_Grid_In,GridZ,GridY,'InputFileData%TI_Grid_In', ErrStat2, ErrMsg2); - if(Failed()) return - DO cou1=1,size(InputFileData%TI_Grid_In,1) - read(UnIn,*) InputFileData%TI_Grid_In(cou1,:) - ENDDO - !---------------------- END OF FILE ----------------------------------------- - CALL Cleanup( ) - -CONTAINS - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - Failed = ErrStat >= AbortErrLev - if(Failed) call cleanup() - end function Failed - SUBROUTINE Check() - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - END SUBROUTINE Check - SUBROUTINE Cleanup() - IF (UnIn > 0) CLOSE ( UnIn ) - END SUBROUTINE Cleanup -END SUBROUTINE REadTICalcTables - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE AA_PrintSum( InputFileData, p, u, y, ErrStat, ErrMsg ) - ! This routine generates the summary file, which contains a summary of input file options. - ! passed variables - TYPE(AA_InputFile), INTENT(IN) :: InputFileData ! Input-file data - TYPE(AA_ParameterType), INTENT(IN) :: p ! Parameters - TYPE(AA_InputType), INTENT(IN) :: u ! inputs - TYPE(AA_OutputType), INTENT(IN) :: y ! outputs - INTEGER(IntKi), INTENT(OUT) :: ErrStat - CHARACTER(*), INTENT(OUT) :: ErrMsg - ! Local variables. - INTEGER(IntKi) :: I ! Index for the nodes. - INTEGER(IntKi) :: UnSu ! I/O unit number for the summary output file - CHARACTER(*), PARAMETER :: FmtDat = '(A,T35,1(:,F13.3))' ! Format for outputting mass and modal data. - CHARACTER(*), PARAMETER :: FmtDatT = '(A,T35,1(:,F13.8))' ! Format for outputting time steps. - CHARACTER(30) :: OutPFmt ! Format to print list of selected output channels to summary file - CHARACTER(100) :: Msg ! temporary string for writing appropriate text to summary file - ! Open the summary file and give it a heading. - RETURN -END SUBROUTINE AA_PrintSum - -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Calc_WriteOutput( p, u, m, y, ErrStat, ErrMsg ) - TYPE(AA_ParameterType), INTENT(IN ) :: p ! The module parameters - TYPE(AA_InputType), INTENT(IN ) :: u ! inputs - TYPE(AA_MiscVarType), INTENT(INOUT) :: m ! misc variables - TYPE(AA_OutputType), INTENT(INOUT) :: y ! outputs - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code - CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred - ! local variables - CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteOutput' - INTEGER(intKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - INTEGER(IntKi) :: j,k,counter,i,oi - ! start routine: - ErrStat = ErrID_None - ErrMsg = "" - ! FOR THE FIRST OUTPUT FILE - IF (p%NrOutFile .gt. 0) THEN - ! This loop order has to be kept even though not the most efficient unless OASPL size and loop is changed in subtoutine CalcOutput in AeroAcousitcs.f90 - y%WriteOutput(1:p%NrObsLoc)=y%DirectiviOutput - - counter=p%NrObsLoc - do k=1,p%NrObsLoc - do i=1,p%NumBlades - do j=1,p%NumBlNds - counter=counter+1 - y%WriteOutput(counter) = y%OASPL(k,j,i) - ! InitOut%WriteOutputHdr(i) = "Bl "//trim(num2lstr(m))//" Nd "//trim(num2lstr(k))//" Obs "//trim(num2lstr(j)) - ! InitOut%WriteOutputUnt(i) = "SPL" - enddo - enddo - enddo - endif - ! FOR THE SECOND OUTPUT FILE - IF (p%NrOutFile .gt. 1) THEN - counter=0 - DO J = 1, size(p%FreqList) - DO K = 1,p%NrObsLoc - DO I = 1,p%NumBlades - counter=counter+1 - y%WriteOutputforPE(counter) = y%SumSpecNoise(J,K,I) - DO oi = 1,3 - counter=counter+1 - y%WriteOutputforPE(counter) = y%OutLECoords(oi,J,K,I) - ENDDO - END DO ! - END DO ! - ENDDO - ENDIF - ! FOR THE THIRD OUTPUT FILE - IF (p%NrOutFile .gt. 2) THEN - counter=0 - do k=1,p%NrObsLoc - do i=1,p%NumBlades - do j=1,p%NumBlNds - do oi=1,size(y%OASPL_Mech,1) - counter=counter+1 - y%WriteOutputSep(counter) = y%OASPL_Mech(oi,k,j,i) - enddo - enddo - enddo - enddo - ENDIF - ! FOR THE FOURTH OUTPUT FILE - IF (p%NrOutFile .gt. 3) THEN - counter=0 - DO J = 1, size(p%FreqList) - DO K = 1,p%NrObsLoc - do oi=1,size(y%OASPL_Mech,1) - counter=counter+1 - y%WriteOutputSepFreq(counter) = y%SumSpecNoiseSep(oi,K,J) - END DO ! - END DO ! - ENDDO - ENDIF -END SUBROUTINE Calc_WriteOutput -!---------------------------------------------------------------------------------------------------------------------------------- -END MODULE AeroAcoustics_IO diff --git a/modules/aerodyn/src/AeroAcoustics/AeroAcoustics_Types.f90 b/modules/aerodyn/src/AeroAcoustics/AeroAcoustics_Types.f90 deleted file mode 100644 index 0c1e95cd5..000000000 --- a/modules/aerodyn/src/AeroAcoustics/AeroAcoustics_Types.f90 +++ /dev/null @@ -1,6180 +0,0 @@ -!STARTOFREGISTRYGENERATEDFILE 'AeroAcoustics_Types.f90' -! -! WARNING This file is generated automatically by the FAST registry. -! Do not edit. Your changes to this file will be lost. -! -! FAST Registry (v3.02.00, 23-Jul-2016) -!********************************************************************************************************************************* -! AeroAcoustics_Types -!................................................................................................................................. -! This file is part of AeroAcoustics. -! -! Copyright (C) 2012-2016 National Renewable Energy Laboratory -! -! Licensed under the Apache License, Version 2.0 (the "License"); -! you may not use this file except in compliance with the License. -! You may obtain a copy of the License at -! -! http://www.apache.org/licenses/LICENSE-2.0 -! -! Unless required by applicable law or agreed to in writing, software -! distributed under the License is distributed on an "AS IS" BASIS, -! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -! See the License for the specific language governing permissions and -! limitations under the License. -! -! -! W A R N I N G : This file was automatically generated from the FAST registry. Changes made to this file may be lost. -! -!********************************************************************************************************************************* -!> This module contains the user-defined types needed in AeroAcoustics. It also contains copy, destroy, pack, and -!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. -MODULE AeroAcoustics_Types -!--------------------------------------------------------------------------------------------------------------------------------- -USE AirfoilInfo_Types -USE NWTC_Library -IMPLICIT NONE -! ========= AA_BladePropsType ======= - TYPE, PUBLIC :: AA_BladePropsType - INTEGER(IntKi) :: NumBlNds !< Number of blade nodes used in the analysis [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TEThick !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: TEAngle !< [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: AerCent !< [-] - END TYPE AA_BladePropsType -! ======================= -! ========= AA_InitInputType ======= - TYPE, PUBLIC :: AA_InitInputType - CHARACTER(1024) :: InputFile !< Name of the input file [-] - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumBlNds !< Number of blades on the turbine [-] - CHARACTER(1024) :: RootName !< RootName for writing output files [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlSpn !< Span at blade node [m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlChord !< Chord at blade node [m] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - REAL(ReKi) :: SpdSound !< Speed of sound [m/s] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: BlAFID !< Index of airfoil data file for blade node location [array of numBladeNodes by numBlades] [-] - TYPE(AFInfoType) , DIMENSION(:), ALLOCATABLE :: AFInfo !< Airfoil information structure containing the aerodynamic center and airfoil shape coordinates [-] - END TYPE AA_InitInputType -! ======================= -! ========= AA_InitOutputType ======= - TYPE, PUBLIC :: AA_InitOutputType - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] - TYPE(ProgDesc) :: Ver !< This module's name, version, and date [-] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] - END TYPE AA_InitOutputType -! ======================= -! ========= AA_InputFile ======= - TYPE, PUBLIC :: AA_InputFile - REAL(DbKi) :: DTAero !< Time interval for aerodynamic calculations {or "default"} [s] - INTEGER(IntKi) :: IBLUNT !< FLAG TO COMPUTE BLUNTNESS NOISE [-] - INTEGER(IntKi) :: ILAM !< FLAG TO COMPUTE LBL NOISE {1=steady model, 2=Beddoes-Leishman unsteady model} [-] - INTEGER(IntKi) :: ITIP !< FLAG TO COMPUTE TIP NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: ITRIP !< FLAG TO TRIP BOUNDARY LAYER {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: ITURB !< FLAG TO COMPUTE TBLTE NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - INTEGER(IntKi) :: IInflow !< FLAG TO COMPUTE Turbulent Inflow NOISE {0=none, 1=baseline potential flow, 2=potential flow with Bak correction} [-] - LOGICAL :: ROUND !< LOGICAL INDICATING ROUNDED TIP [-] - REAL(ReKi) :: ALPRAT !< TIP LIFT CURVE SLOPE [-] - INTEGER(IntKi) :: OctBand !< Octave Bands [-] - INTEGER(IntKi) :: NrObsLoc !< Number of observer locations [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsX !< Observer location in tower-base coordinate X horizontal [m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsY !< Observer location in tower-base coordinate Y lateral [m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsZ !< Observer location in tower-base coordinate Z vertical [m] - TYPE(AA_BladePropsType) , DIMENSION(:), ALLOCATABLE :: BladeProps !< blade property information from blade input files [-] - LOGICAL :: SumPrint !< Generate a summary file listing input options and interpolated properties to ".AD.sum"? [flag] - CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] - INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] - END TYPE AA_InputFile -! ======================= -! ========= AA_ContinuousStateType ======= - TYPE, PUBLIC :: AA_ContinuousStateType - REAL(SiKi) :: DummyContState !< Remove this variable if you have continuous states [-] - END TYPE AA_ContinuousStateType -! ======================= -! ========= AA_DiscreteStateType ======= - TYPE, PUBLIC :: AA_DiscreteStateType - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: MeanVrel !< Vrel Cumu. Mean [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: VrelSq !< Vrel Squared Store [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TIVrel !< Vrel St. deviat [-] - END TYPE AA_DiscreteStateType -! ======================= -! ========= AA_ConstraintStateType ======= - TYPE, PUBLIC :: AA_ConstraintStateType - REAL(SiKi) :: DummyConstrState !< Remove this variable if you have states [-] - END TYPE AA_ConstraintStateType -! ======================= -! ========= AA_OtherStateType ======= - TYPE, PUBLIC :: AA_OtherStateType - REAL(SiKi) :: DummyOtherState !< Remove this variable if you have states [-] - END TYPE AA_OtherStateType -! ======================= -! ========= AA_MiscVarType ======= - TYPE, PUBLIC :: AA_MiscVarType - REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: WithoutSweepPitchTwist !< 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 :: ChordAngleTE !< C [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SpanAngleTE !< C [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: ChordAngleLE !< C [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: SpanAngleLE !< C [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: rTEtoObserve !< C [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: rLEtoObserve !< C [-] - REAL(ReKi) :: RotSpeedAoA !< C [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLLBL !< C [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLP !< C [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLS !< C [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLALPH !< C [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLTBL !< C [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLTIP !< C [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLTI !< C [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SPLBLUNT !< C [-] - END TYPE AA_MiscVarType -! ======================= -! ========= AA_ParameterType ======= - TYPE, PUBLIC :: AA_ParameterType - REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] - INTEGER(IntKi) :: IBLUNT !< FLAG TO COMPUTE BLUNTNESS NOISE [-] - INTEGER(IntKi) :: ILAM !< FLAG TO COMPUTE LBL NOISE [-] - INTEGER(IntKi) :: ITIP !< FLAG TO COMPUTE TIP NOISE [-] - INTEGER(IntKi) :: ITRIP !< FLAG TO TRIP BOUNDARY LAYER [-] - INTEGER(IntKi) :: ITURB !< FLAG TO COMPUTE TBLTE NOISE [-] - INTEGER(IntKi) :: IInflow !< FLAG TO COMPUTE Turbulent Inflow NOISE [-] - LOGICAL :: ROUND !< LOGICAL INDICATING ROUNDED TIP [-] - REAL(ReKi) :: ALPRAT !< TIP LIFT CURVE SLOPE [-] - INTEGER(IntKi) :: OctBand !< Octave Bands [-] - INTEGER(IntKi) :: NumBlades !< Number of blades on the turbine [-] - INTEGER(IntKi) :: NumBlNds !< Number of nodes on each blade [-] - REAL(ReKi) :: AirDens !< Air density [kg/m^3] - REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] - REAL(ReKi) :: SpdSound !< Speed of sound [m/s] - INTEGER(IntKi) :: NrObsLoc !< Number of observer locations [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsX !< Observer location in tower-base coordinate X horizontal [m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsY !< Observer location in tower-base coordinate Y lateral [m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ObsZ !< Observer location in tower-base coordinate Z vertical [m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: FreqList !< List of Frequencies to Calculate [Hz] - 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 [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TEThick !< ation [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: TEAngle !< ation [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AerCent !< ation [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: BlAFID !< Index of airfoil data file for blade node location [array of numBladeNodes by numBlades] [-] - TYPE(AFInfoType) , DIMENSION(:), ALLOCATABLE :: AFInfo !< Airfoil information structure containing the aerodynamic center and airfoil shape coordinates [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AFLECo !< Dimensionalized [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AFTECo - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlSpn !< Span at blade node [m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BlChord !< Chord at blade node [m] - END TYPE AA_ParameterType -! ======================= -! ========= AA_InputType ======= - TYPE, PUBLIC :: AA_InputType - REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: RotLtoG !< 3x3 rotation matrix transform a vector from the local airfoil coordinate system to the global inertial coordinate system [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: AeroCent_G !< location in global coordinates of the blade element aerodynamic center. 1st index = vector components, 2nd index = blade node, 3rd index = blade [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vrel !< Vrel [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: AoANoise !< Angle of attack [-] - END TYPE AA_InputType -! ======================= -! ========= AA_OutputType ======= - TYPE, PUBLIC :: AA_OutputType - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SumSpecNoise !< Spectra of summed noise level of all blades and blade nodes for each receiver and frequency [SPL] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WriteOutput !< Data to be written to an output file: see WriteOutputHdr for names of each variable [see WriteOutputUnt] - END TYPE AA_OutputType -! ======================= -CONTAINS - SUBROUTINE AA_CopyBladePropsType( SrcBladePropsTypeData, DstBladePropsTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_BladePropsType), INTENT(IN) :: SrcBladePropsTypeData - TYPE(AA_BladePropsType), INTENT(INOUT) :: DstBladePropsTypeData - 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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyBladePropsType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstBladePropsTypeData%NumBlNds = SrcBladePropsTypeData%NumBlNds -IF (ALLOCATED(SrcBladePropsTypeData%TEThick)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%TEThick,1) - i1_u = UBOUND(SrcBladePropsTypeData%TEThick,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%TEThick)) THEN - ALLOCATE(DstBladePropsTypeData%TEThick(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%TEThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%TEThick = SrcBladePropsTypeData%TEThick -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%TEAngle)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%TEAngle,1) - i1_u = UBOUND(SrcBladePropsTypeData%TEAngle,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%TEAngle)) THEN - ALLOCATE(DstBladePropsTypeData%TEAngle(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%TEAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%TEAngle = SrcBladePropsTypeData%TEAngle -ENDIF -IF (ALLOCATED(SrcBladePropsTypeData%AerCent)) THEN - i1_l = LBOUND(SrcBladePropsTypeData%AerCent,1) - i1_u = UBOUND(SrcBladePropsTypeData%AerCent,1) - IF (.NOT. ALLOCATED(DstBladePropsTypeData%AerCent)) THEN - ALLOCATE(DstBladePropsTypeData%AerCent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladePropsTypeData%AerCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBladePropsTypeData%AerCent = SrcBladePropsTypeData%AerCent -ENDIF - END SUBROUTINE AA_CopyBladePropsType - - SUBROUTINE AA_DestroyBladePropsType( BladePropsTypeData, ErrStat, ErrMsg ) - TYPE(AA_BladePropsType), INTENT(INOUT) :: BladePropsTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyBladePropsType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(BladePropsTypeData%TEThick)) THEN - DEALLOCATE(BladePropsTypeData%TEThick) -ENDIF -IF (ALLOCATED(BladePropsTypeData%TEAngle)) THEN - DEALLOCATE(BladePropsTypeData%TEAngle) -ENDIF -IF (ALLOCATED(BladePropsTypeData%AerCent)) THEN - DEALLOCATE(BladePropsTypeData%AerCent) -ENDIF - END SUBROUTINE AA_DestroyBladePropsType - - SUBROUTINE AA_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AA_BladePropsType), 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 = 'AA_PackBladePropsType' - ! 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 - Int_BufSz = Int_BufSz + 1 ! NumBlNds - Int_BufSz = Int_BufSz + 1 ! TEThick allocated yes/no - IF ( ALLOCATED(InData%TEThick) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TEThick upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TEThick) ! TEThick - END IF - Int_BufSz = Int_BufSz + 1 ! TEAngle allocated yes/no - IF ( ALLOCATED(InData%TEAngle) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TEAngle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TEAngle) ! TEAngle - END IF - Int_BufSz = Int_BufSz + 1 ! AerCent allocated yes/no - IF ( ALLOCATED(InData%AerCent) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AerCent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AerCent) ! AerCent - END IF - 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 - - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%TEThick) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TEThick,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEThick,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%TEThick)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TEThick))-1 ) = PACK(InData%TEThick,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TEThick) - END IF - IF ( .NOT. ALLOCATED(InData%TEAngle) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TEAngle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEAngle,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%TEAngle)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TEAngle))-1 ) = PACK(InData%TEAngle,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TEAngle) - END IF - IF ( .NOT. ALLOCATED(InData%AerCent) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AerCent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AerCent,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%AerCent)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AerCent))-1 ) = PACK(InData%AerCent,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AerCent) - END IF - END SUBROUTINE AA_PackBladePropsType - - SUBROUTINE AA_UnPackBladePropsType( 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(AA_BladePropsType), 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 - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackBladePropsType' - ! 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 - OutData%NumBlNds = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TEThick not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TEThick)) DEALLOCATE(OutData%TEThick) - ALLOCATE(OutData%TEThick(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TEThick)>0) OutData%TEThick = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TEThick))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TEThick) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TEAngle not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TEAngle)) DEALLOCATE(OutData%TEAngle) - ALLOCATE(OutData%TEAngle(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TEAngle)>0) OutData%TEAngle = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TEAngle))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TEAngle) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AerCent not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AerCent)) DEALLOCATE(OutData%AerCent) - ALLOCATE(OutData%AerCent(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AerCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AerCent)>0) OutData%AerCent = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AerCent))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AerCent) - DEALLOCATE(mask1) - END IF - END SUBROUTINE AA_UnPackBladePropsType - - SUBROUTINE AA_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_InitInputType), INTENT(IN) :: SrcInitInputData - TYPE(AA_InitInputType), INTENT(INOUT) :: DstInitInputData - 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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyInitInput' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInitInputData%InputFile = SrcInitInputData%InputFile - DstInitInputData%NumBlades = SrcInitInputData%NumBlades - DstInitInputData%NumBlNds = SrcInitInputData%NumBlNds - DstInitInputData%RootName = SrcInitInputData%RootName -IF (ALLOCATED(SrcInitInputData%BlSpn)) THEN - i1_l = LBOUND(SrcInitInputData%BlSpn,1) - i1_u = UBOUND(SrcInitInputData%BlSpn,1) - i2_l = LBOUND(SrcInitInputData%BlSpn,2) - i2_u = UBOUND(SrcInitInputData%BlSpn,2) - IF (.NOT. ALLOCATED(DstInitInputData%BlSpn)) THEN - ALLOCATE(DstInitInputData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BlSpn = SrcInitInputData%BlSpn -ENDIF -IF (ALLOCATED(SrcInitInputData%BlChord)) THEN - i1_l = LBOUND(SrcInitInputData%BlChord,1) - i1_u = UBOUND(SrcInitInputData%BlChord,1) - i2_l = LBOUND(SrcInitInputData%BlChord,2) - i2_u = UBOUND(SrcInitInputData%BlChord,2) - IF (.NOT. ALLOCATED(DstInitInputData%BlChord)) THEN - ALLOCATE(DstInitInputData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BlChord = SrcInitInputData%BlChord -ENDIF - DstInitInputData%AirDens = SrcInitInputData%AirDens - DstInitInputData%KinVisc = SrcInitInputData%KinVisc - DstInitInputData%SpdSound = SrcInitInputData%SpdSound -IF (ALLOCATED(SrcInitInputData%BlAFID)) THEN - i1_l = LBOUND(SrcInitInputData%BlAFID,1) - i1_u = UBOUND(SrcInitInputData%BlAFID,1) - i2_l = LBOUND(SrcInitInputData%BlAFID,2) - i2_u = UBOUND(SrcInitInputData%BlAFID,2) - IF (.NOT. ALLOCATED(DstInitInputData%BlAFID)) THEN - ALLOCATE(DstInitInputData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitInputData%BlAFID = SrcInitInputData%BlAFID -ENDIF -IF (ALLOCATED(SrcInitInputData%AFInfo)) THEN - i1_l = LBOUND(SrcInitInputData%AFInfo,1) - i1_u = UBOUND(SrcInitInputData%AFInfo,1) - IF (.NOT. ALLOCATED(DstInitInputData%AFInfo)) THEN - ALLOCATE(DstInitInputData%AFInfo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%AFInfo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInitInputData%AFInfo,1), UBOUND(SrcInitInputData%AFInfo,1) - CALL AFI_Copyafinfotype( SrcInitInputData%AFInfo(i1), DstInitInputData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE AA_CopyInitInput - - SUBROUTINE AA_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) - TYPE(AA_InitInputType), INTENT(INOUT) :: InitInputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInitInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitInputData%BlSpn)) THEN - DEALLOCATE(InitInputData%BlSpn) -ENDIF -IF (ALLOCATED(InitInputData%BlChord)) THEN - DEALLOCATE(InitInputData%BlChord) -ENDIF -IF (ALLOCATED(InitInputData%BlAFID)) THEN - DEALLOCATE(InitInputData%BlAFID) -ENDIF -IF (ALLOCATED(InitInputData%AFInfo)) THEN -DO i1 = LBOUND(InitInputData%AFInfo,1), UBOUND(InitInputData%AFInfo,1) - CALL AFI_Destroyafinfotype( InitInputData%AFInfo(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(InitInputData%AFInfo) -ENDIF - END SUBROUTINE AA_DestroyInitInput - - SUBROUTINE AA_PackInitInput( 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(AA_InitInputType), 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 = 'AA_PackInitInput' - ! 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 - Int_BufSz = Int_BufSz + 1*LEN(InData%InputFile) ! InputFile - Int_BufSz = Int_BufSz + 1 ! NumBlades - Int_BufSz = Int_BufSz + 1 ! NumBlNds - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! BlSpn allocated yes/no - IF ( ALLOCATED(InData%BlSpn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlSpn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlSpn) ! BlSpn - END IF - Int_BufSz = Int_BufSz + 1 ! BlChord allocated yes/no - IF ( ALLOCATED(InData%BlChord) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlChord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlChord) ! BlChord - END IF - Re_BufSz = Re_BufSz + 1 ! AirDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! SpdSound - Int_BufSz = Int_BufSz + 1 ! BlAFID allocated yes/no - IF ( ALLOCATED(InData%BlAFID) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlAFID upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BlAFID) ! BlAFID - END IF - Int_BufSz = Int_BufSz + 1 ! AFInfo allocated yes/no - IF ( ALLOCATED(InData%AFInfo) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AFInfo upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) - Int_BufSz = Int_BufSz + 3 ! AFInfo: size of buffers for each call to pack subtype - CALL AFI_Packafinfotype( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AFInfo - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AFInfo - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AFInfo - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AFInfo - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - 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 I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%BlSpn) ) 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%BlSpn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSpn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%BlSpn)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlSpn))-1 ) = PACK(InData%BlSpn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlSpn) - END IF - IF ( .NOT. ALLOCATED(InData%BlChord) ) 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%BlChord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlChord,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%BlChord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlChord))-1 ) = PACK(InData%BlChord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlChord) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%BlAFID) ) 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%BlAFID,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAFID,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%BlAFID)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BlAFID))-1 ) = PACK(InData%BlAFID,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BlAFID) - END IF - IF ( .NOT. ALLOCATED(InData%AFInfo) ) 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%AFInfo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFInfo,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) - CALL AFI_Packafinfotype( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, OnlySize ) ! AFInfo - 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 - END IF - END SUBROUTINE AA_PackInitInput - - SUBROUTINE AA_UnPackInitInput( 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(AA_InitInputType), 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 - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackInitInput' - ! 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 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlNds = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSpn 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%BlSpn)) DEALLOCATE(OutData%BlSpn) - ALLOCATE(OutData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BlSpn)>0) OutData%BlSpn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlSpn))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlSpn) - DEALLOCATE(mask2) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlChord 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%BlChord)) DEALLOCATE(OutData%BlChord) - ALLOCATE(OutData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BlChord)>0) OutData%BlChord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlChord))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlChord) - DEALLOCATE(mask2) - END IF - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAFID 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%BlAFID)) DEALLOCATE(OutData%BlAFID) - ALLOCATE(OutData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BlAFID)>0) OutData%BlAFID = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BlAFID))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BlAFID) - DEALLOCATE(mask2) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFInfo 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%AFInfo)) DEALLOCATE(OutData%AFInfo) - ALLOCATE(OutData%AFInfo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AFInfo,1), UBOUND(OutData%AFInfo,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 AFI_Unpackafinfotype( Re_Buf, Db_Buf, Int_Buf, OutData%AFInfo(i1), ErrStat2, ErrMsg2 ) ! AFInfo - 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 - END IF - END SUBROUTINE AA_UnPackInitInput - - SUBROUTINE AA_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_InitOutputType), INTENT(IN) :: SrcInitOutputData - TYPE(AA_InitOutputType), INTENT(INOUT) :: DstInitOutputData - 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 = 'AA_CopyInitOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInitOutputData%WriteOutputHdr)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputHdr,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputHdr,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputHdr)) THEN - ALLOCATE(DstInitOutputData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputHdr = SrcInitOutputData%WriteOutputHdr -ENDIF -IF (ALLOCATED(SrcInitOutputData%WriteOutputUnt)) THEN - i1_l = LBOUND(SrcInitOutputData%WriteOutputUnt,1) - i1_u = UBOUND(SrcInitOutputData%WriteOutputUnt,1) - IF (.NOT. ALLOCATED(DstInitOutputData%WriteOutputUnt)) THEN - ALLOCATE(DstInitOutputData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInitOutputData%WriteOutputUnt = SrcInitOutputData%WriteOutputUnt -ENDIF - CALL NWTC_Library_Copyprogdesc( SrcInitOutputData%Ver, DstInitOutputData%Ver, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstInitOutputData%AirDens = SrcInitOutputData%AirDens - END SUBROUTINE AA_CopyInitOutput - - SUBROUTINE AA_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) - TYPE(AA_InitOutputType), INTENT(INOUT) :: InitOutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInitOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InitOutputData%WriteOutputHdr)) THEN - DEALLOCATE(InitOutputData%WriteOutputHdr) -ENDIF -IF (ALLOCATED(InitOutputData%WriteOutputUnt)) THEN - DEALLOCATE(InitOutputData%WriteOutputUnt) -ENDIF - CALL NWTC_Library_Destroyprogdesc( InitOutputData%Ver, ErrStat, ErrMsg ) - END SUBROUTINE AA_DestroyInitOutput - - SUBROUTINE AA_PackInitOutput( 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(AA_InitOutputType), 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 = 'AA_PackInitOutput' - ! 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 - Int_BufSz = Int_BufSz + 1 ! WriteOutputHdr allocated yes/no - IF ( ALLOCATED(InData%WriteOutputHdr) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputHdr upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputHdr)*LEN(InData%WriteOutputHdr) ! WriteOutputHdr - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutputUnt allocated yes/no - IF ( ALLOCATED(InData%WriteOutputUnt) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutputUnt upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%WriteOutputUnt)*LEN(InData%WriteOutputUnt) ! WriteOutputUnt - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, .TRUE. ) ! Ver - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! AirDens - 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 - - IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) 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%WriteOutputHdr,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) - DO I = 1, LEN(InData%WriteOutputHdr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputHdr(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) 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%WriteOutputUnt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) - DO I = 1, LEN(InData%WriteOutputUnt) - IntKiBuf(Int_Xferred) = ICHAR(InData%WriteOutputUnt(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - END IF - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver - 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 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_PackInitOutput - - SUBROUTINE AA_UnPackInitOutput( 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(AA_InitOutputType), 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 - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackInitOutput' - ! 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr 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%WriteOutputHdr)) DEALLOCATE(OutData%WriteOutputHdr) - ALLOCATE(OutData%WriteOutputHdr(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) - DO I = 1, LEN(OutData%WriteOutputHdr) - OutData%WriteOutputHdr(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt 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%WriteOutputUnt)) DEALLOCATE(OutData%WriteOutputUnt) - ALLOCATE(OutData%WriteOutputUnt(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) - DO I = 1, LEN(OutData%WriteOutputUnt) - OutData%WriteOutputUnt(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - END IF - 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 NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Ver, ErrStat2, ErrMsg2 ) ! Ver - 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) - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_UnPackInitOutput - - SUBROUTINE AA_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_InputFile), INTENT(IN) :: SrcInputFileData - TYPE(AA_InputFile), INTENT(INOUT) :: DstInputFileData - 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 = 'AA_CopyInputFile' -! - ErrStat = ErrID_None - ErrMsg = "" - DstInputFileData%DTAero = SrcInputFileData%DTAero - DstInputFileData%IBLUNT = SrcInputFileData%IBLUNT - DstInputFileData%ILAM = SrcInputFileData%ILAM - DstInputFileData%ITIP = SrcInputFileData%ITIP - DstInputFileData%ITRIP = SrcInputFileData%ITRIP - DstInputFileData%ITURB = SrcInputFileData%ITURB - DstInputFileData%IInflow = SrcInputFileData%IInflow - DstInputFileData%ROUND = SrcInputFileData%ROUND - DstInputFileData%ALPRAT = SrcInputFileData%ALPRAT - DstInputFileData%OctBand = SrcInputFileData%OctBand - DstInputFileData%NrObsLoc = SrcInputFileData%NrObsLoc -IF (ALLOCATED(SrcInputFileData%ObsX)) THEN - i1_l = LBOUND(SrcInputFileData%ObsX,1) - i1_u = UBOUND(SrcInputFileData%ObsX,1) - IF (.NOT. ALLOCATED(DstInputFileData%ObsX)) THEN - ALLOCATE(DstInputFileData%ObsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ObsX = SrcInputFileData%ObsX -ENDIF -IF (ALLOCATED(SrcInputFileData%ObsY)) THEN - i1_l = LBOUND(SrcInputFileData%ObsY,1) - i1_u = UBOUND(SrcInputFileData%ObsY,1) - IF (.NOT. ALLOCATED(DstInputFileData%ObsY)) THEN - ALLOCATE(DstInputFileData%ObsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ObsY = SrcInputFileData%ObsY -ENDIF -IF (ALLOCATED(SrcInputFileData%ObsZ)) THEN - i1_l = LBOUND(SrcInputFileData%ObsZ,1) - i1_u = UBOUND(SrcInputFileData%ObsZ,1) - IF (.NOT. ALLOCATED(DstInputFileData%ObsZ)) THEN - ALLOCATE(DstInputFileData%ObsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%ObsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%ObsZ = SrcInputFileData%ObsZ -ENDIF -IF (ALLOCATED(SrcInputFileData%BladeProps)) THEN - i1_l = LBOUND(SrcInputFileData%BladeProps,1) - i1_u = UBOUND(SrcInputFileData%BladeProps,1) - IF (.NOT. ALLOCATED(DstInputFileData%BladeProps)) THEN - ALLOCATE(DstInputFileData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcInputFileData%BladeProps,1), UBOUND(SrcInputFileData%BladeProps,1) - CALL AA_Copybladepropstype( SrcInputFileData%BladeProps(i1), DstInputFileData%BladeProps(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - DstInputFileData%SumPrint = SrcInputFileData%SumPrint -IF (ALLOCATED(SrcInputFileData%OutList)) THEN - i1_l = LBOUND(SrcInputFileData%OutList,1) - i1_u = UBOUND(SrcInputFileData%OutList,1) - IF (.NOT. ALLOCATED(DstInputFileData%OutList)) THEN - ALLOCATE(DstInputFileData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputFileData%OutList = SrcInputFileData%OutList -ENDIF - DstInputFileData%NumOuts = SrcInputFileData%NumOuts - END SUBROUTINE AA_CopyInputFile - - SUBROUTINE AA_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) - TYPE(AA_InputFile), INTENT(INOUT) :: InputFileData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInputFile' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InputFileData%ObsX)) THEN - DEALLOCATE(InputFileData%ObsX) -ENDIF -IF (ALLOCATED(InputFileData%ObsY)) THEN - DEALLOCATE(InputFileData%ObsY) -ENDIF -IF (ALLOCATED(InputFileData%ObsZ)) THEN - DEALLOCATE(InputFileData%ObsZ) -ENDIF -IF (ALLOCATED(InputFileData%BladeProps)) THEN -DO i1 = LBOUND(InputFileData%BladeProps,1), UBOUND(InputFileData%BladeProps,1) - CALL AA_Destroybladepropstype( InputFileData%BladeProps(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(InputFileData%BladeProps) -ENDIF -IF (ALLOCATED(InputFileData%OutList)) THEN - DEALLOCATE(InputFileData%OutList) -ENDIF - END SUBROUTINE AA_DestroyInputFile - - SUBROUTINE AA_PackInputFile( 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(AA_InputFile), 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 = 'AA_PackInputFile' - ! 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 - Db_BufSz = Db_BufSz + 1 ! DTAero - Int_BufSz = Int_BufSz + 1 ! IBLUNT - Int_BufSz = Int_BufSz + 1 ! ILAM - Int_BufSz = Int_BufSz + 1 ! ITIP - Int_BufSz = Int_BufSz + 1 ! ITRIP - Int_BufSz = Int_BufSz + 1 ! ITURB - Int_BufSz = Int_BufSz + 1 ! IInflow - Int_BufSz = Int_BufSz + 1 ! ROUND - Re_BufSz = Re_BufSz + 1 ! ALPRAT - Int_BufSz = Int_BufSz + 1 ! OctBand - Int_BufSz = Int_BufSz + 1 ! NrObsLoc - Int_BufSz = Int_BufSz + 1 ! ObsX allocated yes/no - IF ( ALLOCATED(InData%ObsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsX) ! ObsX - END IF - Int_BufSz = Int_BufSz + 1 ! ObsY allocated yes/no - IF ( ALLOCATED(InData%ObsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsY) ! ObsY - END IF - Int_BufSz = Int_BufSz + 1 ! ObsZ allocated yes/no - IF ( ALLOCATED(InData%ObsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsZ) ! ObsZ - END IF - Int_BufSz = Int_BufSz + 1 ! BladeProps allocated yes/no - IF ( ALLOCATED(InData%BladeProps) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BladeProps upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) - Int_BufSz = Int_BufSz + 3 ! BladeProps: size of buffers for each call to pack subtype - CALL AA_Packbladepropstype( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BladeProps - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! BladeProps - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BladeProps - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BladeProps - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SumPrint - Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no - IF ( ALLOCATED(InData%OutList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutList upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%OutList)*LEN(InData%OutList) ! OutList - END IF - Int_BufSz = Int_BufSz + 1 ! NumOuts - 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 - - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DTAero - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IBLUNT - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ILAM - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ITIP - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ITRIP - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ITURB - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IInflow - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%ROUND , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ALPRAT - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OctBand - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NrObsLoc - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ObsX) ) 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%ObsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsX,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%ObsX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ObsX))-1 ) = PACK(InData%ObsX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ObsX) - END IF - IF ( .NOT. ALLOCATED(InData%ObsY) ) 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%ObsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsY,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%ObsY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ObsY))-1 ) = PACK(InData%ObsY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ObsY) - END IF - IF ( .NOT. ALLOCATED(InData%ObsZ) ) 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%ObsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsZ,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%ObsZ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ObsZ))-1 ) = PACK(InData%ObsZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ObsZ) - END IF - IF ( .NOT. ALLOCATED(InData%BladeProps) ) 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%BladeProps,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeProps,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BladeProps,1), UBOUND(InData%BladeProps,1) - CALL AA_Packbladepropstype( Re_Buf, Db_Buf, Int_Buf, InData%BladeProps(i1), ErrStat2, ErrMsg2, OnlySize ) ! BladeProps - 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 - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%OutList) ) 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%OutList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AA_PackInputFile - - SUBROUTINE AA_UnPackInputFile( 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(AA_InputFile), 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 - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackInputFile' - ! 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 - OutData%DTAero = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%IBLUNT = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ILAM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ITIP = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ITRIP = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ITURB = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%IInflow = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ROUND = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%ALPRAT = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%OctBand = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NrObsLoc = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsX 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%ObsX)) DEALLOCATE(OutData%ObsX) - ALLOCATE(OutData%ObsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ObsX)>0) OutData%ObsX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ObsX))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ObsX) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsY 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%ObsY)) DEALLOCATE(OutData%ObsY) - ALLOCATE(OutData%ObsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ObsY)>0) OutData%ObsY = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ObsY))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ObsY) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsZ 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%ObsZ)) DEALLOCATE(OutData%ObsZ) - ALLOCATE(OutData%ObsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ObsZ)>0) OutData%ObsZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ObsZ))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ObsZ) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeProps 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%BladeProps)) DEALLOCATE(OutData%BladeProps) - ALLOCATE(OutData%BladeProps(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeProps.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BladeProps,1), UBOUND(OutData%BladeProps,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 AA_Unpackbladepropstype( Re_Buf, Db_Buf, Int_Buf, OutData%BladeProps(i1), ErrStat2, ErrMsg2 ) ! BladeProps - 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 - END IF - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList 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%OutList)) DEALLOCATE(OutData%OutList) - ALLOCATE(OutData%OutList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE AA_UnPackInputFile - - SUBROUTINE AA_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(AA_ContinuousStateType), INTENT(INOUT) :: DstContStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyContState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstContStateData%DummyContState = SrcContStateData%DummyContState - END SUBROUTINE AA_CopyContState - - SUBROUTINE AA_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(AA_ContinuousStateType), INTENT(INOUT) :: ContStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyContState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE AA_DestroyContState - - SUBROUTINE AA_PackContState( 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(AA_ContinuousStateType), 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 = 'AA_PackContState' - ! 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 + 1 ! DummyContState - 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 - - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_PackContState - - SUBROUTINE AA_UnPackContState( 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(AA_ContinuousStateType), 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 - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackContState' - ! 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 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_UnPackContState - - SUBROUTINE AA_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_DiscreteStateType), INTENT(IN) :: SrcDiscStateData - TYPE(AA_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData - 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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyDiscState' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcDiscStateData%MeanVrel)) THEN - i1_l = LBOUND(SrcDiscStateData%MeanVrel,1) - i1_u = UBOUND(SrcDiscStateData%MeanVrel,1) - i2_l = LBOUND(SrcDiscStateData%MeanVrel,2) - i2_u = UBOUND(SrcDiscStateData%MeanVrel,2) - IF (.NOT. ALLOCATED(DstDiscStateData%MeanVrel)) THEN - ALLOCATE(DstDiscStateData%MeanVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%MeanVrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%MeanVrel = SrcDiscStateData%MeanVrel -ENDIF -IF (ALLOCATED(SrcDiscStateData%VrelSq)) THEN - i1_l = LBOUND(SrcDiscStateData%VrelSq,1) - i1_u = UBOUND(SrcDiscStateData%VrelSq,1) - i2_l = LBOUND(SrcDiscStateData%VrelSq,2) - i2_u = UBOUND(SrcDiscStateData%VrelSq,2) - IF (.NOT. ALLOCATED(DstDiscStateData%VrelSq)) THEN - ALLOCATE(DstDiscStateData%VrelSq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%VrelSq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%VrelSq = SrcDiscStateData%VrelSq -ENDIF -IF (ALLOCATED(SrcDiscStateData%TIVrel)) THEN - i1_l = LBOUND(SrcDiscStateData%TIVrel,1) - i1_u = UBOUND(SrcDiscStateData%TIVrel,1) - i2_l = LBOUND(SrcDiscStateData%TIVrel,2) - i2_u = UBOUND(SrcDiscStateData%TIVrel,2) - IF (.NOT. ALLOCATED(DstDiscStateData%TIVrel)) THEN - ALLOCATE(DstDiscStateData%TIVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstDiscStateData%TIVrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstDiscStateData%TIVrel = SrcDiscStateData%TIVrel -ENDIF - END SUBROUTINE AA_CopyDiscState - - SUBROUTINE AA_DestroyDiscState( DiscStateData, ErrStat, ErrMsg ) - TYPE(AA_DiscreteStateType), INTENT(INOUT) :: DiscStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyDiscState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(DiscStateData%MeanVrel)) THEN - DEALLOCATE(DiscStateData%MeanVrel) -ENDIF -IF (ALLOCATED(DiscStateData%VrelSq)) THEN - DEALLOCATE(DiscStateData%VrelSq) -ENDIF -IF (ALLOCATED(DiscStateData%TIVrel)) THEN - DEALLOCATE(DiscStateData%TIVrel) -ENDIF - END SUBROUTINE AA_DestroyDiscState - - SUBROUTINE AA_PackDiscState( 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(AA_DiscreteStateType), 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 = 'AA_PackDiscState' - ! 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 - Int_BufSz = Int_BufSz + 1 ! MeanVrel allocated yes/no - IF ( ALLOCATED(InData%MeanVrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! MeanVrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%MeanVrel) ! MeanVrel - END IF - Int_BufSz = Int_BufSz + 1 ! VrelSq allocated yes/no - IF ( ALLOCATED(InData%VrelSq) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! VrelSq upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%VrelSq) ! VrelSq - END IF - Int_BufSz = Int_BufSz + 1 ! TIVrel allocated yes/no - IF ( ALLOCATED(InData%TIVrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TIVrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TIVrel) ! TIVrel - END IF - 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 - - IF ( .NOT. ALLOCATED(InData%MeanVrel) ) 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%MeanVrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeanVrel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%MeanVrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MeanVrel,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%MeanVrel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MeanVrel))-1 ) = PACK(InData%MeanVrel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MeanVrel) - END IF - IF ( .NOT. ALLOCATED(InData%VrelSq) ) 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%VrelSq,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelSq,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%VrelSq,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VrelSq,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%VrelSq)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%VrelSq))-1 ) = PACK(InData%VrelSq,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%VrelSq) - END IF - IF ( .NOT. ALLOCATED(InData%TIVrel) ) 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%TIVrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIVrel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TIVrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIVrel,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%TIVrel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TIVrel))-1 ) = PACK(InData%TIVrel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TIVrel) - END IF - END SUBROUTINE AA_PackDiscState - - SUBROUTINE AA_UnPackDiscState( 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(AA_DiscreteStateType), 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 - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackDiscState' - ! 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MeanVrel 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%MeanVrel)) DEALLOCATE(OutData%MeanVrel) - ALLOCATE(OutData%MeanVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MeanVrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MeanVrel)>0) OutData%MeanVrel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MeanVrel))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MeanVrel) - DEALLOCATE(mask2) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VrelSq 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%VrelSq)) DEALLOCATE(OutData%VrelSq) - ALLOCATE(OutData%VrelSq(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VrelSq.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%VrelSq)>0) OutData%VrelSq = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%VrelSq))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%VrelSq) - DEALLOCATE(mask2) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TIVrel 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%TIVrel)) DEALLOCATE(OutData%TIVrel) - ALLOCATE(OutData%TIVrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIVrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TIVrel)>0) OutData%TIVrel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TIVrel))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TIVrel) - DEALLOCATE(mask2) - END IF - END SUBROUTINE AA_UnPackDiscState - - SUBROUTINE AA_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_ConstraintStateType), INTENT(IN) :: SrcConstrStateData - TYPE(AA_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyConstrState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstConstrStateData%DummyConstrState = SrcConstrStateData%DummyConstrState - END SUBROUTINE AA_CopyConstrState - - SUBROUTINE AA_DestroyConstrState( ConstrStateData, ErrStat, ErrMsg ) - TYPE(AA_ConstraintStateType), INTENT(INOUT) :: ConstrStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyConstrState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE AA_DestroyConstrState - - SUBROUTINE AA_PackConstrState( 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(AA_ConstraintStateType), 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 = 'AA_PackConstrState' - ! 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 + 1 ! DummyConstrState - 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 - - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_PackConstrState - - SUBROUTINE AA_UnPackConstrState( 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(AA_ConstraintStateType), 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 - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackConstrState' - ! 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 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_UnPackConstrState - - SUBROUTINE AA_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_OtherStateType), INTENT(IN) :: SrcOtherStateData - TYPE(AA_OtherStateType), INTENT(INOUT) :: DstOtherStateData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyOtherState' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOtherStateData%DummyOtherState = SrcOtherStateData%DummyOtherState - END SUBROUTINE AA_CopyOtherState - - SUBROUTINE AA_DestroyOtherState( OtherStateData, ErrStat, ErrMsg ) - TYPE(AA_OtherStateType), INTENT(INOUT) :: OtherStateData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyOtherState' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE AA_DestroyOtherState - - SUBROUTINE AA_PackOtherState( 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(AA_OtherStateType), 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 = 'AA_PackOtherState' - ! 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 + 1 ! DummyOtherState - 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 - - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_PackOtherState - - SUBROUTINE AA_UnPackOtherState( 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(AA_OtherStateType), 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 - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackOtherState' - ! 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 - OutData%DummyOtherState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE AA_UnPackOtherState - - SUBROUTINE AA_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(AA_MiscVarType), INTENT(INOUT) :: DstMiscData - 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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyMisc' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcMiscData%WithoutSweepPitchTwist)) THEN - i1_l = LBOUND(SrcMiscData%WithoutSweepPitchTwist,1) - i1_u = UBOUND(SrcMiscData%WithoutSweepPitchTwist,1) - i2_l = LBOUND(SrcMiscData%WithoutSweepPitchTwist,2) - i2_u = UBOUND(SrcMiscData%WithoutSweepPitchTwist,2) - i3_l = LBOUND(SrcMiscData%WithoutSweepPitchTwist,3) - i3_u = UBOUND(SrcMiscData%WithoutSweepPitchTwist,3) - i4_l = LBOUND(SrcMiscData%WithoutSweepPitchTwist,4) - i4_u = UBOUND(SrcMiscData%WithoutSweepPitchTwist,4) - IF (.NOT. ALLOCATED(DstMiscData%WithoutSweepPitchTwist)) THEN - ALLOCATE(DstMiscData%WithoutSweepPitchTwist(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 DstMiscData%WithoutSweepPitchTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%WithoutSweepPitchTwist = SrcMiscData%WithoutSweepPitchTwist -ENDIF -IF (ALLOCATED(SrcMiscData%AllOuts)) THEN - i1_l = LBOUND(SrcMiscData%AllOuts,1) - i1_u = UBOUND(SrcMiscData%AllOuts,1) - IF (.NOT. ALLOCATED(DstMiscData%AllOuts)) THEN - ALLOCATE(DstMiscData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%AllOuts = SrcMiscData%AllOuts -ENDIF -IF (ALLOCATED(SrcMiscData%ChordAngleTE)) THEN - i1_l = LBOUND(SrcMiscData%ChordAngleTE,1) - i1_u = UBOUND(SrcMiscData%ChordAngleTE,1) - i2_l = LBOUND(SrcMiscData%ChordAngleTE,2) - i2_u = UBOUND(SrcMiscData%ChordAngleTE,2) - i3_l = LBOUND(SrcMiscData%ChordAngleTE,3) - i3_u = UBOUND(SrcMiscData%ChordAngleTE,3) - IF (.NOT. ALLOCATED(DstMiscData%ChordAngleTE)) THEN - ALLOCATE(DstMiscData%ChordAngleTE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ChordAngleTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ChordAngleTE = SrcMiscData%ChordAngleTE -ENDIF -IF (ALLOCATED(SrcMiscData%SpanAngleTE)) THEN - i1_l = LBOUND(SrcMiscData%SpanAngleTE,1) - i1_u = UBOUND(SrcMiscData%SpanAngleTE,1) - i2_l = LBOUND(SrcMiscData%SpanAngleTE,2) - i2_u = UBOUND(SrcMiscData%SpanAngleTE,2) - i3_l = LBOUND(SrcMiscData%SpanAngleTE,3) - i3_u = UBOUND(SrcMiscData%SpanAngleTE,3) - IF (.NOT. ALLOCATED(DstMiscData%SpanAngleTE)) THEN - ALLOCATE(DstMiscData%SpanAngleTE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SpanAngleTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SpanAngleTE = SrcMiscData%SpanAngleTE -ENDIF -IF (ALLOCATED(SrcMiscData%ChordAngleLE)) THEN - i1_l = LBOUND(SrcMiscData%ChordAngleLE,1) - i1_u = UBOUND(SrcMiscData%ChordAngleLE,1) - i2_l = LBOUND(SrcMiscData%ChordAngleLE,2) - i2_u = UBOUND(SrcMiscData%ChordAngleLE,2) - i3_l = LBOUND(SrcMiscData%ChordAngleLE,3) - i3_u = UBOUND(SrcMiscData%ChordAngleLE,3) - IF (.NOT. ALLOCATED(DstMiscData%ChordAngleLE)) THEN - ALLOCATE(DstMiscData%ChordAngleLE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%ChordAngleLE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%ChordAngleLE = SrcMiscData%ChordAngleLE -ENDIF -IF (ALLOCATED(SrcMiscData%SpanAngleLE)) THEN - i1_l = LBOUND(SrcMiscData%SpanAngleLE,1) - i1_u = UBOUND(SrcMiscData%SpanAngleLE,1) - i2_l = LBOUND(SrcMiscData%SpanAngleLE,2) - i2_u = UBOUND(SrcMiscData%SpanAngleLE,2) - i3_l = LBOUND(SrcMiscData%SpanAngleLE,3) - i3_u = UBOUND(SrcMiscData%SpanAngleLE,3) - IF (.NOT. ALLOCATED(DstMiscData%SpanAngleLE)) THEN - ALLOCATE(DstMiscData%SpanAngleLE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SpanAngleLE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SpanAngleLE = SrcMiscData%SpanAngleLE -ENDIF -IF (ALLOCATED(SrcMiscData%rTEtoObserve)) THEN - i1_l = LBOUND(SrcMiscData%rTEtoObserve,1) - i1_u = UBOUND(SrcMiscData%rTEtoObserve,1) - i2_l = LBOUND(SrcMiscData%rTEtoObserve,2) - i2_u = UBOUND(SrcMiscData%rTEtoObserve,2) - i3_l = LBOUND(SrcMiscData%rTEtoObserve,3) - i3_u = UBOUND(SrcMiscData%rTEtoObserve,3) - IF (.NOT. ALLOCATED(DstMiscData%rTEtoObserve)) THEN - ALLOCATE(DstMiscData%rTEtoObserve(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rTEtoObserve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rTEtoObserve = SrcMiscData%rTEtoObserve -ENDIF -IF (ALLOCATED(SrcMiscData%rLEtoObserve)) THEN - i1_l = LBOUND(SrcMiscData%rLEtoObserve,1) - i1_u = UBOUND(SrcMiscData%rLEtoObserve,1) - i2_l = LBOUND(SrcMiscData%rLEtoObserve,2) - i2_u = UBOUND(SrcMiscData%rLEtoObserve,2) - i3_l = LBOUND(SrcMiscData%rLEtoObserve,3) - i3_u = UBOUND(SrcMiscData%rLEtoObserve,3) - IF (.NOT. ALLOCATED(DstMiscData%rLEtoObserve)) THEN - ALLOCATE(DstMiscData%rLEtoObserve(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%rLEtoObserve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%rLEtoObserve = SrcMiscData%rLEtoObserve -ENDIF - DstMiscData%RotSpeedAoA = SrcMiscData%RotSpeedAoA -IF (ALLOCATED(SrcMiscData%SPLLBL)) THEN - i1_l = LBOUND(SrcMiscData%SPLLBL,1) - i1_u = UBOUND(SrcMiscData%SPLLBL,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLLBL)) THEN - ALLOCATE(DstMiscData%SPLLBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLLBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLLBL = SrcMiscData%SPLLBL -ENDIF -IF (ALLOCATED(SrcMiscData%SPLP)) THEN - i1_l = LBOUND(SrcMiscData%SPLP,1) - i1_u = UBOUND(SrcMiscData%SPLP,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLP)) THEN - ALLOCATE(DstMiscData%SPLP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLP = SrcMiscData%SPLP -ENDIF -IF (ALLOCATED(SrcMiscData%SPLS)) THEN - i1_l = LBOUND(SrcMiscData%SPLS,1) - i1_u = UBOUND(SrcMiscData%SPLS,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLS)) THEN - ALLOCATE(DstMiscData%SPLS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLS = SrcMiscData%SPLS -ENDIF -IF (ALLOCATED(SrcMiscData%SPLALPH)) THEN - i1_l = LBOUND(SrcMiscData%SPLALPH,1) - i1_u = UBOUND(SrcMiscData%SPLALPH,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLALPH)) THEN - ALLOCATE(DstMiscData%SPLALPH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLALPH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLALPH = SrcMiscData%SPLALPH -ENDIF -IF (ALLOCATED(SrcMiscData%SPLTBL)) THEN - i1_l = LBOUND(SrcMiscData%SPLTBL,1) - i1_u = UBOUND(SrcMiscData%SPLTBL,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLTBL)) THEN - ALLOCATE(DstMiscData%SPLTBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLTBL = SrcMiscData%SPLTBL -ENDIF -IF (ALLOCATED(SrcMiscData%SPLTIP)) THEN - i1_l = LBOUND(SrcMiscData%SPLTIP,1) - i1_u = UBOUND(SrcMiscData%SPLTIP,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLTIP)) THEN - ALLOCATE(DstMiscData%SPLTIP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTIP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLTIP = SrcMiscData%SPLTIP -ENDIF -IF (ALLOCATED(SrcMiscData%SPLTI)) THEN - i1_l = LBOUND(SrcMiscData%SPLTI,1) - i1_u = UBOUND(SrcMiscData%SPLTI,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLTI)) THEN - ALLOCATE(DstMiscData%SPLTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLTI = SrcMiscData%SPLTI -ENDIF -IF (ALLOCATED(SrcMiscData%SPLBLUNT)) THEN - i1_l = LBOUND(SrcMiscData%SPLBLUNT,1) - i1_u = UBOUND(SrcMiscData%SPLBLUNT,1) - IF (.NOT. ALLOCATED(DstMiscData%SPLBLUNT)) THEN - ALLOCATE(DstMiscData%SPLBLUNT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SPLBLUNT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SPLBLUNT = SrcMiscData%SPLBLUNT -ENDIF - END SUBROUTINE AA_CopyMisc - - SUBROUTINE AA_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(AA_MiscVarType), INTENT(INOUT) :: MiscData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyMisc' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(MiscData%WithoutSweepPitchTwist)) THEN - DEALLOCATE(MiscData%WithoutSweepPitchTwist) -ENDIF -IF (ALLOCATED(MiscData%AllOuts)) THEN - DEALLOCATE(MiscData%AllOuts) -ENDIF -IF (ALLOCATED(MiscData%ChordAngleTE)) THEN - DEALLOCATE(MiscData%ChordAngleTE) -ENDIF -IF (ALLOCATED(MiscData%SpanAngleTE)) THEN - DEALLOCATE(MiscData%SpanAngleTE) -ENDIF -IF (ALLOCATED(MiscData%ChordAngleLE)) THEN - DEALLOCATE(MiscData%ChordAngleLE) -ENDIF -IF (ALLOCATED(MiscData%SpanAngleLE)) THEN - DEALLOCATE(MiscData%SpanAngleLE) -ENDIF -IF (ALLOCATED(MiscData%rTEtoObserve)) THEN - DEALLOCATE(MiscData%rTEtoObserve) -ENDIF -IF (ALLOCATED(MiscData%rLEtoObserve)) THEN - DEALLOCATE(MiscData%rLEtoObserve) -ENDIF -IF (ALLOCATED(MiscData%SPLLBL)) THEN - DEALLOCATE(MiscData%SPLLBL) -ENDIF -IF (ALLOCATED(MiscData%SPLP)) THEN - DEALLOCATE(MiscData%SPLP) -ENDIF -IF (ALLOCATED(MiscData%SPLS)) THEN - DEALLOCATE(MiscData%SPLS) -ENDIF -IF (ALLOCATED(MiscData%SPLALPH)) THEN - DEALLOCATE(MiscData%SPLALPH) -ENDIF -IF (ALLOCATED(MiscData%SPLTBL)) THEN - DEALLOCATE(MiscData%SPLTBL) -ENDIF -IF (ALLOCATED(MiscData%SPLTIP)) THEN - DEALLOCATE(MiscData%SPLTIP) -ENDIF -IF (ALLOCATED(MiscData%SPLTI)) THEN - DEALLOCATE(MiscData%SPLTI) -ENDIF -IF (ALLOCATED(MiscData%SPLBLUNT)) THEN - DEALLOCATE(MiscData%SPLBLUNT) -ENDIF - END SUBROUTINE AA_DestroyMisc - - SUBROUTINE AA_PackMisc( 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(AA_MiscVarType), 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 = 'AA_PackMisc' - ! 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 - 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 - END IF - Int_BufSz = Int_BufSz + 1 ! AllOuts allocated yes/no - IF ( ALLOCATED(InData%AllOuts) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AllOuts upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOuts) ! AllOuts - END IF - Int_BufSz = Int_BufSz + 1 ! ChordAngleTE allocated yes/no - IF ( ALLOCATED(InData%ChordAngleTE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! ChordAngleTE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ChordAngleTE) ! ChordAngleTE - END IF - Int_BufSz = Int_BufSz + 1 ! SpanAngleTE allocated yes/no - IF ( ALLOCATED(InData%SpanAngleTE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SpanAngleTE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SpanAngleTE) ! SpanAngleTE - END IF - Int_BufSz = Int_BufSz + 1 ! ChordAngleLE allocated yes/no - IF ( ALLOCATED(InData%ChordAngleLE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! ChordAngleLE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ChordAngleLE) ! ChordAngleLE - END IF - Int_BufSz = Int_BufSz + 1 ! SpanAngleLE allocated yes/no - IF ( ALLOCATED(InData%SpanAngleLE) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! SpanAngleLE upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SpanAngleLE) ! SpanAngleLE - END IF - Int_BufSz = Int_BufSz + 1 ! rTEtoObserve allocated yes/no - IF ( ALLOCATED(InData%rTEtoObserve) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rTEtoObserve upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rTEtoObserve) ! rTEtoObserve - END IF - Int_BufSz = Int_BufSz + 1 ! rLEtoObserve allocated yes/no - IF ( ALLOCATED(InData%rLEtoObserve) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! rLEtoObserve upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%rLEtoObserve) ! rLEtoObserve - END IF - Re_BufSz = Re_BufSz + 1 ! RotSpeedAoA - Int_BufSz = Int_BufSz + 1 ! SPLLBL allocated yes/no - IF ( ALLOCATED(InData%SPLLBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLLBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLLBL) ! SPLLBL - END IF - Int_BufSz = Int_BufSz + 1 ! SPLP allocated yes/no - IF ( ALLOCATED(InData%SPLP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLP) ! SPLP - END IF - Int_BufSz = Int_BufSz + 1 ! SPLS allocated yes/no - IF ( ALLOCATED(InData%SPLS) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLS upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLS) ! SPLS - END IF - Int_BufSz = Int_BufSz + 1 ! SPLALPH allocated yes/no - IF ( ALLOCATED(InData%SPLALPH) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLALPH upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLALPH) ! SPLALPH - END IF - Int_BufSz = Int_BufSz + 1 ! SPLTBL allocated yes/no - IF ( ALLOCATED(InData%SPLTBL) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLTBL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLTBL) ! SPLTBL - END IF - Int_BufSz = Int_BufSz + 1 ! SPLTIP allocated yes/no - IF ( ALLOCATED(InData%SPLTIP) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLTIP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLTIP) ! SPLTIP - END IF - Int_BufSz = Int_BufSz + 1 ! SPLTI allocated yes/no - IF ( ALLOCATED(InData%SPLTI) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLTI upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLTI) ! SPLTI - END IF - Int_BufSz = Int_BufSz + 1 ! SPLBLUNT allocated yes/no - IF ( ALLOCATED(InData%SPLBLUNT) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SPLBLUNT upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SPLBLUNT) ! SPLBLUNT - END IF - 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 - - IF ( .NOT. ALLOCATED(InData%WithoutSweepPitchTwist) ) 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) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WithoutSweepPitchTwist,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WithoutSweepPitchTwist,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WithoutSweepPitchTwist,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WithoutSweepPitchTwist,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WithoutSweepPitchTwist,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WithoutSweepPitchTwist,4) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%WithoutSweepPitchTwist)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WithoutSweepPitchTwist))-1 ) = PACK(InData%WithoutSweepPitchTwist,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WithoutSweepPitchTwist) - END IF - IF ( .NOT. ALLOCATED(InData%AllOuts) ) 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%AllOuts,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%AllOuts)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AllOuts))-1 ) = PACK(InData%AllOuts,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AllOuts) - END IF - IF ( .NOT. ALLOCATED(InData%ChordAngleTE) ) 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%ChordAngleTE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleTE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleTE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleTE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleTE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleTE,3) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%ChordAngleTE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ChordAngleTE))-1 ) = PACK(InData%ChordAngleTE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ChordAngleTE) - END IF - IF ( .NOT. ALLOCATED(InData%SpanAngleTE) ) 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%SpanAngleTE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleTE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleTE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleTE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleTE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleTE,3) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%SpanAngleTE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SpanAngleTE))-1 ) = PACK(InData%SpanAngleTE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SpanAngleTE) - END IF - IF ( .NOT. ALLOCATED(InData%ChordAngleLE) ) 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%ChordAngleLE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleLE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleLE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleLE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChordAngleLE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChordAngleLE,3) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%ChordAngleLE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ChordAngleLE))-1 ) = PACK(InData%ChordAngleLE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ChordAngleLE) - END IF - IF ( .NOT. ALLOCATED(InData%SpanAngleLE) ) 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%SpanAngleLE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleLE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleLE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleLE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SpanAngleLE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SpanAngleLE,3) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%SpanAngleLE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SpanAngleLE))-1 ) = PACK(InData%SpanAngleLE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SpanAngleLE) - END IF - IF ( .NOT. ALLOCATED(InData%rTEtoObserve) ) 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%rTEtoObserve,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rTEtoObserve,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rTEtoObserve,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rTEtoObserve,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rTEtoObserve,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rTEtoObserve,3) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%rTEtoObserve)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rTEtoObserve))-1 ) = PACK(InData%rTEtoObserve,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rTEtoObserve) - END IF - IF ( .NOT. ALLOCATED(InData%rLEtoObserve) ) 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%rLEtoObserve,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLEtoObserve,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLEtoObserve,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLEtoObserve,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%rLEtoObserve,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLEtoObserve,3) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%rLEtoObserve)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rLEtoObserve))-1 ) = PACK(InData%rLEtoObserve,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rLEtoObserve) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotSpeedAoA - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%SPLLBL) ) 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%SPLLBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLLBL,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%SPLLBL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SPLLBL))-1 ) = PACK(InData%SPLLBL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SPLLBL) - END IF - IF ( .NOT. ALLOCATED(InData%SPLP) ) 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%SPLP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLP,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%SPLP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SPLP))-1 ) = PACK(InData%SPLP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SPLP) - END IF - IF ( .NOT. ALLOCATED(InData%SPLS) ) 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%SPLS,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLS,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%SPLS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SPLS))-1 ) = PACK(InData%SPLS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SPLS) - END IF - IF ( .NOT. ALLOCATED(InData%SPLALPH) ) 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%SPLALPH,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLALPH,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%SPLALPH)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SPLALPH))-1 ) = PACK(InData%SPLALPH,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SPLALPH) - END IF - IF ( .NOT. ALLOCATED(InData%SPLTBL) ) 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%SPLTBL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLTBL,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%SPLTBL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SPLTBL))-1 ) = PACK(InData%SPLTBL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SPLTBL) - END IF - IF ( .NOT. ALLOCATED(InData%SPLTIP) ) 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%SPLTIP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLTIP,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%SPLTIP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SPLTIP))-1 ) = PACK(InData%SPLTIP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SPLTIP) - END IF - IF ( .NOT. ALLOCATED(InData%SPLTI) ) 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%SPLTI,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLTI,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%SPLTI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SPLTI))-1 ) = PACK(InData%SPLTI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SPLTI) - END IF - IF ( .NOT. ALLOCATED(InData%SPLBLUNT) ) 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%SPLBLUNT,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SPLBLUNT,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%SPLBLUNT)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SPLBLUNT))-1 ) = PACK(InData%SPLBLUNT,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SPLBLUNT) - END IF - END SUBROUTINE AA_PackMisc - - SUBROUTINE AA_UnPackMisc( 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(AA_MiscVarType), 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 - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackMisc' - ! 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WithoutSweepPitchTwist 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 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - 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 (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WithoutSweepPitchTwist.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%WithoutSweepPitchTwist)>0) OutData%WithoutSweepPitchTwist = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WithoutSweepPitchTwist))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WithoutSweepPitchTwist) - DEALLOCATE(mask4) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts 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%AllOuts)) DEALLOCATE(OutData%AllOuts) - ALLOCATE(OutData%AllOuts(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AllOuts)>0) OutData%AllOuts = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AllOuts))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AllOuts) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChordAngleTE 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 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ChordAngleTE)) DEALLOCATE(OutData%ChordAngleTE) - ALLOCATE(OutData%ChordAngleTE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChordAngleTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%ChordAngleTE)>0) OutData%ChordAngleTE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ChordAngleTE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ChordAngleTE) - DEALLOCATE(mask3) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SpanAngleTE 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 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SpanAngleTE)) DEALLOCATE(OutData%SpanAngleTE) - ALLOCATE(OutData%SpanAngleTE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SpanAngleTE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%SpanAngleTE)>0) OutData%SpanAngleTE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SpanAngleTE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SpanAngleTE) - DEALLOCATE(mask3) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChordAngleLE 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 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ChordAngleLE)) DEALLOCATE(OutData%ChordAngleLE) - ALLOCATE(OutData%ChordAngleLE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChordAngleLE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%ChordAngleLE)>0) OutData%ChordAngleLE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ChordAngleLE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ChordAngleLE) - DEALLOCATE(mask3) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SpanAngleLE 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 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SpanAngleLE)) DEALLOCATE(OutData%SpanAngleLE) - ALLOCATE(OutData%SpanAngleLE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SpanAngleLE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%SpanAngleLE)>0) OutData%SpanAngleLE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SpanAngleLE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SpanAngleLE) - DEALLOCATE(mask3) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rTEtoObserve 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 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rTEtoObserve)) DEALLOCATE(OutData%rTEtoObserve) - ALLOCATE(OutData%rTEtoObserve(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rTEtoObserve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%rTEtoObserve)>0) OutData%rTEtoObserve = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rTEtoObserve))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rTEtoObserve) - DEALLOCATE(mask3) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLEtoObserve 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 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%rLEtoObserve)) DEALLOCATE(OutData%rLEtoObserve) - ALLOCATE(OutData%rLEtoObserve(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLEtoObserve.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%rLEtoObserve)>0) OutData%rLEtoObserve = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rLEtoObserve))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rLEtoObserve) - DEALLOCATE(mask3) - END IF - OutData%RotSpeedAoA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLLBL 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%SPLLBL)) DEALLOCATE(OutData%SPLLBL) - ALLOCATE(OutData%SPLLBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLLBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SPLLBL)>0) OutData%SPLLBL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SPLLBL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SPLLBL) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLP 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%SPLP)) DEALLOCATE(OutData%SPLP) - ALLOCATE(OutData%SPLP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SPLP)>0) OutData%SPLP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SPLP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SPLP) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLS 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%SPLS)) DEALLOCATE(OutData%SPLS) - ALLOCATE(OutData%SPLS(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLS.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SPLS)>0) OutData%SPLS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SPLS))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SPLS) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLALPH 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%SPLALPH)) DEALLOCATE(OutData%SPLALPH) - ALLOCATE(OutData%SPLALPH(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLALPH.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SPLALPH)>0) OutData%SPLALPH = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SPLALPH))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SPLALPH) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLTBL 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%SPLTBL)) DEALLOCATE(OutData%SPLTBL) - ALLOCATE(OutData%SPLTBL(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTBL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SPLTBL)>0) OutData%SPLTBL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SPLTBL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SPLTBL) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLTIP 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%SPLTIP)) DEALLOCATE(OutData%SPLTIP) - ALLOCATE(OutData%SPLTIP(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTIP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SPLTIP)>0) OutData%SPLTIP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SPLTIP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SPLTIP) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLTI 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%SPLTI)) DEALLOCATE(OutData%SPLTI) - ALLOCATE(OutData%SPLTI(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLTI.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SPLTI)>0) OutData%SPLTI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SPLTI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SPLTI) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SPLBLUNT 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%SPLBLUNT)) DEALLOCATE(OutData%SPLBLUNT) - ALLOCATE(OutData%SPLBLUNT(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SPLBLUNT.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SPLBLUNT)>0) OutData%SPLBLUNT = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SPLBLUNT))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SPLBLUNT) - DEALLOCATE(mask1) - END IF - END SUBROUTINE AA_UnPackMisc - - SUBROUTINE AA_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_ParameterType), INTENT(IN) :: SrcParamData - TYPE(AA_ParameterType), INTENT(INOUT) :: DstParamData - 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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyParam' -! - ErrStat = ErrID_None - ErrMsg = "" - DstParamData%DT = SrcParamData%DT - DstParamData%IBLUNT = SrcParamData%IBLUNT - DstParamData%ILAM = SrcParamData%ILAM - DstParamData%ITIP = SrcParamData%ITIP - DstParamData%ITRIP = SrcParamData%ITRIP - DstParamData%ITURB = SrcParamData%ITURB - DstParamData%IInflow = SrcParamData%IInflow - DstParamData%ROUND = SrcParamData%ROUND - DstParamData%ALPRAT = SrcParamData%ALPRAT - DstParamData%OctBand = SrcParamData%OctBand - DstParamData%NumBlades = SrcParamData%NumBlades - DstParamData%NumBlNds = SrcParamData%NumBlNds - DstParamData%AirDens = SrcParamData%AirDens - DstParamData%KinVisc = SrcParamData%KinVisc - DstParamData%SpdSound = SrcParamData%SpdSound - DstParamData%NrObsLoc = SrcParamData%NrObsLoc -IF (ALLOCATED(SrcParamData%ObsX)) THEN - i1_l = LBOUND(SrcParamData%ObsX,1) - i1_u = UBOUND(SrcParamData%ObsX,1) - IF (.NOT. ALLOCATED(DstParamData%ObsX)) THEN - ALLOCATE(DstParamData%ObsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ObsX = SrcParamData%ObsX -ENDIF -IF (ALLOCATED(SrcParamData%ObsY)) THEN - i1_l = LBOUND(SrcParamData%ObsY,1) - i1_u = UBOUND(SrcParamData%ObsY,1) - IF (.NOT. ALLOCATED(DstParamData%ObsY)) THEN - ALLOCATE(DstParamData%ObsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ObsY = SrcParamData%ObsY -ENDIF -IF (ALLOCATED(SrcParamData%ObsZ)) THEN - i1_l = LBOUND(SrcParamData%ObsZ,1) - i1_u = UBOUND(SrcParamData%ObsZ,1) - IF (.NOT. ALLOCATED(DstParamData%ObsZ)) THEN - ALLOCATE(DstParamData%ObsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ObsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%ObsZ = SrcParamData%ObsZ -ENDIF -IF (ALLOCATED(SrcParamData%FreqList)) THEN - i1_l = LBOUND(SrcParamData%FreqList,1) - i1_u = UBOUND(SrcParamData%FreqList,1) - IF (.NOT. ALLOCATED(DstParamData%FreqList)) THEN - ALLOCATE(DstParamData%FreqList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%FreqList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%FreqList = SrcParamData%FreqList -ENDIF - DstParamData%NumOuts = SrcParamData%NumOuts - DstParamData%RootName = SrcParamData%RootName -IF (ALLOCATED(SrcParamData%OutParam)) THEN - i1_l = LBOUND(SrcParamData%OutParam,1) - i1_u = UBOUND(SrcParamData%OutParam,1) - IF (.NOT. ALLOCATED(DstParamData%OutParam)) THEN - ALLOCATE(DstParamData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%OutParam,1), UBOUND(SrcParamData%OutParam,1) - CALL NWTC_Library_Copyoutparmtype( SrcParamData%OutParam(i1), DstParamData%OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%TEThick)) THEN - i1_l = LBOUND(SrcParamData%TEThick,1) - i1_u = UBOUND(SrcParamData%TEThick,1) - i2_l = LBOUND(SrcParamData%TEThick,2) - i2_u = UBOUND(SrcParamData%TEThick,2) - IF (.NOT. ALLOCATED(DstParamData%TEThick)) THEN - ALLOCATE(DstParamData%TEThick(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TEThick = SrcParamData%TEThick -ENDIF -IF (ALLOCATED(SrcParamData%TEAngle)) THEN - i1_l = LBOUND(SrcParamData%TEAngle,1) - i1_u = UBOUND(SrcParamData%TEAngle,1) - i2_l = LBOUND(SrcParamData%TEAngle,2) - i2_u = UBOUND(SrcParamData%TEAngle,2) - IF (.NOT. ALLOCATED(DstParamData%TEAngle)) THEN - ALLOCATE(DstParamData%TEAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%TEAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%TEAngle = SrcParamData%TEAngle -ENDIF -IF (ALLOCATED(SrcParamData%AerCent)) THEN - i1_l = LBOUND(SrcParamData%AerCent,1) - i1_u = UBOUND(SrcParamData%AerCent,1) - i2_l = LBOUND(SrcParamData%AerCent,2) - i2_u = UBOUND(SrcParamData%AerCent,2) - i3_l = LBOUND(SrcParamData%AerCent,3) - i3_u = UBOUND(SrcParamData%AerCent,3) - IF (.NOT. ALLOCATED(DstParamData%AerCent)) THEN - ALLOCATE(DstParamData%AerCent(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AerCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AerCent = SrcParamData%AerCent -ENDIF -IF (ALLOCATED(SrcParamData%BlAFID)) THEN - i1_l = LBOUND(SrcParamData%BlAFID,1) - i1_u = UBOUND(SrcParamData%BlAFID,1) - i2_l = LBOUND(SrcParamData%BlAFID,2) - i2_u = UBOUND(SrcParamData%BlAFID,2) - IF (.NOT. ALLOCATED(DstParamData%BlAFID)) THEN - ALLOCATE(DstParamData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlAFID = SrcParamData%BlAFID -ENDIF -IF (ALLOCATED(SrcParamData%AFInfo)) THEN - i1_l = LBOUND(SrcParamData%AFInfo,1) - i1_u = UBOUND(SrcParamData%AFInfo,1) - IF (.NOT. ALLOCATED(DstParamData%AFInfo)) THEN - ALLOCATE(DstParamData%AFInfo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFInfo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcParamData%AFInfo,1), UBOUND(SrcParamData%AFInfo,1) - CALL AFI_Copyafinfotype( SrcParamData%AFInfo(i1), DstParamData%AFInfo(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcParamData%AFLECo)) THEN - i1_l = LBOUND(SrcParamData%AFLECo,1) - i1_u = UBOUND(SrcParamData%AFLECo,1) - i2_l = LBOUND(SrcParamData%AFLECo,2) - i2_u = UBOUND(SrcParamData%AFLECo,2) - i3_l = LBOUND(SrcParamData%AFLECo,3) - i3_u = UBOUND(SrcParamData%AFLECo,3) - IF (.NOT. ALLOCATED(DstParamData%AFLECo)) THEN - ALLOCATE(DstParamData%AFLECo(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFLECo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AFLECo = SrcParamData%AFLECo -ENDIF -IF (ALLOCATED(SrcParamData%AFTECo)) THEN - i1_l = LBOUND(SrcParamData%AFTECo,1) - i1_u = UBOUND(SrcParamData%AFTECo,1) - i2_l = LBOUND(SrcParamData%AFTECo,2) - i2_u = UBOUND(SrcParamData%AFTECo,2) - i3_l = LBOUND(SrcParamData%AFTECo,3) - i3_u = UBOUND(SrcParamData%AFTECo,3) - IF (.NOT. ALLOCATED(DstParamData%AFTECo)) THEN - ALLOCATE(DstParamData%AFTECo(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%AFTECo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%AFTECo = SrcParamData%AFTECo -ENDIF -IF (ALLOCATED(SrcParamData%BlSpn)) THEN - i1_l = LBOUND(SrcParamData%BlSpn,1) - i1_u = UBOUND(SrcParamData%BlSpn,1) - i2_l = LBOUND(SrcParamData%BlSpn,2) - i2_u = UBOUND(SrcParamData%BlSpn,2) - IF (.NOT. ALLOCATED(DstParamData%BlSpn)) THEN - ALLOCATE(DstParamData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlSpn = SrcParamData%BlSpn -ENDIF -IF (ALLOCATED(SrcParamData%BlChord)) THEN - i1_l = LBOUND(SrcParamData%BlChord,1) - i1_u = UBOUND(SrcParamData%BlChord,1) - i2_l = LBOUND(SrcParamData%BlChord,2) - i2_u = UBOUND(SrcParamData%BlChord,2) - IF (.NOT. ALLOCATED(DstParamData%BlChord)) THEN - ALLOCATE(DstParamData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%BlChord = SrcParamData%BlChord -ENDIF - END SUBROUTINE AA_CopyParam - - SUBROUTINE AA_DestroyParam( ParamData, ErrStat, ErrMsg ) - TYPE(AA_ParameterType), INTENT(INOUT) :: ParamData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyParam' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ParamData%ObsX)) THEN - DEALLOCATE(ParamData%ObsX) -ENDIF -IF (ALLOCATED(ParamData%ObsY)) THEN - DEALLOCATE(ParamData%ObsY) -ENDIF -IF (ALLOCATED(ParamData%ObsZ)) THEN - DEALLOCATE(ParamData%ObsZ) -ENDIF -IF (ALLOCATED(ParamData%FreqList)) THEN - DEALLOCATE(ParamData%FreqList) -ENDIF -IF (ALLOCATED(ParamData%OutParam)) THEN -DO i1 = LBOUND(ParamData%OutParam,1), UBOUND(ParamData%OutParam,1) - CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%TEThick)) THEN - DEALLOCATE(ParamData%TEThick) -ENDIF -IF (ALLOCATED(ParamData%TEAngle)) THEN - DEALLOCATE(ParamData%TEAngle) -ENDIF -IF (ALLOCATED(ParamData%AerCent)) THEN - DEALLOCATE(ParamData%AerCent) -ENDIF -IF (ALLOCATED(ParamData%BlAFID)) THEN - DEALLOCATE(ParamData%BlAFID) -ENDIF -IF (ALLOCATED(ParamData%AFInfo)) THEN -DO i1 = LBOUND(ParamData%AFInfo,1), UBOUND(ParamData%AFInfo,1) - CALL AFI_Destroyafinfotype( ParamData%AFInfo(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ParamData%AFInfo) -ENDIF -IF (ALLOCATED(ParamData%AFLECo)) THEN - DEALLOCATE(ParamData%AFLECo) -ENDIF -IF (ALLOCATED(ParamData%AFTECo)) THEN - DEALLOCATE(ParamData%AFTECo) -ENDIF -IF (ALLOCATED(ParamData%BlSpn)) THEN - DEALLOCATE(ParamData%BlSpn) -ENDIF -IF (ALLOCATED(ParamData%BlChord)) THEN - DEALLOCATE(ParamData%BlChord) -ENDIF - END SUBROUTINE AA_DestroyParam - - SUBROUTINE AA_PackParam( 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(AA_ParameterType), 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 = 'AA_PackParam' - ! 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 - Db_BufSz = Db_BufSz + 1 ! DT - Int_BufSz = Int_BufSz + 1 ! IBLUNT - Int_BufSz = Int_BufSz + 1 ! ILAM - Int_BufSz = Int_BufSz + 1 ! ITIP - Int_BufSz = Int_BufSz + 1 ! ITRIP - Int_BufSz = Int_BufSz + 1 ! ITURB - Int_BufSz = Int_BufSz + 1 ! IInflow - Int_BufSz = Int_BufSz + 1 ! ROUND - Re_BufSz = Re_BufSz + 1 ! ALPRAT - Int_BufSz = Int_BufSz + 1 ! OctBand - Int_BufSz = Int_BufSz + 1 ! NumBlades - Int_BufSz = Int_BufSz + 1 ! NumBlNds - Re_BufSz = Re_BufSz + 1 ! AirDens - Re_BufSz = Re_BufSz + 1 ! KinVisc - Re_BufSz = Re_BufSz + 1 ! SpdSound - Int_BufSz = Int_BufSz + 1 ! NrObsLoc - Int_BufSz = Int_BufSz + 1 ! ObsX allocated yes/no - IF ( ALLOCATED(InData%ObsX) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsX upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsX) ! ObsX - END IF - Int_BufSz = Int_BufSz + 1 ! ObsY allocated yes/no - IF ( ALLOCATED(InData%ObsY) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsY upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsY) ! ObsY - END IF - Int_BufSz = Int_BufSz + 1 ! ObsZ allocated yes/no - IF ( ALLOCATED(InData%ObsZ) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ObsZ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%ObsZ) ! ObsZ - END IF - Int_BufSz = Int_BufSz + 1 ! FreqList allocated yes/no - IF ( ALLOCATED(InData%FreqList) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! FreqList upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%FreqList) ! FreqList - END IF - Int_BufSz = Int_BufSz + 1 ! NumOuts - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no - IF ( ALLOCATED(InData%OutParam) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! OutParam upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - Int_BufSz = Int_BufSz + 3 ! OutParam: size of buffers for each call to pack subtype - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutParam - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OutParam - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OutParam - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OutParam - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! TEThick allocated yes/no - IF ( ALLOCATED(InData%TEThick) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TEThick upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TEThick) ! TEThick - END IF - Int_BufSz = Int_BufSz + 1 ! TEAngle allocated yes/no - IF ( ALLOCATED(InData%TEAngle) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! TEAngle upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%TEAngle) ! TEAngle - END IF - Int_BufSz = Int_BufSz + 1 ! AerCent allocated yes/no - IF ( ALLOCATED(InData%AerCent) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AerCent upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AerCent) ! AerCent - END IF - Int_BufSz = Int_BufSz + 1 ! BlAFID allocated yes/no - IF ( ALLOCATED(InData%BlAFID) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlAFID upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%BlAFID) ! BlAFID - END IF - Int_BufSz = Int_BufSz + 1 ! AFInfo allocated yes/no - IF ( ALLOCATED(InData%AFInfo) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AFInfo upper/lower bounds for each dimension - DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) - Int_BufSz = Int_BufSz + 3 ! AFInfo: size of buffers for each call to pack subtype - CALL AFI_Packafinfotype( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AFInfo - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! AFInfo - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AFInfo - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AFInfo - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! AFLECo allocated yes/no - IF ( ALLOCATED(InData%AFLECo) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AFLECo upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AFLECo) ! AFLECo - END IF - Int_BufSz = Int_BufSz + 1 ! AFTECo allocated yes/no - IF ( ALLOCATED(InData%AFTECo) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AFTECo upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AFTECo) ! AFTECo - END IF - Int_BufSz = Int_BufSz + 1 ! BlSpn allocated yes/no - IF ( ALLOCATED(InData%BlSpn) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlSpn upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlSpn) ! BlSpn - END IF - Int_BufSz = Int_BufSz + 1 ! BlChord allocated yes/no - IF ( ALLOCATED(InData%BlChord) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BlChord upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BlChord) ! BlChord - END IF - 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 - - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IBLUNT - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ILAM - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ITIP - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ITRIP - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ITURB - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IInflow - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%ROUND , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ALPRAT - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OctBand - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NrObsLoc - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%ObsX) ) 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%ObsX,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsX,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%ObsX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ObsX))-1 ) = PACK(InData%ObsX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ObsX) - END IF - IF ( .NOT. ALLOCATED(InData%ObsY) ) 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%ObsY,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsY,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%ObsY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ObsY))-1 ) = PACK(InData%ObsY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ObsY) - END IF - IF ( .NOT. ALLOCATED(InData%ObsZ) ) 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%ObsZ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ObsZ,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%ObsZ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ObsZ))-1 ) = PACK(InData%ObsZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ObsZ) - END IF - IF ( .NOT. ALLOCATED(InData%FreqList) ) 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%FreqList,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqList,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%FreqList)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FreqList))-1 ) = PACK(InData%FreqList,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FreqList) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%OutParam) ) 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%OutParam,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParam,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%OutParam,1), UBOUND(InData%OutParam,1) - CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutParam - 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 - END IF - IF ( .NOT. ALLOCATED(InData%TEThick) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TEThick,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEThick,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TEThick,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEThick,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%TEThick)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TEThick))-1 ) = PACK(InData%TEThick,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TEThick) - END IF - IF ( .NOT. ALLOCATED(InData%TEAngle) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TEAngle,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEAngle,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TEAngle,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TEAngle,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%TEAngle)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TEAngle))-1 ) = PACK(InData%TEAngle,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TEAngle) - END IF - IF ( .NOT. ALLOCATED(InData%AerCent) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AerCent,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AerCent,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AerCent,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AerCent,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AerCent,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AerCent,3) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%AerCent)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AerCent))-1 ) = PACK(InData%AerCent,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AerCent) - END IF - IF ( .NOT. ALLOCATED(InData%BlAFID) ) 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%BlAFID,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlAFID,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%BlAFID)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BlAFID))-1 ) = PACK(InData%BlAFID,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BlAFID) - END IF - IF ( .NOT. ALLOCATED(InData%AFInfo) ) 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%AFInfo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFInfo,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AFInfo,1), UBOUND(InData%AFInfo,1) - CALL AFI_Packafinfotype( Re_Buf, Db_Buf, Int_Buf, InData%AFInfo(i1), ErrStat2, ErrMsg2, OnlySize ) ! AFInfo - 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 - END IF - IF ( .NOT. ALLOCATED(InData%AFLECo) ) 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%AFLECo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFLECo,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFLECo,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFLECo,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFLECo,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFLECo,3) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%AFLECo)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AFLECo))-1 ) = PACK(InData%AFLECo,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AFLECo) - END IF - IF ( .NOT. ALLOCATED(InData%AFTECo) ) 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%AFTECo,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFTECo,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFTECo,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFTECo,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AFTECo,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFTECo,3) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%AFTECo)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AFTECo))-1 ) = PACK(InData%AFTECo,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AFTECo) - END IF - IF ( .NOT. ALLOCATED(InData%BlSpn) ) 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%BlSpn,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlSpn,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%BlSpn)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlSpn))-1 ) = PACK(InData%BlSpn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlSpn) - END IF - IF ( .NOT. ALLOCATED(InData%BlChord) ) 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%BlChord,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BlChord,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%BlChord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlChord))-1 ) = PACK(InData%BlChord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlChord) - END IF - END SUBROUTINE AA_PackParam - - SUBROUTINE AA_UnPackParam( 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(AA_ParameterType), 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 - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackParam' - ! 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 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%IBLUNT = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ILAM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ITIP = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ITRIP = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ITURB = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%IInflow = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ROUND = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%ALPRAT = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%OctBand = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlNds = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NrObsLoc = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsX 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%ObsX)) DEALLOCATE(OutData%ObsX) - ALLOCATE(OutData%ObsX(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsX.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ObsX)>0) OutData%ObsX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ObsX))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ObsX) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsY 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%ObsY)) DEALLOCATE(OutData%ObsY) - ALLOCATE(OutData%ObsY(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsY.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ObsY)>0) OutData%ObsY = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ObsY))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ObsY) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ObsZ 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%ObsZ)) DEALLOCATE(OutData%ObsZ) - ALLOCATE(OutData%ObsZ(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ObsZ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ObsZ)>0) OutData%ObsZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ObsZ))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ObsZ) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreqList 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%FreqList)) DEALLOCATE(OutData%FreqList) - ALLOCATE(OutData%FreqList(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqList.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FreqList)>0) OutData%FreqList = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FreqList))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FreqList) - DEALLOCATE(mask1) - END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam 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%OutParam)) DEALLOCATE(OutData%OutParam) - ALLOCATE(OutData%OutParam(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParam.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%OutParam,1), UBOUND(OutData%OutParam,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 NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%OutParam(i1), ErrStat2, ErrMsg2 ) ! OutParam - 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 - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TEThick not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TEThick)) DEALLOCATE(OutData%TEThick) - ALLOCATE(OutData%TEThick(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEThick.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TEThick)>0) OutData%TEThick = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TEThick))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TEThick) - DEALLOCATE(mask2) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TEAngle not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TEAngle)) DEALLOCATE(OutData%TEAngle) - ALLOCATE(OutData%TEAngle(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TEAngle.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TEAngle)>0) OutData%TEAngle = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TEAngle))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TEAngle) - DEALLOCATE(mask2) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AerCent not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AerCent)) DEALLOCATE(OutData%AerCent) - ALLOCATE(OutData%AerCent(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AerCent.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AerCent)>0) OutData%AerCent = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AerCent))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AerCent) - DEALLOCATE(mask3) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAFID 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%BlAFID)) DEALLOCATE(OutData%BlAFID) - ALLOCATE(OutData%BlAFID(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BlAFID)>0) OutData%BlAFID = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BlAFID))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BlAFID) - DEALLOCATE(mask2) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFInfo 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%AFInfo)) DEALLOCATE(OutData%AFInfo) - ALLOCATE(OutData%AFInfo(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFInfo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AFInfo,1), UBOUND(OutData%AFInfo,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 AFI_Unpackafinfotype( Re_Buf, Db_Buf, Int_Buf, OutData%AFInfo(i1), ErrStat2, ErrMsg2 ) ! AFInfo - 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 - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFLECo 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 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AFLECo)) DEALLOCATE(OutData%AFLECo) - ALLOCATE(OutData%AFLECo(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFLECo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AFLECo)>0) OutData%AFLECo = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AFLECo))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AFLECo) - DEALLOCATE(mask3) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFTECo 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 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AFTECo)) DEALLOCATE(OutData%AFTECo) - ALLOCATE(OutData%AFTECo(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFTECo.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AFTECo)>0) OutData%AFTECo = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AFTECo))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AFTECo) - DEALLOCATE(mask3) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSpn 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%BlSpn)) DEALLOCATE(OutData%BlSpn) - ALLOCATE(OutData%BlSpn(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BlSpn)>0) OutData%BlSpn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlSpn))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlSpn) - DEALLOCATE(mask2) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlChord 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%BlChord)) DEALLOCATE(OutData%BlChord) - ALLOCATE(OutData%BlChord(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BlChord)>0) OutData%BlChord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlChord))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlChord) - DEALLOCATE(mask2) - END IF - END SUBROUTINE AA_UnPackParam - - SUBROUTINE AA_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_InputType), INTENT(IN) :: SrcInputData - TYPE(AA_InputType), INTENT(INOUT) :: DstInputData - 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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%RotLtoG)) THEN - i1_l = LBOUND(SrcInputData%RotLtoG,1) - i1_u = UBOUND(SrcInputData%RotLtoG,1) - i2_l = LBOUND(SrcInputData%RotLtoG,2) - i2_u = UBOUND(SrcInputData%RotLtoG,2) - i3_l = LBOUND(SrcInputData%RotLtoG,3) - i3_u = UBOUND(SrcInputData%RotLtoG,3) - i4_l = LBOUND(SrcInputData%RotLtoG,4) - i4_u = UBOUND(SrcInputData%RotLtoG,4) - IF (.NOT. ALLOCATED(DstInputData%RotLtoG)) THEN - ALLOCATE(DstInputData%RotLtoG(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 DstInputData%RotLtoG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%RotLtoG = SrcInputData%RotLtoG -ENDIF -IF (ALLOCATED(SrcInputData%AeroCent_G)) THEN - i1_l = LBOUND(SrcInputData%AeroCent_G,1) - i1_u = UBOUND(SrcInputData%AeroCent_G,1) - i2_l = LBOUND(SrcInputData%AeroCent_G,2) - i2_u = UBOUND(SrcInputData%AeroCent_G,2) - i3_l = LBOUND(SrcInputData%AeroCent_G,3) - i3_u = UBOUND(SrcInputData%AeroCent_G,3) - IF (.NOT. ALLOCATED(DstInputData%AeroCent_G)) THEN - ALLOCATE(DstInputData%AeroCent_G(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%AeroCent_G.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%AeroCent_G = SrcInputData%AeroCent_G -ENDIF -IF (ALLOCATED(SrcInputData%Vrel)) THEN - i1_l = LBOUND(SrcInputData%Vrel,1) - i1_u = UBOUND(SrcInputData%Vrel,1) - i2_l = LBOUND(SrcInputData%Vrel,2) - i2_u = UBOUND(SrcInputData%Vrel,2) - IF (.NOT. ALLOCATED(DstInputData%Vrel)) THEN - ALLOCATE(DstInputData%Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vrel = SrcInputData%Vrel -ENDIF -IF (ALLOCATED(SrcInputData%AoANoise)) THEN - i1_l = LBOUND(SrcInputData%AoANoise,1) - i1_u = UBOUND(SrcInputData%AoANoise,1) - i2_l = LBOUND(SrcInputData%AoANoise,2) - i2_u = UBOUND(SrcInputData%AoANoise,2) - IF (.NOT. ALLOCATED(DstInputData%AoANoise)) THEN - ALLOCATE(DstInputData%AoANoise(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%AoANoise.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%AoANoise = SrcInputData%AoANoise -ENDIF - END SUBROUTINE AA_CopyInput - - SUBROUTINE AA_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(AA_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InputData%RotLtoG)) THEN - DEALLOCATE(InputData%RotLtoG) -ENDIF -IF (ALLOCATED(InputData%AeroCent_G)) THEN - DEALLOCATE(InputData%AeroCent_G) -ENDIF -IF (ALLOCATED(InputData%Vrel)) THEN - DEALLOCATE(InputData%Vrel) -ENDIF -IF (ALLOCATED(InputData%AoANoise)) THEN - DEALLOCATE(InputData%AoANoise) -ENDIF - END SUBROUTINE AA_DestroyInput - - SUBROUTINE AA_PackInput( 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(AA_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 = 'AA_PackInput' - ! 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 - Int_BufSz = Int_BufSz + 1 ! RotLtoG allocated yes/no - IF ( ALLOCATED(InData%RotLtoG) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! RotLtoG upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%RotLtoG) ! RotLtoG - END IF - Int_BufSz = Int_BufSz + 1 ! AeroCent_G allocated yes/no - IF ( ALLOCATED(InData%AeroCent_G) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! AeroCent_G upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AeroCent_G) ! AeroCent_G - END IF - Int_BufSz = Int_BufSz + 1 ! Vrel allocated yes/no - IF ( ALLOCATED(InData%Vrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vrel) ! Vrel - END IF - Int_BufSz = Int_BufSz + 1 ! AoANoise allocated yes/no - IF ( ALLOCATED(InData%AoANoise) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AoANoise upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AoANoise) ! AoANoise - END IF - 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 - - IF ( .NOT. ALLOCATED(InData%RotLtoG) ) 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%RotLtoG,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotLtoG,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotLtoG,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotLtoG,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotLtoG,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotLtoG,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotLtoG,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotLtoG,4) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%RotLtoG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotLtoG))-1 ) = PACK(InData%RotLtoG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotLtoG) - END IF - IF ( .NOT. ALLOCATED(InData%AeroCent_G) ) 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%AeroCent_G,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroCent_G,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AeroCent_G,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroCent_G,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AeroCent_G,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroCent_G,3) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%AeroCent_G)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AeroCent_G))-1 ) = PACK(InData%AeroCent_G,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AeroCent_G) - END IF - IF ( .NOT. ALLOCATED(InData%Vrel) ) 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%Vrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vrel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vrel,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%Vrel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Vrel))-1 ) = PACK(InData%Vrel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Vrel) - END IF - IF ( .NOT. ALLOCATED(InData%AoANoise) ) 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%AoANoise,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AoANoise,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AoANoise,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AoANoise,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%AoANoise)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AoANoise))-1 ) = PACK(InData%AoANoise,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AoANoise) - END IF - END SUBROUTINE AA_PackInput - - SUBROUTINE AA_UnPackInput( 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(AA_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 - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackInput' - ! 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotLtoG 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 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotLtoG)) DEALLOCATE(OutData%RotLtoG) - ALLOCATE(OutData%RotLtoG(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%RotLtoG.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%RotLtoG)>0) OutData%RotLtoG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotLtoG))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotLtoG) - DEALLOCATE(mask4) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AeroCent_G 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 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AeroCent_G)) DEALLOCATE(OutData%AeroCent_G) - ALLOCATE(OutData%AeroCent_G(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroCent_G.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AeroCent_G)>0) OutData%AeroCent_G = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AeroCent_G))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AeroCent_G) - DEALLOCATE(mask3) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vrel 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%Vrel)) DEALLOCATE(OutData%Vrel) - ALLOCATE(OutData%Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vrel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Vrel)>0) OutData%Vrel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Vrel))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Vrel) - DEALLOCATE(mask2) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AoANoise 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%AoANoise)) DEALLOCATE(OutData%AoANoise) - ALLOCATE(OutData%AoANoise(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AoANoise.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AoANoise)>0) OutData%AoANoise = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AoANoise))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AoANoise) - DEALLOCATE(mask2) - END IF - END SUBROUTINE AA_UnPackInput - - SUBROUTINE AA_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AA_OutputType), INTENT(IN) :: SrcOutputData - TYPE(AA_OutputType), INTENT(INOUT) :: DstOutputData - 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) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%SumSpecNoise)) THEN - i1_l = LBOUND(SrcOutputData%SumSpecNoise,1) - i1_u = UBOUND(SrcOutputData%SumSpecNoise,1) - i2_l = LBOUND(SrcOutputData%SumSpecNoise,2) - i2_u = UBOUND(SrcOutputData%SumSpecNoise,2) - IF (.NOT. ALLOCATED(DstOutputData%SumSpecNoise)) THEN - ALLOCATE(DstOutputData%SumSpecNoise(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%SumSpecNoise.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%SumSpecNoise = SrcOutputData%SumSpecNoise -ENDIF -IF (ALLOCATED(SrcOutputData%WriteOutput)) THEN - i1_l = LBOUND(SrcOutputData%WriteOutput,1) - i1_u = UBOUND(SrcOutputData%WriteOutput,1) - IF (.NOT. ALLOCATED(DstOutputData%WriteOutput)) THEN - ALLOCATE(DstOutputData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%WriteOutput = SrcOutputData%WriteOutput -ENDIF - END SUBROUTINE AA_CopyOutput - - SUBROUTINE AA_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(AA_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'AA_DestroyOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OutputData%SumSpecNoise)) THEN - DEALLOCATE(OutputData%SumSpecNoise) -ENDIF -IF (ALLOCATED(OutputData%WriteOutput)) THEN - DEALLOCATE(OutputData%WriteOutput) -ENDIF - END SUBROUTINE AA_DestroyOutput - - SUBROUTINE AA_PackOutput( 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(AA_OutputType), 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 = 'AA_PackOutput' - ! 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 - Int_BufSz = Int_BufSz + 1 ! SumSpecNoise allocated yes/no - IF ( ALLOCATED(InData%SumSpecNoise) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SumSpecNoise upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SumSpecNoise) ! SumSpecNoise - END IF - Int_BufSz = Int_BufSz + 1 ! WriteOutput allocated yes/no - IF ( ALLOCATED(InData%WriteOutput) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WriteOutput upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%WriteOutput) ! WriteOutput - END IF - 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 - - IF ( .NOT. ALLOCATED(InData%SumSpecNoise) ) 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%SumSpecNoise,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoise,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SumSpecNoise,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SumSpecNoise,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%SumSpecNoise)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SumSpecNoise))-1 ) = PACK(InData%SumSpecNoise,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SumSpecNoise) - END IF - IF ( .NOT. ALLOCATED(InData%WriteOutput) ) 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%WriteOutput,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) - END IF - END SUBROUTINE AA_PackOutput - - SUBROUTINE AA_UnPackOutput( 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(AA_OutputType), 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 - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'AA_UnPackOutput' - ! 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 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SumSpecNoise 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%SumSpecNoise)) DEALLOCATE(OutData%SumSpecNoise) - ALLOCATE(OutData%SumSpecNoise(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SumSpecNoise.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%SumSpecNoise)>0) OutData%SumSpecNoise = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SumSpecNoise))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SumSpecNoise) - DEALLOCATE(mask2) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput 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%WriteOutput)) DEALLOCATE(OutData%WriteOutput) - ALLOCATE(OutData%WriteOutput(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) - END IF - END SUBROUTINE AA_UnPackOutput - - - SUBROUTINE AA_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is given by the size of u -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(AA_InputType), INTENT(INOUT) :: u(:) ! Input at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Inputs - TYPE(AA_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'AA_Input_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(u)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(u)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(u) - 1 - IF ( order .eq. 0 ) THEN - CALL AA_CopyInput(u(1), u_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AA_Input_ExtrapInterp1(u(1), u(2), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL AA_Input_ExtrapInterp2(u(1), u(2), u(3), t, u_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(u) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE AA_Input_ExtrapInterp - - - SUBROUTINE AA_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = u1, f(t2) = u2 -! -!.................................................................................................................................. - - TYPE(AA_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 - TYPE(AA_InputType), INTENT(INOUT) :: u2 ! Input at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Inputs - TYPE(AA_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'AA_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: b4 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: c4 ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF -IF (ALLOCATED(u_out%RotLtoG) .AND. ALLOCATED(u1%RotLtoG)) THEN - ALLOCATE(b4(SIZE(u_out%RotLtoG,1),SIZE(u_out%RotLtoG,2), & - SIZE(u_out%RotLtoG,3),SIZE(u_out%RotLtoG,4) )) - ALLOCATE(c4(SIZE(u_out%RotLtoG,1),SIZE(u_out%RotLtoG,2), & - SIZE(u_out%RotLtoG,3),SIZE(u_out%RotLtoG,4) )) - b4 = -(u1%RotLtoG - u2%RotLtoG)/t(2) - u_out%RotLtoG = u1%RotLtoG + b4 * t_out - DEALLOCATE(b4) - DEALLOCATE(c4) -END IF ! check if allocated -IF (ALLOCATED(u_out%AeroCent_G) .AND. ALLOCATED(u1%AeroCent_G)) THEN - ALLOCATE(b3(SIZE(u_out%AeroCent_G,1),SIZE(u_out%AeroCent_G,2), & - SIZE(u_out%AeroCent_G,3) )) - ALLOCATE(c3(SIZE(u_out%AeroCent_G,1),SIZE(u_out%AeroCent_G,2), & - SIZE(u_out%AeroCent_G,3) )) - b3 = -(u1%AeroCent_G - u2%AeroCent_G)/t(2) - u_out%AeroCent_G = u1%AeroCent_G + b3 * t_out - DEALLOCATE(b3) - DEALLOCATE(c3) -END IF ! check if allocated -IF (ALLOCATED(u_out%Vrel) .AND. ALLOCATED(u1%Vrel)) THEN - ALLOCATE(b2(SIZE(u_out%Vrel,1),SIZE(u_out%Vrel,2) )) - ALLOCATE(c2(SIZE(u_out%Vrel,1),SIZE(u_out%Vrel,2) )) - b2 = -(u1%Vrel - u2%Vrel)/t(2) - u_out%Vrel = u1%Vrel + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) -END IF ! check if allocated -IF (ALLOCATED(u_out%AoANoise) .AND. ALLOCATED(u1%AoANoise)) THEN - ALLOCATE(b2(SIZE(u_out%AoANoise,1),SIZE(u_out%AoANoise,2) )) - ALLOCATE(c2(SIZE(u_out%AoANoise,1),SIZE(u_out%AoANoise,2) )) - b2 = -(u1%AoANoise - u2%AoANoise)/t(2) - u_out%AoANoise = u1%AoANoise + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) -END IF ! check if allocated - END SUBROUTINE AA_Input_ExtrapInterp1 - - - SUBROUTINE AA_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Input u_out at time t_out, from previous/future time -! values of u (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = u1, f(t2) = u2, f(t3) = u3 -! -!.................................................................................................................................. - - TYPE(AA_InputType), INTENT(INOUT) :: u1 ! Input at t1 > t2 > t3 - TYPE(AA_InputType), INTENT(INOUT) :: u2 ! Input at t2 > t3 - TYPE(AA_InputType), INTENT(INOUT) :: u3 ! Input at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Inputs - TYPE(AA_InputType), INTENT(INOUT) :: u_out ! Input at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Inputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: b4 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: c4 ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'AA_Input_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF -IF (ALLOCATED(u_out%RotLtoG) .AND. ALLOCATED(u1%RotLtoG)) THEN - ALLOCATE(b4(SIZE(u_out%RotLtoG,1),SIZE(u_out%RotLtoG,2), & - SIZE(u_out%RotLtoG,3),SIZE(u_out%RotLtoG,4) )) - ALLOCATE(c4(SIZE(u_out%RotLtoG,1),SIZE(u_out%RotLtoG,2), & - SIZE(u_out%RotLtoG,3),SIZE(u_out%RotLtoG,4) )) - b4 = (t(3)**2*(u1%RotLtoG - u2%RotLtoG) + t(2)**2*(-u1%RotLtoG + u3%RotLtoG))/(t(2)*t(3)*(t(2) - t(3))) - c4 = ( (t(2)-t(3))*u1%RotLtoG + t(3)*u2%RotLtoG - t(2)*u3%RotLtoG ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%RotLtoG = u1%RotLtoG + b4 * t_out + c4 * t_out**2 - DEALLOCATE(b4) - DEALLOCATE(c4) -END IF ! check if allocated -IF (ALLOCATED(u_out%AeroCent_G) .AND. ALLOCATED(u1%AeroCent_G)) THEN - ALLOCATE(b3(SIZE(u_out%AeroCent_G,1),SIZE(u_out%AeroCent_G,2), & - SIZE(u_out%AeroCent_G,3) )) - ALLOCATE(c3(SIZE(u_out%AeroCent_G,1),SIZE(u_out%AeroCent_G,2), & - SIZE(u_out%AeroCent_G,3) )) - b3 = (t(3)**2*(u1%AeroCent_G - u2%AeroCent_G) + t(2)**2*(-u1%AeroCent_G + u3%AeroCent_G))/(t(2)*t(3)*(t(2) - t(3))) - c3 = ( (t(2)-t(3))*u1%AeroCent_G + t(3)*u2%AeroCent_G - t(2)*u3%AeroCent_G ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%AeroCent_G = u1%AeroCent_G + b3 * t_out + c3 * t_out**2 - DEALLOCATE(b3) - DEALLOCATE(c3) -END IF ! check if allocated -IF (ALLOCATED(u_out%Vrel) .AND. ALLOCATED(u1%Vrel)) THEN - ALLOCATE(b2(SIZE(u_out%Vrel,1),SIZE(u_out%Vrel,2) )) - ALLOCATE(c2(SIZE(u_out%Vrel,1),SIZE(u_out%Vrel,2) )) - b2 = (t(3)**2*(u1%Vrel - u2%Vrel) + t(2)**2*(-u1%Vrel + u3%Vrel))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Vrel + t(3)*u2%Vrel - t(2)*u3%Vrel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Vrel = u1%Vrel + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) -END IF ! check if allocated -IF (ALLOCATED(u_out%AoANoise) .AND. ALLOCATED(u1%AoANoise)) THEN - ALLOCATE(b2(SIZE(u_out%AoANoise,1),SIZE(u_out%AoANoise,2) )) - ALLOCATE(c2(SIZE(u_out%AoANoise,1),SIZE(u_out%AoANoise,2) )) - b2 = (t(3)**2*(u1%AoANoise - u2%AoANoise) + t(2)**2*(-u1%AoANoise + u3%AoANoise))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%AoANoise + t(3)*u2%AoANoise - t(2)*u3%AoANoise ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%AoANoise = u1%AoANoise + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) -END IF ! check if allocated - END SUBROUTINE AA_Input_ExtrapInterp2 - - - SUBROUTINE AA_Output_ExtrapInterp(y, t, y_out, t_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is given by the size of y -! -! expressions below based on either -! -! f(t) = a -! f(t) = a + b * t, or -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 (as appropriate) -! -!.................................................................................................................................. - - TYPE(AA_OutputType), INTENT(INOUT) :: y(:) ! Output at t1 > t2 > t3 - REAL(DbKi), INTENT(IN ) :: t(:) ! Times associated with the Outputs - TYPE(AA_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: t_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'AA_Output_ExtrapInterp' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - if ( size(t) .ne. size(y)) then - CALL SetErrStat(ErrID_Fatal,'size(t) must equal size(y)',ErrStat,ErrMsg,RoutineName) - RETURN - endif - order = SIZE(y) - 1 - IF ( order .eq. 0 ) THEN - CALL AA_CopyOutput(y(1), y_out, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 1 ) THEN - CALL AA_Output_ExtrapInterp1(y(1), y(2), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE IF ( order .eq. 2 ) THEN - CALL AA_Output_ExtrapInterp2(y(1), y(2), y(3), t, y_out, t_out, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - ELSE - CALL SetErrStat(ErrID_Fatal,'size(y) must be less than 4 (order must be less than 3).',ErrStat,ErrMsg,RoutineName) - RETURN - ENDIF - END SUBROUTINE AA_Output_ExtrapInterp - - - SUBROUTINE AA_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 1. -! -! f(t) = a + b * t, or -! -! where a and b are determined as the solution to -! f(t1) = y1, f(t2) = y2 -! -!.................................................................................................................................. - - TYPE(AA_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 - TYPE(AA_OutputType), INTENT(INOUT) :: y2 ! Output at t2 - REAL(DbKi), INTENT(IN ) :: tin(2) ! Times associated with the Outputs - TYPE(AA_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(2) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - CHARACTER(*), PARAMETER :: RoutineName = 'AA_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF -IF (ALLOCATED(y_out%SumSpecNoise) .AND. ALLOCATED(y1%SumSpecNoise)) THEN - ALLOCATE(b2(SIZE(y_out%SumSpecNoise,1),SIZE(y_out%SumSpecNoise,2) )) - ALLOCATE(c2(SIZE(y_out%SumSpecNoise,1),SIZE(y_out%SumSpecNoise,2) )) - b2 = -(y1%SumSpecNoise - y2%SumSpecNoise)/t(2) - y_out%SumSpecNoise = y1%SumSpecNoise + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) -END IF ! check if allocated -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) -END IF ! check if allocated - END SUBROUTINE AA_Output_ExtrapInterp1 - - - SUBROUTINE AA_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, ErrMsg ) -! -! This subroutine calculates a extrapolated (or interpolated) Output y_out at time t_out, from previous/future time -! values of y (which has values associated with times in t). Order of the interpolation is 2. -! -! expressions below based on either -! -! f(t) = a + b * t + c * t**2 -! -! where a, b and c are determined as the solution to -! f(t1) = y1, f(t2) = y2, f(t3) = y3 -! -!.................................................................................................................................. - - TYPE(AA_OutputType), INTENT(INOUT) :: y1 ! Output at t1 > t2 > t3 - TYPE(AA_OutputType), INTENT(INOUT) :: y2 ! Output at t2 > t3 - TYPE(AA_OutputType), INTENT(INOUT) :: y3 ! Output at t3 - REAL(DbKi), INTENT(IN ) :: tin(3) ! Times associated with the Outputs - TYPE(AA_OutputType), INTENT(INOUT) :: y_out ! Output at tin_out - REAL(DbKi), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - ! local variables - REAL(DbKi) :: t(3) ! Times associated with the Outputs - REAL(DbKi) :: t_out ! Time to which to be extrap/interpd - INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - INTEGER(IntKi) :: ErrStat2 ! local errors - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors - CHARACTER(*), PARAMETER :: RoutineName = 'AA_Output_ExtrapInterp2' - ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" - ! we'll subtract a constant from the times to resolve some - ! numerical issues when t gets large (and to simplify the equations) - t = tin - tin(1) - t_out = tin_out - tin(1) - - IF ( EqualRealNos( t(1), t(2) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(2), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(2) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN - CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF -IF (ALLOCATED(y_out%SumSpecNoise) .AND. ALLOCATED(y1%SumSpecNoise)) THEN - ALLOCATE(b2(SIZE(y_out%SumSpecNoise,1),SIZE(y_out%SumSpecNoise,2) )) - ALLOCATE(c2(SIZE(y_out%SumSpecNoise,1),SIZE(y_out%SumSpecNoise,2) )) - b2 = (t(3)**2*(y1%SumSpecNoise - y2%SumSpecNoise) + t(2)**2*(-y1%SumSpecNoise + y3%SumSpecNoise))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%SumSpecNoise + t(3)*y2%SumSpecNoise - t(2)*y3%SumSpecNoise ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%SumSpecNoise = y1%SumSpecNoise + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) -END IF ! check if allocated -IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) -END IF ! check if allocated - END SUBROUTINE AA_Output_ExtrapInterp2 - -END MODULE AeroAcoustics_Types -!ENDOFREGISTRYGENERATEDFILE diff --git a/modules/aerodyn/src/AeroAcoustics/CMakeLists.txt b/modules/aerodyn/src/AeroAcoustics/CMakeLists.txt deleted file mode 100644 index b650c3250..000000000 --- a/modules/aerodyn/src/AeroAcoustics/CMakeLists.txt +++ /dev/null @@ -1,14 +0,0 @@ - -add_subdirectory(TNO) -add_subdirectory(TINoise) -###add_subdirectory(src/Xfoil) - -# NOTE: generated as well in parent dir -generate_f90_types(../AirfoilInfo_Registry.txt AirfoilInfo_Types.f90 -noextrap) -generate_f90_types(../AeroAcoustics_Registry.txt AeroAcoustics_Types.f90) - -add_library(AeroAcoustics AeroAcoustics.f90 AeroAcoustics_IO.f90 AirfoilInfo_Types.f90 AeroAcoustics_Types.f90) - -target_link_libraries(AeroAcoustics nwtclibs FullGuidati TNO ) -###target_link_libraries(AeroAcoustics nwtclibs RunXfoil FullGuidati TNO ) - diff --git a/modules/aerodyn/src/AeroAcoustics/TINoise/CMakeLists.txt b/modules/aerodyn/src/AeroAcoustics/TINoise/CMakeLists.txt deleted file mode 100644 index cc783e278..000000000 --- a/modules/aerodyn/src/AeroAcoustics/TINoise/CMakeLists.txt +++ /dev/null @@ -1,4 +0,0 @@ - -add_library(FullGuidati CDA0.f90 CDI0.f90 DEFGEO.f90 DETCP.f90 DETFIELD.f90 DETSPL.f90 DETSTR.f90 DRM_ACU.f90 DRM_AER.f90 FLAT.f90 FUNCS_LM.f90 HANK0.f90 HANK1.f90 INICON.f90 odeint.f90 PRESOUR.f90 READIN.f90 RHSINT.f90 rkck.f90 rkqs.f90 SETMATA.f90 SETMAT.f90 SETRHSA.f90 SETRHS.f90 SOLSEQA.f90 SOLSEQ.f90 SPL_E0A.f90 SPL_E1A.f90 SPL_EX1.f90 SPL_EX2.f90 SPL_EX3.f90 SPL_EX.f90 SPL_PA.f90 SPL_P.f90 SPL_PPA.f90 SPL_PP.f90 STREAM.f90 TI_Noise.f90 TINoiseMods.f90 WAKE.f90 ) - -target_include_directories (FullGuidati PUBLIC) diff --git a/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_E0A.f90 b/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_E0A.f90 index d1a641670..6e31b0f1a 100644 --- a/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_E0A.f90 +++ b/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_E0A.f90 @@ -34,7 +34,10 @@ subroutine SPL_E0A (xa, ya, y2a, n, x, y, khi, klo) h = xa(khi) - xa(klo) - if (h.eq.0.) pause 'bad xa input in splint' + if (h.eq.0.) then + write(*,*)'ERROR:TINoise:SPL_E0A: bad xa input in splint' + STOP 1 + endif a = (xa(khi) - x) / h b = (x - xa(klo)) / h y = a * ya(klo) + b * ya(khi) + ((a**3.0d0 - a) * y2a(klo) & diff --git a/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_E1A.f90 b/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_E1A.f90 index 55f03e5e6..a59553764 100644 --- a/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_E1A.f90 +++ b/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_E1A.f90 @@ -34,7 +34,10 @@ subroutine SPL_E1A (xa, ya, y2a, n, x, y, dydx, khi, klo) h = xa(khi) - xa(klo) - if (h.eq.0.) pause 'bad xa input in splint' + if (h.eq.0.) then + write(*,*)'ERROR:TINoise:SPL_E0A: bad xa input in splint' + STOP 1 + endif a = (xa(khi) - x) / h b = (x - xa(klo)) / h y = a * ya(klo) + b * ya(khi) + ((a**3.0d0 - a) * y2a(klo) & diff --git a/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_EX1.f90 b/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_EX1.f90 index 034b04b43..069cb4b37 100644 --- a/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_EX1.f90 +++ b/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_EX1.f90 @@ -42,8 +42,9 @@ subroutine SPL_EX1 (xa, ya, y2a, n, x, y, dydx, khi, klo) h = xa(khi)-xa(klo) if (h.eq.0.) then - pause 'bad xa input in splint' - endif + write(*,*)'ERROR:TINoise:SPL_E0A: bad xa input in splint' + STOP 1 + endif a = (xa(khi)-x)/h b = (x-xa(klo))/h y = a*ya(klo)+b*ya(khi)+((a*a*a-a)*y2a(klo)+(b*b*b-b)*y2a(khi))*(h*h)/6.0d0 diff --git a/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_EX2.f90 b/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_EX2.f90 index 78a7e62d3..36520c47c 100644 --- a/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_EX2.f90 +++ b/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_EX2.f90 @@ -32,7 +32,10 @@ subroutine SPL_EX2 (xa, ya, y2a, n, x, y, khi, klo) h = xa(khi) - xa(klo) - if (h.eq.0.) pause 'bad xa input in splint' + if (h.eq.0.) then + write(*,*)'ERROR:TINoise:SPL_E0A: bad xa input in splint' + STOP 1 + endif a = (xa(khi) - x) / h b = (x - xa(klo)) / h y = a * ya(klo) + b * ya(khi) + ((a**3.0d0 - a) * y2a(klo) & diff --git a/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_EX3.f90 b/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_EX3.f90 index 4d84f63c6..aa760b6c0 100644 --- a/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_EX3.f90 +++ b/modules/aerodyn/src/AeroAcoustics/TINoise/SPL_EX3.f90 @@ -32,7 +32,11 @@ subroutine SPL_EX3 (xa, ya, y2a, n, x, y, dydx, d2ydx2, khi, klo) h = xa(khi) - xa(klo) - if (h.eq.0.) pause 'bad xa input in splint' + if (h.eq.0.) then + write(*,*)'ERROR:TINoise:SPL_E0A: bad xa input in splint' + STOP 1 + endif + a = (xa(khi) - x) / h b = (x - xa(klo)) / h y = a * ya(klo) + b * ya(khi) + ((a**3.0d0 - a) * y2a(klo) & diff --git a/modules/aerodyn/src/AeroAcoustics/TINoise/TINoiseMods.f90 b/modules/aerodyn/src/AeroAcoustics/TINoise/TINoiseMods.f90 index 458259add..d3b2907c0 100644 --- a/modules/aerodyn/src/AeroAcoustics/TINoise/TINoiseMods.f90 +++ b/modules/aerodyn/src/AeroAcoustics/TINoise/TINoiseMods.f90 @@ -1,194 +1,139 @@ !-----common-------------------------------------------------g.guidati-- -! -! -!----------------------------------------------------------------------- -! -! franco guidati IAG -! Uni Stuttgart +! Franco Guidati IAG, Uni Stuttgart ! modified by Pat Moriarty 10/15/2003 -! -!....................................................................... -! declarations !....................................................................... !======================================================================= MODULE TIPrecision - - - ! This module stores constants to specify the KIND of variables. - - -INTEGER(4), PARAMETER :: DbKi = 8 ! Default kind for double-precision numbers. -INTEGER(4), PARAMETER :: ReKi = 8 ! Default kind for real numbers. - ! NOTE: Use compile option "/real_size:64" (or "/4R8") when using ReKi = 8 - + ! This module stores constants to specify the KIND of variables. + INTEGER(4), PARAMETER :: DbKi = 8 ! Default kind for double-precision numbers. + INTEGER(4), PARAMETER :: ReKi = 8 ! Default kind for real numbers. + ! NOTE: Use compile option "/real_size:64" (or "/4R8") when using ReKi = 8 END MODULE TIPrecision !======================================================================= MODULE TIParams - -INTEGER(4), PARAMETER :: m_in =500 -INTEGER(4), PARAMETER :: mstr=1500 -INTEGER(4), PARAMETER :: mpath = 400 - + INTEGER(4), PARAMETER :: m_in =500 + INTEGER(4), PARAMETER :: mstr=1500 + INTEGER(4), PARAMETER :: mpath = 400 END MODULE TIParams !======================================================================= MODULE TINoiseGeneric - -USE TIPrecision -USE TIParams - -INTEGER(4), PARAMETER :: n=200 -INTEGER(4), PARAMETER :: na=200 - -REAL(DbKi), PARAMETER :: LLL = 0.1 -REAL(DbKi), PARAMETER :: rad = 20.0 -REAL(DbKi) :: mach_ti -REAL(DbKi) :: kappa -REAL(DbKi) :: kwave -REAL(DbKi) :: nc1at(na+1) -REAL(DbKi) :: nc2at(na+1) -REAL(DbKi) :: kwave2 -REAL(DbKi) :: freq,csound,strou -REAL(DbKi) :: pstr1(mstr,mpath),pstr2(mstr,mpath),tim(mstr) -REAL(DbKi) :: d2pstr1(mstr,mpath),d2pstr2(mstr,mpath) -REAL(DbKi) :: poti(mstr,mpath),d2poti(mstr,mpath) -REAL(DbKi) :: yc1at(na+1),yc2at(na+1),d2yc1at(na+1) -REAL(DbKi) :: d2yc2at(na+1),sworkat(na+1) -REAL(DbKi) :: d2yc1(n+1), d2yc2(n+1) -REAL(DbKi) :: tc1at(na+1),tc2at(na+1),pi2,pi2i,pi - -COMPLEX(DbKi) :: Kerna(na+2,na+2) -COMPLEX(DbKi) :: rhsa(na+2,mpath) -COMPLEX(DbKi) :: imag -COMPLEX(DbKi) :: abb1 -COMPLEX(DbKi) :: potsat(na+1,mpath) -COMPLEX(DbKi) :: d2potsat(na+1,mpath) -COMPLEX(DbKi) :: potsum(na+1) -COMPLEX(DbKi) :: d2potsum(na+1) -COMPLEX(DbKi) :: dipole_strength(mstr,mpath) -COMPLEX(DbKi) :: d2dipole_strength(mstr,mpath) - - + USE TIPrecision + USE TIParams + INTEGER(4), PARAMETER :: n=200 + INTEGER(4), PARAMETER :: na=200 + REAL(DbKi), PARAMETER :: LLL = 0.1 + REAL(DbKi), PARAMETER :: rad = 20.0 + REAL(DbKi) :: mach_ti + REAL(DbKi) :: kappa + REAL(DbKi) :: kwave + REAL(DbKi) :: nc1at(na+1) + REAL(DbKi) :: nc2at(na+1) + REAL(DbKi) :: kwave2 + REAL(DbKi) :: freq,csound,strou + REAL(DbKi) :: pstr1(mstr,mpath),pstr2(mstr,mpath),tim(mstr) + REAL(DbKi) :: d2pstr1(mstr,mpath),d2pstr2(mstr,mpath) + REAL(DbKi) :: poti(mstr,mpath),d2poti(mstr,mpath) + REAL(DbKi) :: yc1at(na+1),yc2at(na+1),d2yc1at(na+1) + REAL(DbKi) :: d2yc2at(na+1),sworkat(na+1) + REAL(DbKi) :: d2yc1(n+1), d2yc2(n+1) + REAL(DbKi) :: tc1at(na+1),tc2at(na+1),pi2,pi2i,pi + COMPLEX(DbKi) :: Kerna(na+2,na+2) + COMPLEX(DbKi) :: rhsa(na+2,mpath) + COMPLEX(DbKi) :: imag + COMPLEX(DbKi) :: abb1 + COMPLEX(DbKi) :: potsat(na+1,mpath) + COMPLEX(DbKi) :: d2potsat(na+1,mpath) + COMPLEX(DbKi) :: potsum(na+1) + COMPLEX(DbKi) :: d2potsum(na+1) + COMPLEX(DbKi) :: dipole_strength(mstr,mpath) + COMPLEX(DbKi) :: d2dipole_strength(mstr,mpath) END MODULE TINoiseGeneric !======================================================================= MODULE TINoiseInput - -USE TIPrecision -USE TINoiseGeneric - -INTEGER(4), PARAMETER :: mairfoil = 1 -INTEGER(4), PARAMETER :: mfreq = 100 -INTEGER(4), PARAMETER :: nklow = -50 -INTEGER(4), PARAMETER :: nkhig = 50 -INTEGER(4), PARAMETER :: ndk = 1 -INTEGER(4), PARAMETER :: nstr = 1025 -INTEGER(4), PARAMETER :: nitera = 20 - -REAL(ReKi) :: alpha_in(mairfoil),freq_in(mfreq),chord,dpath -REAL(DbKi), PARAMETER :: xsmo1 = 5.0 -REAL(DbKi), PARAMETER :: xsmo2 = 10.0 -REAL(DbKi), PARAMETER :: deltat = 0.003 -REAL(DbKi), PARAMETER :: xsta1 = -1.0 - -CHARACTER(99) :: cairfoil(mairfoil) -CHARACTER(99) :: cdescript(mairfoil) - -INTEGER(4) :: npath,nairfoil,nfreq - -LOGICAL(1), PARAMETER :: lspectrum = .TRUE. - + USE TIPrecision + USE TINoiseGeneric + INTEGER(4), PARAMETER :: mairfoil = 1 + INTEGER(4), PARAMETER :: mfreq = 100 + INTEGER(4), PARAMETER :: nklow = -50 + INTEGER(4), PARAMETER :: nkhig = 50 + INTEGER(4), PARAMETER :: ndk = 1 + INTEGER(4), PARAMETER :: nstr = 1025 + INTEGER(4), PARAMETER :: nitera = 20 + REAL(ReKi) :: alpha_in(mairfoil),freq_in(mfreq),chord,dpath + REAL(DbKi), PARAMETER :: xsmo1 = 5.0 + REAL(DbKi), PARAMETER :: xsmo2 = 10.0 + REAL(DbKi), PARAMETER :: deltat = 0.003 + REAL(DbKi), PARAMETER :: xsta1 = -1.0 + CHARACTER(99) :: cairfoil(mairfoil) + CHARACTER(99) :: cdescript(mairfoil) + INTEGER(4) :: npath,nairfoil,nfreq + LOGICAL(1), PARAMETER :: lspectrum = .TRUE. END MODULE TINoiseInput !======================================================================= MODULE TINoiseGeo - -USE TIPrecision -USE TINoiseGeneric - -REAL(DbKi) :: td(4,4), Ad(4,4), alfa, Kern(n+2,n+2),rhs(n+2),pots(n+1), d2pots(n+1), ds(n) -REAL(DbKi) :: ywinf1, ywinf2, ywn1, ywn2, swork(n+1), yc1(n+1), yc2(n+1) -REAL(DbKi) :: tc1(n+1), tc2(n+1),dst(-2:2,-2:2) -REAL(DbKi) :: nc1(n+1), nc2(n+1) - -INTEGER(4) :: ipiv(n+2), ipiva(na+2) - + USE TIPrecision + USE TINoiseGeneric + REAL(DbKi) :: td(4,4), Ad(4,4), alfa, Kern(n+2,n+2),rhs(n+2),pots(n+1), d2pots(n+1), ds(n) + REAL(DbKi) :: ywinf1, ywinf2, ywn1, ywn2, swork(n+1), yc1(n+1), yc2(n+1) + REAL(DbKi) :: tc1(n+1), tc2(n+1),dst(-2:2,-2:2) + REAL(DbKi) :: nc1(n+1), nc2(n+1) + INTEGER(4) :: ipiv(n+2), ipiva(na+2) END MODULE TINoiseGeo !======================================================================= MODULE TINoiseDDD - -USE TIPrecision - -REAL(DbKi) :: x1, x2, s1, s2 + USE TIPrecision + REAL(DbKi) :: x1, x2, s1, s2 END MODULE TINoiseDDD !======================================================================= MODULE TINoiseRHSin -USE TIPrecision - -INTEGER(4) :: ipath -LOGICAL(1) :: lderiv + USE TIPrecision + INTEGER(4) :: ipath + LOGICAL(1) :: lderiv END MODULE TINoiseRHSin !======================================================================= MODULE TINoiseFLAT - -USE TIPrecision - -REAL(DbKi) :: eta2 + USE TIPrecision + REAL(DbKi) :: eta2 END MODULE TINoiseFLAT !======================================================================= MODULE TINoisePATH - -USE TIPrecision - -INTEGER(4), PARAMETER :: MAXSTP=100000 -INTEGER(4), PARAMETER :: NMAX=50 -INTEGER(4), PARAMETER :: kmax=200 -INTEGER(4) :: kount - -REAL(DbKi) :: dxsav,xp(kmax),yp(NMAX,kmax) -REAL(DbKi), PARAMETER :: TINY=1.e-30 - + USE TIPrecision + INTEGER(4), PARAMETER :: MAXSTP=100000 + INTEGER(4), PARAMETER :: NMAX=50 + INTEGER(4), PARAMETER :: kmax=200 + INTEGER(4) :: kount + REAL(DbKi) :: dxsav,xp(kmax),yp(NMAX,kmax) + REAL(DbKi), PARAMETER :: TINY=1.e-30 END MODULE TINoisePATH !======================================================================= MODULE TINoiseCancela - -USE TIPrecision - -INTEGER(4) :: icanc -REAL(DbKi) :: sobs + USE TIPrecision + INTEGER(4) :: icanc + REAL(DbKi) :: sobs END MODULE TINoiseCancela !======================================================================= MODULE TINoiseDombon - -USE TIPrecision - -INTEGER(4) :: jdom + USE TIPrecision + INTEGER(4) :: jdom END MODULE TINoiseDombon !======================================================================= MODULE TINoiseVsside - -USE TIPrecision - -INTEGER(4) :: ivsside, iping + USE TIPrecision + INTEGER(4) :: ivsside, iping END MODULE TINoiseVsside !======================================================================= MODULE TICoords - -USE TIPrecision -USE TIParams - -INTEGER(4) :: n_in -REAL(DbKi) :: x_ti(m_in),y_ti(m_in) - - + USE TIPrecision + USE TIParams + INTEGER(4) :: n_in + REAL(DbKi) :: x_ti(m_in),y_ti(m_in) END MODULE TICoords !======================================================================= MODULE TI_Guidati - -USE TIPrecision - -INTEGER(4) :: icount_freq -INTEGER(4),PARAMETER :: NumFreqBands = 34 !must be same as NumBands in TNO Mods - -REAL(ReKi) :: SPL_Airfoil(NumFreqBands) -REAL(ReKi) :: SPL_FlatPlate(NumFreqBands) -REAL(ReKi) :: DSPL_TI(NumFreqBands) - + USE TIPrecision + INTEGER(4) :: icount_freq + INTEGER(4),PARAMETER :: NumFreqBands = 34 !must be same as NumBands in TNO Mods + REAL(ReKi) :: SPL_Airfoil(NumFreqBands) + REAL(ReKi) :: SPL_FlatPlate(NumFreqBands) + REAL(ReKi) :: DSPL_TI(NumFreqBands) END MODULE TI_Guidati diff --git a/modules/aerodyn/src/AeroAcoustics/TINoise/odeint.f90 b/modules/aerodyn/src/AeroAcoustics/TINoise/odeint.f90 index f03ba7741..29f74cf8f 100644 --- a/modules/aerodyn/src/AeroAcoustics/TINoise/odeint.f90 +++ b/modules/aerodyn/src/AeroAcoustics/TINoise/odeint.f90 @@ -62,10 +62,12 @@ SUBROUTINE odeint(ystart,nvar,x1,x2,eps,h1,hmin,nok,nbad,derivs,rkqs) return endif if(abs(hnext).lt.hmin) then - pause 'stepsize smaller than minimum in odeint' + write(*,*)'ERROR:xfoil:odeint: stepsize smaller than minimum in odeint' + STOP 1 endif h=hnext 16 continue - pause 'too many steps in odeint' + write(*,*)'ERROR:xfoil:odeint: too many steps in odeint' + STOP 1 return END diff --git a/modules/aerodyn/src/AeroAcoustics/TINoise/rkqs.f90 b/modules/aerodyn/src/AeroAcoustics/TINoise/rkqs.f90 index 0fb2bac13..d23f76b17 100644 --- a/modules/aerodyn/src/AeroAcoustics/TINoise/rkqs.f90 +++ b/modules/aerodyn/src/AeroAcoustics/TINoise/rkqs.f90 @@ -30,7 +30,10 @@ SUBROUTINE rkqs(y,dydx,n,x,htry,eps,yscal,hdid,hnext,derivs) h=.1*h endif xnew=x+h - if(xnew.eq.x)pause 'stepsize underflow in rkqs' + if(xnew.eq.x) then + write(*,*)'ERROR:xfoil:rkqs: stepsize underflow in rkqs' + STOP 1 + endif goto 1 else if(errmax.gt.ERRCON)then diff --git a/modules/aerodyn/src/AeroAcoustics/TNO/CMakeLists.txt b/modules/aerodyn/src/AeroAcoustics/TNO/CMakeLists.txt deleted file mode 100644 index ea54ef04d..000000000 --- a/modules/aerodyn/src/AeroAcoustics/TNO/CMakeLists.txt +++ /dev/null @@ -1,4 +0,0 @@ - -add_library(TNO int1.f90 int2.f90 TNOMods.f90 pressure.f90 qk61.f ) - -target_include_directories (TNO PUBLIC) diff --git a/modules/aerodyn/src/AeroAcoustics/TNO/TNOMods.f90 b/modules/aerodyn/src/AeroAcoustics/TNO/TNOMods.f90 index 1633d2f26..d92817058 100644 --- a/modules/aerodyn/src/AeroAcoustics/TNO/TNOMods.f90 +++ b/modules/aerodyn/src/AeroAcoustics/TNO/TNOMods.f90 @@ -1,81 +1,53 @@ MODULE TNOConstants - -USE Precision - -REAL (kind=4),PARAMETER :: Cnuk = 5.5 -REAL (kind=4),PARAMETER :: kappa = 0.41 -REAL (kind=4),PARAMETER :: Cmu = 0.09 -REAL (kind=4),PARAMETER :: pi = 3.1415 - -INTEGER (4),PARAMETER :: limit = 5000 - -INTEGER (4) :: i_omega -!!REAL (ReKi),ALLOCATABLE :: omega(:) -REAL (kind=4) :: omega - + use ISO_FORTRAN_ENV + REAL (kind=4),PARAMETER :: Cnuk = 5.5 + REAL (kind=4),PARAMETER :: kappa = 0.41 + REAL (kind=4),PARAMETER :: Cmu = 0.09 + REAL (kind=4),PARAMETER :: pi = 3.1415 + INTEGER (4),PARAMETER :: limit = 5000 + INTEGER (4) :: i_omega + !!REAL (ReKi),ALLOCATABLE :: omega(:) + REAL (kind=4) :: omega END MODULE TNOConstants - !=========================================================== - MODULE Atmosphere - -USE Precision - -!atmosphere constants -REAL (kind=4) nu -REAL (kind=4) co -REAL (kind=4) rho - + use ISO_FORTRAN_ENV + !atmosphere constants + REAL (kind=4) nu + REAL (kind=4) co + REAL (kind=4) rho END MODULE Atmosphere - - !=========================================================== - MODULE Wavenumber - -USE Precision - -REAL (kind=4) :: k -REAL (kind=4) :: k1 -REAL (kind=4) :: k3 - + use ISO_FORTRAN_ENV + REAL (kind=4) :: k + REAL (kind=4) :: k1 + REAL (kind=4) :: k3 END MODULE Wavenumber - !=========================================================== - MODULE BLParams - -USE Precision -REAL (kind=4) :: d99(2) -REAL (kind=4) :: Cf(2) -REAL (kind=4) :: d_star(2) -REAL (kind=4) :: edgevel(2) + use ISO_FORTRAN_ENV + REAL (kind=4) :: d99(2) + REAL (kind=4) :: Cf(2) + REAL (kind=4) :: d_star(2) + REAL (kind=4) :: edgevel(2) END MODULE BLParams !=========================================================== - MODULE AirfoilParams - -USE Precision - -CHARACTER*128 :: airfoil -REAL (kind=4) :: aofa,a_chord,Mach,Re -REAL (kind=4) :: xtrup, xtrlo -LOGICAL :: ISTRIPPED -LOGICAL :: ISNACA -LOGICAL :: ISSUCTION - + use ISO_FORTRAN_ENV + CHARACTER*128 :: airfoil + REAL(kind=4) :: aofa,a_chord,Mach,Re + REAL(kind=4) :: xtrup, xtrlo + LOGICAL :: ISTRIPPED + LOGICAL :: ISNACA + LOGICAL :: ISSUCTION END MODULE AirfoilParams - !=========================================================== - MODULE Third_Octave_Bands - -USE Precision - -INTEGER (4),PARAMETER :: NumBands = 34 -REAL (kind=4),PARAMETER :: Third_Octave(NumBands) = (/10.,12.5,16.,20.,25.,31.5,40.,50.,63.,80., & - 100.,125.,160.,200.,250.,315.,400.,500.,630.,800., & - 1000.,1250.,1600.,2000.,2500.,3150.,4000.,5000.,6300.,8000., & - 10000.,12500.,16000.,20000./) - + use ISO_FORTRAN_ENV + INTEGER (4),PARAMETER :: NumBands = 34 + REAL (kind=4),PARAMETER :: Third_Octave(NumBands) = (/10.,12.5,16.,20.,25.,31.5,40.,50.,63.,80., & + 100.,125.,160.,200.,250.,315.,400.,500.,630.,800., & + 1000.,1250.,1600.,2000.,2500.,3150.,4000.,5000.,6300.,8000., & + 10000.,12500.,16000.,20000./) END MODULE Third_Octave_Bands diff --git a/modules/aerodyn/src/AeroAcoustics/TNO/int1.f90 b/modules/aerodyn/src/AeroAcoustics/TNO/int1.f90 index 82ec38028..2bac7ec61 100644 --- a/modules/aerodyn/src/AeroAcoustics/TNO/int1.f90 +++ b/modules/aerodyn/src/AeroAcoustics/TNO/int1.f90 @@ -2,7 +2,7 @@ FUNCTION int1(x2) USE Atmosphere USE BLParams -USE Precision +use ISO_FORTRAN_ENV USE TNOConstants USE Wavenumber USE AirfoilParams diff --git a/modules/aerodyn/src/AeroAcoustics/TNO/pressure.f90 b/modules/aerodyn/src/AeroAcoustics/TNO/pressure.f90 index 0dc412986..ecf8520c1 100644 --- a/modules/aerodyn/src/AeroAcoustics/TNO/pressure.f90 +++ b/modules/aerodyn/src/AeroAcoustics/TNO/pressure.f90 @@ -3,7 +3,7 @@ FUNCTION Pressure(k1_in) USE Atmosphere USE AirfoilParams USE BLParams - USE Precision + use ISO_FORTRAN_ENV USE TNOConstants USE Wavenumber diff --git a/modules/aerodyn/src/AeroAcoustics/Xfoil/CMakeLists.txt b/modules/aerodyn/src/AeroAcoustics/Xfoil/CMakeLists.txt deleted file mode 100644 index 9f0d453e5..000000000 --- a/modules/aerodyn/src/AeroAcoustics/Xfoil/CMakeLists.txt +++ /dev/null @@ -1,4 +0,0 @@ - -add_library(RunXfoil dplot_noise.f get_airfoil_coords.f naca.f plutil_noise.f profil.f sort.f spline.f userio.f xbl.f xblsys.f xfoil_noise.f xgdes_noise.f xgeom_noise.f xoper_noise.f xpanel.f xsolve.f xtcam_noise.f xutils.f xfoil_noise_mods.f90 XFOIL.INC XBL.INC CIRCLE.INC PINDEX.INC) - -target_include_directories (RunXfoil PUBLIC) diff --git a/modules/aerodyn/src/AeroAcoustics/Xfoil/dplot_noise.f b/modules/aerodyn/src/AeroAcoustics/Xfoil/dplot_noise.f index 7a5d8f61c..1fe0c7442 100644 --- a/modules/aerodyn/src/AeroAcoustics/Xfoil/dplot_noise.f +++ b/modules/aerodyn/src/AeroAcoustics/Xfoil/dplot_noise.f @@ -20,7 +20,7 @@ SUBROUTINE DPLOT_Noise(NPR1,XPR,YPR) - USE XfoilBLParams + USE XfoilBLParams, only: Cf, d99, d_star INCLUDE 'XFOIL.INC' C----------------------------------------------------------- diff --git a/modules/aerodyn/src/AeroAcoustics/Xfoil/xbl.f~ b/modules/aerodyn/src/AeroAcoustics/Xfoil/xbl.f~ deleted file mode 100644 index c91f2a14d..000000000 --- a/modules/aerodyn/src/AeroAcoustics/Xfoil/xbl.f~ +++ /dev/null @@ -1,1579 +0,0 @@ -C*********************************************************************** -C Module: xbl.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** -C - SUBROUTINE SETBL -C------------------------------------------------- -C Sets up the BL Newton system coefficients -C for the current BL variables and the edge -C velocities received from SETUP. The local -C BL system coefficients are then -C incorporated into the global Newton system. -C------------------------------------------------- - INCLUDE 'XFOIL.INC' - INCLUDE 'XBL.INC' - REAL USAV(IVX,2) - REAL U1_M(2*IVX), U2_M(2*IVX) - REAL D1_M(2*IVX), D2_M(2*IVX) - REAL ULE1_M(2*IVX), ULE2_M(2*IVX) - REAL UTE1_M(2*IVX), UTE2_M(2*IVX) - REAL MA_CLMR, MSQ_CLMR, MDI -C -C---- set the CL used to define Mach, Reynolds numbers - IF(LALFA) THEN - CLMR = CL - ELSE - CLMR = CLSPEC - ENDIF -C -C---- set current MINF(CL) - CALL MRCL(CLMR,MA_CLMR,RE_CLMR) - MSQ_CLMR = 2.0*MINF*MA_CLMR -C -C---- set compressibility parameter TKLAM and derivative TK_MSQ - CALL COMSET -C -C---- set gas constant (= Cp/Cv) - GAMBL = GAMMA - GM1BL = GAMM1 -C -C---- set parameters for compressibility correction - QINFBL = QINF - TKBL = TKLAM - TKBL_MS = TKL_MSQ -C -C---- stagnation density and 1/enthalpy - RSTBL = (1.0 + 0.5*GM1BL*MINF**2) ** (1.0/GM1BL) - RSTBL_MS = 0.5*RSTBL/(1.0 + 0.5*GM1BL*MINF**2) -C - HSTINV = GM1BL*(MINF/QINFBL)**2 / (1.0 + 0.5*GM1BL*MINF**2) - HSTINV_MS = GM1BL*( 1.0/QINFBL)**2 / (1.0 + 0.5*GM1BL*MINF**2) - & - 0.5*GM1BL*HSTINV / (1.0 + 0.5*GM1BL*MINF**2) -C -C---- Sutherland's const./To (assumes stagnation conditions are at STP) - HVRAT = 0.35 -C -C---- set Reynolds number based on freestream density, velocity, viscosity - HERAT = 1.0 - 0.5*QINFBL**2*HSTINV - HERAT_MS = - 0.5*QINFBL**2*HSTINV_MS -C - REYBL = REINF * SQRT(HERAT**3) * (1.0+HVRAT)/(HERAT+HVRAT) - REYBL_RE = SQRT(HERAT**3) * (1.0+HVRAT)/(HERAT+HVRAT) - REYBL_MS = REYBL * (1.5/HERAT - 1.0/(HERAT+HVRAT))*HERAT_MS -C - AMCRIT = ACRIT -C -C---- save TE thickness - DWTE = WGAP(1) -C - IF(.NOT.LBLINI) THEN -C----- initialize BL by marching with Ue (fudge at separation) - WRITE(*,*) - WRITE(*,*) 'Initializing BL ...' - CALL MRCHUE - LBLINI = .TRUE. - ENDIF -C - WRITE(*,*) -C -C---- march BL with current Ue and Ds to establish transition - CALL MRCHDU -C - DO 5 IS=1, 2 - DO 6 IBL=2, NBL(IS) - USAV(IBL,IS) = UEDG(IBL,IS) - 6 CONTINUE - 5 CONTINUE -C - CALL UESET -C - DO 7 IS=1, 2 - DO 8 IBL=2, NBL(IS) - TEMP = USAV(IBL,IS) - USAV(IBL,IS) = UEDG(IBL,IS) - UEDG(IBL,IS) = TEMP - 8 CONTINUE - 7 CONTINUE -C - ILE1 = IPAN(2,1) - ILE2 = IPAN(2,2) - ITE1 = IPAN(IBLTE(1),1) - ITE2 = IPAN(IBLTE(2),2) -C - JVTE1 = ISYS(IBLTE(1),1) - JVTE2 = ISYS(IBLTE(2),2) -C - DULE1 = UEDG(2,1) - USAV(2,1) - DULE2 = UEDG(2,2) - USAV(2,2) -C -C---- set LE and TE Ue sensitivities wrt all m values - DO 10 JS=1, 2 - DO 110 JBL=2, NBL(JS) - J = IPAN(JBL,JS) - JV = ISYS(JBL,JS) - ULE1_M(JV) = -VTI( 2,1)*VTI(JBL,JS)*DIJ(ILE1,J) - ULE2_M(JV) = -VTI( 2,2)*VTI(JBL,JS)*DIJ(ILE2,J) - UTE1_M(JV) = -VTI(IBLTE(1),1)*VTI(JBL,JS)*DIJ(ITE1,J) - UTE2_M(JV) = -VTI(IBLTE(2),2)*VTI(JBL,JS)*DIJ(ITE2,J) - 110 CONTINUE - 10 CONTINUE -C - ULE1_A = UINV_A(2,1) - ULE2_A = UINV_A(2,2) -C -C**** Go over each boundary layer/wake - DO 2000 IS=1, 2 -C -C---- there is no station "1" at similarity, so zero everything out - DO 20 JS=1, 2 - DO 210 JBL=2, NBL(JS) - JV = ISYS(JBL,JS) - U1_M(JV) = 0. - D1_M(JV) = 0. - 210 CONTINUE - 20 CONTINUE - U1_A = 0. - D1_A = 0. -C - DUE1 = 0. - DDS1 = 0. -C -C---- similarity station pressure gradient parameter x/u du/dx - IBL = 2 - BULE = 1.0 -C -C---- set forced transition arc length position - CALL XIFSET(IS) -C - TRAN = .FALSE. - TURB = .FALSE. -C -C**** Sweep downstream setting up BL equation linearizations - DO 1000 IBL=2, NBL(IS) -C - IV = ISYS(IBL,IS) -C - SIMI = IBL.EQ.2 - WAKE = IBL.GT.IBLTE(IS) - TRAN = IBL.EQ.ITRAN(IS) - TURB = IBL.GT.ITRAN(IS) -C - I = IPAN(IBL,IS) -C -C---- set primary variables for current station - XSI = XSSI(IBL,IS) - IF(IBL.LT.ITRAN(IS)) AMI = CTAU(IBL,IS) - IF(IBL.GE.ITRAN(IS)) CTI = CTAU(IBL,IS) - UEI = UEDG(IBL,IS) - THI = THET(IBL,IS) - MDI = MASS(IBL,IS) -C - DSI = MDI/UEI -C - IF(WAKE) THEN - IW = IBL - IBLTE(IS) - DSWAKI = WGAP(IW) - ELSE - DSWAKI = 0. - ENDIF -C -C---- set derivatives of DSI (= D2) - D2_M2 = 1.0/UEI - D2_U2 = -DSI/UEI -C - DO 30 JS=1, 2 - DO 310 JBL=2, NBL(JS) - J = IPAN(JBL,JS) - JV = ISYS(JBL,JS) - U2_M(JV) = -VTI(IBL,IS)*VTI(JBL,JS)*DIJ(I,J) - D2_M(JV) = D2_U2*U2_M(JV) - 310 CONTINUE - 30 CONTINUE - D2_M(IV) = D2_M(IV) + D2_M2 -C - U2_A = UINV_A(IBL,IS) - D2_A = D2_U2*U2_A -C -C---- "forced" changes due to mismatch between UEDG and USAV=UINV+dij*MASS - DUE2 = UEDG(IBL,IS) - USAV(IBL,IS) - DDS2 = D2_U2*DUE2 -C - CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN -C -C---- check for transition and set TRAN, XT, etc. if found - IF(TRAN) THEN - CALL TRCHEK - AMI = AMPL2 - ENDIF - IF(IBL.EQ.ITRAN(IS) .AND. .NOT.TRAN) THEN - WRITE(*,*) 'SETBL: Xtr??? n1 n2: ', AMPL1, AMPL2 - ENDIF -C -C---- assemble 10x4 linearized system for dCtau, dTh, dDs, dUe, dXi -C at the previous "1" station and the current "2" station -C - IF(IBL.EQ.IBLTE(IS)+1) THEN -C -C----- define quantities at start of wake, adding TE base thickness to Dstar - TTE = THET(IBLTE(1),1) + THET(IBLTE(2),2) - DTE = DSTR(IBLTE(1),1) + DSTR(IBLTE(2),2) + ANTE - CTE = ( CTAU(IBLTE(1),1)*THET(IBLTE(1),1) - & + CTAU(IBLTE(2),2)*THET(IBLTE(2),2) ) / TTE - CALL TESYS(CTE,TTE,DTE) -C - TTE_TTE1 = 1.0 - TTE_TTE2 = 1.0 - DTE_MTE1 = 1.0 / UEDG(IBLTE(1),1) - DTE_UTE1 = -DSTR(IBLTE(1),1) / UEDG(IBLTE(1),1) - DTE_MTE2 = 1.0 / UEDG(IBLTE(2),2) - DTE_UTE2 = -DSTR(IBLTE(2),2) / UEDG(IBLTE(2),2) - CTE_CTE1 = THET(IBLTE(1),1)/TTE - CTE_CTE2 = THET(IBLTE(2),2)/TTE - CTE_TTE1 = (CTAU(IBLTE(1),1) - CTE)/TTE - CTE_TTE2 = (CTAU(IBLTE(2),2) - CTE)/TTE -C -C----- re-define D1 sensitivities wrt m since D1 depends on both TE Ds values - DO 35 JS=1, 2 - DO 350 JBL=2, NBL(JS) - J = IPAN(JBL,JS) - JV = ISYS(JBL,JS) - D1_M(JV) = DTE_UTE1*UTE1_M(JV) + DTE_UTE2*UTE2_M(JV) - 350 CONTINUE - 35 CONTINUE - D1_M(JVTE1) = D1_M(JVTE1) + DTE_MTE1 - D1_M(JVTE2) = D1_M(JVTE2) + DTE_MTE2 -C -C----- "forced" changes from UEDG --- USAV=UINV+dij*MASS mismatch - DUE1 = 0. - DDS1 = DTE_UTE1*(UEDG(IBLTE(1),1) - USAV(IBLTE(1),1)) - & + DTE_UTE2*(UEDG(IBLTE(2),2) - USAV(IBLTE(2),2)) -C - ELSE -C - CALL BLSYS -C - ENDIF -C -C -C---- Save wall shear and equil. max shear coefficient for plotting output - TAU(IBL,IS) = 0.5*R2*U2*U2*CF2 - DIS(IBL,IS) = R2*U2*U2*U2*DI2*HS2*0.5 - CTQ(IBL,IS) = CQ2 - DELT(IBL,IS) = DE2 - USLP(IBL,IS) = 1.60/(1.0+US2) -C -C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -c IF(WAKE) THEN -c ALD = DLCON -c ELSE -c ALD = 1.0 -c ENDIF -cC -c IF(TURB .AND. .NOT.WAKE) THEN -c GCC = GCCON -c HKC = HK2 - 1.0 - GCC/RT2 -c IF(HKC .LT. 0.01) THEN -c HKC = 0.01 -c ENDIF -c ELSE -c HKC = HK2 - 1.0 -c ENDIF -cC -c HR = HKC / (GACON*ALD*HK2) -c UQ = (0.5*CF2 - HR**2) / (GBCON*D2) -cC -c IF(TURB) THEN -c IBLP = MIN(IBL+1,NBL(IS)) -c IBLM = MAX(IBL-1,2 ) -c DXSSI = XSSI(IBLP,IS) - XSSI(IBLM,IS) -c IF(DXXSI.EQ.0.0) DXSSI = 1.0 -c GUXD(IBL,IS) = -LOG(UEDG(IBLP,IS)/UEDG(IBLM,IS)) / DXSSI -c GUXQ(IBL,IS) = -UQ -c ELSE -c GUXD(IBL,IS) = 0.0 -c GUXQ(IBL,IS) = 0.0 -c ENDIF -C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -C -C---- set XI sensitivities wrt LE Ue changes - IF(IS.EQ.1) THEN - XI_ULE1 = SST_GO - XI_ULE2 = -SST_GP - ELSE - XI_ULE1 = -SST_GO - XI_ULE2 = SST_GP - ENDIF -C -C---- stuff BL system coefficients into main Jacobian matrix -C - DO 40 JV=1, NSYS - VM(1,JV,IV) = VS1(1,3)*D1_M(JV) + VS1(1,4)*U1_M(JV) - & + VS2(1,3)*D2_M(JV) + VS2(1,4)*U2_M(JV) - & + (VS1(1,5) + VS2(1,5) + VSX(1)) - & *(XI_ULE1*ULE1_M(JV) + XI_ULE2*ULE2_M(JV)) - 40 CONTINUE -C - VB(1,1,IV) = VS1(1,1) - VB(1,2,IV) = VS1(1,2) -C - VA(1,1,IV) = VS2(1,1) - VA(1,2,IV) = VS2(1,2) -C - IF(LALFA) THEN - VDEL(1,2,IV) = VSR(1)*RE_CLMR + VSM(1)*MSQ_CLMR - ELSE - VDEL(1,2,IV) = - & (VS1(1,4)*U1_A + VS1(1,3)*D1_A) - & + (VS2(1,4)*U2_A + VS2(1,3)*D2_A) - & + (VS1(1,5) + VS2(1,5) + VSX(1)) - & *(XI_ULE1*ULE1_A + XI_ULE2*ULE2_A) - ENDIF -C - VDEL(1,1,IV) = VSREZ(1) - & + (VS1(1,4)*DUE1 + VS1(1,3)*DDS1) - & + (VS2(1,4)*DUE2 + VS2(1,3)*DDS2) - & + (VS1(1,5) + VS2(1,5) + VSX(1)) - & *(XI_ULE1*DULE1 + XI_ULE2*DULE2) -C -C - DO 50 JV=1, NSYS - VM(2,JV,IV) = VS1(2,3)*D1_M(JV) + VS1(2,4)*U1_M(JV) - & + VS2(2,3)*D2_M(JV) + VS2(2,4)*U2_M(JV) - & + (VS1(2,5) + VS2(2,5) + VSX(2)) - & *(XI_ULE1*ULE1_M(JV) + XI_ULE2*ULE2_M(JV)) - 50 CONTINUE -C - VB(2,1,IV) = VS1(2,1) - VB(2,2,IV) = VS1(2,2) -C - VA(2,1,IV) = VS2(2,1) - VA(2,2,IV) = VS2(2,2) -C - IF(LALFA) THEN - VDEL(2,2,IV) = VSR(2)*RE_CLMR + VSM(2)*MSQ_CLMR - ELSE - VDEL(2,2,IV) = - & (VS1(2,4)*U1_A + VS1(2,3)*D1_A) - & + (VS2(2,4)*U2_A + VS2(2,3)*D2_A) - & + (VS1(2,5) + VS2(2,5) + VSX(2)) - & *(XI_ULE1*ULE1_A + XI_ULE2*ULE2_A) - ENDIF -C - VDEL(2,1,IV) = VSREZ(2) - & + (VS1(2,4)*DUE1 + VS1(2,3)*DDS1) - & + (VS2(2,4)*DUE2 + VS2(2,3)*DDS2) - & + (VS1(2,5) + VS2(2,5) + VSX(2)) - & *(XI_ULE1*DULE1 + XI_ULE2*DULE2) -C -C - DO 60 JV=1, NSYS - VM(3,JV,IV) = VS1(3,3)*D1_M(JV) + VS1(3,4)*U1_M(JV) - & + VS2(3,3)*D2_M(JV) + VS2(3,4)*U2_M(JV) - & + (VS1(3,5) + VS2(3,5) + VSX(3)) - & *(XI_ULE1*ULE1_M(JV) + XI_ULE2*ULE2_M(JV)) - 60 CONTINUE -C - VB(3,1,IV) = VS1(3,1) - VB(3,2,IV) = VS1(3,2) -C - VA(3,1,IV) = VS2(3,1) - VA(3,2,IV) = VS2(3,2) -C - IF(LALFA) THEN - VDEL(3,2,IV) = VSR(3)*RE_CLMR + VSM(3)*MSQ_CLMR - ELSE - VDEL(3,2,IV) = - & (VS1(3,4)*U1_A + VS1(3,3)*D1_A) - & + (VS2(3,4)*U2_A + VS2(3,3)*D2_A) - & + (VS1(3,5) + VS2(3,5) + VSX(3)) - & *(XI_ULE1*ULE1_A + XI_ULE2*ULE2_A) - ENDIF -C - VDEL(3,1,IV) = VSREZ(3) - & + (VS1(3,4)*DUE1 + VS1(3,3)*DDS1) - & + (VS2(3,4)*DUE2 + VS2(3,3)*DDS2) - & + (VS1(3,5) + VS2(3,5) + VSX(3)) - & *(XI_ULE1*DULE1 + XI_ULE2*DULE2) -C -C - IF(IBL.EQ.IBLTE(IS)+1) THEN -C -C----- redefine coefficients for TTE, DTE, etc - VZ(1,1) = VS1(1,1)*CTE_CTE1 - VZ(1,2) = VS1(1,1)*CTE_TTE1 + VS1(1,2)*TTE_TTE1 - VB(1,1,IV) = VS1(1,1)*CTE_CTE2 - VB(1,2,IV) = VS1(1,1)*CTE_TTE2 + VS1(1,2)*TTE_TTE2 -C - VZ(2,1) = VS1(2,1)*CTE_CTE1 - VZ(2,2) = VS1(2,1)*CTE_TTE1 + VS1(2,2)*TTE_TTE1 - VB(2,1,IV) = VS1(2,1)*CTE_CTE2 - VB(2,2,IV) = VS1(2,1)*CTE_TTE2 + VS1(2,2)*TTE_TTE2 -C - VZ(3,1) = VS1(3,1)*CTE_CTE1 - VZ(3,2) = VS1(3,1)*CTE_TTE1 + VS1(3,2)*TTE_TTE1 - VB(3,1,IV) = VS1(3,1)*CTE_CTE2 - VB(3,2,IV) = VS1(3,1)*CTE_TTE2 + VS1(3,2)*TTE_TTE2 -C - ENDIF -C -C---- turbulent intervals will follow if currently at transition interval - IF(TRAN) THEN - TURB = .TRUE. -C -C------ save transition location - ITRAN(IS) = IBL - TFORCE(IS) = TRFORC - XSSITR(IS) = XT -C -C------ interpolate airfoil geometry to find transition x/c -C- (for user output) - IF(IS.EQ.1) THEN - STR = SST - XT - ELSE - STR = SST + XT - ENDIF - CHX = XTE - XLE - CHY = YTE - YLE - CHSQ = CHX**2 + CHY**2 - XTR = SEVAL(STR,X,XP,S,N) - YTR = SEVAL(STR,Y,YP,S,N) - XOCTR(IS) = ((XTR-XLE)*CHX + (YTR-YLE)*CHY)/CHSQ - YOCTR(IS) = ((YTR-YLE)*CHX - (XTR-XLE)*CHY)/CHSQ - ENDIF -C - TRAN = .FALSE. -C - IF(IBL.EQ.IBLTE(IS)) THEN -C----- set "2" variables at TE to wake correlations for next station -C - TURB = .TRUE. - WAKE = .TRUE. - CALL BLVAR(3) - CALL BLMID(3) - ENDIF -C - DO 80 JS=1, 2 - DO 810 JBL=2, NBL(JS) - JV = ISYS(JBL,JS) - U1_M(JV) = U2_M(JV) - D1_M(JV) = D2_M(JV) - 810 CONTINUE - 80 CONTINUE -C - U1_A = U2_A - D1_A = D2_A -C - DUE1 = DUE2 - DDS1 = DDS2 -C -C---- set BL variables for next station - DO 190 ICOM=1, NCOM - COM1(ICOM) = COM2(ICOM) - 190 CONTINUE -C -C---- next streamwise station - 1000 CONTINUE -C - IF(TFORCE(IS)) THEN - WRITE(*,9100) IS,XOCTR(IS),ITRAN(IS) - 9100 FORMAT(1X,'Side',I2,' forced transition at x/c = ',F7.4,I5) - ELSE - WRITE(*,9200) IS,XOCTR(IS),ITRAN(IS) - 9200 FORMAT(1X,'Side',I2,' free transition at x/c = ',F7.4,I5) - ENDIF -C -C---- next airfoil side - 2000 CONTINUE -C - RETURN - END - - - SUBROUTINE IBLSYS -C--------------------------------------------- -C Sets the BL Newton system line number -C corresponding to each BL station. -C--------------------------------------------- - INCLUDE 'XFOIL.INC' - INCLUDE 'XBL.INC' -C - IV = 0 - DO 10 IS=1, 2 - DO 110 IBL=2, NBL(IS) - IV = IV+1 - ISYS(IBL,IS) = IV - 110 CONTINUE - 10 CONTINUE -C - NSYS = IV - IF(NSYS.GT.2*IVX) STOP '*** IBLSYS: BL system array overflow. ***' -C - RETURN - END - - - SUBROUTINE MRCHUE -C---------------------------------------------------- -C Marches the BLs and wake in direct mode using -C the UEDG array. If separation is encountered, -C a plausible value of Hk extrapolated from -C upstream is prescribed instead. Continuous -C checking of transition onset is performed. -C---------------------------------------------------- - INCLUDE 'XFOIL.INC' - INCLUDE 'XBL.INC' - LOGICAL DIRECT - REAL MSQ -C -C---- shape parameters for separation criteria - HLMAX = 3.8 - HTMAX = 2.5 -C - DO 2000 IS=1, 2 -C - WRITE(*,*) ' side ', IS, ' ...' -C -C---- set forced transition arc length position - CALL XIFSET(IS) -C -C---- initialize similarity station with Thwaites' formula - IBL = 2 - XSI = XSSI(IBL,IS) - UEI = UEDG(IBL,IS) -C BULE = LOG(UEDG(IBL+1,IS)/UEI) / LOG(XSSI(IBL+1,IS)/XSI) -C BULE = MAX( -.08 , BULE ) - BULE = 1.0 - UCON = UEI/XSI**BULE - TSQ = 0.45/(UCON*(5.0*BULE+1.0)*REYBL) * XSI**(1.0-BULE) - THI = SQRT(TSQ) - DSI = 2.2*THI - AMI = 0.0 -C -C---- initialize Ctau for first turbulent station - CTI = 0.03 -C - TRAN = .FALSE. - TURB = .FALSE. - ITRAN(IS) = IBLTE(IS) -C -C---- march downstream - DO 1000 IBL=2, NBL(IS) - IBM = IBL-1 -C - IW = IBL - IBLTE(IS) -C - SIMI = IBL.EQ.2 - WAKE = IBL.GT.IBLTE(IS) -C -C------ prescribed quantities - XSI = XSSI(IBL,IS) - UEI = UEDG(IBL,IS) -C - IF(WAKE) THEN - IW = IBL - IBLTE(IS) - DSWAKI = WGAP(IW) - ELSE - DSWAKI = 0. - ENDIF -C - DIRECT = .TRUE. -C -C------ Newton iteration loop for current station - DO 100 ITBL=1, 25 -C -C-------- assemble 10x3 linearized system for dCtau, dTh, dDs, dUe, dXi -C at the previous "1" station and the current "2" station -C (the "1" station coefficients will be ignored) -C -C - CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN -C -C-------- check for transition and set appropriate flags and things - IF((.NOT.SIMI) .AND. (.NOT.TURB)) THEN - CALL TRCHEK - AMI = AMPL2 -C -C--------- fixed BUG MD 7 Jun 99 - IF(TRAN) THEN - ITRAN(IS) = IBL - IF(CTI.LE.0.0) THEN - CTI = 0.03 - S2 = CTI - ENDIF - ELSE - ITRAN(IS) = IBL+2 - ENDIF -C -C - ENDIF -C - IF(IBL.EQ.IBLTE(IS)+1) THEN - TTE = THET(IBLTE(1),1) + THET(IBLTE(2),2) - DTE = DSTR(IBLTE(1),1) + DSTR(IBLTE(2),2) + ANTE - CTE = ( CTAU(IBLTE(1),1)*THET(IBLTE(1),1) - & + CTAU(IBLTE(2),2)*THET(IBLTE(2),2) ) / TTE - CALL TESYS(CTE,TTE,DTE) - ELSE - CALL BLSYS - ENDIF -C - IF(DIRECT) THEN -C -C--------- try direct mode (set dUe = 0 in currently empty 4th line) - VS2(4,1) = 0. - VS2(4,2) = 0. - VS2(4,3) = 0. - VS2(4,4) = 1.0 - VSREZ(4) = 0. -C -C--------- solve Newton system for current "2" station - CALL GAUSS(4,4,VS2,VSREZ,1) -C -C--------- determine max changes and underrelax if necessary - DMAX = MAX( ABS(VSREZ(2)/THI), - & ABS(VSREZ(3)/DSI) ) - IF(IBL.LT.ITRAN(IS)) DMAX = MAX(DMAX,ABS(VSREZ(1)/10.0)) - IF(IBL.GE.ITRAN(IS)) DMAX = MAX(DMAX,ABS(VSREZ(1)/CTI )) -C - RLX = 1.0 - IF(DMAX.GT.0.3) RLX = 0.3/DMAX -C -C--------- see if direct mode is not applicable - IF(IBL .NE. IBLTE(IS)+1) THEN -C -C---------- calculate resulting kinematic shape parameter Hk - MSQ = UEI*UEI*HSTINV / (GM1BL*(1.0 - 0.5*UEI*UEI*HSTINV)) - HTEST = (DSI + RLX*VSREZ(3)) / (THI + RLX*VSREZ(2)) - CALL HKIN( HTEST, MSQ, HKTEST, DUMMY, DUMMY) -C -C---------- decide whether to do direct or inverse problem based on Hk - IF(IBL.LT.ITRAN(IS)) HMAX = HLMAX - IF(IBL.GE.ITRAN(IS)) HMAX = HTMAX - DIRECT = HKTEST.LT.HMAX - ENDIF -C - IF(DIRECT) THEN -C---------- update as usual -ccc IF(IBL.LT.ITRAN(IS)) AMI = AMI + RLX*VSREZ(1) - IF(IBL.GE.ITRAN(IS)) CTI = CTI + RLX*VSREZ(1) - THI = THI + RLX*VSREZ(2) - DSI = DSI + RLX*VSREZ(3) - ELSE -C---------- set prescribed Hk for inverse calculation at the current station - IF(IBL.LT.ITRAN(IS)) THEN -C----------- laminar case: relatively slow increase in Hk downstream - HTARG = HK1 + 0.03*(X2-X1)/T1 - ELSE IF(IBL.EQ.ITRAN(IS)) THEN -C----------- transition interval: weighted laminar and turbulent case - HTARG = HK1 + (0.03*(XT-X1) - 0.15*(X2-XT))/T1 - ELSE IF(WAKE) THEN -C----------- turbulent wake case: -C- asymptotic wake behavior with approximate Backward Euler - CONST = 0.03*(X2-X1)/T1 - HK2 = HK1 - HK2 = HK2 - (HK2 + CONST*(HK2-1.0)**3 - HK1) - & /(1.0 + 3.0*CONST*(HK2-1.0)**2) - HK2 = HK2 - (HK2 + CONST*(HK2-1.0)**3 - HK1) - & /(1.0 + 3.0*CONST*(HK2-1.0)**2) - HK2 = HK2 - (HK2 + CONST*(HK2-1.0)**3 - HK1) - & /(1.0 + 3.0*CONST*(HK2-1.0)**2) - HTARG = HK2 - ELSE -C----------- turbulent case: relatively fast decrease in Hk downstream - HTARG = HK1 - 0.15*(X2-X1)/T1 - ENDIF -C -C---------- limit specified Hk to something reasonable - IF(WAKE) THEN - HTARG = MAX( HTARG , 1.01 ) - ELSE - HTARG = MAX( HTARG , HMAX ) - ENDIF -C - WRITE(*,1300) IBL, HTARG - 1300 FORMAT(' MRCHUE: Inverse mode at', I4, ' Hk =', F8.3) -C -C---------- try again with prescribed Hk - GO TO 100 -C - ENDIF -C - ELSE -C -C-------- inverse mode (force Hk to prescribed value HTARG) - VS2(4,1) = 0. - VS2(4,2) = HK2_T2 - VS2(4,3) = HK2_D2 - VS2(4,4) = HK2_U2 - VSREZ(4) = HTARG - HK2 -C - CALL GAUSS(4,4,VS2,VSREZ,1) -C - - DMAX = MAX( ABS(VSREZ(2)/THI), - & ABS(VSREZ(3)/DSI) ) - - IF(IBL.GE.ITRAN(IS)) DMAX = MAX( DMAX , ABS(VSREZ(1)/CTI)) -C - RLX = 1.0 - IF(DMAX.GT.0.3) RLX = 0.3/DMAX -C -C--------- update variables -ccc IF(IBL.LT.ITRAN(IS)) AMI = AMI + RLX*VSREZ(1) - IF(IBL.GE.ITRAN(IS)) CTI = CTI + RLX*VSREZ(1) - THI = THI + RLX*VSREZ(2) - DSI = DSI + RLX*VSREZ(3) - UEI = UEI + RLX*VSREZ(4) -C - ENDIF -C -C-------- eliminate absurd transients - IF(IBL.GE.ITRAN(IS)) THEN - CTI = MIN(CTI , 0.30 ) - CTI = MAX(CTI , 0.0000001 ) - ENDIF -C - IF(IBL.LE.IBLTE(IS)) THEN - HKLIM = 1.02 - ELSE - HKLIM = 1.00005 - ENDIF - MSQ = UEI*UEI*HSTINV / (GM1BL*(1.0 - 0.5*UEI*UEI*HSTINV)) - DSW = DSI - DSWAKI - CALL DSLIM(DSW,THI,UEI,MSQ,HKLIM) - DSI = DSW + DSWAKI -C - IF(DMAX.LE.1.0E-5) GO TO 110 -C - 100 CONTINUE - WRITE(*,1350) IBL, IS, DMAX - 1350 FORMAT(' MRCHUE: Convergence failed at',I4,' side',I2, - & ' Res =', E12.4) -C -C------ the current unconverged solution might still be reasonable... -CCC IF(DMAX .LE. 0.1) GO TO 110 - IF(DMAX .LE. 0.1) GO TO 109 -C -C------- the current solution is garbage --> extrapolate values instead - IF(IBL.GT.3) THEN - IF(IBL.LE.IBLTE(IS)) THEN - THI = THET(IBM,IS) * (XSSI(IBL,IS)/XSSI(IBM,IS))**0.5 - DSI = DSTR(IBM,IS) * (XSSI(IBL,IS)/XSSI(IBM,IS))**0.5 - ELSE IF(IBL.EQ.IBLTE(IS)+1) THEN - CTI = CTE - THI = TTE - DSI = DTE - ELSE - THI = THET(IBM,IS) - RATLEN = (XSSI(IBL,IS)-XSSI(IBM,IS)) / (10.0*DSTR(IBM,IS)) - DSI = (DSTR(IBM,IS) + THI*RATLEN) / (1.0 + RATLEN) - ENDIF - IF(IBL.EQ.ITRAN(IS)) CTI = 0.05 - IF(IBL.GT.ITRAN(IS)) CTI = CTAU(IBM,IS) -C - UEI = UEDG(IBL,IS) - IF(IBL.GT.2 .AND. IBL.LT.NBL(IS)) - & UEI = 0.5*(UEDG(IBL-1,IS) + UEDG(IBL+1,IS)) - ENDIF -C - 109 CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN -C -C------- check for transition and set appropriate flags and things - IF((.NOT.SIMI) .AND. (.NOT.TURB)) THEN - CALL TRCHEK - AMI = AMPL2 - IF( TRAN) ITRAN(IS) = IBL - IF(.NOT.TRAN) ITRAN(IS) = IBL+2 - ENDIF -C -C------- set all other extrapolated values for current station - IF(IBL.LT.ITRAN(IS)) CALL BLVAR(1) - IF(IBL.GE.ITRAN(IS)) CALL BLVAR(2) - IF(WAKE) CALL BLVAR(3) -C - IF(IBL.LT.ITRAN(IS)) CALL BLMID(1) - IF(IBL.GE.ITRAN(IS)) CALL BLMID(2) - IF(WAKE) CALL BLMID(3) -C -C------ pick up here after the Newton iterations - 110 CONTINUE -C -C------ store primary variables - IF(IBL.LT.ITRAN(IS)) CTAU(IBL,IS) = AMI - IF(IBL.GE.ITRAN(IS)) CTAU(IBL,IS) = CTI - THET(IBL,IS) = THI - DSTR(IBL,IS) = DSI - UEDG(IBL,IS) = UEI - MASS(IBL,IS) = DSI*UEI - TAU(IBL,IS) = 0.5*R2*U2*U2*CF2 - DIS(IBL,IS) = R2*U2*U2*U2*DI2*HS2*0.5 - CTQ(IBL,IS) = CQ2 - DELT(IBL,IS) = DE2 -C -C------ set "1" variables to "2" variables for next streamwise station - CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN - DO 310 ICOM=1, NCOM - COM1(ICOM) = COM2(ICOM) - 310 CONTINUE -C -C------ turbulent intervals will follow transition interval or TE - IF(TRAN .OR. IBL.EQ.IBLTE(IS)) THEN - TURB = .TRUE. -C -C------- save transition location - TFORCE(IS) = TRFORC - XSSITR(IS) = XT - ENDIF -C - TRAN = .FALSE. -C - IF(IBL.EQ.IBLTE(IS)) THEN - THI = THET(IBLTE(1),1) + THET(IBLTE(2),2) - DSI = DSTR(IBLTE(1),1) + DSTR(IBLTE(2),2) + ANTE - ENDIF -C - 1000 CONTINUE - 2000 CONTINUE -C - RETURN - END - - - SUBROUTINE MRCHDU -C---------------------------------------------------- -C Marches the BLs and wake in mixed mode using -C the current Ue and Hk. The calculated Ue -C and Hk lie along a line quasi-normal to the -C natural Ue-Hk characteristic line of the -C current BL so that the Goldstein or Levy-Lees -C singularity is never encountered. Continuous -C checking of transition onset is performed. -C---------------------------------------------------- - INCLUDE 'XFOIL.INC' - INCLUDE 'XBL.INC' - REAL VTMP(4,5), VZTMP(4) - REAL MSQ,SENNEW -ccc REAL MDI -C - DATA DEPS / 5.0E-6 / -C -C---- constant controlling how far Hk is allowed to deviate -C- from the specified value. - SENSWT = 1000.0 - SENNEW=0.0 -C - DO 2000 IS=1, 2 -C -C---- set forced transition arc length position - CALL XIFSET(IS) -C -C---- set leading edge pressure gradient parameter x/u du/dx - IBL = 2 - XSI = XSSI(IBL,IS) - UEI = UEDG(IBL,IS) -CCC BULE = LOG(UEDG(IBL+1,IS)/UEI) / LOG(XSSI(IBL+1,IS)/XSI) -CCC BULE = MAX( -.08 , BULE ) - BULE = 1.0 -C -C---- old transition station - ITROLD = ITRAN(IS) -C - TRAN = .FALSE. - TURB = .FALSE. - ITRAN(IS) = IBLTE(IS) -C -C---- march downstream - DO 1000 IBL=2, NBL(IS) - IBM = IBL-1 -C - SIMI = IBL.EQ.2 - WAKE = IBL.GT.IBLTE(IS) -C -C------ initialize current station to existing variables - XSI = XSSI(IBL,IS) - UEI = UEDG(IBL,IS) - THI = THET(IBL,IS) - DSI = DSTR(IBL,IS) -CCC MDI = MASS(IBL,IS) -C -C------ fixed BUG MD 7 June 99 - IF(IBL.LT.ITROLD) THEN - AMI = CTAU(IBL,IS) - CTI = 0.03 - ELSE - CTI = CTAU(IBL,IS) - IF(CTI.LE.0.0) CTI = 0.03 - ENDIF -C -CCC DSI = MDI/UEI -C - IF(WAKE) THEN - IW = IBL - IBLTE(IS) - DSWAKI = WGAP(IW) - ELSE - DSWAKI = 0. - ENDIF -C - IF(IBL.LE.IBLTE(IS)) DSI = MAX(DSI-DSWAKI,1.02000*THI) + DSWAKI - IF(IBL.GT.IBLTE(IS)) DSI = MAX(DSI-DSWAKI,1.00005*THI) + DSWAKI -C -C------ Newton iteration loop for current station - DO 100 ITBL=1, 25 -C -C-------- assemble 10x3 linearized system for dCtau, dTh, dDs, dUe, dXi -C at the previous "1" station and the current "2" station -C (the "1" station coefficients will be ignored) -C -C - CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN -C -C-------- check for transition and set appropriate flags and things - IF((.NOT.SIMI) .AND. (.NOT.TURB)) THEN - CALL TRCHEK - AMI = AMPL2 - IF( TRAN) ITRAN(IS) = IBL - IF(.NOT.TRAN) ITRAN(IS) = IBL+2 - ENDIF -C - IF(IBL.EQ.IBLTE(IS)+1) THEN - TTE = THET(IBLTE(1),1) + THET(IBLTE(2),2) - DTE = DSTR(IBLTE(1),1) + DSTR(IBLTE(2),2) + ANTE - CTE = ( CTAU(IBLTE(1),1)*THET(IBLTE(1),1) - & + CTAU(IBLTE(2),2)*THET(IBLTE(2),2) ) / TTE - CALL TESYS(CTE,TTE,DTE) - ELSE - CALL BLSYS - ENDIF -C -C-------- set stuff at first iteration... - IF(ITBL.EQ.1) THEN -C -C--------- set "baseline" Ue and Hk for forming Ue(Hk) relation - UEREF = U2 - HKREF = HK2 -C -C--------- if current point IBL was turbulent and is now laminar, then... - IF(IBL.LT.ITRAN(IS) .AND. IBL.GE.ITROLD ) THEN -C---------- extrapolate baseline Hk - UEM = UEDG(IBL-1,IS) - DSM = DSTR(IBL-1,IS) - THM = THET(IBL-1,IS) - MSQ = UEM*UEM*HSTINV / (GM1BL*(1.0 - 0.5*UEM*UEM*HSTINV)) - CALL HKIN( DSM/THM, MSQ, HKREF, DUMMY, DUMMY ) - ENDIF -C -C--------- if current point IBL was laminar, then... - IF(IBL.LT.ITROLD) THEN -C---------- reinitialize or extrapolate Ctau if it's now turbulent - IF(TRAN) CTAU(IBL,IS) = 0.03 - IF(TURB) CTAU(IBL,IS) = CTAU(IBL-1,IS) - IF(TRAN .OR. TURB) THEN - CTI = CTAU(IBL,IS) - S2 = CTI - ENDIF - ENDIF -C - ENDIF -C -C - IF(SIMI .OR. IBL.EQ.IBLTE(IS)+1) THEN -C -C--------- for similarity station or first wake point, prescribe Ue - VS2(4,1) = 0. - VS2(4,2) = 0. - VS2(4,3) = 0. - VS2(4,4) = U2_UEI - VSREZ(4) = UEREF - U2 -C - ELSE -C -C********* calculate Ue-Hk characteristic slope -C - DO 20 K=1, 4 - VZTMP(K) = VSREZ(K) - DO 201 L=1, 5 - VTMP(K,L) = VS2(K,L) - 201 CONTINUE - 20 CONTINUE -C -C--------- set unit dHk - VTMP(4,1) = 0. - VTMP(4,2) = HK2_T2 - VTMP(4,3) = HK2_D2 - VTMP(4,4) = HK2_U2*U2_UEI - VZTMP(4) = 1.0 -C -C--------- calculate dUe response - CALL GAUSS(4,4,VTMP,VZTMP,1) -C -C--------- set SENSWT * (normalized dUe/dHk) - SENNEW = SENSWT * VZTMP(4) * HKREF/UEREF - IF(ITBL.LE.5) THEN - SENS = SENNEW - ELSE IF(ITBL.LE.15) THEN - SENS = 0.5*(SENS + SENNEW) - ENDIF -C -C--------- set prescribed Ue-Hk combination - VS2(4,1) = 0. - VS2(4,2) = HK2_T2 * HKREF - VS2(4,3) = HK2_D2 * HKREF - VS2(4,4) =( HK2_U2 * HKREF + SENS/UEREF )*U2_UEI - VSREZ(4) = -(HKREF**2)*(HK2 / HKREF - 1.0) - & - SENS*(U2 / UEREF - 1.0) -C - ENDIF -C -C-------- solve Newton system for current "2" station - CALL GAUSS(4,4,VS2,VSREZ,1) -C -C-------- determine max changes and underrelax if necessary - - DMAX = MAX( ABS(VSREZ(2)/THI), - & ABS(VSREZ(3)/DSI) ) - - IF(IBL.GE.ITRAN(IS)) DMAX = MAX(DMAX,ABS(VSREZ(1)/(10.0*CTI))) -C - RLX = 1.0 - IF(DMAX.GT.0.3) RLX = 0.3/DMAX -C -C-------- update as usual - IF(IBL.LT.ITRAN(IS)) AMI = AMI + RLX*VSREZ(1) - IF(IBL.GE.ITRAN(IS)) CTI = CTI + RLX*VSREZ(1) - THI = THI + RLX*VSREZ(2) - DSI = DSI + RLX*VSREZ(3) - UEI = UEI + RLX*VSREZ(4) -C -C-------- eliminate absurd transients - IF(IBL.GE.ITRAN(IS)) THEN - CTI = MIN(CTI , 0.30 ) - CTI = MAX(CTI , 0.0000001 ) - ENDIF -C - IF(IBL.LE.IBLTE(IS)) THEN - HKLIM = 1.02 - ELSE - HKLIM = 1.00005 - ENDIF - MSQ = UEI*UEI*HSTINV / (GM1BL*(1.0 - 0.5*UEI*UEI*HSTINV)) - DSW = DSI - DSWAKI - CALL DSLIM(DSW,THI,UEI,MSQ,HKLIM) - DSI = DSW + DSWAKI -C - IF(DMAX.LE.DEPS) GO TO 110 -C - 100 CONTINUE -C - WRITE(*,1350) IBL, IS, DMAX - 1350 FORMAT(' MRCHDU: Convergence failed at',I4,' side',I2, - & ' Res =', E12.4) -C -C------ the current unconverged solution might still be reasonable... -CCC IF(DMAX .LE. 0.1) GO TO 110 - IF(DMAX .LE. 0.1) GO TO 109 -C -C------- the current solution is garbage --> extrapolate values instead - IF(IBL.GT.3) THEN - IF(IBL.LE.IBLTE(IS)) THEN - THI = THET(IBM,IS) * (XSSI(IBL,IS)/XSSI(IBM,IS))**0.5 - DSI = DSTR(IBM,IS) * (XSSI(IBL,IS)/XSSI(IBM,IS))**0.5 - UEI = UEDG(IBM,IS) - ELSE IF(IBL.EQ.IBLTE(IS)+1) THEN - CTI = CTE - THI = TTE - DSI = DTE - UEI = UEDG(IBM,IS) - ELSE - THI = THET(IBM,IS) - RATLEN = (XSSI(IBL,IS)-XSSI(IBM,IS)) / (10.0*DSTR(IBM,IS)) - DSI = (DSTR(IBM,IS) + THI*RATLEN) / (1.0 + RATLEN) - UEI = UEDG(IBM,IS) - ENDIF - IF(IBL.EQ.ITRAN(IS)) CTI = 0.05 - IF(IBL.GT.ITRAN(IS)) CTI = CTAU(IBM,IS) - ENDIF -C - 109 CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN -C -C------- check for transition and set appropriate flags and things - IF((.NOT.SIMI) .AND. (.NOT.TURB)) THEN - CALL TRCHEK - AMI = AMPL2 - IF( TRAN) ITRAN(IS) = IBL - IF(.NOT.TRAN) ITRAN(IS) = IBL+2 - ENDIF -C -C------- set all other extrapolated values for current station - IF(IBL.LT.ITRAN(IS)) CALL BLVAR(1) - IF(IBL.GE.ITRAN(IS)) CALL BLVAR(2) - IF(WAKE) CALL BLVAR(3) -C - IF(IBL.LT.ITRAN(IS)) CALL BLMID(1) - IF(IBL.GE.ITRAN(IS)) CALL BLMID(2) - IF(WAKE) CALL BLMID(3) -C -C------ pick up here after the Newton iterations - 110 CONTINUE -C - SENS = SENNEW -C -C------ store primary variables - IF(IBL.LT.ITRAN(IS)) CTAU(IBL,IS) = AMI - IF(IBL.GE.ITRAN(IS)) CTAU(IBL,IS) = CTI - THET(IBL,IS) = THI - DSTR(IBL,IS) = DSI - UEDG(IBL,IS) = UEI - MASS(IBL,IS) = DSI*UEI - TAU(IBL,IS) = 0.5*R2*U2*U2*CF2 - DIS(IBL,IS) = R2*U2*U2*U2*DI2*HS2*0.5 - CTQ(IBL,IS) = CQ2 -C -C------ set "1" variables to "2" variables for next streamwise station - CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN - DO 310 ICOM=1, NCOM - COM1(ICOM) = COM2(ICOM) - 310 CONTINUE -C -C -C------ turbulent intervals will follow transition interval or TE - IF(TRAN .OR. IBL.EQ.IBLTE(IS)) THEN - TURB = .TRUE. -C -C------- save transition location - TFORCE(IS) = TRFORC - XSSITR(IS) = XT - ENDIF -C - TRAN = .FALSE. -C - 1000 CONTINUE -C - 2000 CONTINUE -C - RETURN - END - - - SUBROUTINE XIFSET(IS) -C----------------------------------------------------- -C Sets forced-transition BL coordinate locations. -C----------------------------------------------------- - INCLUDE 'XFOIL.INC' - INCLUDE 'XBL.INC' -C - IF(XSTRIP(IS).GE.1.0) THEN - XIFORC = XSSI(IBLTE(IS),IS) - RETURN - ENDIF -C - CHX = XTE - XLE - CHY = YTE - YLE - CHSQ = CHX**2 + CHY**2 -C -C---- calculate chord-based x/c, y/c - DO 10 I=1, N - W1(I) = ((X(I)-XLE)*CHX + (Y(I)-YLE)*CHY) / CHSQ - W2(I) = ((Y(I)-YLE)*CHX - (X(I)-XLE)*CHY) / CHSQ - 10 CONTINUE - -C - CALL SPLIND(W1,W3,S,N,-999.0,-999.0) - CALL SPLIND(W2,W4,S,N,-999.0,-999.0) -C - IF(IS.EQ.1) THEN -C - -C----- set approximate arc length of forced transition point for SINVRT - STR = SLE + (S(1)-SLE)*XSTRIP(IS) -C -C----- calculate actual arc length - CALL SINVRT(STR,XSTRIP(IS),W1,W3,S,N) - -C - - -C----- set BL coordinate value - XIFORC = MIN( (SST - STR) , XSSI(IBLTE(IS),IS) ) -C - ELSE -C----- same for bottom side -C - - - STR = SLE + (S(N)-SLE)*XSTRIP(IS) - CALL SINVRT(STR,XSTRIP(IS),W1,W3,S,N) - - - - - XIFORC = MIN( (STR - SST) , XSSI(IBLTE(IS),IS) ) -C - ENDIF -C - IF(XIFORC .LT. 0.0) THEN - WRITE(*,1000) IS - 1000 FORMAT(/' *** Stagnation point is past trip on side',I2,' ***') - XIFORC = XSSI(IBLTE(IS),IS) - ENDIF -C - RETURN - END - - - - - SUBROUTINE UPDATE -C------------------------------------------------------------------ -C Adds on Newton deltas to boundary layer variables. -C Checks for excessive changes and underrelaxes if necessary. -C Calculates max and rms changes. -C Also calculates the change in the global variable "AC". -C If LALFA=.TRUE. , "AC" is CL -C If LALFA=.FALSE., "AC" is alpha -C------------------------------------------------------------------ - INCLUDE 'XFOIL.INC' - REAL UNEW(IVX,2), U_AC(IVX,2) - REAL QNEW(IQX), Q_AC(IQX) - EQUIVALENCE (VA(1,1,1), UNEW(1,1)) , - & (VB(1,1,1), QNEW(1) ) - EQUIVALENCE (VA(1,1,IVX), U_AC(1,1)) , - & (VB(1,1,IVX), Q_AC(1) ) - REAL MSQ -C -C---- max allowable alpha changes per iteration - DALMAX = 0.5*DTOR - DALMIN = -0.5*DTOR -C -C---- max allowable CL change per iteration - DCLMAX = 0.5 - DCLMIN = -0.5 - IF(MATYP.NE.1) DCLMIN = MAX(-0.5 , -0.9*CL) -C - HSTINV = GAMM1*(MINF/QINF)**2 / (1.0 + 0.5*GAMM1*MINF**2) -C -C---- calculate new Ue distribution assuming no under-relaxation -C- also set the sensitivity of Ue wrt to alpha or Re - DO 1 IS=1, 2 - DO 10 IBL=2, NBL(IS) - I = IPAN(IBL,IS) -C - DUI = 0. - DUI_AC = 0. - DO 100 JS=1, 2 - DO 1000 JBL=2, NBL(JS) - J = IPAN(JBL,JS) - JV = ISYS(JBL,JS) - UE_M = -VTI(IBL,IS)*VTI(JBL,JS)*DIJ(I,J) - DUI = DUI + UE_M*(MASS(JBL,JS)+VDEL(3,1,JV)) - DUI_AC = DUI_AC + UE_M*( -VDEL(3,2,JV)) - 1000 CONTINUE - 100 CONTINUE -C -C-------- UINV depends on "AC" only if "AC" is alpha - IF(LALFA) THEN - UINV_AC = 0. - ELSE - UINV_AC = UINV_A(IBL,IS) - ENDIF -C - UNEW(IBL,IS) = UINV(IBL,IS) + DUI - U_AC(IBL,IS) = UINV_AC + DUI_AC -C - 10 CONTINUE - 1 CONTINUE -C -C---- set new Qtan from new Ue with appropriate sign change - DO 2 IS=1, 2 - DO 20 IBL=2, IBLTE(IS) - I = IPAN(IBL,IS) - QNEW(I) = VTI(IBL,IS)*UNEW(IBL,IS) - Q_AC(I) = VTI(IBL,IS)*U_AC(IBL,IS) - 20 CONTINUE - 2 CONTINUE -C -C---- calculate new CL from this new Qtan - SA = SIN(ALFA) - CA = COS(ALFA) -C - BETA = SQRT(1.0 - MINF**2) - BETA_MSQ = -0.5/BETA -C - BFAC = 0.5*MINF**2 / (1.0 + BETA) - BFAC_MSQ = 0.5 / (1.0 + BETA) - & - BFAC / (1.0 + BETA) * BETA_MSQ -C - CLNEW = 0. - CL_A = 0. - CL_MS = 0. - CL_AC = 0. -C - I = 1 - CGINC = 1.0 - (QNEW(I)/QINF)**2 - CPG1 = CGINC / (BETA + BFAC*CGINC) - CPG1_MS = -CPG1/(BETA + BFAC*CGINC)*(BETA_MSQ + BFAC_MSQ*CGINC) -C - CPI_Q = -2.0*QNEW(I)/QINF**2 - CPC_CPI = (1.0 - BFAC*CPG1)/ (BETA + BFAC*CGINC) - CPG1_AC = CPC_CPI*CPI_Q*Q_AC(I) -C - DO 3 I=1, N - IP = I+1 - IF(I.EQ.N) IP = 1 -C - CGINC = 1.0 - (QNEW(IP)/QINF)**2 - CPG2 = CGINC / (BETA + BFAC*CGINC) - CPG2_MS = -CPG2/(BETA + BFAC*CGINC)*(BETA_MSQ + BFAC_MSQ*CGINC) -C - CPI_Q = -2.0*QNEW(IP)/QINF**2 - CPC_CPI = (1.0 - BFAC*CPG2)/ (BETA + BFAC*CGINC) - CPG2_AC = CPC_CPI*CPI_Q*Q_AC(IP) -C - DX = (X(IP) - X(I))*CA + (Y(IP) - Y(I))*SA - DX_A = -(X(IP) - X(I))*SA + (Y(IP) - Y(I))*CA -C - AG = 0.5*(CPG2 + CPG1 ) - AG_MS = 0.5*(CPG2_MS + CPG1_MS) - AG_AC = 0.5*(CPG2_AC + CPG1_AC) -C - CLNEW = CLNEW + DX *AG - CL_A = CL_A + DX_A*AG - CL_MS = CL_MS + DX *AG_MS - CL_AC = CL_AC + DX *AG_AC -C - CPG1 = CPG2 - CPG1_MS = CPG2_MS - CPG1_AC = CPG2_AC - 3 CONTINUE -C -C---- initialize under-relaxation factor - RLX = 1.0 -C - IF(LALFA) THEN -C===== alpha is prescribed: AC is CL -C -C----- set change in Re to account for CL changing, since Re = Re(CL) - DAC = (CLNEW - CL) / (1.0 - CL_AC - CL_MS*2.0*MINF*MINF_CL) -C -C----- set under-relaxation factor if Re change is too large - IF(RLX*DAC .GT. DCLMAX) RLX = DCLMAX/DAC - IF(RLX*DAC .LT. DCLMIN) RLX = DCLMIN/DAC -C - ELSE -C===== CL is prescribed: AC is alpha -C -C----- set change in alpha to drive CL to prescribed value - DAC = (CLNEW - CLSPEC) / (0.0 - CL_AC - CL_A) -C -C----- set under-relaxation factor if alpha change is too large - IF(RLX*DAC .GT. DALMAX) RLX = DALMAX/DAC - IF(RLX*DAC .LT. DALMIN) RLX = DALMIN/DAC -C - ENDIF -C - RMSBL = 0. - RMXBL = 0. -C - DHI = 1.5 - DLO = -.5 -C -C---- calculate changes in BL variables and under-relaxation if needed - DO 4 IS=1, 2 - DO 40 IBL=2, NBL(IS) - IV = ISYS(IBL,IS) -C -C-------- set changes without underrelaxation - DCTAU = VDEL(1,1,IV) - DAC*VDEL(1,2,IV) - DTHET = VDEL(2,1,IV) - DAC*VDEL(2,2,IV) - DMASS = VDEL(3,1,IV) - DAC*VDEL(3,2,IV) - DUEDG = UNEW(IBL,IS) + DAC*U_AC(IBL,IS) - UEDG(IBL,IS) - DDSTR = (DMASS - DSTR(IBL,IS)*DUEDG)/UEDG(IBL,IS) -C -C-------- normalize changes - IF(IBL.LT.ITRAN(IS)) DN1 = DCTAU / 10.0 - IF(IBL.GE.ITRAN(IS)) DN1 = DCTAU / CTAU(IBL,IS) - DN2 = DTHET / THET(IBL,IS) - DN3 = DDSTR / DSTR(IBL,IS) - DN4 = ABS(DUEDG)/0.25 -C -C-------- accumulate for rms change - RMSBL = RMSBL + DN1**2 + DN2**2 + DN3**2 + DN4**2 -C -C-------- see if Ctau needs underrelaxation - RDN1 = RLX*DN1 - IF(ABS(DN1) .GT. ABS(RMXBL)) THEN - RMXBL = DN1 - IF(IBL.LT.ITRAN(IS)) VMXBL = 'n' - IF(IBL.GE.ITRAN(IS)) VMXBL = 'C' - IMXBL = IBL - ISMXBL = IS - ENDIF - IF(RDN1 .GT. DHI) RLX = DHI/DN1 - IF(RDN1 .LT. DLO) RLX = DLO/DN1 -C -C-------- see if Theta needs underrelaxation - RDN2 = RLX*DN2 - IF(ABS(DN2) .GT. ABS(RMXBL)) THEN - RMXBL = DN2 - VMXBL = 'T' - IMXBL = IBL - ISMXBL = IS - ENDIF - IF(RDN2 .GT. DHI) RLX = DHI/DN2 - IF(RDN2 .LT. DLO) RLX = DLO/DN2 -C -C-------- see if Dstar needs underrelaxation - RDN3 = RLX*DN3 - IF(ABS(DN3) .GT. ABS(RMXBL)) THEN - RMXBL = DN3 - VMXBL = 'D' - IMXBL = IBL - ISMXBL = IS - ENDIF - IF(RDN3 .GT. DHI) RLX = DHI/DN3 - IF(RDN3 .LT. DLO) RLX = DLO/DN3 -C -C-------- see if Ue needs underrelaxation - RDN4 = RLX*DN4 - IF(ABS(DN4) .GT. ABS(RMXBL)) THEN - RMXBL = DUEDG - VMXBL = 'U' - IMXBL = IBL - ISMXBL = IS - ENDIF - IF(RDN4 .GT. DHI) RLX = DHI/DN4 - IF(RDN4 .LT. DLO) RLX = DLO/DN4 -C - 40 CONTINUE - 4 CONTINUE -C -C---- set true rms change - RMSBL = SQRT( RMSBL / (4.0*FLOAT( NBL(1)+NBL(2) )) ) -C -C - IF(LALFA) THEN -C----- set underrelaxed change in Reynolds number from change in lift - CL = CL + RLX*DAC - ELSE -C----- set underrelaxed change in alpha - ALFA = ALFA + RLX*DAC - ADEG = ALFA/DTOR - ENDIF -C -C---- update BL variables with underrelaxed changes - DO 5 IS=1, 2 - DO 50 IBL=2, NBL(IS) - IV = ISYS(IBL,IS) -C - DCTAU = VDEL(1,1,IV) - DAC*VDEL(1,2,IV) - DTHET = VDEL(2,1,IV) - DAC*VDEL(2,2,IV) - DMASS = VDEL(3,1,IV) - DAC*VDEL(3,2,IV) - DUEDG = UNEW(IBL,IS) + DAC*U_AC(IBL,IS) - UEDG(IBL,IS) - DDSTR = (DMASS - DSTR(IBL,IS)*DUEDG)/UEDG(IBL,IS) -C - CTAU(IBL,IS) = CTAU(IBL,IS) + RLX*DCTAU - THET(IBL,IS) = THET(IBL,IS) + RLX*DTHET - DSTR(IBL,IS) = DSTR(IBL,IS) + RLX*DDSTR - UEDG(IBL,IS) = UEDG(IBL,IS) + RLX*DUEDG -C - IF(IBL.GT.IBLTE(IS)) THEN - IW = IBL - IBLTE(IS) - DSWAKI = WGAP(IW) - ELSE - DSWAKI = 0. - ENDIF -C -C-------- eliminate absurd transients - IF(IBL.GE.ITRAN(IS)) - & CTAU(IBL,IS) = MIN( CTAU(IBL,IS) , 0.25 ) -C - IF(IBL.LE.IBLTE(IS)) THEN - HKLIM = 1.02 - ELSE - HKLIM = 1.00005 - ENDIF - MSQ = UEDG(IBL,IS)**2*HSTINV - & / (GAMM1*(1.0 - 0.5*UEDG(IBL,IS)**2*HSTINV)) - DSW = DSTR(IBL,IS) - DSWAKI - CALL DSLIM(DSW,THET(IBL,IS),UEDG(IBL,IS),MSQ,HKLIM) - DSTR(IBL,IS) = DSW + DSWAKI -C -C-------- set new mass defect (nonlinear update) - MASS(IBL,IS) = DSTR(IBL,IS) * UEDG(IBL,IS) -C - 50 CONTINUE - 5 CONTINUE -C -C -C---- equate upper wake arrays to lower wake arrays - DO 6 KBL=1, NBL(2)-IBLTE(2) - CTAU(IBLTE(1)+KBL,1) = CTAU(IBLTE(2)+KBL,2) - THET(IBLTE(1)+KBL,1) = THET(IBLTE(2)+KBL,2) - DSTR(IBLTE(1)+KBL,1) = DSTR(IBLTE(2)+KBL,2) - UEDG(IBLTE(1)+KBL,1) = UEDG(IBLTE(2)+KBL,2) - TAU(IBLTE(1)+KBL,1) = TAU(IBLTE(2)+KBL,2) - DIS(IBLTE(1)+KBL,1) = DIS(IBLTE(2)+KBL,2) - CTQ(IBLTE(1)+KBL,1) = CTQ(IBLTE(2)+KBL,2) - 6 CONTINUE -C - RETURN - END - - - - SUBROUTINE DSLIM(DSTR,THET,UEDG,MSQ,HKLIM) - IMPLICIT REAL (A-H,M,O-Z) -C - H = DSTR/THET - CALL HKIN(H,MSQ,HK,HK_H,HK_M) -C - DH = MAX( 0.0 , HKLIM-HK ) / HK_H - DSTR = DSTR + DH*THET -C - RETURN - END - - - - - - - - - - - - - - - - - - - - - - - diff --git a/modules/aerodyn/src/AeroAcoustics/Xfoil/xfoil_noise.f b/modules/aerodyn/src/AeroAcoustics/Xfoil/xfoil_noise.f index eb35ebeca..14eb85446 100644 --- a/modules/aerodyn/src/AeroAcoustics/Xfoil/xfoil_noise.f +++ b/modules/aerodyn/src/AeroAcoustics/Xfoil/xfoil_noise.f @@ -19,6 +19,13 @@ C*********************************************************************** C SUBROUTINE XFOIL_Noise +C NOTE FROM EBRA: +C Noise parameters are retrieved as follows +C - OPER is called +C - DPLOT_Noise is called +C The parameters d99, Cf and d_star are computed +C and stored in the module XfoilBLParams +C USE XfoilAirfoilParams INCLUDE 'XFOIL.INC' @@ -1293,8 +1300,7 @@ SUBROUTINE PANGEN(SHOPAR) DO I = 1, NB-1 IF(SBLE.EQ.SB(I) .AND. SBLE.EQ.SB(I+1)) THEN IBLE = I - WRITE(*,*) - WRITE(*,*) 'Sharp leading edge' + WRITE(*,*) 'Sharp leading edge detected on airfoil' GO TO 21 ENDIF ENDDO diff --git a/modules/aerodyn/src/AeroAcoustics/Xfoil/xoper_noise.f b/modules/aerodyn/src/AeroAcoustics/Xfoil/xoper_noise.f index 423aa246e..5e64d7e48 100644 --- a/modules/aerodyn/src/AeroAcoustics/Xfoil/xoper_noise.f +++ b/modules/aerodyn/src/AeroAcoustics/Xfoil/xoper_noise.f @@ -542,6 +542,8 @@ SUBROUTINE MHINGE SUBROUTINE VPAR_Noise(xtrup,xtrlo) + use XfoilPrecision, only: ReKi + real(ReKi), intent(in) :: xtrup, xtrlo C--------------------------------------------- C Viscous parameter change menu routine. C--------------------------------------------- @@ -853,10 +855,10 @@ SUBROUTINE VISCAL(NITER1) RETURN C.................................................................... 2000 FORMAT - & (/1X,I3,' rms: ',E10.4,' max: ',E10.4,3X,A1,' at ',I4,I3, + & (/1X,I3,' rms: ',E11.4,' max: ',E11.4,3X,A1,' at ',I4,I3, & ' RLX:',F6.3) 2010 FORMAT - & (/1X,I3,' rms: ',E10.4,' max: ',E10.4,3X,A1,' at ',I4,I3) + & (/1X,I3,' rms: ',E11.4,' max: ',E11.4,3X,A1,' at ',I4,I3) 2020 FORMAT & ( 1X,3X,' a =', F7.3,' CL =',F8.4 / & 1X,3X,' Cm =', F8.4, ' CD =',F9.5, diff --git a/modules/aerodyn/src/AeroAcoustics_Registry.txt b/modules/aerodyn/src/AeroAcoustics_Registry.txt index 60e24be5c..b54391201 100644 --- a/modules/aerodyn/src/AeroAcoustics_Registry.txt +++ b/modules/aerodyn/src/AeroAcoustics_Registry.txt @@ -67,8 +67,10 @@ typedef ^ AA_InputFile IntKi IInflow typedef ^ AA_InputFile IntKi X_BLMethod - - - "Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Xfoil" - typedef ^ AA_InputFile IntKi TICalcMeth - - - "TICalcMeth" - typedef ^ AA_InputFile IntKi XfoilCall - - - "Integer describing Xfoil calls, = 1 Interpolate from pretabulated = 2 Call Xfoil for each node etc" - -typedef ^ AA_InputFile IntKi aweightflag - - - "Integer a weighting call" - -typedef ^ AA_InputFile LOGICAL ROUND - - - "LOGICAL INDICATING ROUNDED TIP" - +typedef ^ AA_InputFile IntKi NReListBL - - - "Number of values of ReListXfoil" - +typedef ^ AA_InputFile ReKi AlphaLinsp {3} - - "Linspace (min,max,n) of angle of attacks in degrees used when calling Xfoil to tabulate the boundary layer properties [used only if BLMod=2 and XfoilCall=1]" - deg +typedef ^ AA_InputFile Logical aweightflag - - - "Integer a weighting call" - +typedef ^ AA_InputFile Logical ROUND - - - "LOGICAL INDICATING ROUNDED TIP" - typedef ^ AA_InputFile ReKi ALPRAT - - - "TIP LIFT CURVE SLOPE" - typedef ^ AA_InputFile IntKi AA_Bl_Prcntge - - - "see the AeroAcoustics input file for description " - typedef ^ AA_InputFile IntKi NrObsLoc - - - "Number of observer locations " - @@ -78,9 +80,10 @@ typedef ^ AA_InputFile ReKi ObsZ typedef ^ AA_InputFile AA_BladePropsType BladeProps {:} - - "blade property information from blade input files" - typedef ^ AA_InputFile IntKi NrOutFile - - - "Nr of output files" - typedef ^ AA_InputFile CHARACTER(1024) AAoutfile {:} - - "AAoutfile for writing output files" - -typedef ^ AA_InputFile IntKi LargeBinOutput - - - "flag for output bin file " - +typedef ^ AA_InputFile Logical LargeBinOutput - - - "Flag for output bin file " - +typedef ^ AA_InputFile Logical XfoilTabOut - - - "Flag to output the tabulated data from xfoil for different AoA and Re, for all profiles " - typedef ^ AA_InputFile IntKi Comp_AA_After - - - " " - -typedef ^ AA_InputFile ReKi saveeach - - - " " - +typedef ^ AA_InputFile ReKi SaveEach - - - " " - typedef ^ AA_InputFile ReKi z0_AA - - - "Surface roughness" - typedef ^ AA_InputFile ReKi ReListXfoil {:} - - "" typedef ^ AA_InputFile ReKi AoAListXfoil {:} - - "" deg @@ -122,7 +125,6 @@ typedef ^ OtherStateType SiKi DummyOt # # Define misc/optimization variables (any data that are not considered actual states) here: ##typedef ^ MiscVarType ReKi DisturbedInflow {:}{:}{:} - - "InflowOnBlade values modified by tower influence" m/s -typedef ^ MiscVarType ReKi WithoutSweepPitchTwist {:}{:}{:}{:} - - "Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles" - typedef ^ MiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" - typedef ^ MiscVarType ReKi ChordAngleTE {:}{:}{:} - - "C" - typedef ^ MiscVarType ReKi SpanAngleTE {:}{:}{:} - - "C" - @@ -143,7 +145,7 @@ typedef ^ MiscVarType ReKi SPLTIGu typedef ^ MiscVarType ReKi SPLBLUNT {:} - - "C" - typedef ^ MiscVarType ReKi CfVar {:} - - "Xfoil Output Skin friction coef Pressure Side" - typedef ^ MiscVarType ReKi d99Var {:} - - "Xfoil Output " - -typedef ^ MiscVarType ReKi dstarVar {:} - - "Xfoil Output " - +typedef ^ MiscVarType ReKi dStarVar {:} - - "Xfoil Output " - typedef ^ MiscVarType ReKi EdgeVelVar {:} - - "Xfoil Output " - typedef ^ MiscVarType IntKi speccou - - - "Secptrum counter every XX seconds new spectrum" - typedef ^ MiscVarType IntKi filesopen - - - "check if file is open" - @@ -152,16 +154,16 @@ typedef ^ MiscVarType IntKi filesop # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: typedef ^ ParameterType ReKI saveeach - - - "FLAG TO COMPUTE BLUNTNESS NOISE " - typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds -typedef ^ ParameterType IntKi IBLUNT - - - "FLAG TO COMPUTE BLUNTNESS NOISE " - -typedef ^ ParameterType IntKi ILAM - - - "FLAG TO COMPUTE LBL NOISE " - -typedef ^ ParameterType IntKi ITIP - - - "FLAG TO COMPUTE TIP NOISE " - -typedef ^ ParameterType IntKi ITRIP - - - "FLAG TO TRIP BOUNDARY LAYER" - -typedef ^ ParameterType IntKi ITURB - - - "FLAG TO COMPUTE TBLTE NOISE" - -typedef ^ ParameterType IntKi IInflow - - - "FLAG TO COMPUTE Turbulent Inflow NOISE" - +typedef ^ ParameterType IntKi IBLUNT - - - "Bluntness noise model" - +typedef ^ ParameterType IntKi ILAM - - - "LBL noise model " - +typedef ^ ParameterType IntKi ITIP - - - "Tip noise model" - +typedef ^ ParameterType IntKi ITRIP - - - "Trip boundary layer" - +typedef ^ ParameterType IntKi ITURB - - - "Tblte noise model" - +typedef ^ ParameterType IntKi IInflow - - - "Turbulent inflow noise model" - typedef ^ ParameterType IntKi X_BLMethod - - - "Integer describing calculation method for boundary layer properties, = 1 BPM = 2 Xfoil" - typedef ^ ParameterType IntKi TICalcMeth - - - "" - typedef ^ ParameterType IntKi XfoilCall - - - "Integer describing Xfoil calls, = 1 Interpolate from pretabulated = 2 Call Xfoil for each node etc" - -typedef ^ ParameterType LOGICAL ROUND - - - "LOGICAL INDICATING ROUNDED TIP" - +typedef ^ ParameterType Logical ROUND - - - "Logical indicating rounded tip" - typedef ^ ParameterType ReKi ALPRAT - - - "TIP LIFT CURVE SLOPE" - typedef ^ ParameterType IntKi NumBlades - - - "Number of blades on the turbine" - typedef ^ ParameterType IntKi NumBlNds - - - "Number of nodes on each blade" - @@ -176,14 +178,14 @@ typedef ^ ParameterType ReKi rotorre typedef ^ ParameterType ReKi rotorregionlimitsalph {:} - - "" typedef ^ ParameterType ReKi rotorregionlimitsrad {:} - - "" typedef ^ ParameterType IntKi NrObsLoc - - - "Number of observer locations " - -typedef ^ ParameterType IntKi aweightflag - - - " " - -typedef ^ ParameterType IntKi LargeBinOutput - - - " " - +typedef ^ ParameterType Logical aweightflag - - - " " - +typedef ^ ParameterType Logical LargeBinOutput - - - " " - typedef ^ ParameterType IntKi Comp_AA_After - - - " " - typedef ^ ParameterType ReKi ObsX {:} - - "Observer location in tower-base coordinate X horizontal" m typedef ^ ParameterType ReKi ObsY {:} - - "Observer location in tower-base coordinate Y lateral" m typedef ^ ParameterType ReKi ObsZ {:} - - "Observer location in tower-base coordinate Z vertical" m typedef ^ ParameterType ReKi FreqList {:} - - "List of Acoustic Frequencies to Calculate" Hz -typedef ^ ParameterType ReKi Aweight {:} - - "List of Acoustic Frequencies a weighting" dB +typedef ^ ParameterType ReKi Aweight {:} - - "List of Acoustic Frequencies a weighting" dB typedef ^ ParameterType ReKi Fsample - - - "Sampling Frequency 1/delta(t) - 1/(simulation time step)" Hz typedef ^ ParameterType IntKi total_sample - - - "Total FFT Sample amount for dissipation calculation" - typedef ^ ParameterType IntKi total_sampleTI - - - "Total FFT Sample amount for dissipation calculation" - @@ -218,15 +220,14 @@ typedef ^ ParameterType ReKi AFLECo typedef ^ ParameterType ReKi AFTECo {:}{:}{:} - - typedef ^ ParameterType ReKi BlSpn {:}{:} - - "Span at blade node" m typedef ^ ParameterType ReKi BlChord {:}{:} - - "Chord at blade node" m -typedef ^ ParameterType ReKi UListXfoil {:} - - "For Xfoil BL the list of Wind Speed" m/s typedef ^ ParameterType ReKi ReListXfoil {:} - - "For Xfoil BL the list of Reynolds" - typedef ^ ParameterType ReKi AOAListXfoil {:} - - "For Xfoil BL the list of Angle Of Attack " deg -typedef ^ ParameterType ReKi dstarall1 {:}{:}{:} - - "Xfoil Output Disp Thickness Suction Side" m -typedef ^ ParameterType ReKi dstarall2 {:}{:}{:} - - "Xfoil Output Disp Thickness Pressure Side" m -typedef ^ ParameterType ReKi d99all1 {:}{:}{:} - - "Xfoil Output B.L. Thickness Suction Side" m -typedef ^ ParameterType ReKi d99all2 {:}{:}{:} - - "Xfoil Output B.L. Thickness Pressure Side" m -typedef ^ ParameterType ReKi Cfall1 {:}{:}{:} - - "Xfoil Output Skin friction coef Suction Side" - -typedef ^ ParameterType ReKi Cfall2 {:}{:}{:} - - "Xfoil Output Skin friction coef Pressure Side" - +typedef ^ ParameterType ReKi dStarAll1 {:}{:}{:} - - "Xfoil Output Disp Thickness Suction Side" m +typedef ^ ParameterType ReKi dStarAll2 {:}{:}{:} - - "Xfoil Output Disp Thickness Pressure Side" m +typedef ^ ParameterType ReKi d99All1 {:}{:}{:} - - "Xfoil Output B.L. Thickness Suction Side" m +typedef ^ ParameterType ReKi d99All2 {:}{:}{:} - - "Xfoil Output B.L. Thickness Pressure Side" m +typedef ^ ParameterType ReKi CfAll1 {:}{:}{:} - - "Xfoil Output Skin friction coef Suction Side" - +typedef ^ ParameterType ReKi CfAll2 {:}{:}{:} - - "Xfoil Output Skin friction coef Pressure Side" - typedef ^ ParameterType ReKi EdgeVelRat1 {:}{:}{:} - - "Xfoil Output Edge Velocity Ratio Suction" - typedef ^ ParameterType ReKi EdgeVelRat2 {:}{:}{:} - - "Xfoil Output Edge Velocity Ratio Pressure Side" - typedef ^ ParameterType ReKi AFThickGuida {:}{:} - - "1 and 10 percent thickness t/c used for Simplified Guidati" diff --git a/modules/aerodyn/src/AeroDyn_Registry_Backup.txt b/modules/aerodyn/src/AeroDyn_Registry_Backup.txt deleted file mode 100644 index 9f542dcde..000000000 --- a/modules/aerodyn/src/AeroDyn_Registry_Backup.txt +++ /dev/null @@ -1,200 +0,0 @@ -################################################################################################################################### -# Registry for AeroDyn 15 in the FAST Modularization Framework -# This Registry file is used to create AeroDyn_Types which contains data used in the AeroDyn module. -# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. -# See the NWTC Programmer's Handbook for further information on the format/contents of this file. -# -# Entries are of the form -# -# -# Use ^ as a shortcut for the value in the same column from the previous line. -################################################################################################################################### -# ...... Include files (definitions from NWTC Library) ............................................................................ -include Registry_NWTC_Library.txt -usefrom AirfoilInfo_Registry.txt -usefrom BEMT_Registry.txt -usefrom UnsteadyAero_Registry.txt - -# ..... Initialization data ....................................................................................................... -# Define inputs that the initialization routine may need here: -typedef AeroDyn/AD InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - -typedef ^ InitInputType Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - -typedef ^ InitInputType IntKi NumBlades - - - "Number of blades on the turbine" - -typedef ^ InitInputType ReKi Gravity - - - "Gravity force" Nm/s^2 -typedef ^ InitInputType CHARACTER(1024) RootName - - - "RootName for writing output files" - -typedef ^ InitInputType ReKi HubPosition {3} - - "X-Y-Z reference position of hub" m -typedef ^ InitInputType R8Ki HubOrientation {3}{3} - - "DCM reference orientation of hub" - -typedef ^ InitInputType ReKi BladeRootPosition {:}{:} - - "X-Y-Z reference position of each blade root (3 x NumBlades)" m -typedef ^ InitInputType R8Ki BladeRootOrientation {:}{:}{:} - - "DCM reference orientation of blade roots (3x3 x NumBlades)" - - -# 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" - -typedef ^ AD_BladePropsType ReKi BlSpn {:} - - "Span at blade node" m -typedef ^ AD_BladePropsType ReKi BlCrvAC {:} - - "Curve at blade node" m -typedef ^ AD_BladePropsType ReKi BlSwpAC {:} - - "Sweep at blade node" m -typedef ^ AD_BladePropsType ReKi BlCrvAng {:} - - "Curve angle at blade node" radians -typedef ^ AD_BladePropsType ReKi BlTwist {:} - - "Twist at blade node" radians -typedef ^ AD_BladePropsType ReKi BlChord {:} - - "Chord at blade node" m -typedef ^ AD_BladePropsType IntKi BlAFID {:} - - "ID of Airfoil at blade node" - - -# Define outputs from the initialization routine here: -typedef ^ AD_BladeShape SiKi AirfoilCoords {:}{:}{:} - - "x-y coordinates for airfoils, relative to node" m -# Define outputs from the initialization routine here: -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - -typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - -typedef ^ InitOutputType ReKi AirDens - - - "Air density" kg/m^3 -typedef ^ InitOutputType AD_BladeShape BladeShape {:} - - "airfoil coordinates for each blade" m -typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - -typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_z {:} - - "Names of the constraint states used in linearization" - -typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - -typedef ^ InitOutputType LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - -typedef ^ InitOutputType LOGICAL RotFrame_z {:} - - "Flag that tells FAST/MBC3 if the constraint states used in linearization are in the rotating frame (not used for glue)" - -typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - -typedef ^ InitOutputType LOGICAL IsLoad_u {:} - - "Flag that tells FAST if the inputs used in linearization are loads (for preconditioning matrix)" - -typedef ^ InitOutputType AD_BladePropsType BladeProps {:} - - "blade property information from blade input files" - -typedef ^ InitOutputType ReKi TwrElev {:} - - "Elevation at tower node" m -typedef ^ InitOutputType ReKi TwrDiam {:} - - "Diameter of tower at node" m - -# ..... Input file data ........................................................................................................... - -# ..... Primary Input file data ................................................................................................... -typedef ^ AD_InputFile DbKi DTAero - - - "Time interval for aerodynamic calculations {or "default"}" s -typedef ^ AD_InputFile IntKi WakeMod - - - "Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT}" - -typedef ^ AD_InputFile IntKi AFAeroMod - - - "Type of blade airfoil aerodynamics model {1=steady model, 2=Beddoes-Leishman unsteady model}" - -typedef ^ AD_InputFile IntKi TwrPotent - - - "Type tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - -typedef ^ AD_InputFile LOGICAL TwrShadow - - - "Calculate tower influence on wind based on downstream tower shadow?" - -typedef ^ AD_InputFile LOGICAL TwrAero - - - "Calculate tower aerodynamic loads?" flag -typedef ^ AD_InputFile Logical FrozenWake - - - "Flag that tells this module it should assume a frozen wake during linearization." - -typedef ^ AD_InputFile Logical CavitCheck - - - "Flag that tells us if we want to check for cavitation" - -typedef ^ AD_InputFile ReKi AirDens - - - "Air density" kg/m^3 -typedef ^ AD_InputFile ReKi KinVisc - - - "Kinematic air viscosity" m^2/s -typedef ^ AD_InputFile ReKi Patm - - - "Atmospheric pressure" Pa -typedef ^ AD_InputFile ReKi Pvap - - - "Vapour pressure" Pa -typedef ^ AD_InputFile ReKi FluidDepth - - - "Submerged hub depth" m -typedef ^ AD_InputFile ReKi SpdSound - - - "Speed of sound" m/s -typedef ^ AD_InputFile IntKi SkewMod - - - "Type of skewed-wake correction model {1=uncoupled, 2=Pitt/Peters, 3=coupled} [unused when WakeMod=0]" - -typedef ^ AD_InputFile ReKi SkewModFactor - - - "Constant used in Pitt/Peters skewed wake model (default is 15*pi/32)" - -typedef ^ AD_InputFile LOGICAL TipLoss - - - "Use the Prandtl tip-loss model? [unused when WakeMod=0]" flag -typedef ^ AD_InputFile LOGICAL HubLoss - - - "Use the Prandtl hub-loss model? [unused when WakeMod=0]" flag -typedef ^ AD_InputFile LOGICAL TanInd - - - "Include tangential induction in BEMT calculations? [unused when WakeMod=0]" flag -typedef ^ AD_InputFile LOGICAL AIDrag - - - "Include the drag term in the axial-induction calculation? [unused when WakeMod=0]" flag -typedef ^ AD_InputFile LOGICAL TIDrag - - - "Include the drag term in the tangential-induction calculation? [unused when WakeMod=0 or TanInd=FALSE]" flag -typedef ^ AD_InputFile ReKi IndToler - - - "Convergence tolerance for BEM induction factors [unused when WakeMod=0]" - -typedef ^ AD_InputFile ReKi MaxIter - - - "Maximum number of iteration steps [unused when WakeMod=0]" - -typedef ^ AD_InputFile IntKi UAMod - - - "Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2]" - -typedef ^ AD_InputFile LOGICAL FLookup - - - "Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAeroMod=2]" flag -typedef ^ AD_InputFile ReKi InCol_Alfa - - - "The column in the airfoil tables that contains the angle of attack" - -typedef ^ AD_InputFile ReKi InCol_Cl - - - "The column in the airfoil tables that contains the lift coefficient" - -typedef ^ AD_InputFile ReKi InCol_Cd - - - "The column in the airfoil tables that contains the drag coefficient" - -typedef ^ AD_InputFile ReKi InCol_Cm - - - "The column in the airfoil tables that contains the pitching-moment coefficient; use zero if there is no Cm column" - -typedef ^ AD_InputFile ReKi InCol_Cpmin - - - "The column in the airfoil tables that contains the drag coefficient; use zero if there is no Cpmin column" - -typedef ^ AD_InputFile IntKi NumAFfiles - - - "Number of airfoil files used" - -typedef ^ AD_InputFile CHARACTER(1024) AFNames {:} - - "Airfoil file names (NumAF lines)" "quoted strings" -typedef ^ AD_InputFile LOGICAL UseBlCm - - - "Include aerodynamic pitching moment in calculations?" flag -#typedef ^ AD_InputFile IntKi NumBlNds - - - "Number of blade nodes used in the analysis" - -typedef ^ AD_InputFile AD_BladePropsType BladeProps {:} - - "blade property information from blade input files" - -typedef ^ AD_InputFile IntKi NumTwrNds - - - "Number of tower nodes used in the analysis" - -typedef ^ AD_InputFile ReKi TwrElev {:} - - "Elevation at tower node" m -typedef ^ AD_InputFile ReKi TwrDiam {:} - - "Diameter of tower at node" m -typedef ^ AD_InputFile ReKi TwrCd {:} - - "Coefficient of drag at tower node" - -typedef ^ AD_InputFile LOGICAL SumPrint - - - "Generate a summary file listing input options and interpolated properties to ".AD.sum"?" flag -typedef ^ AD_InputFile IntKi NBlOuts - - - "Number of blade node outputs [0 - 9]" - -typedef ^ AD_InputFile IntKi BlOutNd {9} - - "Blade nodes whose values will be output" - -typedef ^ AD_InputFile IntKi NTwOuts - - - "Number of tower node outputs [0 - 9]" - -typedef ^ AD_InputFile IntKi TwOutNd {9} - - "Tower nodes whose values will be output" - -typedef ^ AD_InputFile IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ AD_InputFile CHARACTER(ChanLen) OutList {:} - - "List of user-requested output channels" - -typedef ^ AD_InputFile ReKi tau1_const - - - "time constant for DBEMT [used only when WakeMod=2 and DBEMT_Mod=1]" s -typedef ^ AD_InputFile IntKi DBEMT_Mod - - - "Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1}" - - -# ..... States .................................................................................................................... -# Define continuous (differentiable) states here: -typedef ^ ContinuousStateType BEMT_ContinuousStateType BEMT - - - "Continuous states from the BEMT module" - - -# Define discrete (nondifferentiable) states here: -typedef ^ DiscreteStateType BEMT_DiscreteStateType BEMT - - - "Discrete states from the BEMT module" - - -# Define constraint states here: -typedef ^ ConstraintStateType BEMT_ConstraintStateType BEMT - - - "Constraint states from the BEMT module" - - -# Define "other" states here: -typedef ^ OtherStateType BEMT_OtherStateType BEMT - - - "OtherStates from the BEMT module" - - -# Define misc/optimization variables (any data that are not considered actual states) here: -typedef ^ MiscVarType BEMT_MiscVarType BEMT - - - "MiscVars from the BEMT module" - -typedef ^ MiscVarType BEMT_OutputType BEMT_y - - - "Outputs from the BEMT module" - -typedef ^ MiscVarType BEMT_InputType BEMT_u 2 - - "Inputs to the BEMT module" - -typedef ^ MiscVarType ReKi DisturbedInflow {:}{:}{:} - - "InflowOnBlade values modified by tower influence" m/s -typedef ^ MiscVarType ReKi WithoutSweepPitchTwist {:}{:}{:}{:} - - "Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles" - -typedef ^ MiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" - -typedef ^ MiscVarType ReKi W_Twr {:} - - "relative wind speed normal to the tower at node j" m/s -typedef ^ MiscVarType ReKi X_Twr {:} - - "local x-component of force per unit length of the jth node in the tower" m/s -typedef ^ MiscVarType ReKi Y_Twr {:} - - "local y-component of force per unit length of the jth node in the tower" m/s -typedef ^ MiscVarType ReKi Curve {:}{:} - - "curvature angle, saved for possible output to file" rad -typedef ^ MiscVarType ReKi TwrClrnc {:}{:} - - "Distance between tower (including tower radius) and blade node (not including blade width), saved for possible output to file" m -typedef ^ MiscVarType ReKi X {:}{:} - - "normal force per unit length (normal to the plane, not chord) of the jth node in the kth blade" N/m -typedef ^ MiscVarType ReKi Y {:}{:} - - "tangential force per unit length (tangential to the plane, not chord) of the jth node in the kth blade" N/m -typedef ^ MiscVarType ReKi M {:}{:} - - "pitching moment per unit length of the jth node in the kth blade" Nm/m -typedef ^ MiscVarType ReKi V_DiskAvg {3} - - "disk-average relative wind speed" m/s -typedef ^ MiscVarType ReKi hub_theta_x_root {3} - - "angles saved for FAST.Farm" rad -typedef ^ MiscVarType ReKi V_dot_x - - - -typedef ^ MiscVarType 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)" - -typedef ^ MiscVarType MeshMapType B_L_2_H_P {:} - - "mapping data structure to map each bladeLoad output mesh to the MiscVar%HubLoad mesh" -typedef ^ MiscVarType ReKi SigmaCavitCrit {:}{:} - - "critical cavitation number- inception value (above which cavit will occur)" - -typedef ^ MiscVarType ReKi SigmaCavit {:}{:} - - "cavitation number at node " - -typedef ^ MiscVarType Logical CavitWarnSet {:}{:} - - "cavitation warning issued " - - -# ..... Parameters ................................................................................................................ -# Define parameters here: -# Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: -typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds -typedef ^ ParameterType IntKi WakeMod - - - "Type of wake/induction model {0=none, 1=BEMT, 2=DBEMT}" - -typedef ^ ParameterType IntKi TwrPotent - - - "Type tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - -typedef ^ ParameterType LOGICAL TwrShadow - - - "Calculate tower influence on wind based on downstream tower shadow?" - -typedef ^ ParameterType LOGICAL TwrAero - - - "Calculate tower aerodynamic loads?" flag -typedef ^ ParameterType Logical FrozenWake - - - "Flag that tells this module it should assume a frozen wake during linearization." - -typedef ^ ParameterType Logical CavitCheck - - - "Flag that tells us if we want to check for cavitation" - -typedef ^ ParameterType IntKi NumBlades - - - "Number of blades on the turbine" - -typedef ^ ParameterType IntKi NumBlNds - - - "Number of nodes on each blade" - -typedef ^ ParameterType IntKi NumTwrNds - - - "Number of nodes on the tower" - -typedef ^ ParameterType ReKi TwrDiam {:} - - "Diameter of tower at node" m -typedef ^ ParameterType ReKi TwrCd {:} - - "Coefficient of drag at tower node" - -typedef ^ ParameterType ReKi AirDens - - - "Air density" kg/m^3 -typedef ^ ParameterType ReKi KinVisc - - - "Kinematic air viscosity" m^2/s -typedef ^ ParameterType ReKi SpdSound - - - "Speed of sound" m/s -typedef ^ ParameterType ReKi Gravity - - - "Gravitational acceleration" m/s^2 -typedef ^ ParameterType ReKi Patm - - - "Atmospheric pressure" Pa -typedef ^ ParameterType ReKi Pvap - - - "Vapour pressure" Pa -typedef ^ ParameterType ReKi FluidDepth - - - "Submerged hub height" m -typedef ^ ParameterType AFI_ParameterType AFI - - - "AirfoilInfo parameters" -typedef ^ ParameterType BEMT_ParameterType BEMT - - - "Parameters for BEMT module" -# parameters for output -typedef ^ ParameterType IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ ParameterType CHARACTER(1024) RootName - - - "RootName for writing output files" - -typedef ^ ParameterType OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - -typedef ^ ParameterType IntKi NBlOuts - - - "Number of blade node outputs [0 - 9]" - -typedef ^ ParameterType IntKi BlOutNd {9} - - "Blade nodes whose values will be output" - -typedef ^ ParameterType IntKi NTwOuts - - - "Number of tower node outputs [0 - 9]" - -typedef ^ ParameterType IntKi TwOutNd {9} - - "Tower nodes whose values will be output" - -typedef ^ ParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - -typedef ^ ParameterType ReKi du {:} - - "vector that determines size of perturbation for u (inputs)" -typedef ^ ParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - - -# ..... Inputs .................................................................................................................... -# Define inputs that are contained on the mesh here: -typedef ^ InputType MeshType TowerMotion - - - "motion on the tower" - -typedef ^ InputType MeshType HubMotion - - - "motion on the hub" - -typedef ^ InputType MeshType BladeRootMotion {:} - - "motion on each blade root" - -typedef ^ InputType MeshType BladeMotion {:} - - "motion on each blade" - -# Define inputs that are not on this mesh here: -typedef ^ InputType ReKi InflowOnBlade {:}{:}{:} - - "U,V,W at nodes on each blade (note if we change the requirement that NumNodes is the same for each blade, this will need to change)" m/s -typedef ^ InputType ReKi InflowOnTower {:}{:} - - "U,V,W at nodes on the tower" m/s - -# ..... Outputs ................................................................................................................... -# Define outputs that are contained on the mesh here: -typedef ^ OutputType MeshType TowerLoad - - - "loads on the tower" - -typedef ^ OutputType MeshType BladeLoad {:} - - "loads on each blade" - -# Define outputs that are not on this mesh here: -typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" diff --git a/modules/aerodyn/src/AeroDyn_Registry_Emre.txt b/modules/aerodyn/src/AeroDyn_Registry_Emre.txt deleted file mode 100644 index 08e2d9f58..000000000 --- a/modules/aerodyn/src/AeroDyn_Registry_Emre.txt +++ /dev/null @@ -1,195 +0,0 @@ -################################################################################################################################### -# Registry for AeroDyn 15 in the FAST Modularization Framework -# This Registry file is used to create AeroDyn_Types which contains data used in the AeroDyn module. -# It also contains copy, destroy, pack, and unpack routines associated with each defined data types. -# See the NWTC Programmer's Handbook for further information on the format/contents of this file. -# -# Entries are of the form -# -# -# Use ^ as a shortcut for the value in the same column from the previous line. -################################################################################################################################### -# File last committed $Date$ -# (File) Revision #: $Rev$ -# URL: $HeadURL$ -################################################################################################################################### -# ...... Include files (definitions from NWTC Library) ............................................................................ -include Registry_NWTC_Library.txt -usefrom AirfoilInfo_Registry.txt -usefrom BEMT_Registry.txt -usefrom UnsteadyAero_Registry.txt -usefrom AeroAcoustics_Registry.txt - -# ..... Initialization data ....................................................................................................... -# Define inputs that the initialization routine may need here: -typedef AeroDyn/AD InitInputType CHARACTER(1024) InputFile - - - "Name of the input file" - -typedef ^ InitInputType Logical Linearize - .FALSE. - "Flag that tells this module if the glue code wants to linearize." - -typedef ^ InitInputType IntKi NumBlades - - - "Number of blades on the turbine" -typedef ^ InitInputType CHARACTER(1024) RootName - - - "RootName for writing output files" - -typedef ^ InitInputType ReKi HubPosition {3} - - "X-Y-Z reference position of hub" m -typedef ^ InitInputType R8Ki HubOrientation {3}{3} - - "DCM reference orientation of hub" - -typedef ^ InitInputType ReKi BladeRootPosition {:}{:} - - "X-Y-Z reference position of each blade root (3 x NumBlades)" m -typedef ^ InitInputType R8Ki BladeRootOrientation {:}{:}{:} - - "DCM reference orientation of blade roots (3x3 x NumBlades)" - - -# Define outputs from the initialization routine here: -typedef ^ AD_BladeShape SiKi AirfoilCoords {:}{:}{:} - - "x-y coordinates for airfoils, relative to node" m -# Define outputs from the initialization routine here: -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - -typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:} - - "Units of the output-to-file channels" - -typedef ^ InitOutputType ProgDesc Ver - - - "This module's name, version, and date" - -typedef ^ InitOutputType ReKi AirDens - - - "Air density" kg/m^3 -typedef ^ InitOutputType AD_BladeShape BladeShape {:} - - "airfoil coordinates for each blade" m -typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_y {:} - - "Names of the outputs used in linearization" - -typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_z {:} - - "Names of the constraint states used in linearization" - -typedef ^ InitOutputType CHARACTER(LinChanLen) LinNames_u {:} - - "Names of the inputs used in linearization" - -typedef ^ InitOutputType LOGICAL RotFrame_y {:} - - "Flag that tells FAST/MBC3 if the outputs used in linearization are in the rotating frame" - -typedef ^ InitOutputType LOGICAL RotFrame_z {:} - - "Flag that tells FAST/MBC3 if the constraint states used in linearization are in the rotating frame (not used for glue)" - -typedef ^ InitOutputType LOGICAL RotFrame_u {:} - - "Flag that tells FAST/MBC3 if the inputs used in linearization are in the rotating frame" - - -# ..... Input file data ........................................................................................................... -# This is data defined in the Input File for this module (or could otherwise be passed in) -# ..... Blade Input file data ..................................................................................................... -typedef ^ AD_BladePropsType IntKi NumBlNds - - - "Number of blade nodes used in the analysis" - -typedef ^ AD_BladePropsType ReKi BlSpn {:} - - "Span at blade node" m -typedef ^ AD_BladePropsType ReKi BlCrvAC {:} - - "Curve at blade node" m -typedef ^ AD_BladePropsType ReKi BlSwpAC {:} - - "Sweep at blade node" m -typedef ^ AD_BladePropsType ReKi BlCrvAng {:} - - "Curve angle at blade node" radians -typedef ^ AD_BladePropsType ReKi BlTwist {:} - - "Twist at blade node" radians -typedef ^ AD_BladePropsType ReKi BlChord {:} - - "Chord at blade node" m -typedef ^ AD_BladePropsType IntKi BlAFID {:} - - "ID of Airfoil at blade node" - - -# ..... Primary Input file data ................................................................................................... -typedef ^ AD_InputFile DbKi DTAero - - - "Time interval for aerodynamic calculations {or "default"}" s -typedef ^ AD_InputFile IntKi WakeMod - - - "Type of wake/induction model {0=none, 1=BEMT}" - -typedef ^ AD_InputFile IntKi AFAeroMod - - - "Type of blade airfoil aerodynamics model {1=steady model, 2=Beddoes-Leishman unsteady model}" - -typedef ^ AD_InputFile IntKi TwrPotent - - - "Type tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - -typedef ^ AD_InputFile LOGICAL TwrShadow - - - "Calculate tower influence on wind based on downstream tower shadow?" - -typedef ^ AD_InputFile LOGICAL TwrAero - - - "Calculate tower aerodynamic loads?" flag -typedef ^ AD_InputFile Logical FrozenWake - - - "Flag that tells this module it should assume a frozen wake during linearization." - -typedef ^ AD_InputFile Logical CompAA - - - "Compute AeroAcoustic noise" flag -typedef ^ AD_InputFile CHARACTER(1024) AA_InputFile - - - "AeroAcoustics input file name" "quoted strings" -typedef ^ AD_InputFile ReKi AirDens - - - "Air density" kg/m^3 -typedef ^ AD_InputFile ReKi KinVisc - - - "Kinematic air viscosity" m^2/s -typedef ^ AD_InputFile ReKi SpdSound - - - "Speed of sound" m/s -typedef ^ AD_InputFile IntKi SkewMod - - - "Type of skewed-wake correction model {1=uncoupled, 2=Pitt/Peters, 3=coupled} [used only when WakeMod=1]" - -typedef ^ AD_InputFile LOGICAL TipLoss - - - "Use the Prandtl tip-loss model? [used only when WakeMod=1]" flag -typedef ^ AD_InputFile LOGICAL HubLoss - - - "Use the Prandtl hub-loss model? [used only when WakeMod=1]" flag -typedef ^ AD_InputFile LOGICAL TanInd - - - "Include tangential induction in BEMT calculations? [used only when WakeMod=1]" flag -typedef ^ AD_InputFile LOGICAL AIDrag - - - "Include the drag term in the axial-induction calculation? [used only when WakeMod=1]" flag -typedef ^ AD_InputFile LOGICAL TIDrag - - - "Include the drag term in the tangential-induction calculation? [used only when WakeMod=1 and TanInd=TRUE]" flag -typedef ^ AD_InputFile ReKi IndToler - - - "Convergence tolerance for BEM induction factors [used only when WakeMod=1]" - -typedef ^ AD_InputFile ReKi MaxIter - - - "Maximum number of iteration steps [used only when WakeMod=1]" - -typedef ^ AD_InputFile IntKi UAMod - - - "Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAreoMod=2]" - -typedef ^ AD_InputFile LOGICAL FLookup - - - "Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAreoMod=2]" flag -typedef ^ AD_InputFile ReKi InCol_Alfa - - - "The column in the airfoil tables that contains the angle of attack" - -typedef ^ AD_InputFile ReKi InCol_Cl - - - "The column in the airfoil tables that contains the lift coefficient" - -typedef ^ AD_InputFile ReKi InCol_Cd - - - "The column in the airfoil tables that contains the drag coefficient" - -typedef ^ AD_InputFile ReKi InCol_Cm - - - "The column in the airfoil tables that contains the pitching-moment coefficient; use zero if there is no Cm column" - -typedef ^ AD_InputFile ReKi InCol_Cpmin - - - "The column in the airfoil tables that contains the drag coefficient; use zero if there is no Cpmin column" - -typedef ^ AD_InputFile IntKi NumAFfiles - - - "Number of airfoil files used" - -typedef ^ AD_InputFile CHARACTER(1024) AFNames {:} - - "Airfoil file names (NumAF lines)" "quoted strings" -typedef ^ AD_InputFile LOGICAL UseBlCm - - - "Include aerodynamic pitching moment in calculations?" flag -#typedef ^ AD_InputFile IntKi NumBlNds - - - "Number of blade nodes used in the analysis" - -typedef ^ AD_InputFile AD_BladePropsType BladeProps {:} - - "blade property information from blade input files" - -typedef ^ AD_InputFile IntKi NumTwrNds - - - "Number of tower nodes used in the analysis" - -typedef ^ AD_InputFile ReKi TwrElev {:} - - "Elevation at tower node" m -typedef ^ AD_InputFile ReKi TwrDiam {:} - - "Diameter of tower at node" m -typedef ^ AD_InputFile ReKi TwrCd {:} - - "Coefficient of drag at tower node" - -typedef ^ AD_InputFile LOGICAL SumPrint - - - "Generate a summary file listing input options and interpolated properties to ".AD.sum"?" flag -typedef ^ AD_InputFile IntKi NBlOuts - - - "Number of blade node outputs [0 - 9]" - -typedef ^ AD_InputFile IntKi BlOutNd {9} - - "Blade nodes whose values will be output" - -typedef ^ AD_InputFile IntKi NTwOuts - - - "Number of tower node outputs [0 - 9]" - -typedef ^ AD_InputFile IntKi TwOutNd {9} - - "Tower nodes whose values will be output" - -typedef ^ AD_InputFile IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ AD_InputFile CHARACTER(ChanLen) OutList {:} - - "List of user-requested output channels" - - -# ..... States .................................................................................................................... -# Define continuous (differentiable) states here: -typedef ^ ContinuousStateType BEMT_ContinuousStateType BEMT - - - "Continuous states from the BEMT module" - -typedef ^ ContinuousStateType AA_ContinuousStateType AA - - - "Continuous states from the AA module" - - -# Define discrete (nondifferentiable) states here: -typedef ^ DiscreteStateType BEMT_DiscreteStateType BEMT - - - "Discrete states from the BEMT module" - -typedef ^ DiscreteStateType AA_DiscreteStateType AA - - - "Discrete states from the AA module" - - -# Define constraint states here: -typedef ^ ConstraintStateType BEMT_ConstraintStateType BEMT - - - "Constraint states from the BEMT module" - -typedef ^ ConstraintStateType AA_ConstraintStateType AA - - - "Constraint states from the AA module" - - -# Define "other" states here: -typedef ^ OtherStateType BEMT_OtherStateType BEMT - - - "OtherStates from the BEMT module" - -typedef ^ OtherStateType AA_OtherStateType AA - - - "OtherStates from the AA module" - - -# Define misc/optimization variables (any data that are not considered actual states) here: -typedef ^ MiscVarType BEMT_MiscVarType BEMT - - - "MiscVars from the BEMT module" - -typedef ^ MiscVarType BEMT_OutputType BEMT_y - - - "Outputs from the BEMT module" - -typedef ^ MiscVarType BEMT_InputType BEMT_u 2 - - "Inputs to the BEMT module" - -typedef ^ MiscVarType AA_MiscVarType AA - - - "MiscVars from the AA module" - -typedef ^ MiscVarType AA_OutputType AA_y - - - "Outputs from the AA module" - -typedef ^ MiscVarType AA_InputType AA_u - - - "Inputs to the AA module" - - -typedef ^ MiscVarType ReKi DisturbedInflow {:}{:}{:} - - "InflowOnBlade values modified by tower influence" m/s -typedef ^ MiscVarType ReKi WithoutSweepPitchTwist {:}{:}{:}{:} - - "Coordinate system equivalent to BladeMotion Orientation, but without live sweep, blade-pitch, and twist angles" - -typedef ^ MiscVarType ReKi AllOuts {:} - - "An array holding the value of all of the calculated (not only selected) output channels" - -typedef ^ MiscVarType ReKi W_Twr {:} - - "relative wind speed normal to the tower at node j" m/s -typedef ^ MiscVarType ReKi X_Twr {:} - - "local x-component of force per unit length of the jth node in the tower" m/s -typedef ^ MiscVarType ReKi Y_Twr {:} - - "local y-component of force per unit length of the jth node in the tower" m/s -typedef ^ MiscVarType ReKi Curve {:}{:} - - "curvature angle, saved for possible output to file" rad -typedef ^ MiscVarType ReKi TwrClrnc {:}{:} - - "Distance between tower (including tower radius) and blade node (not including blade width), saved for possible output to file" m -typedef ^ MiscVarType ReKi X {:}{:} - - "normal force per unit length (normal to the plane, not chord) of the jth node in the kth blade" N/m -typedef ^ MiscVarType ReKi Y {:}{:} - - "tangential force per unit length (tangential to the plane, not chord) of the jth node in the kth blade" N/m -typedef ^ MiscVarType ReKi M {:}{:} - - "pitching moment per unit length of the jth node in the kth blade" Nm/m -typedef ^ MiscVarType ReKi V_DiskAvg {3} - - "disk-average relative wind speed" m/s -typedef ^ MiscVarType ReKi V_dot_x - - - -typedef ^ MiscVarType 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)" - -typedef ^ MiscVarType MeshMapType B_L_2_H_P {:} - - "mapping data structure to map each bladeLoad output mesh to the MiscVar%HubLoad mesh" - -# ..... Parameters ................................................................................................................ -# Define parameters here: -# Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: -typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds -typedef ^ ParameterType IntKi WakeMod - - - "Type of wake/induction model {0=none, 1=BEMT}" - -typedef ^ ParameterType IntKi TwrPotent - - - "Type tower influence on wind based on potential flow around the tower {0=none, 1=baseline potential flow, 2=potential flow with Bak correction}" - -typedef ^ ParameterType LOGICAL TwrShadow - - - "Calculate tower influence on wind based on downstream tower shadow?" - -typedef ^ ParameterType LOGICAL TwrAero - - - "Calculate tower aerodynamic loads?" flag -typedef ^ ParameterType Logical FrozenWake - - - "Flag that tells this module it should assume a frozen wake during linearization." - -typedef ^ ParameterType Logical CompAA - - - "Compute AeroAcoustic noise" flag -typedef ^ ParameterType IntKi NumBlades - - - "Number of blades on the turbine" - -typedef ^ ParameterType IntKi NumBlNds - - - "Number of nodes on each blade" - -typedef ^ ParameterType IntKi NumTwrNds - - - "Number of nodes on the tower" - -typedef ^ ParameterType ReKi TwrDiam {:} - - "Diameter of tower at node" m -typedef ^ ParameterType ReKi TwrCd {:} - - "Coefficient of drag at tower node" - -typedef ^ ParameterType ReKi AirDens - - - "Air density" kg/m^3 -typedef ^ ParameterType ReKi KinVisc - - - "Kinematic air viscosity" m^2/s -typedef ^ ParameterType ReKi SpdSound - - - "Speed of sound" m/s -typedef ^ ParameterType AFI_ParameterType AFI - - - "AirfoilInfo parameters" -typedef ^ ParameterType BEMT_ParameterType BEMT - - - "Parameters for BEMT module" -typedef ^ ParameterType AA_ParameterType AA - - - "Parameters for AA module" -# parameters for output -typedef ^ ParameterType IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - -typedef ^ ParameterType CHARACTER(1024) RootName - - - "RootName for writing output files" - -typedef ^ ParameterType OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - -typedef ^ ParameterType IntKi NBlOuts - - - "Number of blade node outputs [0 - 9]" - -typedef ^ ParameterType IntKi BlOutNd {9} - - "Blade nodes whose values will be output" - -typedef ^ ParameterType IntKi NTwOuts - - - "Number of tower node outputs [0 - 9]" - -typedef ^ ParameterType IntKi TwOutNd {9} - - "Tower nodes whose values will be output" - -typedef ^ ParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - -typedef ^ ParameterType ReKi du {:} - - "vector that determines size of perturbation for u (inputs)" -typedef ^ ParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - - -# ..... Inputs .................................................................................................................... -# Define inputs that are contained on the mesh here: -typedef ^ InputType MeshType TowerMotion - - - "motion on the tower" - -typedef ^ InputType MeshType HubMotion - - - "motion on the hub" - -typedef ^ InputType MeshType BladeRootMotion {:} - - "motion on each blade root" - -typedef ^ InputType MeshType BladeMotion {:} - - "motion on each blade" - -# Define inputs that are not on this mesh here: -typedef ^ InputType ReKi InflowOnBlade {:}{:}{:} "U,V,W at nodes on each blade (note if we change the requirement that NumNodes is the same for each blade, this will need to change)" m/s -typedef ^ InputType ReKi InflowOnTower {:}{:} "U,V,W at nodes on the tower" m/s - -# ..... Outputs ................................................................................................................... -# Define outputs that are contained on the mesh here: -typedef ^ OutputType MeshType TowerLoad - - - "loads on the tower" - -typedef ^ OutputType MeshType BladeLoad {:} - - "loads on each blade" - -# Define outputs that are not on this mesh here: -typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index cc89a1401..898a4f84e 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -132,6 +132,36 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -335,7 +365,79 @@ - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/vs-build/RunRegistry.bat b/vs-build/RunRegistry.bat index e2b6df556..092e19c0b 100644 --- a/vs-build/RunRegistry.bat +++ b/vs-build/RunRegistry.bat @@ -135,6 +135,10 @@ SET CURR_LOC=%AD_Loc% %REGISTRY% "%CURR_LOC%\UnsteadyAero_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" GOTO checkError +:AA +SET CURR_LOC=%AD_Loc% +%REGISTRY% "%CURR_LOC%\AeroAcoustics_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" + :AeroDyn14 SET CURR_LOC=%AD14_Loc% %REGISTRY% "%CURR_LOC%\Registry-AD14.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -I "%IfW_Loc%" -O "%Output_Loc%" @@ -283,4 +287,4 @@ SET ALL_FAST_Includes= echo %lines% set lines= -:PathsOnly \ No newline at end of file +:PathsOnly