From d6b7cff09c62b9b886848787deb109eb513c78cc Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Wed, 11 Nov 2020 20:01:28 -0700 Subject: [PATCH 01/27] OLAF: update and activation of UA --- cmake/OpenfastFortranOptions.cmake | 2 +- modules/aerodyn/src/AeroDyn.f90 | 76 +++-- modules/aerodyn/src/FVW.f90 | 247 ++++++++------ modules/aerodyn/src/FVW_Registry.txt | 9 +- modules/aerodyn/src/FVW_Types.f90 | 465 ++++++++++++++++++++++----- modules/aerodyn/src/UnsteadyAero.f90 | 13 +- 6 files changed, 582 insertions(+), 230 deletions(-) diff --git a/cmake/OpenfastFortranOptions.cmake b/cmake/OpenfastFortranOptions.cmake index 231c4f8008..9b6a1f4daa 100644 --- a/cmake/OpenfastFortranOptions.cmake +++ b/cmake/OpenfastFortranOptions.cmake @@ -115,7 +115,7 @@ macro(set_fast_gfortran) # debug flags if(CMAKE_BUILD_TYPE MATCHES Debug) - set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -fcheck=all -pedantic -fbacktrace " ) + set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_DEBUG} -fcheck=all,no-array-temps -pedantic -fbacktrace " ) endif() if(CYGWIN) diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 58a11dfbdd..013589d4c6 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -1393,26 +1393,41 @@ subroutine SetInputs(p, u, m, indx, errStat, errMsg) 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 + ! Disturbed inflow on blade (if tower shadow present) + call SetDisturbedInflow(p, u, m, errStat, errMsg) if (p%WakeMod /= WakeMod_FVW) then ! 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) endif +end subroutine SetInputs + +!> Disturbed inflow on the blade if tower shadow or tower influence are enabled +subroutine SetDisturbedInflow(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) :: errStat2 + character(ErrMsgLen) :: errMsg2 + character(*), parameter :: RoutineName = 'SetDisturbedInflow' + errStat = ErrID_None + errMsg = "" + if (p%TwrPotent /= TwrPotent_none .or. p%TwrShadow) then + call TwrInfl( p, u, m, errStat2, errMsg2 ) ! NOTE: tower clearance is computed here.. + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + else + m%DisturbedInflow = u%InflowOnBlade + end if +end subroutine SetDisturbedInflow -end subroutine SetInputs !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine sets m%BEMT_u(indx). subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) @@ -1662,7 +1677,7 @@ subroutine SetInputsForFVW(p, u, m, errStat, errMsg) real(R8Ki) :: Azimuth(p%NumBlades) integer(intKi) :: tIndx - integer(intKi) :: k ! loop counter for blades + integer(intKi) :: k,j ! loop counter for blades and nodes character(*), parameter :: RoutineName = 'SetInputsForFVW' do tIndx=1,size(u) @@ -1687,7 +1702,14 @@ subroutine SetInputsForFVW(p, u, m, errStat, errMsg) m%FVW_u(tIndx)%WingsMesh(k)%TranslationVel = u(tIndx)%BladeMotion(k)%TranslationVel m%FVW_u(tIndx)%HubPosition = u(tIndx)%HubMotion%Position(:,1) + u(tIndx)%HubMotion%TranslationDisp(:,1) m%FVW_u(tIndx)%HubOrientation = u(tIndx)%HubMotion%Orientation(:,:,1) - enddo + + ! Inputs for dynamic stall (see SetInputsForBEMT) + do j=1,p%NumBlNds + ! inputs for CUA, section pitch/torsion rate + m%FVW_u(tIndx)%omega_z(j,k) = dot_product( u(tIndx)%BladeMotion(k)%RotationVel( :,j), m%WithoutSweepPitchTwist(3,:,j,k) ) ! rotation of no-sweep-pitch coordinate system around z of the jth node in the kth blade + end do !j=nodes + + enddo !k=blade if (ALLOCATED(m%FVW_u(tIndx)%V_wind)) then m%FVW_u(tIndx)%V_wind = u(tIndx)%InflowWakeVel ! Applying tower shadow to V_wind based on r_wind positions @@ -1699,8 +1721,10 @@ subroutine SetInputsForFVW(p, u, m, errStat, errMsg) endif end if endif + ! Disturbed inflow for UA on Lifting line Mesh Points + call SetDisturbedInflow(p, u(tIndx), m, errStat, errMsg) + m%FVW_u(tIndx)%Vwnd_LLMP = m%DisturbedInflow enddo - m%FVW%Vwnd_ND = m%DisturbedInflow ! Nasty transfer for UA, but this is temporary, waiting for AeroDyn to handle UA end subroutine SetInputsForFVW !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine sets m%AA_u. @@ -1794,7 +1818,7 @@ subroutine SetOutputsFromFVW(u, p, OtherState, x, xd, m, y, ErrStat, ErrMsg) type(AD_ContinuousStateType),intent(in ) :: x !< continuous states type(AD_DiscreteStateType),intent(in ) :: xd !< Discrete states type(AD_OutputType), intent(inout) :: y !< AD outputs - type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables + type(AD_MiscVarType),target,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 @@ -1818,7 +1842,8 @@ subroutine SetOutputsFromFVW(u, p, OtherState, x, xd, m, y, ErrStat, ErrMsg) real(ReKi) :: Cx, Cy real(ReKi) :: Cl_Static, Cd_Static, Cm_Static real(ReKi) :: Cl_dyn, Cd_dyn, Cm_dyn - type(UA_InputType) :: u_UA + type(UA_InputType), pointer :: u_UA ! Alias to shorten notations + integer(IntKi), parameter :: InputIndex=1 ! we will always use values at t in this routine integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 @@ -1837,7 +1862,7 @@ subroutine SetOutputsFromFVW(u, p, OtherState, x, xd, m, y, ErrStat, ErrMsg) ! --- Computing main aero variables from induction - setting local variables Vind = m%FVW_y%Vind(1:3,j,k) Vstr = u%BladeMotion(k)%TranslationVel(1:3,j) - Vwnd = m%DisturbedInflow(1:3,j,k) ! NOTE: contains tower shadow + Vwnd = m%DisturbedInflow(1:3,j,k) ! NOTE: contains tower shadow ! TODO in FVW_u%Vwnd_LLMP theta = m%FVW%PitchAndTwist(j,k) call FVW_AeroOuts( m%WithoutSweepPitchTwist(1:3,1:3,j,k), u%BladeMotion(k)%Orientation(1:3,1:3,j), & ! inputs theta, Vstr(1:3), Vind(1:3), VWnd(1:3), p%KinVisc, p%FVW%Chord(j,k), & ! inputs @@ -1850,34 +1875,25 @@ subroutine SetOutputsFromFVW(u, p, OtherState, x, xd, m, y, ErrStat, ErrMsg) Cd_Static = AFI_interp%Cd Cm_Static = AFI_interp%Cm - ! Set dynamic to the (will be same as static if UA_Flag is false) + ! Set dynamic coeff to the static coeff by default Cl_dyn = AFI_interp%Cl Cd_dyn = AFI_interp%Cd Cm_dyn = AFI_interp%Cm - if (m%FVW%UA_Flag) then if ((OtherState%FVW%UA_Flag(j,k)) .and. ( .not. EqualRealNos(Vrel,0.0_ReKi) ) ) then - - ! ....... compute inputs to UA ........... - u_UA%alpha = alpha + u_UA => m%FVW%u_UA(j,k,InputIndex) ! Alias + ! Making sure inputs are consistent + u_UA%alpha = alpha u_UA%U = Vrel - u_UA%Re = Re - u_UA%UserProp = 0.0_ReKi ! FIX ME - - ! FIX ME: this is copied 3 times!!!! - u_UA%v_ac(1) = sin(u_UA%alpha)*u_UA%U - u_UA%v_ac(2) = cos(u_UA%alpha)*u_UA%U - u_UA%omega = dot_product( u%BladeMotion(k)%RotationVel( :,j), m%WithoutSweepPitchTwist(3,:,j,k) ) ! rotation of no-sweep-pitch coordinate system around z of the jth node in the kth blade - + u_UA%v_ac(1) = sin(u_UA%alpha)*u_UA%U + u_UA%v_ac(2) = cos(u_UA%alpha)*u_UA%U call UA_CalcOutput(j, k, u_UA, m%FVW%p_UA, x%FVW%UA, xd%FVW%UA, OtherState%FVW%UA, p%AFI(p%FVW%AFindx(j,k)), m%FVW%y_UA, m%FVW%m_UA, errStat2, errMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'SetOutputsFromFVW') Cl_dyn = m%FVW%y_UA%Cl Cd_dyn = m%FVW%y_UA%Cd Cm_dyn = m%FVW%y_UA%Cm - end if end if - cp = cos(phi) sp = sin(phi) Cx = Cl_dyn*cp + Cd_dyn*sp diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index 23c727ccb7..bf2d412d83 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -115,12 +115,6 @@ subroutine FVW_Init(AFInfo, InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ! Move the InitInp%WingsMesh to u CALL MOVE_ALLOC( InitInp%WingsMesh, u%WingsMesh ) ! Move from InitInp to u -!NOTE: We do not have the windspeed until after the FVW initialization (IfW is not initialized until after AD15) - ! Wind Speed hack, TODO temporary NOTE: it is still needed? - m%Vwnd_LL(:,:,:) = 0 - m%Vwnd_NW(:,:,:,:) = 0 - m%Vwnd_FW(:,:,:,:) = 0 - ! This mesh is passed in as a cousin of the BladeMotion mesh. CALL Wings_Panelling_Init(u%WingsMesh, p, m, ErrStat2, ErrMsg2); if(Failed()) return @@ -146,8 +140,8 @@ subroutine FVW_Init(AFInfo, InitInp, u, p, x, xd, z, OtherState, y, m, Interval, call Map_LL_NW(p, m, z, x, 1.0_ReKi, ErrStat2, ErrMsg2); if(Failed()) return call Map_NW_FW(p, m, z, x, ErrStat2, ErrMsg2); if(Failed()) return - ! Initialize output - CALL FVW_Init_Y( p, u, y, ErrStat2, ErrMsg2); if(Failed()) return + ! Initialize input guess and output + CALL FVW_Init_U_Y( p, u, y, ErrStat2, ErrMsg2); if(Failed()) return ! Returned guessed locations where wind will be required CALL SetRequestedWindPoints(m%r_wind, x, p, m ) @@ -156,11 +150,10 @@ subroutine FVW_Init(AFInfo, InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ! --- UA ! NOTE: quick and dirty since this should belong to AD - interval = InitInp%DTAero ! important, UA, needs proper interval + interval = InitInp%DTAero ! important, gluecode and UA, needs proper interval call UA_Init_Wrapper(AFInfo, InitInp, interval, p, x, xd, OtherState, m, ErrStat2, ErrMsg2); if (Failed()) return ! Framework types unused - Interval = InitInp%DTAero OtherState%NULL = 0 xd%NULL = 0 InitOut%NULL = 0 @@ -252,8 +245,11 @@ subroutine FVW_InitMiscVars( p, m, ErrStat, ErrMsg ) call AllocAry( m%r_wind, 3, nMax, 'Requested wind points', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ) m%r_wind = 0.0_ReKi ! set to zero so InflowWind can shortcut calculations m%OldWakeTime = -HUGE(1.0_DbKi) - ! Temporary UA - call AllocAry( m%Vwnd_ND, 3, p%nSpan+1, p%nWings, 'Vwnd_ND', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%TE = -999999_ReKi; + ! Wind set to 0. TODO check if -99999 works now + !NOTE: We do not have the windspeed until after the FVW initialization (IfW is not initialized until after AD15) + m%Vwnd_LL(:,:,:) = 0 + m%Vwnd_NW(:,:,:,:) = 0 + m%Vwnd_FW(:,:,:,:) = 0 end subroutine FVW_InitMiscVars ! ============================================================================== @@ -341,7 +337,8 @@ subroutine FVW_InitConstraint( z, p, m, ErrStat, ErrMsg ) if(.false.) print*,m%nNW ! unused var for now end subroutine FVW_InitConstraint ! ============================================================================== -subroutine FVW_Init_Y( p, u, y, ErrStat, ErrMsg ) +!> Init/allocate inputs and outputs +subroutine FVW_Init_U_Y( p, u, y, ErrStat, ErrMsg ) type(FVW_ParameterType), intent(in ) :: p !< Parameters type(FVW_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined type(FVW_OutputType), intent( out) :: y !< Constraints @@ -350,7 +347,7 @@ subroutine FVW_Init_Y( p, u, y, ErrStat, ErrMsg ) integer(IntKi) :: nMax ! Total number of wind points possible integer(IntKi) :: ErrStat2 ! temporary error status of the operation character(ErrMsgLen) :: ErrMsg2 ! temporary error message - character(*), parameter :: RoutineName = 'FVW_Init_Y' + character(*), parameter :: RoutineName = 'FVW_Init_U_Y' ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -360,15 +357,15 @@ subroutine FVW_Init_Y( p, u, y, ErrStat, ErrMsg ) nMax = nMax + (p%nSpan+1) * (p%nNWMax+1) * p%nWings ! Nearwake points nMax = nMax + (FWnSpan+1) * (p%nFWMax+1) * p%nWings ! Far wake points - call AllocAry( u%V_wind, 3, nMax, 'Wind Velocity at points', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ) - call AllocAry( y%Vind , 3, p%nSpan+1, p%nWings, 'Induced velocity vector', ErrStat2, ErrMsg2 ); ! TODO potentially nSpan+1 for AD15 - !call AllocAry( y%Cl_KJ , 1, 1, 'Lift coefficient from circulation (Kutta-Joukowski)', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ) - if (ErrStat >= AbortErrLev) return - y%Vind = 0.0_ReKi - return -end subroutine FVW_Init_Y - - + call AllocAry( u%V_wind, 3, nMax, 'Wind Velocity at points', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName) + call AllocAry( y%Vind , 3, p%nSpan+1, p%nWings, 'Induced velocity vector', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName) + call AllocAry( u%omega_z, p%nSpan+1, p%nWings, 'Section torsion rate' , ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName) + call AllocAry( u%Vwnd_LLMP,3, p%nSpan+1, p%nWings, 'Dist. wind at LL nodes', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName) + y%Vind = 0.0_ReKi ! TODO check if 0 is somehow required? + u%V_wind = -9999.9_ReKi + u%Vwnd_LLMP = -9999.9_ReKi + u%omega_z = -9999.9_ReKi +end subroutine FVW_Init_U_Y ! ============================================================================== !> Setting parameters *and misc* from module inputs SUBROUTINE FVW_SetParametersFromInputs( InitInp, p, ErrStat, ErrMsg ) @@ -579,13 +576,18 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m ! Distribute the Wind we requested to Inflow wind to storage Misc arrays CALL DistributeRequestedWind(u(1)%V_wind, p, m) - ! --- Solve for circulation at t + ! --- Solve for quasi steady circulation at t ! Returns: z%Gamma_LL (at t) call AllocAry( z_guess%Gamma_LL, p%nSpan, p%nWings, 'Lifting line Circulation', ErrStat, ErrMsg ); z_guess%Gamma_LL = m%Gamma_LL call FVW_CalcConstrStateResidual(t, uInterp, p, x, xd, z_guess, OtherState, m, z, AFInfo, ErrStat2, ErrMsg2, 1); if(Failed()) return - call UA_UpdateState_Wrapper(AFInfo,t, n, uInterp, p, x, xd, OtherState, m, ErrStat2, ErrMsg2); if(Failed()) return + ! TODO convert quasi steady Gamma to unsteady gamma with UA states + + ! Compute UA inputs at t + if (m%UA_Flag) then + call CalculateInputsAndOtherStatesForUA(1, uInterp, p, x, xd, z, OtherState, AFInfo, m, ErrStat2, ErrMsg2); if(Failed()) return + end if ! Map circulation and positions between LL and NW and then NW and FW ! Changes: x only @@ -631,15 +633,21 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m ShedScale = (t+p%DTaero - m%OldWakeTime)/p%DTfvw call Map_LL_NW(p, m, z, x, ShedScale, ErrStat2, ErrMsg2); if(Failed()) return call Map_NW_FW(p, m, z, x, ErrStat2, ErrMsg2); if(Failed()) return - !call print_x_NW_FW(p, m, x,'Map2') - ! --- Solve for circulation at t+p%DTaero + ! --- Solve for quasi steady circulation at t+p%DTaero ! Returns: z%Gamma_LL (at t+p%DTaero) z_guess%Gamma_LL = z%Gamma_LL ! We use as guess the circulation from the previous time step (see above) call FVW_CalcConstrStateResidual(t+p%DTaero, uInterp, p, x, xd, z_guess, OtherState, m, z, AFInfo, ErrStat2, ErrMsg2, 2); if(Failed()) return ! print*,'US: z_Gamma',x%Gamma_NW(1,1,1) ! print*,'US: x_Gamma',z%Gamma_LL(1,1) + ! Compute UA inputs at t+DTaero and integrate UA states between t and t+dtAero + if (m%UA_Flag) then + call CalculateInputsAndOtherStatesForUA(2, uInterp, p, x, xd, z, OtherState, AFInfo, m, ErrStat2, ErrMsg2); if(Failed()) return + call UA_UpdateState_Wrapper(AFInfo, t, n, (/t,t+p%DTaero/), p, x, xd, OtherState, m, ErrStat2, ErrMsg2); if(Failed()) return + end if + + ! TODO compute unsteady Gamma here based on UA Cl ! Updating circulation of near wake panel (and position but irrelevant) ! Changes: x only @@ -647,7 +655,7 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m call Map_NW_FW(p, m, z, x, ErrStat2, ErrMsg2); if(Failed()) return !call print_x_NW_FW(p, m, x,'Map3') - ! --- Fake handling of ground effect + ! --- Fake handling of ground effect (ensure vorticies above ground) call FakeGroundEffect(p, x, m, ErrStat, ErrMsg) ! set the wind points required for t+p%DTaero timestep @@ -964,7 +972,7 @@ subroutine FVW_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, m%VTKStep = m%iStep+1 ! We use glue code step number for outputs endif if (m%FirstCall) then - call MKDIR('vtk_fvw') + call MKDIR('vtk_fvw') ! TODO TODO TODO endif if ( ( t - m%VTKlastTime ) >= p%DTvtk*OneMinusEpsilon ) then m%VTKlastTime = t @@ -993,6 +1001,8 @@ end subroutine FVW_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- ! --- UA related, should be merged with AeroDyn !---------------------------------------------------------------------------------------------------------------------------------- +!> Init UA +!! NOTE: UA is done at the "AeroDyn" nodes, not the control points subroutine UA_Init_Wrapper(AFInfo, InitInp, interval, p, x, xd, OtherState, m, ErrStat, ErrMsg ) use UnsteadyAero, only: UA_Init, UA_TurnOff_param type(AFI_ParameterType), intent(in ) :: AFInfo(:) !< The airfoil parameter data, temporary, for UA.. @@ -1007,37 +1017,34 @@ subroutine UA_Init_Wrapper(AFInfo, InitInp, interval, p, x, xd, OtherState, m, E character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! type(UA_InitInputType) :: Init_UA_Data - type(UA_InputType) :: u_UA type(UA_InitOutputType):: InitOutData_UA integer :: i,j - integer(intKi) :: ErrStat2 ! temporary Error status + integer(intKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 ErrStat = ErrID_None ErrMsg = "" m%UA_Flag=InitInp%UA_Flag ! --- Condensed version of BEMT_Init_Otherstate - allocate ( OtherState%UA_Flag( InitInp%numBladeNodes, InitInp%NumBlades ), STAT = ErrStat2 ) + allocate ( OtherState%UA_Flag( InitInp%numBladeNodes, InitInp%numBlades ), STAT = ErrStat2 ) OtherState%UA_Flag=m%UA_Flag if ( m%UA_Flag ) then - ErrMsg2='Unsteady aerodynamic (`AFAeroMod>1`) cannot be used with the free wake code (`WakeMod=3`) for now.'; ErrStat2=ErrID_Fatal; - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'UA_Init_Wrapper'); return - ! ---Condensed version of "BEMT_Set_UA_InitData" allocate(Init_UA_Data%c(InitInp%numBladeNodes,InitInp%numBlades), STAT = errStat2) - do j = 1,InitInp%NumBlades; do i = 1,InitInp%numBladeNodes; + do j = 1,InitInp%numBlades; do i = 1,InitInp%numBladeNodes; Init_UA_Data%c(i,j) = p%chord(i,j) ! NOTE: InitInp chord move-allocd to p end do; end do Init_UA_Data%dt = interval Init_UA_Data%OutRootName = '' - Init_UA_Data%numBlades = InitInp%NumBlades - Init_UA_Data%nNodesPerBlade = InitInp%numBladeNodes + Init_UA_Data%numBlades = InitInp%numBlades + Init_UA_Data%nNodesPerBlade = InitInp%numBladeNodes ! At AeroDyn ndoes, not CP Init_UA_Data%NumOuts = 0 Init_UA_Data%UAMod = InitInp%UAMod Init_UA_Data%Flookup = InitInp%Flookup - Init_UA_Data%a_s = InitInp%a_s ! m/s - ! --- UA init - call UA_Init( Init_UA_Data, u_UA, m%p_UA, x%UA, xd%UA, OtherState%UA, m%y_UA, m%m_UA, interval, InitOutData_UA, ErrStat2, ErrMsg2); if(Failed())return + Init_UA_Data%a_s = InitInp%a_s ! Speed of sound, m/s + ! --- UA init, getting an irrelevant guess for u_UA + allocate(m%u_UA( InitInp%numBladeNodes, InitInp%numBlades, 2), stat=errStat2) + call UA_Init( Init_UA_Data, m%u_UA(1,1,1), m%p_UA, x%UA, xd%UA, OtherState%UA, m%y_UA, m%m_UA, interval, InitOutData_UA, ErrStat2, ErrMsg2); if(Failed())return m%p_UA%ShedEffect=.False. !< Important, when coupling UA wih vortex code, shed vorticity is inherently accounted for ! --- Condensed version of "BEMT_CheckInitUA" do j = 1,InitInp%numBlades; do i = 1,InitInp%numBladeNodes; ! Loop over blades and nodes @@ -1061,7 +1068,6 @@ subroutine UA_Init_Wrapper(AFInfo, InitInp, interval, p, x, xd, OtherState, m, E end do write (69,'(A)') ' ' #endif - call UA_DestroyInput( u_UA, ErrStat2, ErrMsg2 ); if(Failed())return call UA_DestroyInitInput( Init_UA_Data, ErrStat2, ErrMsg2 ); if(Failed())return call UA_DestroyInitOutput( InitOutData_UA, ErrStat2, ErrMsg2 ); if(Failed())return @@ -1078,14 +1084,88 @@ logical function Failed() end function Failed end subroutine UA_Init_Wrapper -subroutine UA_UpdateState_Wrapper(AFInfo, t, n, u, p, x, xd, OtherState, m, ErrStat, ErrMsg ) +!> Compute necessary inputs for UA at a given time step, stored in m%u_UA +!! Inputs are AoA, U, Re, +!! See equivalent version in BEMT, and SetInputs_for_UA in BEMT +subroutine CalculateInputsAndOtherStatesForUA(InputIndex, u, p, x, xd, z, OtherState, AFInfo, m, ErrStat, ErrMsg) + use UnsteadyAero, only: UA_TurnOff_input + integer(IntKi), intent(in ) :: InputIndex ! InputIndex= 1 or 2, depending on time step we are calculating inputs for + type(FVW_InputType), intent(in ) :: u ! Input + type(FVW_ParameterType), intent(in ) :: p ! Parameters + type(FVW_ContinuousStateType), intent(in ) :: x ! Continuous states at given time step + type(FVW_DiscreteStateType), intent(in ) :: xd ! Discrete states at given time step + type(FVW_ConstraintStateType), intent(in ) :: z ! Constraint states at given time step + type(FVW_OtherStateType), intent(inout) :: OtherState ! Other states at given time step + type(FVW_MiscVarType), target, intent(inout) :: m ! Misc/optimization variables + type(AFI_ParameterType), intent(in ) :: AFInfo(:) ! The airfoil parameter data + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local + real(ReKi), dimension(:,:), allocatable :: Vind_node + type(UA_InputType), pointer :: u_UA ! Alias to shorten notations + integer(IntKi) :: i,j + character(ErrMsgLen) :: errMsg2 ! temporary Error message if ErrStat /= ErrID_None + integer(IntKi) :: errStat2 ! temporary Error status of the operation + ErrStat = ErrID_None + ErrMsg = "" + + ! --- Induction on the lifting line control points + ! NOTE: this is expensive since it's an output for FVW but here we have to use it for UA + ! Set m%Vind_LL + m%Vind_LL=-9999.0_ReKi + call LiftingLineInducedVelocities(p, x, 1, m, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'UA_UpdateState_Wrapper'); if (ErrStat >= AbortErrLev) return + allocate(Vind_node(3,1:p%nSpan+1)) + + do j = 1,p%nWings + ! Induced velocity at Nodes (NOTE: we rely on storage done when computing Circulation) + if (m%nNW>1) then + call interpextrap_cp2node(m%s_CP_LL(:,j), m%Vind_LL(1,:,j), m%s_LL(:,j), Vind_node(1,:)) + call interpextrap_cp2node(m%s_CP_LL(:,j), m%Vind_LL(2,:,j), m%s_LL(:,j), Vind_node(2,:)) + call interpextrap_cp2node(m%s_CP_LL(:,j), m%Vind_LL(3,:,j), m%s_LL(:,j), Vind_node(3,:)) + else + Vind_node=0.0_ReKi + endif + do i = 1,p%nSpan+1 + ! We only update the UnsteadyAero states if we have unsteady aero turned on for this node + if (OtherState%UA_Flag(i,j)) then + u_UA => m%u_UA(i,j,InputIndex) ! Alias + !! ....... compute inputs to UA ........... + ! NOTE: To be consistent with CalcOutput we take Vwind_ND that was set using m%DisturbedInflow from AeroDyn.. + ! This is not clean, but done to be consistent, waiting for AeroDyn to handle UA + call AlphaVrel_Generic(u%WingsMesh(j)%Orientation(1:3,1:3,i), u%WingsMesh(j)%TranslationVel(1:3,i), Vind_node(1:3,i), u%Vwnd_LLMP(1:3,i,j), & + p%KinVisc, p%Chord(i,j), u_UA%U, u_UA%alpha, u_UA%Re) + u_UA%v_ac(1) = sin(u_UA%alpha)*u_UA%U + u_UA%v_ac(2) = cos(u_UA%alpha)*u_UA%U + u_UA%omega = u%omega_z(i,j) + u_UA%UserProp = 0 ! u1%UserProp(i,j) ! TODO + call UA_TurnOff_input(m%p_UA, AFInfo(p%AFIndx(i,j)), u_UA, ErrStat2, ErrMsg2) + if (ErrStat2 /= ErrID_None) then + OtherState%UA_Flag(i,j) = .FALSE. + call WrScr( 'Warning: Turning off dynamic stall due to '//trim(ErrMsg2)//' '//trim(NodeText(i,j))) + endif + endif + end do ! i nSpan + end do ! j nWings + deallocate(Vind_node) + +contains + function NodeText(i,j) + integer(IntKi), intent(in) :: i ! node number + integer(IntKi), intent(in) :: j ! blade number + character(25) :: NodeText + NodeText = '(nd:'//trim(num2lstr(i))//' bld:'//trim(num2lstr(j))//')' + end function NodeText +end subroutine CalculateInputsAndOtherStatesForUA + + +subroutine UA_UpdateState_Wrapper(AFInfo, t, n, uTimes, p, x, xd, OtherState, m, ErrStat, ErrMsg ) use FVW_VortexTools, only: interpextrap_cp2node use UnsteadyAero, only: UA_UpdateStates, UA_TurnOff_input - type(AFI_ParameterType), intent(in ) :: AFInfo(:) !< The airfoil parameter data, temporary, for UA.. - real(DbKi), intent(in ) :: t !< Current simulation time in seconds + type(AFI_ParameterType), intent(in ) :: AFInfo(:) !< The airfoil parameter data, temporary, for UA.. + real(DbKi), intent(in ) :: t !< Curent time + real(DbKi), intent(in ) :: uTimes(:) !< Simulation times where integer(IntKi), intent(in ) :: n !< time step type(FVW_ParameterType), intent(in ) :: p !< Parameters - type(FVW_InputType), intent(in ) :: u !< Inputs type(FVW_ContinuousStateType), intent(inout) :: x !< Initial continuous states type(FVW_DiscreteStateType), intent(inout) :: xd !< Initial discrete states type(FVW_OtherStateType), intent(inout) :: OtherState !< Initial other states @@ -1093,75 +1173,28 @@ subroutine UA_UpdateState_Wrapper(AFInfo, t, n, u, p, x, xd, OtherState, m, ErrS integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local - type(UA_InputType) :: u_UA(1) - REAL(DbKi) :: uTimes(1) integer :: i,j - integer, parameter :: k=1 ! index for u_UA (in case it is ever dimensioned differently) integer(intKi) :: ErrStat2 ! temporary Error status character(ErrMsgLen) :: ErrMsg2 - real(ReKi), dimension(:,:), allocatable :: Vind_node ErrStat = ErrID_None ErrStat2 = ErrID_None ErrMsg = "" ErrMsg2 = "" - - uTimes = t - - if (m%UA_Flag) then - - ! --- Induction on the lifting line control point - ! NOTE: this is expensive since it's an output for FVW but here we have to use it for UA - ! Set m%Vind_LL - m%Vind_LL=-9999.0_ReKi - call LiftingLineInducedVelocities(p, x, 1, m, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'UA_UpdateState_Wrapper'); if (ErrStat >= AbortErrLev) return - - allocate(Vind_node(3,1:p%nSpan+1)) - - ! --- Condensed version of BEMT_Update States - do j = 1,p%nWings - ! Induced velocity at Nodes (NOTE: we rely on storage done when computing Circulation) - if (m%nNW>1) then - call interpextrap_cp2node(m%s_CP_LL(:,j), m%Vind_LL(1,:,j), m%s_LL(:,j), Vind_node(1,:)) - call interpextrap_cp2node(m%s_CP_LL(:,j), m%Vind_LL(2,:,j), m%s_LL(:,j), Vind_node(2,:)) - call interpextrap_cp2node(m%s_CP_LL(:,j), m%Vind_LL(3,:,j), m%s_LL(:,j), Vind_node(3,:)) - else - Vind_node=0.0_ReKi - endif - - do i = 1,p%nSpan+1 - ! We only update the UnsteadyAero states if we have unsteady aero turned on for this node - if (OtherState%UA_Flag(i,j) .and. n > 0) then - !! ....... compute inputs to UA ........... - ! NOTE: To be consistent with CalcOutput we take Vwind_ND that was set using m%DisturbedInflow from AeroDyn.. - ! This is not clean, but done to be consistent, waiting for AeroDyn to handle UA - call AlphaVrel_Generic(u%WingsMesh(j)%Orientation(1:3,1:3,i), u%WingsMesh(j)%TranslationVel(1:3,i), Vind_node(:,i), m%Vwnd_ND(:,i,j), & - p%KinVisc, p%Chord(i,j), u_UA(k)%U, u_UA(k)%alpha, u_UA(k)%Re) - ! FIX ME: this is copied 3 times!!!! - u_UA%v_ac(1) = sin(u_UA%alpha)*u_UA%U - u_UA%v_ac(2) = cos(u_UA%alpha)*u_UA%U - u_UA%omega = 0.0_ReKi ! FIX ME!!!! dot_product( u%BladeMotion(j)%RotationVel( :,i), m%WithoutSweepPitchTwist(3,:,i,j) ) ! rotation of no-sweep-pitch coordinate system around z of the jth node in the kth blade - u_UA(k)%UserProp = 0 ! u1%UserProp(i,j) ! TODO - - !! ....... check inputs to UA ........... - call UA_TurnOff_input(m%p_UA, AFInfo(p%AFIndx(i,j)), u_UA(k), ErrStat2, ErrMsg2) - if (ErrStat2 /= ErrID_None) then - OtherState%UA_Flag(i,j) = .FALSE. - call WrScr( 'Warning: Turning off dynamic stall due to '//trim(ErrMsg2)//' '//trim(NodeText(i,j))) - else - ! COMPUTE: xd%UA, OtherState%UA - call UA_UpdateStates( i, j, t, n, u_UA, uTimes, m%p_UA, x%UA, xd%UA, OtherState%UA, AFInfo(p%AFIndx(i,j)), m%m_UA, ErrStat2, ErrMsg2 ) - if (ErrStat2 /= ErrID_None) then - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'UA_UpdateState_Wrapper'//trim(NodeText(i,j))) - call WrScr(trim(ErrMsg)) - if (ErrStat >= AbortErrLev) return - end if - end if + ! --- Condensed version of BEMT_Update States + do j = 1,p%nWings + do i = 1,p%nSpan+1 + ! We only update the UnsteadyAero states if we have unsteady aero turned on for this node + if (OtherState%UA_Flag(i,j)) then + ! COMPUTE: x%UA, xd%UA, OtherState%UA + call UA_UpdateStates( i, j, t, n, m%u_UA(i,j,:), uTimes, m%p_UA, x%UA, xd%UA, OtherState%UA, AFInfo(p%AFIndx(i,j)), m%m_UA, errStat2, errMsg2 ) + if (ErrStat2 /= ErrID_None) then + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'UA_UpdateState_Wrapper'//trim(NodeText(i,j))) + call WrScr(trim(ErrMsg)) + if (ErrStat >= AbortErrLev) return end if - end do - end do - call UA_DestroyInput( u_UA(k), ErrStat2, ErrMsg2 ); - deallocate(Vind_node) - endif + end if + end do ! i span + end do !j wings call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'UA_UpdateState_Wrapper') contains function NodeText(i,j) diff --git a/modules/aerodyn/src/FVW_Registry.txt b/modules/aerodyn/src/FVW_Registry.txt index 518636e9cc..a1ea30eda3 100644 --- a/modules/aerodyn/src/FVW_Registry.txt +++ b/modules/aerodyn/src/FVW_Registry.txt @@ -119,11 +119,11 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi BN_Cy :: - - "tangential force coefficient (tangential to the plane, not chord) of the jth node in the kth blade" - # TODO UA - Should be part of AeroDyn +typedef ^ ^ UA_InputType u_UA {:}{:}{:} - - "inputs to UnsteadyAero numBlades x numNode x 2 (t and t+dt)" - typedef ^ ^ UA_MiscVarType m_UA - - - "misc vars for UnsteadyAero" - typedef ^ ^ UA_OutputType y_UA - - - "outputs from UnsteadyAero" - typedef ^ ^ UA_ParameterType p_UA - - - "parameters for UnsteadyAero" - typedef ^ ^ LOGICAL UA_Flag - - - "logical flag indicating whether to use UnsteadyAero" - -typedef ^ ^ ReKi Vwnd_ND ::: - - "InflowOnBlade (at nodes) values modified by tower influence. ONLY for UA" m/s # ........ Input ............ # FVW_InputType @@ -131,6 +131,9 @@ typedef FVW/FVW InputType MeshType typedef ^ ^ ReKi V_wind :: - - "Wind at requested points (r_wind)" - typedef ^ ^ ReKi HubOrientation {3}{3} - - "Orientation of hub coordinate system (for output only)" - typedef ^ ^ ReKi HubPosition {3} - - "Origin of hub (for output only)" - +# FOR UA +typedef ^ ^ ReKi Vwnd_LLMP {:}{:}{:} - - "Disturbed wind at LL mesh points (not CP), for UA only" - +typedef ^ ^ ReKi omega_z {:}{:} - - "rotation of no-sweep-pitch-twist coordinate system around z (for CDBEMT and CUA)" "rad/s" # ........ Output ............ # FVW_OutputType @@ -178,8 +181,8 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi zLocal :: - - "Distance to blade node, measured along the blade" m typedef ^ ^ ReKi zTip : - - "Distance to blade tip, measured along the blade" m typedef ^ ^ ReKi rLocal :: - - "Radial distance to blade node from the center of rotation, measured in the rotor plane, needed for DBEMT" m -typedef ^ ^ IntKi NumBlades - - - "Number of blades" - -typedef ^ ^ IntKi NumBladeNodes - - - "Number of nodes on each blade" - +typedef ^ ^ IntKi numBlades - - - "Number of blades" - +typedef ^ ^ IntKi numBladeNodes - - - "Number of nodes on each blade" - typedef ^ ^ DbKi DTaero - - - "Time interval for calls (from AD15)" s typedef ^ ^ ReKi KinVisc - - - "Kinematic air viscosity" m^2/s # TODO UA - Should be part of AeroDyn diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index 98355c2aad..8f30fe90d6 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -137,11 +137,11 @@ MODULE FVW_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_Cm !< Coefficient moment, including unsteady aero effects [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_Cx !< normal force coefficient (normal to the plane, not chord) of the jth node in the kth blade [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_Cy !< tangential force coefficient (tangential to the plane, not chord) of the jth node in the kth blade [-] + TYPE(UA_InputType) , DIMENSION(:,:,:), ALLOCATABLE :: u_UA !< inputs to UnsteadyAero numBlades x numNode x 2 (t and t+dt) [-] TYPE(UA_MiscVarType) :: m_UA !< misc vars for UnsteadyAero [-] TYPE(UA_OutputType) :: y_UA !< outputs from UnsteadyAero [-] TYPE(UA_ParameterType) :: p_UA !< parameters for UnsteadyAero [-] LOGICAL :: UA_Flag !< logical flag indicating whether to use UnsteadyAero [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vwnd_ND !< InflowOnBlade (at nodes) values modified by tower influence. ONLY for UA [m/s] END TYPE FVW_MiscVarType ! ======================= ! ========= FVW_InputType ======= @@ -150,6 +150,8 @@ MODULE FVW_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: V_wind !< Wind at requested points (r_wind) [-] REAL(ReKi) , DIMENSION(1:3,1:3) :: HubOrientation !< Orientation of hub coordinate system (for output only) [-] REAL(ReKi) , DIMENSION(1:3) :: HubPosition !< Origin of hub (for output only) [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vwnd_LLMP !< Disturbed wind at LL mesh points (not CP), for UA only [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: omega_z !< rotation of no-sweep-pitch-twist coordinate system around z (for CDBEMT and CUA) [rad/s] END TYPE FVW_InputType ! ======================= ! ========= FVW_OutputType ======= @@ -198,8 +200,8 @@ MODULE FVW_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: zLocal !< Distance to blade node, measured along the blade [m] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: zTip !< Distance to blade tip, measured along the blade [m] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: rLocal !< Radial distance to blade node from the center of rotation, measured in the rotor plane, needed for DBEMT [m] - INTEGER(IntKi) :: NumBlades !< Number of blades [-] - INTEGER(IntKi) :: NumBladeNodes !< Number of nodes on each blade [-] + INTEGER(IntKi) :: numBlades !< Number of blades [-] + INTEGER(IntKi) :: numBladeNodes !< Number of nodes on each blade [-] REAL(DbKi) :: DTaero !< Time interval for calls (from AD15) [s] REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] INTEGER(IntKi) :: UAMod !< Model for the dynamic stall equations [1 = Leishman/Beddoes, 2 = Gonzalez, 3 = Minnema] [-] @@ -1541,6 +1543,30 @@ SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) END IF END IF DstMiscData%BN_Cy = SrcMiscData%BN_Cy +ENDIF +IF (ALLOCATED(SrcMiscData%u_UA)) THEN + i1_l = LBOUND(SrcMiscData%u_UA,1) + i1_u = UBOUND(SrcMiscData%u_UA,1) + i2_l = LBOUND(SrcMiscData%u_UA,2) + i2_u = UBOUND(SrcMiscData%u_UA,2) + i3_l = LBOUND(SrcMiscData%u_UA,3) + i3_u = UBOUND(SrcMiscData%u_UA,3) + IF (.NOT. ALLOCATED(DstMiscData%u_UA)) THEN + ALLOCATE(DstMiscData%u_UA(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%u_UA.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i3 = LBOUND(SrcMiscData%u_UA,3), UBOUND(SrcMiscData%u_UA,3) + DO i2 = LBOUND(SrcMiscData%u_UA,2), UBOUND(SrcMiscData%u_UA,2) + DO i1 = LBOUND(SrcMiscData%u_UA,1), UBOUND(SrcMiscData%u_UA,1) + CALL UA_CopyInput( SrcMiscData%u_UA(i1,i2,i3), DstMiscData%u_UA(i1,i2,i3), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO + ENDDO ENDIF CALL UA_CopyMisc( SrcMiscData%m_UA, DstMiscData%m_UA, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -1552,22 +1578,6 @@ SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN DstMiscData%UA_Flag = SrcMiscData%UA_Flag -IF (ALLOCATED(SrcMiscData%Vwnd_ND)) THEN - i1_l = LBOUND(SrcMiscData%Vwnd_ND,1) - i1_u = UBOUND(SrcMiscData%Vwnd_ND,1) - i2_l = LBOUND(SrcMiscData%Vwnd_ND,2) - i2_u = UBOUND(SrcMiscData%Vwnd_ND,2) - i3_l = LBOUND(SrcMiscData%Vwnd_ND,3) - i3_u = UBOUND(SrcMiscData%Vwnd_ND,3) - IF (.NOT. ALLOCATED(DstMiscData%Vwnd_ND)) THEN - ALLOCATE(DstMiscData%Vwnd_ND(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%Vwnd_ND.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Vwnd_ND = SrcMiscData%Vwnd_ND -ENDIF END SUBROUTINE FVW_CopyMisc SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg ) @@ -1728,13 +1738,20 @@ SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(MiscData%BN_Cy)) THEN DEALLOCATE(MiscData%BN_Cy) +ENDIF +IF (ALLOCATED(MiscData%u_UA)) THEN +DO i3 = LBOUND(MiscData%u_UA,3), UBOUND(MiscData%u_UA,3) +DO i2 = LBOUND(MiscData%u_UA,2), UBOUND(MiscData%u_UA,2) +DO i1 = LBOUND(MiscData%u_UA,1), UBOUND(MiscData%u_UA,1) + CALL UA_DestroyInput( MiscData%u_UA(i1,i2,i3), ErrStat, ErrMsg ) +ENDDO +ENDDO +ENDDO + DEALLOCATE(MiscData%u_UA) ENDIF CALL UA_DestroyMisc( MiscData%m_UA, ErrStat, ErrMsg ) CALL UA_DestroyOutput( MiscData%y_UA, ErrStat, ErrMsg ) CALL UA_DestroyParam( MiscData%p_UA, ErrStat, ErrMsg ) -IF (ALLOCATED(MiscData%Vwnd_ND)) THEN - DEALLOCATE(MiscData%Vwnd_ND) -ENDIF END SUBROUTINE FVW_DestroyMisc SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2031,7 +2048,34 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*2 ! BN_Cy upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%BN_Cy) ! BN_Cy END IF + Int_BufSz = Int_BufSz + 1 ! u_UA allocated yes/no + IF ( ALLOCATED(InData%u_UA) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! u_UA upper/lower bounds for each dimension ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i3 = LBOUND(InData%u_UA,3), UBOUND(InData%u_UA,3) + DO i2 = LBOUND(InData%u_UA,2), UBOUND(InData%u_UA,2) + DO i1 = LBOUND(InData%u_UA,1), UBOUND(InData%u_UA,1) + Int_BufSz = Int_BufSz + 3 ! u_UA: size of buffers for each call to pack subtype + CALL UA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2, .TRUE. ) ! u_UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_UA + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_UA + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_UA + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO + END DO + END IF Int_BufSz = Int_BufSz + 3 ! m_UA: size of buffers for each call to pack subtype CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_UA, ErrStat2, ErrMsg2, .TRUE. ) ! m_UA CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2084,11 +2128,6 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 1 ! UA_Flag - Int_BufSz = Int_BufSz + 1 ! Vwnd_ND allocated yes/no - IF ( ALLOCATED(InData%Vwnd_ND) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vwnd_ND upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_ND) ! Vwnd_ND - END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -3253,6 +3292,57 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Re_Xferred = Re_Xferred + 1 END DO END DO + END IF + IF ( .NOT. ALLOCATED(InData%u_UA) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%u_UA,3), UBOUND(InData%u_UA,3) + DO i2 = LBOUND(InData%u_UA,2), UBOUND(InData%u_UA,2) + DO i1 = LBOUND(InData%u_UA,1), UBOUND(InData%u_UA,1) + CALL UA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2, OnlySize ) ! u_UA + 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 DO + END DO END IF CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_UA, ErrStat2, ErrMsg2, OnlySize ) ! m_UA CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3340,31 +3430,6 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ENDIF IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%Vwnd_ND) ) 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%Vwnd_ND,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_ND,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_ND,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_ND,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_ND,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_ND,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vwnd_ND,3), UBOUND(InData%Vwnd_ND,3) - DO i2 = LBOUND(InData%Vwnd_ND,2), UBOUND(InData%Vwnd_ND,2) - DO i1 = LBOUND(InData%Vwnd_ND,1), UBOUND(InData%Vwnd_ND,1) - ReKiBuf(Re_Xferred) = InData%Vwnd_ND(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF END SUBROUTINE FVW_PackMisc SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4684,6 +4749,72 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = Re_Xferred + 1 END DO END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_UA 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%u_UA)) DEALLOCATE(OutData%u_UA) + ALLOCATE(OutData%u_UA(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%u_UA.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%u_UA,3), UBOUND(OutData%u_UA,3) + DO i2 = LBOUND(OutData%u_UA,2), UBOUND(OutData%u_UA,2) + DO i1 = LBOUND(OutData%u_UA,1), UBOUND(OutData%u_UA,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 UA_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2 ) ! u_UA + 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 DO + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -4807,34 +4938,6 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_ND 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%Vwnd_ND)) DEALLOCATE(OutData%Vwnd_ND) - ALLOCATE(OutData%Vwnd_ND(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%Vwnd_ND.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vwnd_ND,3), UBOUND(OutData%Vwnd_ND,3) - DO i2 = LBOUND(OutData%Vwnd_ND,2), UBOUND(OutData%Vwnd_ND,2) - DO i1 = LBOUND(OutData%Vwnd_ND,1), UBOUND(OutData%Vwnd_ND,1) - OutData%Vwnd_ND(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF END SUBROUTINE FVW_UnPackMisc SUBROUTINE FVW_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -4847,6 +4950,7 @@ SUBROUTINE FVW_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg 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 = 'FVW_CopyInput' @@ -4885,6 +4989,36 @@ SUBROUTINE FVW_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ENDIF DstInputData%HubOrientation = SrcInputData%HubOrientation DstInputData%HubPosition = SrcInputData%HubPosition +IF (ALLOCATED(SrcInputData%Vwnd_LLMP)) THEN + i1_l = LBOUND(SrcInputData%Vwnd_LLMP,1) + i1_u = UBOUND(SrcInputData%Vwnd_LLMP,1) + i2_l = LBOUND(SrcInputData%Vwnd_LLMP,2) + i2_u = UBOUND(SrcInputData%Vwnd_LLMP,2) + i3_l = LBOUND(SrcInputData%Vwnd_LLMP,3) + i3_u = UBOUND(SrcInputData%Vwnd_LLMP,3) + IF (.NOT. ALLOCATED(DstInputData%Vwnd_LLMP)) THEN + ALLOCATE(DstInputData%Vwnd_LLMP(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%Vwnd_LLMP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputData%Vwnd_LLMP = SrcInputData%Vwnd_LLMP +ENDIF +IF (ALLOCATED(SrcInputData%omega_z)) THEN + i1_l = LBOUND(SrcInputData%omega_z,1) + i1_u = UBOUND(SrcInputData%omega_z,1) + i2_l = LBOUND(SrcInputData%omega_z,2) + i2_u = UBOUND(SrcInputData%omega_z,2) + IF (.NOT. ALLOCATED(DstInputData%omega_z)) THEN + ALLOCATE(DstInputData%omega_z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%omega_z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputData%omega_z = SrcInputData%omega_z +ENDIF END SUBROUTINE FVW_CopyInput SUBROUTINE FVW_DestroyInput( InputData, ErrStat, ErrMsg ) @@ -4904,6 +5038,12 @@ SUBROUTINE FVW_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(InputData%V_wind)) THEN DEALLOCATE(InputData%V_wind) +ENDIF +IF (ALLOCATED(InputData%Vwnd_LLMP)) THEN + DEALLOCATE(InputData%Vwnd_LLMP) +ENDIF +IF (ALLOCATED(InputData%omega_z)) THEN + DEALLOCATE(InputData%omega_z) ENDIF END SUBROUTINE FVW_DestroyInput @@ -4973,6 +5113,16 @@ SUBROUTINE FVW_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S END IF Re_BufSz = Re_BufSz + SIZE(InData%HubOrientation) ! HubOrientation Re_BufSz = Re_BufSz + SIZE(InData%HubPosition) ! HubPosition + Int_BufSz = Int_BufSz + 1 ! Vwnd_LLMP allocated yes/no + IF ( ALLOCATED(InData%Vwnd_LLMP) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Vwnd_LLMP upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_LLMP) ! Vwnd_LLMP + END IF + Int_BufSz = Int_BufSz + 1 ! omega_z allocated yes/no + IF ( ALLOCATED(InData%omega_z) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! omega_z upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%omega_z) ! omega_z + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -5071,6 +5221,51 @@ SUBROUTINE FVW_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ReKiBuf(Re_Xferred) = InData%HubPosition(i1) Re_Xferred = Re_Xferred + 1 END DO + IF ( .NOT. ALLOCATED(InData%Vwnd_LLMP) ) 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%Vwnd_LLMP,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LLMP,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LLMP,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LLMP,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LLMP,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LLMP,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Vwnd_LLMP,3), UBOUND(InData%Vwnd_LLMP,3) + DO i2 = LBOUND(InData%Vwnd_LLMP,2), UBOUND(InData%Vwnd_LLMP,2) + DO i1 = LBOUND(InData%Vwnd_LLMP,1), UBOUND(InData%Vwnd_LLMP,1) + ReKiBuf(Re_Xferred) = InData%Vwnd_LLMP(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%omega_z) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%omega_z,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_z,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%omega_z,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_z,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%omega_z,2), UBOUND(InData%omega_z,2) + DO i1 = LBOUND(InData%omega_z,1), UBOUND(InData%omega_z,1) + ReKiBuf(Re_Xferred) = InData%omega_z(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF END SUBROUTINE FVW_PackInput SUBROUTINE FVW_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5088,6 +5283,7 @@ SUBROUTINE FVW_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: i 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 = 'FVW_UnPackInput' @@ -5196,6 +5392,57 @@ SUBROUTINE FVW_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_LLMP 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%Vwnd_LLMP)) DEALLOCATE(OutData%Vwnd_LLMP) + ALLOCATE(OutData%Vwnd_LLMP(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%Vwnd_LLMP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Vwnd_LLMP,3), UBOUND(OutData%Vwnd_LLMP,3) + DO i2 = LBOUND(OutData%Vwnd_LLMP,2), UBOUND(OutData%Vwnd_LLMP,2) + DO i1 = LBOUND(OutData%Vwnd_LLMP,1), UBOUND(OutData%Vwnd_LLMP,1) + OutData%Vwnd_LLMP(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! omega_z not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%omega_z)) DEALLOCATE(OutData%omega_z) + ALLOCATE(OutData%omega_z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%omega_z,2), UBOUND(OutData%omega_z,2) + DO i1 = LBOUND(OutData%omega_z,1), UBOUND(OutData%omega_z,1) + OutData%omega_z(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF END SUBROUTINE FVW_UnPackInput SUBROUTINE FVW_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -6833,8 +7080,8 @@ SUBROUTINE FVW_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrS END IF DstInitInputData%rLocal = SrcInitInputData%rLocal ENDIF - DstInitInputData%NumBlades = SrcInitInputData%NumBlades - DstInitInputData%NumBladeNodes = SrcInitInputData%NumBladeNodes + DstInitInputData%numBlades = SrcInitInputData%numBlades + DstInitInputData%numBladeNodes = SrcInitInputData%numBladeNodes DstInitInputData%DTaero = SrcInitInputData%DTaero DstInitInputData%KinVisc = SrcInitInputData%KinVisc DstInitInputData%UAMod = SrcInitInputData%UAMod @@ -6977,8 +7224,8 @@ SUBROUTINE FVW_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 2*2 ! rLocal upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%rLocal) ! rLocal END IF - Int_BufSz = Int_BufSz + 1 ! NumBlades - Int_BufSz = Int_BufSz + 1 ! NumBladeNodes + Int_BufSz = Int_BufSz + 1 ! numBlades + Int_BufSz = Int_BufSz + 1 ! numBladeNodes Db_BufSz = Db_BufSz + 1 ! DTaero Re_BufSz = Re_BufSz + 1 ! KinVisc Int_BufSz = Int_BufSz + 1 ! UAMod @@ -7186,9 +7433,9 @@ SUBROUTINE FVW_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END DO END DO END IF - IntKiBuf(Int_Xferred) = InData%NumBlades + IntKiBuf(Int_Xferred) = InData%numBlades Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%NumBladeNodes + IntKiBuf(Int_Xferred) = InData%numBladeNodes Int_Xferred = Int_Xferred + 1 DbKiBuf(Db_Xferred) = InData%DTaero Db_Xferred = Db_Xferred + 1 @@ -7442,9 +7689,9 @@ SUBROUTINE FVW_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er END DO END DO END IF - OutData%NumBlades = IntKiBuf(Int_Xferred) + OutData%numBlades = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - OutData%NumBladeNodes = IntKiBuf(Int_Xferred) + OutData%numBladeNodes = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%DTaero = DbKiBuf(Db_Xferred) Db_Xferred = Db_Xferred + 1 @@ -7975,8 +8222,10 @@ SUBROUTINE FVW_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts INTEGER :: i1 ! dim1 counter variable for arrays INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -8015,6 +8264,24 @@ SUBROUTINE FVW_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg b = -(u1%HubPosition(i1) - u2%HubPosition(i1)) u_out%HubPosition(i1) = u1%HubPosition(i1) + b * ScaleFactor END DO +IF (ALLOCATED(u_out%Vwnd_LLMP) .AND. ALLOCATED(u1%Vwnd_LLMP)) THEN + DO i3 = LBOUND(u_out%Vwnd_LLMP,3),UBOUND(u_out%Vwnd_LLMP,3) + DO i2 = LBOUND(u_out%Vwnd_LLMP,2),UBOUND(u_out%Vwnd_LLMP,2) + DO i1 = LBOUND(u_out%Vwnd_LLMP,1),UBOUND(u_out%Vwnd_LLMP,1) + b = -(u1%Vwnd_LLMP(i1,i2,i3) - u2%Vwnd_LLMP(i1,i2,i3)) + u_out%Vwnd_LLMP(i1,i2,i3) = u1%Vwnd_LLMP(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(u_out%omega_z) .AND. ALLOCATED(u1%omega_z)) THEN + DO i2 = LBOUND(u_out%omega_z,2),UBOUND(u_out%omega_z,2) + DO i1 = LBOUND(u_out%omega_z,1),UBOUND(u_out%omega_z,1) + b = -(u1%omega_z(i1,i2) - u2%omega_z(i1,i2)) + u_out%omega_z(i1,i2) = u1%omega_z(i1,i2) + b * ScaleFactor + END DO + END DO +END IF ! check if allocated END SUBROUTINE FVW_Input_ExtrapInterp1 @@ -8052,8 +8319,10 @@ SUBROUTINE FVW_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err CHARACTER(*), PARAMETER :: RoutineName = 'FVW_Input_ExtrapInterp2' INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts INTEGER :: i1 ! dim1 counter variable for arrays INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -8101,6 +8370,26 @@ SUBROUTINE FVW_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err c = ( (t(2)-t(3))*u1%HubPosition(i1) + t(3)*u2%HubPosition(i1) - t(2)*u3%HubPosition(i1) ) * scaleFactor u_out%HubPosition(i1) = u1%HubPosition(i1) + b + c * t_out END DO +IF (ALLOCATED(u_out%Vwnd_LLMP) .AND. ALLOCATED(u1%Vwnd_LLMP)) THEN + DO i3 = LBOUND(u_out%Vwnd_LLMP,3),UBOUND(u_out%Vwnd_LLMP,3) + DO i2 = LBOUND(u_out%Vwnd_LLMP,2),UBOUND(u_out%Vwnd_LLMP,2) + DO i1 = LBOUND(u_out%Vwnd_LLMP,1),UBOUND(u_out%Vwnd_LLMP,1) + b = (t(3)**2*(u1%Vwnd_LLMP(i1,i2,i3) - u2%Vwnd_LLMP(i1,i2,i3)) + t(2)**2*(-u1%Vwnd_LLMP(i1,i2,i3) + u3%Vwnd_LLMP(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*u1%Vwnd_LLMP(i1,i2,i3) + t(3)*u2%Vwnd_LLMP(i1,i2,i3) - t(2)*u3%Vwnd_LLMP(i1,i2,i3) ) * scaleFactor + u_out%Vwnd_LLMP(i1,i2,i3) = u1%Vwnd_LLMP(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO +END IF ! check if allocated +IF (ALLOCATED(u_out%omega_z) .AND. ALLOCATED(u1%omega_z)) THEN + DO i2 = LBOUND(u_out%omega_z,2),UBOUND(u_out%omega_z,2) + DO i1 = LBOUND(u_out%omega_z,1),UBOUND(u_out%omega_z,1) + b = (t(3)**2*(u1%omega_z(i1,i2) - u2%omega_z(i1,i2)) + t(2)**2*(-u1%omega_z(i1,i2) + u3%omega_z(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%omega_z(i1,i2) + t(3)*u2%omega_z(i1,i2) - t(2)*u3%omega_z(i1,i2) ) * scaleFactor + u_out%omega_z(i1,i2) = u1%omega_z(i1,i2) + b + c * t_out + END DO + END DO +END IF ! check if allocated END SUBROUTINE FVW_Input_ExtrapInterp2 diff --git a/modules/aerodyn/src/UnsteadyAero.f90 b/modules/aerodyn/src/UnsteadyAero.f90 index d24a730daf..c05c6882a7 100644 --- a/modules/aerodyn/src/UnsteadyAero.f90 +++ b/modules/aerodyn/src/UnsteadyAero.f90 @@ -47,6 +47,7 @@ module UnsteadyAero integer(intki), parameter :: UA_Gonzalez = 2 ! UAMod = 2 [Gonzalez's variant (changes in Cn,Cc,Cm)] integer(intki), parameter :: UA_MinnemaPierce = 3 ! UAMod = 3 [Minnema/Pierce variant (changes in Cc and Cm)] integer(intki), parameter, public :: UA_HGM = 4 ! UAMod = 4 [continuous variant of HGM (Hansen) model] + integer(intki), parameter, public :: UA_OYE = 5 ! UAMod = 5 [continuous Oye model] real(ReKi), parameter :: Gonzalez_factor = 0.2_ReKi ! this factor, proposed by Gonzalez (for "all" models) is used to modify Cc to account for negative values seen at f=0 (see Eqn 1.40) @@ -1157,7 +1158,7 @@ subroutine UA_ValidateInput(InitInp, ErrStat, ErrMsg) !>>> remove after this feature gets tested better: if (InitInp%UAMod == UA_HGM ) then - call SetErrStat( ErrID_Fatal, "UAMod cannot be 4 (continuous HGM model) in this version of OpenFAST.", ErrStat, ErrMsg, RoutineName ) + call SetErrStat( ErrID_Warn, "UAMod 4 (continuous HGM model) is in beta for this version of OpenFAST.", ErrStat, ErrMsg, RoutineName ) end if !<<< @@ -1885,8 +1886,13 @@ subroutine UA_CalcContStateDeriv( i, j, t, u, p, x, OtherState, AFInfo, m, dxdt, ! Constraining x4 between 0 and 1 increases numerical stability (should be done elsewhere, but we'll double check here in case there were perturbations on the state value) x4 = max( min( x%x(4), 1.0_R8Ki ), 0.0_R8Ki ) +if (p%ShedEffect) then dxdt%x(1) = -1.0_R8Ki / Tu * (BL_p%b1 + p%c(i,j) * U_dot/(2*u%u**2)) * x%x(1) + BL_p%b1 * BL_p%A1 / Tu * alpha_34 dxdt%x(2) = -1.0_R8Ki / Tu * (BL_p%b2 + p%c(i,j) * U_dot/(2*u%u**2)) * x%x(2) + BL_p%b2 * BL_p%A2 / Tu * alpha_34 +else + dxdt%x(1) = 0.0_ReKi + dxdt%x(2) = 0.0_ReKi +endif dxdt%x(3) = -1.0_R8Ki / BL_p%T_p * x%x(3) + 1.0_ReKi / BL_p%T_p * Clp dxdt%x(4) = -1.0_R8Ki / BL_p%T_f0 * x4 + 1.0_ReKi / BL_p%T_f0 * AFI_interp%f_st @@ -1919,7 +1925,11 @@ SUBROUTINE Get_HGM_constants(i, j, p, u, x, BL_p, Tu, alpha_34, alphaE) alpha_34 = atan2(vx_34, u%v_ac(2) ) ! page 5 definitions ! Variables derived from states +if (p%ShedEffect) then alphaE = alpha_34*(1.0_ReKi - BL_p%A1 - BL_p%A2) + x%x(1) + x%x(2) ! Eq. 12 +else + alphaE = alpha_34 +endif call MPi2Pi(alphaE) END SUBROUTINE Get_HGM_constants @@ -2331,6 +2341,7 @@ subroutine UA_CalcOutput( i, j, u, p, x, xd, OtherState, AFInfo, y, misc, ErrSta delta_c_df_primeprime = 0.5_ReKi * (sqrt(fs_aE) - sqrt(x4)) - 0.25_ReKi * (fs_aE - x4) ! bjj: do we need to check that u%alpha is between -pi and + pi? + ! y%Cl = AFI_interp%Cl < TODO consider using this in front of x4 for "true" Cl y%Cl = x4 * (alphaE - BL_p%alpha0) * BL_p%c_lalpha + (1.0_ReKi - x4) * cl_fs + pi * Tu * u%omega ! Eq. 78 y%Cd = AFI_interp%Cd + (u%alpha - alphaE) * y%Cl + (AFI_interp%Cd - BL_p%Cd0) * delta_c_df_primeprime ! Eq. 79 From 215f1a523aead2942719960c122cc1f04ed9a106 Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Mon, 16 Nov 2020 10:24:46 -0700 Subject: [PATCH 02/27] OLAF: output of velocity grids to VTK --- modules/aerodyn/src/FVW.f90 | 50 +- modules/aerodyn/src/FVW_BiotSavart.f90 | 4 +- modules/aerodyn/src/FVW_IO.f90 | 152 ++- modules/aerodyn/src/FVW_Registry.txt | 36 +- modules/aerodyn/src/FVW_Subs.f90 | 277 ++++- modules/aerodyn/src/FVW_Types.f90 | 1181 ++++++++++++++++---- modules/aerodyn/src/FVW_VTK.f90 | 28 +- modules/aerodyn/src/FVW_VortexTools.f90 | 34 +- modules/openfast-library/src/FAST_Subs.f90 | 8 +- 9 files changed, 1443 insertions(+), 327 deletions(-) diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index 7598fc8252..c5dffa1f3e 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -100,7 +100,7 @@ subroutine FVW_Init(AFInfo, InitInp, u, p, x, xd, z, OtherState, y, m, Interval, CALL FVW_SetParametersFromInputs(InitInp, p, ErrStat2, ErrMsg2); if(Failed()) return ! Read and parse the input file here to get other parameters and info - CALL FVW_ReadInputFile(InitInp%FVWFileName, p, InputFileData, ErrStat2, ErrMsg2); if(Failed()) return + CALL FVW_ReadInputFile(InitInp%FVWFileName, p, m, InputFileData, ErrStat2, ErrMsg2); if(Failed()) return ! Trigger required before allocations p%nNWMax = max(InputFileData%nNWPanels,0)+1 ! +1 since LL panel included in NW @@ -148,6 +148,7 @@ subroutine FVW_Init(AFInfo, InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ! Return anything in FVW_InitOutput that should be passed back to the calling code here + ! --- UA ! NOTE: quick and dirty since this should belong to AD interval = InitInp%DTAero ! important, gluecode and UA, needs proper interval @@ -174,6 +175,7 @@ subroutine FVW_InitMiscVars( p, m, ErrStat, ErrMsg ) integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None integer(IntKi) :: nMax ! Total number of wind points possible + integer(IntKi) :: iGrid ! integer(IntKi) :: ErrStat2 ! temporary error status of the operation character(ErrMsgLen) :: ErrMsg2 ! temporary error message character(*), parameter :: RoutineName = 'FVW_InitMiscVars' @@ -242,6 +244,12 @@ subroutine FVW_InitMiscVars( p, m, ErrStat, ErrMsg ) nMax = nMax + p%nSpan * p%nWings ! Lifting line Control Points nMax = nMax + (p%nSpan+1) * (p%nNWMax+1) * p%nWings ! Nearwake points nMax = nMax + (FWnSpan+1) * (p%nFWMax+1) * p%nWings ! Far wake points + do iGrid=1,p%nGridOut + nMax = nMax + m%GridOutputs(iGrid)%nx * m%GridOutputs(iGrid)%ny * m%GridOutputs(iGrid)%nz + call AllocAry(m%GridOutputs(iGrid)%uGrid, 3, m%GridOutputs(iGrid)%nx, m%GridOutputs(iGrid)%ny, m%GridOutputs(iGrid)%nz, 'uGrid', ErrStat2, ErrMsg2); + call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName) + m%GridOutputs(iGrid)%tLastOutput = -HUGE(1.0_DbKi) + enddo call AllocAry( m%r_wind, 3, nMax, 'Requested wind points', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ) m%r_wind = 0.0_ReKi ! set to zero so InflowWind can shortcut calculations m%OldWakeTime = -HUGE(1.0_DbKi) @@ -275,10 +283,13 @@ subroutine FVW_InitMiscVarsPostParam( p, m, ErrStat, ErrMsg ) nSeg = nSeg*2 nSegP = nSegP*2 endif - call AllocAry( m%SegConnct, 4, nSeg , 'SegConnct' , ErrStat2, ErrMsg2 );call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%SegConnct = -999; - call AllocAry( m%SegPoints, 3, nSegP, 'SegPoints' , ErrStat2, ErrMsg2 );call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%SegPoints = -999999_ReKi; - call AllocAry( m%SegGamma , nSeg, 'SegGamma' , ErrStat2, ErrMsg2 );call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%SegGamma = -999999_ReKi; - call AllocAry( m%SegEpsilon, nSeg, 'SegEpsilon', ErrStat2, ErrMsg2 );call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%SegEpsilon= -999999_ReKi; + call AllocAry( m%Sgmt%Connct, 4, nSeg , 'SegConnct' , ErrStat2, ErrMsg2 );call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%Sgmt%Connct = -999; + call AllocAry( m%Sgmt%Points, 3, nSegP, 'SegPoints' , ErrStat2, ErrMsg2 );call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%Sgmt%Points = -999999_ReKi; + call AllocAry( m%Sgmt%Gamma , nSeg, 'SegGamma' , ErrStat2, ErrMsg2 );call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%Sgmt%Gamma = -999999_ReKi; + call AllocAry( m%Sgmt%Epsilon, nSeg, 'SegEpsilon', ErrStat2, ErrMsg2 );call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%Sgmt%Epsilon= -999999_ReKi; + m%Sgmt%nAct = -1 ! Active segments + m%Sgmt%nActP = -1 + m%Sgmt%RegFunction = p%RegFunction call AllocAry( m%CPs , 3, nCPs, 'CPs' , ErrStat2, ErrMsg2 );call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%CPs= -999999_ReKi; call AllocAry( m%Uind , 3, nCPs, 'Uind' , ErrStat2, ErrMsg2 );call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%Uind= -999999_ReKi; @@ -926,8 +937,9 @@ subroutine FVW_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local variables - integer(IntKi) :: iW, n, i0, i1, i2 + integer(IntKi) :: iW, n, i0, i1, i2, iGrid integer(IntKi) :: ErrStat2 + logical :: bGridOutNeeded character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CalcOutput' @@ -969,12 +981,12 @@ subroutine FVW_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, endif ! --- Write to local VTK at fps requested + if (m%VTKStep==-1) then + m%VTKStep = 0 ! Has never been called, special handling for init + else + m%VTKStep = m%iStep+1 ! We use glue code step number for outputs + endif if (p%WrVTK==1) then - if (m%VTKStep==-1) then - m%VTKStep = 0 ! Has never been called, special handling for init - else - m%VTKStep = m%iStep+1 ! We use glue code step number for outputs - endif if (m%FirstCall) then call MKDIR(p%VTK_OutFileRoot) endif @@ -992,6 +1004,22 @@ subroutine FVW_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, endif endif endif + ! --- Write VTK grids + if (p%nGridOut>0) then + if (m%FirstCall) then + call MKDIR(p%VTK_OutFileRoot) + endif + do iGrid=1,p%nGridOut + if ( ( t - m%GridOutputs(iGrid)%tLastOutput) >= m%GridOutputs(iGrid)%DTout * OneMinusEpsilon ) then + ! Compute induced velocity on grid, TODO use the same Tree for all CalcOutput + call InducedVelocitiesAll_OnGrid(m%GridOutputs(iGrid), p, x, m, ErrStat2, ErrMsg2); if (Failed()) return + + m%GridOutputs(iGrid)%tLastOutput = t + call WrVTK_FVW_Grid(p, x, z, m, iGrid, trim(p%VTK_OutFileBase)//'FVW_Grid', m%VTKStep, 9) + endif + enddo + + endif contains diff --git a/modules/aerodyn/src/FVW_BiotSavart.f90 b/modules/aerodyn/src/FVW_BiotSavart.f90 index cb15a379ea..ec5dcc24bf 100644 --- a/modules/aerodyn/src/FVW_BiotSavart.f90 +++ b/modules/aerodyn/src/FVW_BiotSavart.f90 @@ -1,7 +1,9 @@ +!> Biot-Savart law functions +!! NOTE: these functions should be independent of the framework types module FVW_BiotSavart use NWTC_Library, only: ReKi, IntKi - use OMP_LIB ! wrap with #ifdef _OPENMP if this causes an issue + use OMP_LIB implicit none diff --git a/modules/aerodyn/src/FVW_IO.f90 b/modules/aerodyn/src/FVW_IO.f90 index 9dc0f23db9..22b15491a5 100644 --- a/modules/aerodyn/src/FVW_IO.f90 +++ b/modules/aerodyn/src/FVW_IO.f90 @@ -9,16 +9,17 @@ module FVW_IO ! ============================================================================== !> Reads the input file for FVW -SUBROUTINE FVW_ReadInputFile( FileName, p, Inp, ErrStat, ErrMsg ) +SUBROUTINE FVW_ReadInputFile( FileName, p, m, Inp, ErrStat, ErrMsg ) character(len=*), intent(in) :: FileName !< Input file name for FVW - type( FVW_ParameterType ), intent(inout) :: p !< Parameters + type(FVW_ParameterType ), intent(inout) :: p !< Parameters + type(FVW_MiscVarType), intent(inout) :: m !< Misc type(FVW_InputFile), intent(out) :: Inp !< Data stored in the module's input file integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local variables character(1024) :: PriPath ! the path to the primary input file - character(1024) :: VTK_fps_line ! string to temporarially hold value of read line for VTK_fps - integer(IntKi) :: UnIn + character(1024) :: sDummy, sLine ! string to temporarially hold value of read line + integer(IntKi) :: UnIn, i integer(IntKi) :: ErrStat2 character(ErrMsgLen) :: ErrMsg2 ErrStat = ErrID_None @@ -80,7 +81,25 @@ SUBROUTINE FVW_ReadInputFile( FileName, p, Inp, ErrStat, ErrMsg ) CALL ReadVarWDefault(UnIn,FileName,Inp%WrVTK , 'WrVTK' ,'', 0 ,ErrStat2,ErrMsg2); if(Failed())return CALL ReadVarWDefault(UnIn,FileName,Inp%VTKBlades , 'VTKBlades' ,'', 1 ,ErrStat2,ErrMsg2); if(Failed())return CALL ReadVarWDefault(UnIn,FileName,Inp%VTKCoord , 'VTKCoord' ,'', 1 ,ErrStat2,ErrMsg2); if(Failed())return - CALL ReadVar (UnIn,FileName,VTK_fps_line , 'VTK_fps' ,'' ,ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVar (UnIn,FileName,sDummy , 'VTK_fps' ,'' ,ErrStat2,ErrMsg2); if(Failed())return + Inp%DTvtk = Get_DTvtk( sDummy, p%DTaero, Inp%DTfvw ) + + CALL ReadVarWDefault(UnIn,FileName,p%nGridOut , 'nGridOut' ,'', 0 ,ErrStat2,ErrMsg2); + if (ErrStat2/=ErrID_None) then + call WarnSyntax('Grid output missing') + else + allocate(m%GridOutputs(p%nGridOut), stat=ErrStat2); + CALL ReadCom (UnIn,FileName, 'GridOutHeaders', ErrStat2,ErrMsg2); if(Failed()) return + CALL ReadCom (UnIn,FileName, 'GridOutUnits', ErrStat2,ErrMsg2); if(Failed()) return + do i =1, p%nGridOut + ErrMsg2='Error reading OLAF grid outputs line '//trim(num2lstr(i)) + read(UnIn, fmt='(A)', iostat=ErrStat2) sLine ; if(Failed()) return + call ReadGridOut(sLine, m%GridOutputs(i)); if(Failed()) return + if (Check(m%GridOutputs(i)%nx<1, 'Grid output nx needs to be >=1')) return + if (Check(m%GridOutputs(i)%ny<1, 'Grid output ny needs to be >=1')) return + if (Check(m%GridOutputs(i)%nz<1, 'Grid output nz needs to be >=1')) return + enddo + endif ! --- Validation of inputs if (PathIsRelative(Inp%CirculationFile)) Inp%CirculationFile = TRIM(PriPath)//TRIM(Inp%CirculationFile) @@ -117,7 +136,6 @@ SUBROUTINE FVW_ReadInputFile( FileName, p, Inp, ErrStat, ErrMsg ) ! Still we force the user to be responsible. if (Check((.not.(Inp%FWShedVorticity)) .and. Inp%nNWPanels<30, '`FWShedVorticity` should be true if `nNWPanels`<30. Alternatively, use a larger number of NWPanels ')) return - Inp%DTvtk = Get_DTvtk( VTK_fps_line, p%DTaero, Inp%DTfvw ) ! At least one NW panel if FW, this shoudln't be a problem since the LL is in NW, but safety for now !if (Check( (Inp%nNWPanels<=0).and.(Inp%nFWPanels>0) , 'At least one near wake panel is required if the number of far wake panel is >0')) return @@ -144,6 +162,14 @@ subroutine CleanUp() close( UnIn ) end subroutine + subroutine WarnSyntax(msg) + character(len=*), intent(in) :: msg + call WrScr('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!') + call WrScr('OLAF input file is not at its latest format') + call WrScr('Error: '//trim(msg)) + call WrScr('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!') + end subroutine + real(DbKi) function Get_DTvtk( VTK_fps_line, DTaero, DTfvw ) character(len=*), intent(inout) :: VTK_fps_line real(DbKi), intent(in ) :: DTaero @@ -178,9 +204,75 @@ real(DbKi) function Get_DTvtk( VTK_fps_line, DTaero, DTfvw ) end if end function Get_DTvtk + subroutine ReadGridOut(sLine, GridOut) + character(len=*), intent(in) :: sLine !< full line + type(GridOutType), intent(out) :: GridOut + character(255), allocatable :: StrArray(:) ! Array of strings extracted from line + real(ReKi) :: DummyFloat + ! Convert line to array of strings + CALL AllocAry(StrArray, 11, 'StrArray for grid out', ErrStat2, ErrMsg2); + if (ErrStat2/=ErrID_None) return + StrArray(:)=''; + CALL ReadCAryFromStr(sLine, StrArray, 11, 'StrArray', 'StrArray', ErrStat2, ErrMsg2)! NOTE:No Error handling! + ! Default to error + ErrStat2=ErrID_Fatal + ErrMsg2='Error reading OLAF grid outputs line: '//trim(sLine) + ! Name + GridOut%name =StrArray(1) + ! Dtout + call Conv2UC( StrArray(2) ) + if ( index(StrArray(2), "DEFAULT" ) == 1 ) then + GridOut%DTout = p%DTfvw + else + if (.not. is_numeric(StrArray(2), GridOut%DTout) ) return + endif + ! x,y,z + if (.not. is_numeric(StrArray( 3), GridOut%xStart) ) return + if (.not. is_numeric(StrArray( 4), GridOut%xEnd ) ) return + if (.not. is_int (StrArray( 5), GridOut%nx ) ) return + if (.not. is_numeric(StrArray( 6), GridOut%yStart) ) return + if (.not. is_numeric(StrArray( 7), GridOut%yEnd ) ) return + if (.not. is_int (StrArray( 8), GridOut%ny ) ) return + if (.not. is_numeric(StrArray( 9), GridOut%zStart) ) return + if (.not. is_numeric(StrArray(10), GridOut%zEnd ) ) return + if (.not. is_int (StrArray(11), GridOut%nz ) ) return + ! Success + ErrStat2=ErrID_None + ErrMsg2='' + if(allocated(StrArray)) deallocate(StrArray) + end subroutine ReadGridOut END SUBROUTINE FVW_ReadInputFile +function is_numeric(string, x) + implicit none + character(len=*), intent(in) :: string + real(reki), intent(out) :: x + logical :: is_numeric + integer :: e,n + character(len=12) :: fmt + x = 0.0_reki + n=len_trim(string) + write(fmt,'("(F",I0,".0)")') n + read(string,fmt,iostat=e) x + is_numeric = e == 0 +end function is_numeric + +function is_int(string, x) + implicit none + character(len=*), intent(in) :: string + integer(IntKi), intent(out) :: x + logical :: is_int + integer :: e,n + character(len=12) :: fmt + x = 0 + n=len_trim(string) + write(fmt,'("(I",I0,")")') n + read(string,fmt,iostat=e) x + is_int = e == 0 +end function is_int + + !================================================= !> Export FVW variables to VTK !! NOTE: when entering this function nNW and nFW has been incremented by 1 @@ -196,7 +288,6 @@ subroutine WrVTK_FVW(p, x, z, m, FileRootName, VTKcount, Twidth, bladeFrame, Hub logical, intent(in ) :: bladeFrame !< Output in blade coordinate frame real(ReKi),optional,dimension(3,3), intent(in) :: HubOrientation real(ReKi),optional,dimension(3) , intent(in) :: HubPosition - ! local variables integer:: iW character(1024) :: FileName @@ -297,11 +388,56 @@ subroutine WrVTK_FVW(p, x, z, m, FileRootName, VTKcount, Twidth, bladeFrame, Hub nSegP = 2*nSegP endif Filename = TRIM(FileRootName)//'.AllSeg.'//Tstr//'.vtk' - CALL WrVTK_Segments(Filename, mvtk, m%SegPoints(:,1:nSegP), m%SegConnct(:,1:nSeg), m%SegGamma(1:nSeg), m%SegEpsilon(1:nSeg), bladeFrame) + CALL WrVTK_Segments(Filename, mvtk, m%Sgmt%Points(:,1:nSegP), m%Sgmt%Connct(:,1:nSeg), m%Sgmt%Gamma(1:nSeg), m%Sgmt%Epsilon(1:nSeg), bladeFrame) if(.false.) print*,z%Gamma_LL(1,1) ! unused var for now end subroutine WrVTK_FVW +!> Export Grid velocity field to VTK +subroutine WrVTK_FVW_Grid(p, x, z, m, iGrid, FileRootName, VTKcount, Twidth, HubOrientation, HubPosition) + use FVW_VTK ! for all the vtk_* functions + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_ContinuousStateType), intent(in ) :: x !< States + type(FVW_ConstraintStateType), intent(in ) :: z !< Constraints + type(FVW_MiscVarType), target, intent(in ) :: m !< MiscVars + integer(IntKi), intent(in) :: iGrid !< Grid out index + character(*), intent(in) :: FileRootName !< Name of the file to write the output in (excluding extension) + integer(IntKi), intent(in) :: VTKcount !< Indicates number for VTK output file (when 0, the routine will also write reference information) + integer(IntKi), intent(in) :: Twidth !< Number of digits in the maximum write-out step (used to pad the VTK write-out in the filename with zeros) + real(ReKi),optional,dimension(3,3), intent(in) :: HubOrientation + real(ReKi),optional,dimension(3) , intent(in) :: HubPosition + ! local variables + character(1024) :: FileName + character(255) :: Label + character(Twidth) :: Tstr ! string for current VTK write-out step (padded with zeros) + real(ReKi), dimension(3) :: dx + type(GridOutType), pointer :: g + type(FVW_VTK_Misc) :: mvtk + + call vtk_misc_init(mvtk) + call set_vtk_binary_format(.false.,mvtk) ! TODO binary fails + + ! TimeStamp + write(Tstr, '(i' // trim(Num2LStr(Twidth)) //'.'// trim(Num2LStr(Twidth)) // ')') VTKcount + + ! --- Grid + g => m%GridOutputs(iGrid) + Label=trim(g%name) + Filename = TRIM(FileRootName)//'.'//trim(Label)//'.'//Tstr//'.vtk' + if ( vtk_new_ascii_file(trim(filename),Label,mvtk) ) then + dx(1) = (g%xEnd- g%xStart)/max(g%nx-1,1) + dx(2) = (g%yEnd- g%yStart)/max(g%ny-1,1) + dx(3) = (g%zEnd- g%zStart)/max(g%nz-1,1) + call vtk_dataset_structured_points((/g%xStart, g%yStart, g%zStart/),dx,(/g%nx,g%ny,g%nz/),mvtk) + call vtk_point_data_init(mvtk) + call vtk_point_data_vector(g%uGrid(1:3,:,:,:),'Velocity',mvtk) + call vtk_close_file(mvtk) + endif + + if(.false.) print*,z%Gamma_LL(1,1) ! unused var for now +end subroutine WrVTK_FVW_Grid + + subroutine WrVTK_Segments(filename, mvtk, SegPoints, SegConnct, SegGamma, SegEpsilon, bladeFrame) use FVW_VTK diff --git a/modules/aerodyn/src/FVW_Registry.txt b/modules/aerodyn/src/FVW_Registry.txt index c904da6595..eca57832cc 100644 --- a/modules/aerodyn/src/FVW_Registry.txt +++ b/modules/aerodyn/src/FVW_Registry.txt @@ -7,6 +7,30 @@ include Registry_NWTC_Library.txt usefrom AirfoilInfo_Registry.txt usefrom UnsteadyAero_Registry.txt +##################### Grid out ############### +typedef FVW/FVW GridOutType CHARACTER(100) name - - - "Grid name" - +typedef ^ ^ ReKi DTout - - - "Output frequency of grid" - +typedef ^ ^ ReKi xStart - - - "xStart" - +typedef ^ ^ ReKi yStart - - - "yStart" - +typedef ^ ^ ReKi zStart - - - "zStart" - +typedef ^ ^ ReKi xEnd - - - "xEnd" - +typedef ^ ^ ReKi yEnd - - - "yEnd" - +typedef ^ ^ ReKi zEnd - - - "zEnd" - +typedef ^ ^ Intki nx - - - "nx" - +typedef ^ ^ Intki ny - - - "ny" - +typedef ^ ^ Intki nz - - - "nz" - +typedef ^ ^ ReKi uGrid {:}{:}{:}{:} - - "Grid velocity 3 x nz x ny x nx" - +typedef ^ ^ DbKi tLastOutput - - - "Last output time" - + +##################### Segments ############### +typedef FVW/FVW T_Sgmt ReKi Points :: - - "Points delimiting the segments" - +typedef ^ ^ IntKi Connct :: - - "Connectivity of segments" - +typedef ^ ^ ReKi Gamma : - - "Segment circulations" - +typedef ^ ^ ReKi Epsilon : - - "Segment regularization parameter" - +typedef ^ ^ IntKi RegFunction - - - "Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart)" - +typedef ^ ^ IntKi nAct - - - "Number of active segments" - +typedef ^ ^ IntKi nActP - - - "Number of active segment points" - +# TODO add tree, and part ##################### Registry for FVW ############### # ..... PARAMETERS ............. @@ -51,6 +75,7 @@ typedef ^ ^ IntKi typedef ^ ^ CHARACTER(1024) RootName - - - "RootName for writing output files" - typedef ^ ^ CHARACTER(1024) VTK_OutFileRoot - - - "Rootdirectory for writing VTK files" - typedef ^ ^ CHARACTER(1024) VTK_OutFileBase - - - "Basename for writing VTK files" - +typedef ^ ^ IntKi nGridOut - - - "Number of VTK grid to output" - # ....... MiscVars ............ # FVW_MiscVarType @@ -93,13 +118,10 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi dxdt_NW :::: - - "State time derivatie, stored for subcylcing" - typedef ^ ^ ReKi dxdt_FW :::: - - "State time derivatie, stored for subcylcing" - # Convenient storage -typedef ^ ^ Reki alpha_LL :: - - "Angle of attack at lifting line CP, only computed with CircPolarData method" - -typedef ^ ^ Reki Vreln_LL :: - - "Norm of Vrel on the lifting line" - +typedef ^ ^ Reki alpha_LL :: - - "Angle of attack at lifting line CP, only computed with CircPolarData method" - +typedef ^ ^ Reki Vreln_LL :: - - "Norm of Vrel on the lifting line" - # Segment storage (buffer) -typedef ^ ^ IntKi SegConnct :: - - "Connectivity of segments" - -typedef ^ ^ ReKi SegPoints :: - - "Points delimiting the segments" - -typedef ^ ^ ReKi SegGamma : - - "Segment circulations" - -typedef ^ ^ ReKi SegEpsilon : - - "Segment regularization parameter" - +typedef ^ ^ T_Sgmt Sgmt - - - "Segments storage" - # Wake rollup storage (buffer) typedef ^ ^ ReKi CPs :: - - "Control points used for wake rollup computation" - typedef ^ ^ ReKi Uind :: - - "Induced velocities obtained at control points" - @@ -119,6 +141,8 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi BN_Cm :: - - "Coefficient moment, including unsteady aero effects" - typedef ^ ^ ReKi BN_Cx :: - - "normal force coefficient (normal to the plane, not chord) of the jth node in the kth blade" - typedef ^ ^ ReKi BN_Cy :: - - "tangential force coefficient (tangential to the plane, not chord) of the jth node in the kth blade" - +# Outputs +typedef ^ ^ GridOutType GridOutputs {:} - - "Number of VTK grid to output" - # TODO UA - Should be part of AeroDyn typedef ^ ^ UA_InputType u_UA {:}{:}{:} - - "inputs to UnsteadyAero numBlades x numNode x 2 (t and t+dt)" - diff --git a/modules/aerodyn/src/FVW_Subs.f90 b/modules/aerodyn/src/FVW_Subs.f90 index cdff226121..a252c098fe 100644 --- a/modules/aerodyn/src/FVW_Subs.f90 +++ b/modules/aerodyn/src/FVW_Subs.f90 @@ -415,8 +415,11 @@ subroutine SetRequestedWindPoints(r_wind, x, p, m) real(ReKi), dimension(:,:), allocatable, intent(inout) :: r_wind !< Position where wind is requested type(FVW_ContinuousStateType), intent(inout) :: x !< States type(FVW_ParameterType), intent(in ) :: p !< Parameters - type(FVW_MiscVarType), intent(in ) :: m !< Initial misc/optimization variables - integer(IntKi) :: iP_start,iP_end ! Current index of point, start and end of range + type(FVW_MiscVarType), intent(in ), target :: m !< Initial misc/optimization variables + integer(IntKi) :: iP_start,iP_end ! Current index of point, start and end of range + integer(IntKi) :: iGrid,i,j,k + real(ReKi) :: xP,yP,zP,dx,dy,dz + type(GridOutType), pointer :: g ! Using array reshaping to ensure a given near or far wake point is always at the same location in the array. ! NOTE: Maximum number of points are passed, whether they "exist" or not. @@ -449,6 +452,26 @@ subroutine SetRequestedWindPoints(r_wind, x, p, m) iP_end=iP_start-1+(FWnSpan+1)*(p%nFWMax+1)*p%nWings r_wind(1:3,iP_start:iP_end) = reshape( x%r_FW(1:3,1:FWnSpan+1,1:p%nFWMax+1,1:p%nWings), (/ 3, (FWnSpan+1)*(p%nFWMax+1)*p%nWings /)) endif + ! --- VTK points + ! TODO optimize this, and do it only once + iP_start=iP_end+1 + do iGrid=1,p%nGridOut + g => m%GridOutputs(iGrid) + dx = (g%xEnd- g%xStart)/max(g%nx-1,1) + dy = (g%yEnd- g%yStart)/max(g%ny-1,1) + dz = (g%zEnd- g%zStart)/max(g%nz-1,1) + do k=1,g%nz + zP = g%zStart + (k-1)*dz + do j=1,g%ny + yP = g%yStart + (j-1)*dy + do i=1,g%nx + xP = g%xStart + (i-1)*dx + r_wind(1:3,iP_start) = (/xP,yP,zP/) + iP_start=iP_start+1 + enddo + enddo + enddo ! Loop on z + enddo ! Loop on grids !if (DEV_VERSION) then ! ! Additional checks @@ -475,8 +498,10 @@ end subroutine SetRequestedWindPoints subroutine DistributeRequestedWind(V_wind, p, m) real(ReKi), dimension(:,:), intent(in ) :: V_wind !< Position where wind is requested type(FVW_ParameterType), intent(in ) :: p !< Parameters - type(FVW_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + type(FVW_MiscVarType), target, intent(inout) :: m !< Initial misc/optimization variables integer(IntKi) :: iP_start,iP_end ! Current index of point, start and end of range + integer(IntKi) :: iGrid,i,j,k + type(GridOutType), pointer :: g ! Using array reshaping to ensure a given near or far wake point is always at the same location in the array. ! NOTE: Maximum number of points are passed, whether they "exist" or not. @@ -494,6 +519,20 @@ subroutine DistributeRequestedWind(V_wind, p, m) iP_end=iP_start-1+(FWnSpan+1)*(p%nFWMax+1)*p%nWings m%Vwnd_FW(1:3,1:FWnSpan+1,1:p%nFWMax+1,1:p%nWings) = reshape( V_wind(1:3,iP_start:iP_end), (/ 3, FWnSpan+1, p%nFWMax+1, p%nWings /)) endif + ! --- VTK points + ! TODO optimize this + iP_start=iP_end+1 + do iGrid=1,p%nGridOut + g => m%GridOutputs(iGrid) + do k=1,g%nz + do j=1,g%ny + do i=1,g%nx + g%uGrid(1:3,i,j,k) = V_wind(1:3,iP_start) + iP_start=iP_start+1 + enddo + enddo + enddo ! Loop on x + enddo ! Loop on grids end subroutine DistributeRequestedWind @@ -678,6 +717,7 @@ subroutine FVW_InitRegularization(p, m, ErrStat, ErrMsg) p%WakeRegParam = RegParam p%WingRegParam = RegParam p%CoreSpreadEddyVisc = 100 + m%Sgmt%RegFunction = p%RegFunction write(*,'(A)' ) 'The following regularization parameters will be used:' write(*,'(A,I0)' ) 'WakeRegMethod : ', p%WakeRegMethod write(*,'(A,I0)' ) 'RegFunction : ', p%RegFunction @@ -738,87 +778,218 @@ subroutine WakeRegularization(p, x, m, SegConnct, SegPoints, SegGamma, SegEpsilo end subroutine WakeRegularization -!> Compute induced velocities from all vortex elements onto all the vortex elements -!! In : x%r_NW, x%r_FW, x%Gamma_NW, x%Gamma_FW -!! Out: m%Vind_NW, m%Vind_FW -subroutine WakeInducedVelocities(p, x, m, ErrStat, ErrMsg) +!> Compute induced velocities from all vortex elements onto nPoints +!! In : x, x%r_NW, x%r_FW, x%Gamma_NW, x%Gamma_FW +!! Out: Vind +subroutine InducedVelocitiesAll_OnGrid(g, p, x, m, ErrStat, ErrMsg) + type(GridOutType), intent(inout) :: g !< Grid on whcih to compute the velocity type(FVW_ParameterType), intent(in ) :: p !< Parameters type(FVW_ContinuousStateType), intent(in ) :: x !< States type(FVW_MiscVarType), intent(inout) :: 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 - integer(IntKi) :: iW, nSeg, nSegP, nCPs, iHeadP - integer(IntKi) :: nFWEff ! Number of farwake panels that are free at current tmie step - logical :: bMirror ! True if we mirror the vorticity wrt ground + integer(IntKi) :: nCPs, iHeadP + integer(IntKi) :: i,j,k + real(ReKi) :: xP,yP,zP,dx,dy,dz ! TODO new options - integer(IntKi) :: RegFunctionPart - integer(IntKi) :: nPart - real(ReKi) :: DistanceDirect ! Distance under which direct evaluation of the Biot-Savart should be done for tree type(T_Tree) :: Tree - real(ReKi), dimension(:,:), allocatable :: PartPoints !< Particle points - real(ReKi), dimension(:,:), allocatable :: PartAlpha !< Particle circulation - real(ReKi), dimension(:) , allocatable :: PartEpsilon !< Regularization parameter + type(T_Part) :: Part + real(ReKi), dimension(:,:), allocatable :: CPs ! TODO get rid of me with dedicated functions + real(ReKi), dimension(:,:), allocatable :: Uind ! TODO get rid of me with dedicated functions ErrStat= ErrID_None ErrMsg ='' - nFWEff = min(m%nFW, p%nFWFree) - bMirror = p%ShearModel==idShearMirror ! Whether or not we mirror the vorticity wrt ground + ! --- Packing control points + nCPs = g%nx * g%ny * g%nz + allocate(CPs(3, nCPs)) + iHeadP=1 + dx = (g%xEnd- g%xStart)/max(g%nx-1,1) + dy = (g%yEnd- g%yStart)/max(g%ny-1,1) + dz = (g%zEnd- g%zStart)/max(g%nz-1,1) + do k=1,g%nz + zP = g%zStart + (k-1)*dz + do j=1,g%ny + yP = g%yStart + (j-1)*dy + do i=1,g%nx + xP = g%xStart + (i-1)*dx + CPs(1:3,iHeadP) = (/xP,yP,zP/) + iHeadP=iHeadP+1 + enddo + enddo + enddo ! Loop on z + + ! --- Packing Uind points + allocate(Uind(3, nCPs)); Uind=0.0_ReKi + iHeadP=1 + call FlattenValues(g%uGrid, Uind, iHeadP); ! NOTE: Uind contains uGrid now (Uwnd) + + ! --- Compute induced velocity + ! Convert Panels to segments, segments to particles, particles to tree + call InducedVelocitiesAll_Init(p, x, m, m%Sgmt, Part, Tree, ErrStat, ErrMsg) + call InducedVelocitiesAll_Calc(CPs, nCPs, Uind, p, m%Sgmt, Part, Tree, ErrStat, ErrMsg) + call InducedVelocitiesAll_End(p, m, Tree, Part, ErrStat, ErrMsg) + + ! --- Unpacking induced velocity points + iHeadP=1 + call DeflateValues(Uind, g%uGrid, iHeadP) + + deallocate(CPs) + deallocate(Uind) + +end subroutine InducedVelocitiesAll_OnGrid - m%Vind_NW = -9999._ReKi !< Safety - m%Vind_FW = -9999._ReKi !< Safety + + +!> Perform initialization steps before requesting induced velocities from All vortex elements +!! In : x%r_NW, x%r_FW, x%Gamma_NW, x%Gamma_FW +!! Out: Tree, Part, m +subroutine InducedVelocitiesAll_Init(p, x, m, Sgmt, Part, Tree, ErrStat, ErrMsg) + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_ContinuousStateType), intent(in ) :: x !< States + type(FVW_MiscVarType), intent(in ) :: m !< Misc + type(T_Sgmt), intent(inout) :: Sgmt !< Segments + type(T_Part), intent(out) :: Part !< Particle storage if needed + type(T_Tree), intent(out) :: Tree !< Tree of particles if needed + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + integer(IntKi) :: iHeadP, nSeg, nSegP + logical :: bMirror ! True if we mirror the vorticity wrt ground + integer(IntKi) :: nPart + ErrStat= ErrID_None + ErrMsg ='' + + bMirror = p%ShearModel==idShearMirror ! Whether or not we mirror the vorticity wrt ground ! --- Packing all vortex elements into a list of segments - ! NOTE: modifies m%Seg* - call PackPanelsToSegments(p, m, x, 1, bMirror, m%SegConnct, m%SegPoints, m%SegGamma, nSeg, nSegP) + call PackPanelsToSegments(p, m, x, 1, bMirror, Sgmt%Connct, Sgmt%Points, Sgmt%Gamma, nSeg, nSegP) + Sgmt%RegFunction=p%RegFunction + Sgmt%nAct = nSeg + Sgmt%nActP = nSegP ! --- Setting up regularization SegEpsilon - call WakeRegularization(p, x, m, m%SegConnct, m%SegPoints, m%SegGamma, m%SegEpsilon(1:nSeg), ErrStat, ErrMsg) - - ! --- Computing induced velocity - call PackConvectingPoints() - if (DEV_VERSION) then - print'(A,I0,A,I0,A,I0)','Convection - nSeg:',nSeg,' - nSegP:',nSegP, ' - nCPs:',nCPs - endif + call WakeRegularization(p, x, m, Sgmt%Connct, Sgmt%Points, Sgmt%Gamma, Sgmt%Epsilon(1:nSeg), ErrStat, ErrMsg) ! --- Converting to particles if ((p%VelocityMethod==idVelocityTree) .or. (p%VelocityMethod==idVelocityPart)) then iHeadP=1 nPart = p%PartPerSegment * nSeg - allocate(PartPoints(3,nPart), PartAlpha(3,nPart), PartEpsilon(nPart)) - PartAlpha(:,:) = -99999.99_ReKi - PartPoints(:,:) = -99999.99_ReKi - PartEpsilon(:) = -99999.99_ReKi - call SegmentsToPart(m%SegPoints, m%SegConnct, m%SegGamma, m%SegEpsilon, 1, nSeg, p%PartPerSegment, PartPoints, PartAlpha, PartEpsilon, iHeadP) + allocate(Part%P(3,nPart), Part%Alpha(3,nPart), Part%RegParam(nPart)) + Part%Alpha(:,:) = -99999.99_ReKi + Part%P(:,:) = -99999.99_ReKi + Part%RegParam(:) = -99999.99_ReKi + call SegmentsToPart(Sgmt%Points, Sgmt%Connct, Sgmt%Gamma, Sgmt%Epsilon, 1, nSeg, p%PartPerSegment, Part%P, Part%Alpha, Part%RegParam, iHeadP) if (p%RegFunction/=idRegNone) then - RegFunctionPart = idRegExp ! TODO need to find a good equivalence and potentially adapt Epsilon in SegmentsToPart + Part%RegFunction = idRegExp ! TODO need to find a good equivalence and potentially adapt Epsilon in SegmentsToPart endif - if (any(PartEpsilon(:)<-9999.99_ReKi)) then - print*,'Error in Segment to part conversion' - STOP + if (DEV_VERSION) then + if (any(Part%RegParam(:)<-9999.99_ReKi)) then + print*,'Error in Segment to part conversion' + STOP + endif endif endif - ! --- Getting induced velocity - m%Uind=0.0_ReKi ! very important due to side effects of ui_* methods + ! Grow tree if needed + if (p%VelocityMethod==idVelocityTree) then + Tree%DistanceDirect = 2*sum(Part%RegParam)/size(Part%RegParam) ! 2*mean(eps), below that distance eps has a strong effect + call grow_tree(Tree, Part%P, Part%Alpha, Part%RegFunction, Part%RegParam, 0) + endif + +end subroutine InducedVelocitiesAll_Init + +!> Compute induced velocity on flat CPs +subroutine InducedVelocitiesAll_Calc(CPs, nCPs, Uind, p, Sgmt, Part, Tree, ErrStat, ErrMsg) + real(ReKi), dimension(:,:), intent(in) :: CPs !< Control points (3 x nCPs++) + integer(IntKi) , intent(in) :: nCPs !< Number of control points on which to compute (nCPs <= size(CPs,2)) + real(ReKi), dimension(:,: ) , intent(inout) :: Uind !< Induced velocity vector - Side effects!!! (3 x nCPs++) + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(T_Sgmt), intent(in ) :: Sgmt !< Tree of particles if needed + type(T_Part), intent(in ) :: Part !< Particle storage if needed + type(T_Tree), intent(inout) :: Tree !< Tree of particles if needed + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + ErrStat= ErrID_None + ErrMsg ='' + if (p%VelocityMethod==idVelocityBasic) then - call ui_seg( 1, nCPs, m%CPs, 1, nSeg, nSeg, nSegP, m%SegPoints, m%SegConnct, m%SegGamma, p%RegFunction, m%SegEpsilon, m%Uind) + call ui_seg( 1, nCPs, CPs, 1, Sgmt%nAct, Sgmt%nAct, Sgmt%nActP, Sgmt%Points, Sgmt%Connct, Sgmt%Gamma, Sgmt%RegFunction, Sgmt%Epsilon, Uind) elseif (p%VelocityMethod==idVelocityTree) then - - DistanceDirect = 2*sum(PartEpsilon)/size(PartEpsilon) ! 2*mean(eps), below that distance eps has a strong effect - call grow_tree(Tree, PartPoints, PartAlpha, RegFunctionPart, PartEpsilon, 0) + ! Tree has already been grown with InducedVelocitiesAll_Init !call print_tree(Tree) - call ui_tree(Tree, m%CPs, 0, 1, nCPs, p%TreeBranchFactor, DistanceDirect, m%Uind, ErrStat, ErrMsg) + call ui_tree(Tree, CPs, 0, 1, nCPs, p%TreeBranchFactor, Tree%DistanceDirect, Uind, ErrStat, ErrMsg) + + elseif (p%VelocityMethod==idVelocityPart) then + call ui_part_nograd(CPs ,Part%P, Part%Alpha, Part%RegFunction, Part%RegParam, Uind, nCPs, size(Part%P,2)) + endif +end subroutine InducedVelocitiesAll_Calc + + +!> Perform termination steps after velocity was requested from all vortex elements +!! InOut: Tree, Part, m +subroutine InducedVelocitiesAll_End(p, m, Tree, Part, ErrStat, ErrMsg) + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + type(T_Tree), intent(inout) :: Tree !< Tree of particles if needed + type(T_Part), intent(inout) :: Part !< Particle storage if needed + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + ! Local variables + ErrStat= ErrID_None + ErrMsg ='' + + if (p%VelocityMethod==idVelocityBasic) then + ! Nothing + + elseif (p%VelocityMethod==idVelocityTree) then call cut_tree(Tree) - deallocate(PartPoints, PartAlpha, PartEpsilon) + deallocate(Part%P, Part%Alpha, Part%RegParam) elseif (p%VelocityMethod==idVelocityPart) then - call ui_part_nograd(m%CPs ,PartPoints, PartAlpha, RegFunctionPart, PartEpsilon, m%Uind, nCPs, nPart) - deallocate(PartPoints, PartAlpha, PartEpsilon) + deallocate(Part%P, Part%Alpha, Part%RegParam) endif + +end subroutine InducedVelocitiesAll_End + + + + +!> Compute induced velocities from all vortex elements onto all the vortex elements +!! In : x%r_NW, x%r_FW, x%Gamma_NW, x%Gamma_FW +!! Out: m%Vind_NW, m%Vind_FW +subroutine WakeInducedVelocities(p, x, m, ErrStat, ErrMsg) + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_ContinuousStateType), intent(in ) :: x !< States + type(FVW_MiscVarType), intent(inout) :: 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 + integer(IntKi) :: iW, nCPs, iHeadP + integer(IntKi) :: nFWEff ! Number of farwake panels that are free at current tmie step + type(T_Tree) :: Tree + type(T_Part) :: Part + ErrStat= ErrID_None + ErrMsg ='' + + nFWEff = min(m%nFW, p%nFWFree) + + ! --- Pack control points + call PackConvectingPoints() ! m%CPs + + ! --- Compute induced velocity + ! Convert Panels to segments, segments to particles, particles to tree + m%Uind=0.0_ReKi ! very important due to side effects of ui_* methods + call InducedVelocitiesAll_Init(p, x, m, m%Sgmt, Part, Tree, ErrStat, ErrMsg) + call InducedVelocitiesAll_Calc(m%CPs, nCPs, m%Uind, p, m%Sgmt, Part, Tree, ErrStat, ErrMsg) + call InducedVelocitiesAll_End(p, m, Tree, Part, ErrStat, ErrMsg) call UnPackInducedVelocity() + if (DEV_VERSION) then + print'(A,I0,A,I0,A,I0)','Convection - nSeg:',m%Sgmt%nAct,' - nSegP:',m%Sgmt%nActP, ' - nCPs:',nCPs + endif contains !> Pack all the points that convect subroutine PackConvectingPoints() @@ -850,6 +1021,8 @@ subroutine PackConvectingPoints() end subroutine !> Distribute the induced velocity to the proper location subroutine UnPackInducedVelocity() + m%Vind_NW = -9999._ReKi !< Safety + m%Vind_FW = -9999._ReKi !< Safety iHeadP=1 do iW=1,p%nWings CALL VecToLattice(m%Uind, 1, m%Vind_NW(:,:,1:m%nNW+1,iW), iHeadP) @@ -873,7 +1046,7 @@ subroutine UnPackInducedVelocity() endif end subroutine -end subroutine +end subroutine WakeInducedVelocities !> Compute induced velocities from all vortex elements onto the lifting line control points !! In : x%r_NW, x%r_FW, x%Gamma_NW, x%Gamma_FW @@ -896,7 +1069,7 @@ subroutine LiftingLineInducedVelocities(p, x, iDepthStart, m, ErrStat, ErrMsg) bMirror = p%ShearModel==idShearMirror ! Whether or not we mirror the vorticity wrt ground ! --- Packing all vortex elements into a list of segments - call PackPanelsToSegments(p, m, x, iDepthStart, bMirror, m%SegConnct, m%SegPoints, m%SegGamma, nSeg, nSegP) + call PackPanelsToSegments(p, m, x, iDepthStart, bMirror, m%Sgmt%Connct, m%Sgmt%Points, m%Sgmt%Gamma, nSeg, nSegP) ! --- Computing induced velocity if (nSegP==0) then @@ -907,7 +1080,7 @@ subroutine LiftingLineInducedVelocities(p, x, iDepthStart, m, ErrStat, ErrMsg) endif else ! --- Setting up regularization - call WakeRegularization(p, x, m, m%SegConnct(:,1:nSeg), m%SegPoints(:,1:nSegP), m%SegGamma(1:nSeg), m%SegEpsilon(1:nSeg), ErrStat, ErrMsg) + call WakeRegularization(p, x, m, m%Sgmt%Connct(:,1:nSeg), m%Sgmt%Points(:,1:nSegP), m%Sgmt%Gamma(1:nSeg), m%Sgmt%Epsilon(1:nSeg), ErrStat, ErrMsg) nCPs=p%nWings * p%nSpan allocate(CPs (1:3,1:nCPs)) ! NOTE: here we do allocate CPs and Uind insteadof using Misc @@ -918,7 +1091,7 @@ subroutine LiftingLineInducedVelocities(p, x, iDepthStart, m, ErrStat, ErrMsg) if (DEV_VERSION) then print'(A,I0,A,I0,A,I0)','Induction - nSeg:',nSeg,' - nSegP:',nSegP, ' - nCPs:',nCPs endif - call ui_seg( 1, nCPs, CPs, 1, nSeg, nSeg, nSegP, m%SegPoints, m%SegConnct, m%SegGamma, p%RegFunction, m%SegEpsilon, Uind) + call ui_seg( 1, nCPs, CPs, 1, nSeg, nSeg, nSegP, m%Sgmt%Points, m%Sgmt%Connct, m%Sgmt%Gamma, m%Sgmt%RegFunction, m%Sgmt%Epsilon, Uind) call UnPackLiftingLineVelocities() deallocate(Uind) diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index be7ac3b3c3..517fc891e3 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -35,6 +35,34 @@ MODULE FVW_Types USE UnsteadyAero_Types USE NWTC_Library IMPLICIT NONE +! ========= GridOutType ======= + TYPE, PUBLIC :: GridOutType + CHARACTER(100) :: name !< Grid name [-] + REAL(ReKi) :: DTout !< Output frequency of grid [-] + REAL(ReKi) :: xStart !< xStart [-] + REAL(ReKi) :: yStart !< yStart [-] + REAL(ReKi) :: zStart !< zStart [-] + REAL(ReKi) :: xEnd !< xEnd [-] + REAL(ReKi) :: yEnd !< yEnd [-] + REAL(ReKi) :: zEnd !< zEnd [-] + INTEGER(IntKi) :: nx !< nx [-] + INTEGER(IntKi) :: ny !< ny [-] + INTEGER(IntKi) :: nz !< nz [-] + REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: uGrid !< Grid velocity 3 x nz x ny x nx [-] + REAL(DbKi) :: tLastOutput !< Last output time [-] + END TYPE GridOutType +! ======================= +! ========= T_Sgmt ======= + TYPE, PUBLIC :: T_Sgmt + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Points !< Points delimiting the segments [-] + INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Connct !< Connectivity of segments [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Gamma !< Segment circulations [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Epsilon !< Segment regularization parameter [-] + INTEGER(IntKi) :: RegFunction !< Type of regularizaion function (LambOseen, Vatistas, see FVW_BiotSavart) [-] + INTEGER(IntKi) :: nAct !< Number of active segments [-] + INTEGER(IntKi) :: nActP !< Number of active segment points [-] + END TYPE T_Sgmt +! ======================= ! ========= FVW_ParameterType ======= TYPE, PUBLIC :: FVW_ParameterType INTEGER(IntKi) :: nWings !< Number of Wings [-] @@ -76,6 +104,7 @@ MODULE FVW_Types CHARACTER(1024) :: RootName !< RootName for writing output files [-] CHARACTER(1024) :: VTK_OutFileRoot !< Rootdirectory for writing VTK files [-] CHARACTER(1024) :: VTK_OutFileBase !< Basename for writing VTK files [-] + INTEGER(IntKi) :: nGridOut !< Number of VTK grid to output [-] END TYPE FVW_ParameterType ! ======================= ! ========= FVW_MiscVarType ======= @@ -118,10 +147,7 @@ MODULE FVW_Types REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: dxdt_FW !< State time derivatie, stored for subcylcing [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: alpha_LL !< Angle of attack at lifting line CP, only computed with CircPolarData method [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vreln_LL !< Norm of Vrel on the lifting line [-] - INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: SegConnct !< Connectivity of segments [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: SegPoints !< Points delimiting the segments [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SegGamma !< Segment circulations [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: SegEpsilon !< Segment regularization parameter [-] + TYPE(T_Sgmt) :: Sgmt !< Segments storage [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CPs !< Control points used for wake rollup computation [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Uind !< Induced velocities obtained at control points [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_AxInd !< Axial induction [size: (NumBlNds,numBlades)] [-] @@ -139,6 +165,7 @@ MODULE FVW_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_Cm !< Coefficient moment, including unsteady aero effects [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_Cx !< normal force coefficient (normal to the plane, not chord) of the jth node in the kth blade [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_Cy !< tangential force coefficient (tangential to the plane, not chord) of the jth node in the kth blade [-] + TYPE(GridOutType) , DIMENSION(:), ALLOCATABLE :: GridOutputs !< Number of VTK grid to output [-] TYPE(UA_InputType) , DIMENSION(:,:,:), ALLOCATABLE :: u_UA !< inputs to UnsteadyAero numBlades x numNode x 2 (t and t+dt) [-] TYPE(UA_MiscVarType) :: m_UA !< misc vars for UnsteadyAero [-] TYPE(UA_OutputType) :: y_UA !< outputs from UnsteadyAero [-] @@ -253,6 +280,675 @@ MODULE FVW_Types END TYPE FVW_InitOutputType ! ======================= CONTAINS + SUBROUTINE FVW_CopyGridOutType( SrcGridOutTypeData, DstGridOutTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(GridOutType), INTENT(IN) :: SrcGridOutTypeData + TYPE(GridOutType), INTENT(INOUT) :: DstGridOutTypeData + 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 = 'FVW_CopyGridOutType' +! + ErrStat = ErrID_None + ErrMsg = "" + DstGridOutTypeData%name = SrcGridOutTypeData%name + DstGridOutTypeData%DTout = SrcGridOutTypeData%DTout + DstGridOutTypeData%xStart = SrcGridOutTypeData%xStart + DstGridOutTypeData%yStart = SrcGridOutTypeData%yStart + DstGridOutTypeData%zStart = SrcGridOutTypeData%zStart + DstGridOutTypeData%xEnd = SrcGridOutTypeData%xEnd + DstGridOutTypeData%yEnd = SrcGridOutTypeData%yEnd + DstGridOutTypeData%zEnd = SrcGridOutTypeData%zEnd + DstGridOutTypeData%nx = SrcGridOutTypeData%nx + DstGridOutTypeData%ny = SrcGridOutTypeData%ny + DstGridOutTypeData%nz = SrcGridOutTypeData%nz +IF (ALLOCATED(SrcGridOutTypeData%uGrid)) THEN + i1_l = LBOUND(SrcGridOutTypeData%uGrid,1) + i1_u = UBOUND(SrcGridOutTypeData%uGrid,1) + i2_l = LBOUND(SrcGridOutTypeData%uGrid,2) + i2_u = UBOUND(SrcGridOutTypeData%uGrid,2) + i3_l = LBOUND(SrcGridOutTypeData%uGrid,3) + i3_u = UBOUND(SrcGridOutTypeData%uGrid,3) + i4_l = LBOUND(SrcGridOutTypeData%uGrid,4) + i4_u = UBOUND(SrcGridOutTypeData%uGrid,4) + IF (.NOT. ALLOCATED(DstGridOutTypeData%uGrid)) THEN + ALLOCATE(DstGridOutTypeData%uGrid(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 DstGridOutTypeData%uGrid.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstGridOutTypeData%uGrid = SrcGridOutTypeData%uGrid +ENDIF + DstGridOutTypeData%tLastOutput = SrcGridOutTypeData%tLastOutput + END SUBROUTINE FVW_CopyGridOutType + + SUBROUTINE FVW_DestroyGridOutType( GridOutTypeData, ErrStat, ErrMsg ) + TYPE(GridOutType), INTENT(INOUT) :: GridOutTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyGridOutType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(GridOutTypeData%uGrid)) THEN + DEALLOCATE(GridOutTypeData%uGrid) +ENDIF + END SUBROUTINE FVW_DestroyGridOutType + + SUBROUTINE FVW_PackGridOutType( 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(GridOutType), 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 = 'FVW_PackGridOutType' + ! 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%name) ! name + Re_BufSz = Re_BufSz + 1 ! DTout + Re_BufSz = Re_BufSz + 1 ! xStart + Re_BufSz = Re_BufSz + 1 ! yStart + Re_BufSz = Re_BufSz + 1 ! zStart + Re_BufSz = Re_BufSz + 1 ! xEnd + Re_BufSz = Re_BufSz + 1 ! yEnd + Re_BufSz = Re_BufSz + 1 ! zEnd + Int_BufSz = Int_BufSz + 1 ! nx + Int_BufSz = Int_BufSz + 1 ! ny + Int_BufSz = Int_BufSz + 1 ! nz + Int_BufSz = Int_BufSz + 1 ! uGrid allocated yes/no + IF ( ALLOCATED(InData%uGrid) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! uGrid upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%uGrid) ! uGrid + END IF + Db_BufSz = Db_BufSz + 1 ! tLastOutput + 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%name) + IntKiBuf(Int_Xferred) = ICHAR(InData%name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%DTout + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%xStart + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%yStart + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%zStart + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%xEnd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%yEnd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%zEnd + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ny + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nz + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%uGrid) ) 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%uGrid,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uGrid,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%uGrid,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uGrid,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%uGrid,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uGrid,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%uGrid,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uGrid,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%uGrid,4), UBOUND(InData%uGrid,4) + DO i3 = LBOUND(InData%uGrid,3), UBOUND(InData%uGrid,3) + DO i2 = LBOUND(InData%uGrid,2), UBOUND(InData%uGrid,2) + DO i1 = LBOUND(InData%uGrid,1), UBOUND(InData%uGrid,1) + ReKiBuf(Re_Xferred) = InData%uGrid(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + DbKiBuf(Db_Xferred) = InData%tLastOutput + Db_Xferred = Db_Xferred + 1 + END SUBROUTINE FVW_PackGridOutType + + SUBROUTINE FVW_UnPackGridOutType( 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(GridOutType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: 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 = 'FVW_UnPackGridOutType' + ! 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%name) + OutData%name(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%DTout = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%xStart = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%yStart = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%zStart = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%xEnd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%yEnd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%zEnd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%nx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nz = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uGrid 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%uGrid)) DEALLOCATE(OutData%uGrid) + ALLOCATE(OutData%uGrid(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%uGrid.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%uGrid,4), UBOUND(OutData%uGrid,4) + DO i3 = LBOUND(OutData%uGrid,3), UBOUND(OutData%uGrid,3) + DO i2 = LBOUND(OutData%uGrid,2), UBOUND(OutData%uGrid,2) + DO i1 = LBOUND(OutData%uGrid,1), UBOUND(OutData%uGrid,1) + OutData%uGrid(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + OutData%tLastOutput = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END SUBROUTINE FVW_UnPackGridOutType + + SUBROUTINE FVW_CopyT_Sgmt( SrcT_SgmtData, DstT_SgmtData, CtrlCode, ErrStat, ErrMsg ) + TYPE(T_Sgmt), INTENT(IN) :: SrcT_SgmtData + TYPE(T_Sgmt), INTENT(INOUT) :: DstT_SgmtData + 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 = 'FVW_CopyT_Sgmt' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcT_SgmtData%Points)) THEN + i1_l = LBOUND(SrcT_SgmtData%Points,1) + i1_u = UBOUND(SrcT_SgmtData%Points,1) + i2_l = LBOUND(SrcT_SgmtData%Points,2) + i2_u = UBOUND(SrcT_SgmtData%Points,2) + IF (.NOT. ALLOCATED(DstT_SgmtData%Points)) THEN + ALLOCATE(DstT_SgmtData%Points(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Points.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstT_SgmtData%Points = SrcT_SgmtData%Points +ENDIF +IF (ALLOCATED(SrcT_SgmtData%Connct)) THEN + i1_l = LBOUND(SrcT_SgmtData%Connct,1) + i1_u = UBOUND(SrcT_SgmtData%Connct,1) + i2_l = LBOUND(SrcT_SgmtData%Connct,2) + i2_u = UBOUND(SrcT_SgmtData%Connct,2) + IF (.NOT. ALLOCATED(DstT_SgmtData%Connct)) THEN + ALLOCATE(DstT_SgmtData%Connct(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Connct.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstT_SgmtData%Connct = SrcT_SgmtData%Connct +ENDIF +IF (ALLOCATED(SrcT_SgmtData%Gamma)) THEN + i1_l = LBOUND(SrcT_SgmtData%Gamma,1) + i1_u = UBOUND(SrcT_SgmtData%Gamma,1) + IF (.NOT. ALLOCATED(DstT_SgmtData%Gamma)) THEN + ALLOCATE(DstT_SgmtData%Gamma(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Gamma.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstT_SgmtData%Gamma = SrcT_SgmtData%Gamma +ENDIF +IF (ALLOCATED(SrcT_SgmtData%Epsilon)) THEN + i1_l = LBOUND(SrcT_SgmtData%Epsilon,1) + i1_u = UBOUND(SrcT_SgmtData%Epsilon,1) + IF (.NOT. ALLOCATED(DstT_SgmtData%Epsilon)) THEN + ALLOCATE(DstT_SgmtData%Epsilon(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstT_SgmtData%Epsilon.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstT_SgmtData%Epsilon = SrcT_SgmtData%Epsilon +ENDIF + DstT_SgmtData%RegFunction = SrcT_SgmtData%RegFunction + DstT_SgmtData%nAct = SrcT_SgmtData%nAct + DstT_SgmtData%nActP = SrcT_SgmtData%nActP + END SUBROUTINE FVW_CopyT_Sgmt + + SUBROUTINE FVW_DestroyT_Sgmt( T_SgmtData, ErrStat, ErrMsg ) + TYPE(T_Sgmt), INTENT(INOUT) :: T_SgmtData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyT_Sgmt' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(T_SgmtData%Points)) THEN + DEALLOCATE(T_SgmtData%Points) +ENDIF +IF (ALLOCATED(T_SgmtData%Connct)) THEN + DEALLOCATE(T_SgmtData%Connct) +ENDIF +IF (ALLOCATED(T_SgmtData%Gamma)) THEN + DEALLOCATE(T_SgmtData%Gamma) +ENDIF +IF (ALLOCATED(T_SgmtData%Epsilon)) THEN + DEALLOCATE(T_SgmtData%Epsilon) +ENDIF + END SUBROUTINE FVW_DestroyT_Sgmt + + SUBROUTINE FVW_PackT_Sgmt( 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(T_Sgmt), 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 = 'FVW_PackT_Sgmt' + ! 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 ! Points allocated yes/no + IF ( ALLOCATED(InData%Points) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Points upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Points) ! Points + END IF + Int_BufSz = Int_BufSz + 1 ! Connct allocated yes/no + IF ( ALLOCATED(InData%Connct) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Connct upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Connct) ! Connct + END IF + Int_BufSz = Int_BufSz + 1 ! Gamma allocated yes/no + IF ( ALLOCATED(InData%Gamma) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Gamma upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Gamma) ! Gamma + END IF + Int_BufSz = Int_BufSz + 1 ! Epsilon allocated yes/no + IF ( ALLOCATED(InData%Epsilon) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Epsilon upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Epsilon) ! Epsilon + END IF + Int_BufSz = Int_BufSz + 1 ! RegFunction + Int_BufSz = Int_BufSz + 1 ! nAct + Int_BufSz = Int_BufSz + 1 ! nActP + 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%Points) ) 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%Points,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Points,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Points,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Points,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Points,2), UBOUND(InData%Points,2) + DO i1 = LBOUND(InData%Points,1), UBOUND(InData%Points,1) + ReKiBuf(Re_Xferred) = InData%Points(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Connct) ) 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%Connct,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Connct,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Connct,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Connct,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Connct,2), UBOUND(InData%Connct,2) + DO i1 = LBOUND(InData%Connct,1), UBOUND(InData%Connct,1) + IntKiBuf(Int_Xferred) = InData%Connct(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Gamma) ) 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%Gamma,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Gamma,1), UBOUND(InData%Gamma,1) + ReKiBuf(Re_Xferred) = InData%Gamma(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Epsilon) ) 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%Epsilon,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Epsilon,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Epsilon,1), UBOUND(InData%Epsilon,1) + ReKiBuf(Re_Xferred) = InData%Epsilon(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%RegFunction + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nAct + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nActP + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE FVW_PackT_Sgmt + + SUBROUTINE FVW_UnPackT_Sgmt( 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(T_Sgmt), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackT_Sgmt' + ! 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 ! Points 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%Points)) DEALLOCATE(OutData%Points) + ALLOCATE(OutData%Points(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Points.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Points,2), UBOUND(OutData%Points,2) + DO i1 = LBOUND(OutData%Points,1), UBOUND(OutData%Points,1) + OutData%Points(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Connct 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%Connct)) DEALLOCATE(OutData%Connct) + ALLOCATE(OutData%Connct(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Connct.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Connct,2), UBOUND(OutData%Connct,2) + DO i1 = LBOUND(OutData%Connct,1), UBOUND(OutData%Connct,1) + OutData%Connct(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma 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%Gamma)) DEALLOCATE(OutData%Gamma) + ALLOCATE(OutData%Gamma(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Gamma,1), UBOUND(OutData%Gamma,1) + OutData%Gamma(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Epsilon 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%Epsilon)) DEALLOCATE(OutData%Epsilon) + ALLOCATE(OutData%Epsilon(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Epsilon.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Epsilon,1), UBOUND(OutData%Epsilon,1) + OutData%Epsilon(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%RegFunction = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nAct = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nActP = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE FVW_UnPackT_Sgmt + SUBROUTINE FVW_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(FVW_ParameterType), INTENT(IN) :: SrcParamData TYPE(FVW_ParameterType), INTENT(INOUT) :: DstParamData @@ -263,8 +959,6 @@ SUBROUTINE FVW_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg 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 = 'FVW_CopyParam' @@ -347,6 +1041,7 @@ SUBROUTINE FVW_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%RootName = SrcParamData%RootName DstParamData%VTK_OutFileRoot = SrcParamData%VTK_OutFileRoot DstParamData%VTK_OutFileBase = SrcParamData%VTK_OutFileBase + DstParamData%nGridOut = SrcParamData%nGridOut END SUBROUTINE FVW_CopyParam SUBROUTINE FVW_DestroyParam( ParamData, ErrStat, ErrMsg ) @@ -455,6 +1150,7 @@ SUBROUTINE FVW_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName Int_BufSz = Int_BufSz + 1*LEN(InData%VTK_OutFileRoot) ! VTK_OutFileRoot Int_BufSz = Int_BufSz + 1*LEN(InData%VTK_OutFileBase) ! VTK_OutFileBase + Int_BufSz = Int_BufSz + 1 ! nGridOut IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -615,6 +1311,8 @@ SUBROUTINE FVW_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf(Int_Xferred) = ICHAR(InData%VTK_OutFileBase(I:I), IntKi) Int_Xferred = Int_Xferred + 1 END DO ! I + IntKiBuf(Int_Xferred) = InData%nGridOut + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FVW_PackParam SUBROUTINE FVW_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -632,8 +1330,6 @@ SUBROUTINE FVW_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: i 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 = 'FVW_UnPackParam' @@ -789,6 +1485,8 @@ SUBROUTINE FVW_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg OutData%VTK_OutFileBase(I:I) = CHAR(IntKiBuf(Int_Xferred)) Int_Xferred = Int_Xferred + 1 END DO ! I + OutData%nGridOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FVW_UnPackParam SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1274,58 +1972,9 @@ SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) END IF DstMiscData%Vreln_LL = SrcMiscData%Vreln_LL ENDIF -IF (ALLOCATED(SrcMiscData%SegConnct)) THEN - i1_l = LBOUND(SrcMiscData%SegConnct,1) - i1_u = UBOUND(SrcMiscData%SegConnct,1) - i2_l = LBOUND(SrcMiscData%SegConnct,2) - i2_u = UBOUND(SrcMiscData%SegConnct,2) - IF (.NOT. ALLOCATED(DstMiscData%SegConnct)) THEN - ALLOCATE(DstMiscData%SegConnct(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SegConnct.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SegConnct = SrcMiscData%SegConnct -ENDIF -IF (ALLOCATED(SrcMiscData%SegPoints)) THEN - i1_l = LBOUND(SrcMiscData%SegPoints,1) - i1_u = UBOUND(SrcMiscData%SegPoints,1) - i2_l = LBOUND(SrcMiscData%SegPoints,2) - i2_u = UBOUND(SrcMiscData%SegPoints,2) - IF (.NOT. ALLOCATED(DstMiscData%SegPoints)) THEN - ALLOCATE(DstMiscData%SegPoints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SegPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SegPoints = SrcMiscData%SegPoints -ENDIF -IF (ALLOCATED(SrcMiscData%SegGamma)) THEN - i1_l = LBOUND(SrcMiscData%SegGamma,1) - i1_u = UBOUND(SrcMiscData%SegGamma,1) - IF (.NOT. ALLOCATED(DstMiscData%SegGamma)) THEN - ALLOCATE(DstMiscData%SegGamma(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SegGamma.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SegGamma = SrcMiscData%SegGamma -ENDIF -IF (ALLOCATED(SrcMiscData%SegEpsilon)) THEN - i1_l = LBOUND(SrcMiscData%SegEpsilon,1) - i1_u = UBOUND(SrcMiscData%SegEpsilon,1) - IF (.NOT. ALLOCATED(DstMiscData%SegEpsilon)) THEN - ALLOCATE(DstMiscData%SegEpsilon(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%SegEpsilon.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%SegEpsilon = SrcMiscData%SegEpsilon -ENDIF + CALL FVW_Copyt_sgmt( SrcMiscData%Sgmt, DstMiscData%Sgmt, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN IF (ALLOCATED(SrcMiscData%CPs)) THEN i1_l = LBOUND(SrcMiscData%CPs,1) i1_u = UBOUND(SrcMiscData%CPs,1) @@ -1566,6 +2215,22 @@ SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) END IF DstMiscData%BN_Cy = SrcMiscData%BN_Cy ENDIF +IF (ALLOCATED(SrcMiscData%GridOutputs)) THEN + i1_l = LBOUND(SrcMiscData%GridOutputs,1) + i1_u = UBOUND(SrcMiscData%GridOutputs,1) + IF (.NOT. ALLOCATED(DstMiscData%GridOutputs)) THEN + ALLOCATE(DstMiscData%GridOutputs(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%GridOutputs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMiscData%GridOutputs,1), UBOUND(SrcMiscData%GridOutputs,1) + CALL FVW_Copygridouttype( SrcMiscData%GridOutputs(i1), DstMiscData%GridOutputs(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF IF (ALLOCATED(SrcMiscData%u_UA)) THEN i1_l = LBOUND(SrcMiscData%u_UA,1) i1_u = UBOUND(SrcMiscData%u_UA,1) @@ -1698,18 +2363,7 @@ SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg ) IF (ALLOCATED(MiscData%Vreln_LL)) THEN DEALLOCATE(MiscData%Vreln_LL) ENDIF -IF (ALLOCATED(MiscData%SegConnct)) THEN - DEALLOCATE(MiscData%SegConnct) -ENDIF -IF (ALLOCATED(MiscData%SegPoints)) THEN - DEALLOCATE(MiscData%SegPoints) -ENDIF -IF (ALLOCATED(MiscData%SegGamma)) THEN - DEALLOCATE(MiscData%SegGamma) -ENDIF -IF (ALLOCATED(MiscData%SegEpsilon)) THEN - DEALLOCATE(MiscData%SegEpsilon) -ENDIF + CALL FVW_Destroyt_sgmt( MiscData%Sgmt, ErrStat, ErrMsg ) IF (ALLOCATED(MiscData%CPs)) THEN DEALLOCATE(MiscData%CPs) ENDIF @@ -1761,6 +2415,12 @@ SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg ) IF (ALLOCATED(MiscData%BN_Cy)) THEN DEALLOCATE(MiscData%BN_Cy) ENDIF +IF (ALLOCATED(MiscData%GridOutputs)) THEN +DO i1 = LBOUND(MiscData%GridOutputs,1), UBOUND(MiscData%GridOutputs,1) + CALL FVW_Destroygridouttype( MiscData%GridOutputs(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(MiscData%GridOutputs) +ENDIF IF (ALLOCATED(MiscData%u_UA)) THEN DO i3 = LBOUND(MiscData%u_UA,3), UBOUND(MiscData%u_UA,3) DO i2 = LBOUND(MiscData%u_UA,2), UBOUND(MiscData%u_UA,2) @@ -1965,26 +2625,24 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*2 ! Vreln_LL upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%Vreln_LL) ! Vreln_LL END IF - Int_BufSz = Int_BufSz + 1 ! SegConnct allocated yes/no - IF ( ALLOCATED(InData%SegConnct) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SegConnct upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%SegConnct) ! SegConnct - END IF - Int_BufSz = Int_BufSz + 1 ! SegPoints allocated yes/no - IF ( ALLOCATED(InData%SegPoints) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! SegPoints upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SegPoints) ! SegPoints - END IF - Int_BufSz = Int_BufSz + 1 ! SegGamma allocated yes/no - IF ( ALLOCATED(InData%SegGamma) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SegGamma upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SegGamma) ! SegGamma - END IF - Int_BufSz = Int_BufSz + 1 ! SegEpsilon allocated yes/no - IF ( ALLOCATED(InData%SegEpsilon) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SegEpsilon upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%SegEpsilon) ! SegEpsilon - END IF + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! Sgmt: size of buffers for each call to pack subtype + CALL FVW_Packt_sgmt( Re_Buf, Db_Buf, Int_Buf, InData%Sgmt, ErrStat2, ErrMsg2, .TRUE. ) ! Sgmt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Sgmt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Sgmt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Sgmt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 1 ! CPs allocated yes/no IF ( ALLOCATED(InData%CPs) ) THEN Int_BufSz = Int_BufSz + 2*2 ! CPs upper/lower bounds for each dimension @@ -2070,10 +2728,32 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*2 ! BN_Cy upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%BN_Cy) ! BN_Cy END IF + Int_BufSz = Int_BufSz + 1 ! GridOutputs allocated yes/no + IF ( ALLOCATED(InData%GridOutputs) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! GridOutputs upper/lower bounds for each dimension + DO i1 = LBOUND(InData%GridOutputs,1), UBOUND(InData%GridOutputs,1) + Int_BufSz = Int_BufSz + 3 ! GridOutputs: size of buffers for each call to pack subtype + CALL FVW_Packgridouttype( Re_Buf, Db_Buf, Int_Buf, InData%GridOutputs(i1), ErrStat2, ErrMsg2, .TRUE. ) ! GridOutputs + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! GridOutputs + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! GridOutputs + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! GridOutputs + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! u_UA allocated yes/no IF ( ALLOCATED(InData%u_UA) ) THEN Int_BufSz = Int_BufSz + 2*3 ! u_UA upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i3 = LBOUND(InData%u_UA,3), UBOUND(InData%u_UA,3) DO i2 = LBOUND(InData%u_UA,2), UBOUND(InData%u_UA,2) DO i1 = LBOUND(InData%u_UA,1), UBOUND(InData%u_UA,1) @@ -2900,76 +3580,34 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%SegConnct) ) 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%SegConnct,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SegConnct,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SegConnct,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SegConnct,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SegConnct,2), UBOUND(InData%SegConnct,2) - DO i1 = LBOUND(InData%SegConnct,1), UBOUND(InData%SegConnct,1) - IntKiBuf(Int_Xferred) = InData%SegConnct(i1,i2) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SegPoints) ) 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%SegPoints,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SegPoints,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SegPoints,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SegPoints,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%SegPoints,2), UBOUND(InData%SegPoints,2) - DO i1 = LBOUND(InData%SegPoints,1), UBOUND(InData%SegPoints,1) - ReKiBuf(Re_Xferred) = InData%SegPoints(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SegGamma) ) 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%SegGamma,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SegGamma,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SegGamma,1), UBOUND(InData%SegGamma,1) - ReKiBuf(Re_Xferred) = InData%SegGamma(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SegEpsilon) ) 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%SegEpsilon,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SegEpsilon,1) - Int_Xferred = Int_Xferred + 2 + CALL FVW_Packt_sgmt( Re_Buf, Db_Buf, Int_Buf, InData%Sgmt, ErrStat2, ErrMsg2, OnlySize ) ! Sgmt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - DO i1 = LBOUND(InData%SegEpsilon,1), UBOUND(InData%SegEpsilon,1) - ReKiBuf(Re_Xferred) = InData%SegEpsilon(i1) - Re_Xferred = Re_Xferred + 1 - END DO - END IF + 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 IF ( .NOT. ALLOCATED(InData%CPs) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3315,6 +3953,47 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si END DO END DO END IF + IF ( .NOT. ALLOCATED(InData%GridOutputs) ) 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%GridOutputs,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GridOutputs,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%GridOutputs,1), UBOUND(InData%GridOutputs,1) + CALL FVW_Packgridouttype( Re_Buf, Db_Buf, Int_Buf, InData%GridOutputs(i1), ErrStat2, ErrMsg2, OnlySize ) ! GridOutputs + 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%u_UA) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4294,88 +4973,46 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SegConnct 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%SegConnct)) DEALLOCATE(OutData%SegConnct) - ALLOCATE(OutData%SegConnct(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SegConnct.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SegConnct,2), UBOUND(OutData%SegConnct,2) - DO i1 = LBOUND(OutData%SegConnct,1), UBOUND(OutData%SegConnct,1) - OutData%SegConnct(i1,i2) = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SegPoints 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%SegPoints)) DEALLOCATE(OutData%SegPoints) - ALLOCATE(OutData%SegPoints(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SegPoints.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%SegPoints,2), UBOUND(OutData%SegPoints,2) - DO i1 = LBOUND(OutData%SegPoints,1), UBOUND(OutData%SegPoints,1) - OutData%SegPoints(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SegGamma 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%SegGamma)) DEALLOCATE(OutData%SegGamma) - ALLOCATE(OutData%SegGamma(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SegGamma.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SegGamma,1), UBOUND(OutData%SegGamma,1) - OutData%SegGamma(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SegEpsilon 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%SegEpsilon)) DEALLOCATE(OutData%SegEpsilon) - ALLOCATE(OutData%SegEpsilon(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SegEpsilon.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SegEpsilon,1), UBOUND(OutData%SegEpsilon,1) - OutData%SegEpsilon(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - 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 FVW_Unpackt_sgmt( Re_Buf, Db_Buf, Int_Buf, OutData%Sgmt, ErrStat2, ErrMsg2 ) ! Sgmt + 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) IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CPs not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4772,6 +5409,62 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg END DO END DO END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GridOutputs 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%GridOutputs)) DEALLOCATE(OutData%GridOutputs) + ALLOCATE(OutData%GridOutputs(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GridOutputs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%GridOutputs,1), UBOUND(OutData%GridOutputs,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 FVW_Unpackgridouttype( Re_Buf, Db_Buf, Int_Buf, OutData%GridOutputs(i1), ErrStat2, ErrMsg2 ) ! GridOutputs + 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 ! u_UA not allocated Int_Xferred = Int_Xferred + 1 ELSE diff --git a/modules/aerodyn/src/FVW_VTK.f90 b/modules/aerodyn/src/FVW_VTK.f90 index 8770d43b83..55a8aaadf2 100644 --- a/modules/aerodyn/src/FVW_VTK.f90 +++ b/modules/aerodyn/src/FVW_VTK.f90 @@ -107,7 +107,7 @@ logical function vtk_new_ascii_file(filename,label,mvtk) write(mvtk%vtk_unit)'BINARY'//NL else write(mvtk%vtk_unit,'(a)') '# vtk DataFile Version 2.0' - write(mvtk%vtk_unit,'(a)') label + write(mvtk%vtk_unit,'(a)') trim(label) write(mvtk%vtk_unit,'(a)') 'ASCII' write(mvtk%vtk_unit,'(a)') ' ' endif @@ -264,6 +264,32 @@ subroutine vtk_dataset_rectilinear(v1,v2,v3,mvtk) endif end subroutine + subroutine vtk_dataset_structured_points(x0,dx,n,mvtk) + real(ReKi), dimension(3), intent(in) :: x0 !< origin + real(ReKi), dimension(3), intent(in) :: dx !< spacing + integer, dimension(3), intent(in) :: n !< length + type(FVW_VTK_Misc),intent(inout) :: mvtk + + if ( mvtk%bFileOpen ) then + mvtk%nPoints=n(1)*n(2)*n(3) + if (mvtk%bBinary) then + write(mvtk%vtk_unit) 'DATASET STRUCTURED_POINTS'//NL + write(mvtk%buffer,'(A,I0,A,I0,A,I0)') 'DIMENSIONS ',n(1),' ',n(2),' ',n(3) + write(mvtk%vtk_unit) trim(mvtk%buffer)//NL + write(mvtk%buffer,'(A,3F16.8)') 'ORIGIN ', x0 + write(mvtk%vtk_unit) trim(mvtk%buffer)//NL + write(mvtk%buffer,'(A,3F16.8)') 'SPACING ', dx + write(mvtk%vtk_unit) trim(mvtk%buffer)//NL + else + write(mvtk%vtk_unit,'(A)') 'DATASET STRUCTURED_POINTS' + write(mvtk%vtk_unit,'(A,I0,A,I0,A,I0)') 'DIMENSIONS ', n(1),' ',n(2),' ',n(3) + write(mvtk%vtk_unit,'(A,3F16.8,A)') 'ORIGIN ',x0 + write(mvtk%vtk_unit,'(A,3F16.8,A)') 'SPACING ',dx + endif + endif + end subroutine + + ! ------------------------------------------------------------------------- ! --- STRUCTURED GRID (Points dumped without for loop since memory is in proper order) ! ------------------------------------------------------------------------- diff --git a/modules/aerodyn/src/FVW_VortexTools.f90 b/modules/aerodyn/src/FVW_VortexTools.f90 index dc97783624..1fa8856f03 100644 --- a/modules/aerodyn/src/FVW_VortexTools.f90 +++ b/modules/aerodyn/src/FVW_VortexTools.f90 @@ -42,6 +42,7 @@ module FVW_VortexTools type(T_Part) :: Part !< Storage for all particles integer :: iStep =-1 !< Time step at which the tree was built logical :: bGrown =.false. !< Is the tree build + real(ReKi) :: DistanceDirect type(T_Node) :: Root !< Contains the chained-list of nodes end type T_Tree @@ -50,6 +51,37 @@ module FVW_VortexTools end interface contains + !> Flatten/ravel a 3D grid of vectors (each of size n) + subroutine FlattenValues(GridValues, FlatValues, iHeadP) + real(Reki), dimension(:,:,:,:), intent(in ) :: GridValues !< Grid values n x nx x ny x nz + real(ReKi), dimension(:,:), intent( out) :: FlatValues !< Flat values n x (nx x ny x nz) + integer(IntKi), intent(inout) :: iHeadP !< Index indicating where to start in Values + integer(IntKi) :: i,j,k + do k = 1, size(GridValues,4) + do j = 1, size(GridValues,3) + do i = 1, size(GridValues,2) + FlatValues(:,iHeadP) = GridValues(:, i, j, k) + iHeadP=iHeadP+1 + enddo + enddo + enddo + endsubroutine FlattenValues + + !> Flatten a 3D grid of vectors (each of size n) + subroutine DeflateValues(FlatValues, GridValues, iHeadP) + real(ReKi), dimension(:,:), intent(in ) :: FlatValues !< Flat values n x (nx x ny x nz) + real(Reki), dimension(:,:,:,:), intent( out) :: GridValues !< Grid values n x nx x ny x nz + integer(IntKi), intent(inout) :: iHeadP !< Index indicating where to start in Values + integer(IntKi) :: i,j,k + do k = 1, size(GridValues,4) + do j = 1, size(GridValues,3) + do i = 1, size(GridValues,2) + GridValues(:, i, j, k) = FlatValues(:,iHeadP) + iHeadP=iHeadP+1 + enddo + enddo + enddo + endsubroutine DeflateValues subroutine VecToLattice(PointVectors, iDepthStart, LatticeVectors, iHeadP) real(Reki), dimension(:,:), intent(in ) :: PointVectors !< nVal x n @@ -365,7 +397,7 @@ subroutine grow_tree(Tree, PartP, PartAlpha, PartRegFunction, PartRegParam, iSte node%branches=>null() node%leaves=>null() node%nPart=Part%n - ! --- Calling grow function on subbrances + ! --- Calling grow function on subbranches call grow_tree_parallel(Tree%root, Tree%Part) ! call grow_tree_rec(Tree%root, Tree%Part) endif diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 2cbe6cd786..ffbe3f8c78 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -5128,9 +5128,11 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, H call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%HubMotion, trim(p_FAST%VTK_OutFileRoot)//'.AD_HubMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%TowerMotion, trim(p_FAST%VTK_OutFileRoot)//'.AD_TowerMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) - DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, AD%y%BladeLoad(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_Blade'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, AD%Input(1)%BladeMotion(k) ) - END DO + if (allocated(AD%y%BladeLoad)) then + DO K=1,NumBl + call MeshWrVTK(p_FAST%TurbinePos, AD%y%BladeLoad(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_Blade'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, AD%Input(1)%BladeMotion(k) ) + END DO + endif call MeshWrVTK(p_FAST%TurbinePos, AD%y%TowerLoad, trim(p_FAST%VTK_OutFileRoot)//'.AD_Tower', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, AD%Input(1)%TowerMotion ) end if From 4f0661164d0dc4d13627b5fb4c953f3d4d5de52c Mon Sep 17 00:00:00 2001 From: Kelsey Shaler Date: Fri, 4 Dec 2020 11:07:45 -0700 Subject: [PATCH 03/27] Added RK4 option for OLAF --- modules/aerodyn/src/.FVW.f90.swp | Bin 0 -> 16384 bytes modules/aerodyn/src/FVW.f90 | 248 ++++++++++++++++++++++++++++++- modules/aerodyn/src/FVW_Subs.f90 | 2 +- 3 files changed, 246 insertions(+), 4 deletions(-) create mode 100644 modules/aerodyn/src/.FVW.f90.swp diff --git a/modules/aerodyn/src/.FVW.f90.swp b/modules/aerodyn/src/.FVW.f90.swp new file mode 100644 index 0000000000000000000000000000000000000000..3114d7555d467d275aaaad29b8ef01e47470177b GIT binary patch literal 16384 zcmeHOON=8&87>|nz!HLjA|jE)@6B$;-gU-16VNKNkHkAW6HGi0GB3DbwcTaAXWQMT zAG0%i*p(0`B*Za11LyANE`y35kx%1VG$=#Bp%_B1Og->f$y)bYPZ|Y2(1<& zqHg7zZr5M+zpCo5`l~kWQ`?OdIz9U#f#-cfbp0Q+zIgWD+PC{cTnhV^D+8t+`bhWw zL+OTiRWq!uHS5c*9qEL%fp5pI3~QDQeEYzwg+ZsbyuCBqec+U7RlExi6dt%a9=J{1 zKR>5t);&i{^!_`xZVuamOW}dS1BC|)4-_6KJWzO`@Ic{#!UO*o9*Bl_iEGgGtyJ)=$38e$U+3trYWf4Z{Pi6D6-{5z z<)^g)#*UXY{hX$MDo6i^reD8G?qjr^B1-DF&sbM(Jz z`h&Xtk8_M3gQj25^xx&^&uRJ@O+R_dxcuL1dR^1IIl4AS9Mkl# z<>C_GSj;7#iR%NBxj?uR&$!~MU>zh1jth*yB$ z0zU+v0=@uz8W;e(Knr*TSO87{cLPU&m)HvR0zLq| ze47xz0Ima9ff_Ii90!g8UwMxZ%YXpBdqjwj0k;E>y<3P|fzP~4h&kZL?-arZ1n|{c zg_r@p^9~`Jz;)z&p8&2SxBMjVOC*KYfIES2BHw-pI0^h5zW5x#K6#M+a>zqOju*+E z49X2Jdc>)qKtBr$wB;>z`o1Zk5(=D%ym-)-0d@U=qP`@_Rl1HV1uAy>R$z4^uv-d( zm9W>8o?;1RNx{6~R-#A_hJIiL2PA_4%my+Ht)60Yh)!U$5m}MpGsz|dH4e$|D((EC z46MlUJ=U&7O}}Hgv}Xm5)y6;E;KGs0Cn{C^o_JUpFDeuHaRg&hQ__m1vuxbR0&==s zz-m(M9Dg=0wpM*_ifK~>P8FwkX@RM@LoAIBhO&%*iPCDI$JXL#7)P5Z8W}h#Mb|V| zK}yn2b+iLEj^#R6lrJfOE1bk0Q~$=_r4rh<4^(&c+*ne_x8at4yRfj<~G z{>)93T%NBG4}`6uZAJ2;6Lxqk$#R9Y!DMiuhT}n#UO!5max=YOp35qrgok4Ebe3)-QcGh+`i`~ zQwLt)F@`AG=dMj>th6fv0#ehG*)U<*6w?mI^~#tQ9$@$mI3Pk~NM-Y31(G};bn9ALQz?;=?K6cq_9gKggZE-Z;>dTE*>ZzPtQhgvl316t~b^Y>!+A%4YY+`?9IYHNVTpF6*QuPV$WC{*DEDG8xd#sP7R(fvMaSfsvzB_M|~A_NKe4!l%6>RVn93!NPY zyyPQ-Q0NReLSbhJF6W^LoM9{Z#0@~tL3@b zQ!TYFGrLk|T=IOiWyi7AwyH}KD|4@(Y;yWmNYb^2*j7<_$GXJxCRroU169>gd(kDm zqEwWo!?^7_9ms%QqaBP2hAQaf>5E{PEN)YqFL^3X7&L?WW*@<3}47_7zdK+73EktXg9&OWugvV^j`IX~F8w z=3=Yqv^g;o$-i%B(U@sG*$AUyd56#;RzTd1rf`)DS7okraUG?+kOe*hn2(TW>NlI9 zG@UM%rykzOB@FlN9dHk%q-{Tl5R;0TfT+fx-iY2MP}q9w zR=~mi26q0tNQBz1W#jlu-H!Z6jT|)cU|y!pgxO`Mx?4#zIAXqhXiFP1(pL<8)50#C zui^uVwR&@b{#~7!?&%qIOu@dkeJbtZlt3p95MfHmp>SxayAzaZg3}f1TmRv@xgt<- zzF-ui^XI7E#%3P+HRWCfDQFZ28Kwy%W!6rx(Fw|`M-yu*O3SRgn`OQpIHsGGqjSNPr2Q9t$3(C|2a*!zjH+;pItN;3rbDvieg63wj7O0oOg+ru_TCm+?3bdA8 ztCtAP8D63tN$LzbRu>HFxMU0GrqZ$x>iFNH&9M%6;;^i5?cr`klgVN_j|ChGV5%qQ zeK>qklS1jQb;1aB_$;D2Jnn5^K%SgaGXcfBrdZ{?q>4*~Ll;gvZRzoO!=4O64kfq} zys)&gslyJ9P7;!#Hc#Mn^eBr=3h This is a tight coupling routine for computing derivatives of continuous states. subroutine FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) +!.................................................................................................................................. real(DbKi), intent(in ) :: t !< Current simulation time in seconds type(FVW_InputType), intent(in ) :: u !< Inputs at t type(FVW_ParameterType), intent(in ) :: p !< Parameters @@ -769,7 +770,7 @@ subroutine FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSt else VmeanFW=VmeanNW ! Since we convect the first FW point, we need a reasonable velocity there - ! NOTE: mostly needed for sub-cycling and when no NW + ! NOTE: mostly needed for sub-cycling and when no FW m%Vind_FW(1, 1:FWnSpan+1, 1, 1:p%nWings) = VmeanFW(1) m%Vind_FW(2, 1:FWnSpan+1, 1, 1:p%nWings) = VmeanFW(2) m%Vind_FW(3, 1:FWnSpan+1, 1, 1:p%nWings) = VmeanFW(3) @@ -879,6 +880,247 @@ logical function Failed() end function Failed end subroutine FVW_Euler1 !---------------------------------------------------------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine implements the fourth-order Runge-Kutta Method (RK4) for +!numerically integrating ordinary differential equations: +!! +!! Let f(t, x) = dxdt denote the time (t) derivative of the continuous states +!(x). +!! Define constants k1, k2, k3, and k4 as +!! k1 = dt * f(t , x_t ) +!! k2 = dt * f(t + dt/2 , x_t + k1/2 ) +!! k3 = dt * f(t + dt/2 , x_t + k2/2 ), and +!! k4 = dt * f(t + dt , x_t + k3 ). +!! Then the continuous states at t = t + dt are +!! x_(t+dt) = x_t + k1/6 + k2/3 + k3/3 + k4/6 + O(dt^5) +!! +!! For details, see: +!! Press, W. H.; Flannery, B. P.; Teukolsky, S. A.; and Vetterling, W. T. +!"Runge-Kutta Method" and "Adaptive Step Size Control for +!! Runge-Kutta." Sections 16.1 and 16.2 in Numerical Recipes in FORTRAN: The +!Art of Scientific Computing, 2nd ed. Cambridge, England: +!! Cambridge University Press, pp. 704-716, 1992. +SUBROUTINE FVW_RK4( 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 !< time step number + TYPE(FVW_InputType), INTENT(INOUT) :: u(:) !< Inputs at t (out only for mesh record-keeping in ExtrapInterp routine) + REAL(DbKi), INTENT(IN ) :: utimes(:) !< times of input + TYPE(FVW_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(FVW_ContinuousStateType), INTENT(INOUT) :: x !< Continuous states at t on input at t + dt on output + TYPE(FVW_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t + TYPE(FVW_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t (possibly a guess) + TYPE(FVW_OtherStateType), INTENT(INOUT) :: OtherState !< Other states + TYPE(FVW_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(FVW_ContinuousStateType) :: dxdt ! time derivatives of continuous states + real(ReKi) :: dt + TYPE(FVW_ContinuousStateType) :: k1 ! RK4 constant; see above + TYPE(FVW_ContinuousStateType) :: k2 ! RK4 constant; see above + TYPE(FVW_ContinuousStateType) :: k3 ! RK4 constant; see above + TYPE(FVW_ContinuousStateType) :: k4 ! RK4 constant; see above + TYPE(FVW_ContinuousStateType) :: x_tmp ! Holds temporary modification to x + TYPE(FVW_InputType) :: u_interp ! interpolated value of inputs + + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message (ErrMsg) + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + + dt = real(p%DTaero,ReKi) ! NOTE: this is DTaero not DTfvw since we integrate at each sub time step + + if (m%ComputeWakeInduced) then + CALL FVW_CopyContState( x, k1, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + CALL FVW_CopyContState( x, k2, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + CALL FVW_CopyContState( x, k3, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + CALL FVW_CopyContState( x, k4, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + CALL FVW_CopyContState( x, x_tmp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + CALL FVW_CopyContState( x, x_tmp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + + CALL FVW_CopyInput( u(1), u_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + ! interpolate u to find u_interp = u(t) + CALL FVW_Input_ExtrapInterp( u(1:size(utimes)),utimes(:),u_interp, t, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + ! find dxdt at t + CALL FVW_CalcContStateDeriv( t, u_interp, p, x, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + m%dxdt_NW = dxdt%r_NW + m%dxdt_FW = dxdt%r_FW + end if + + if (DEV_VERSION) then + ! Additional checks + if (any(m%dxdt_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings)<-999)) then + print*,'FVW_RK4: Attempting to convect NW with a wrong velocity' + STOP + endif + if ( m%nFW>0) then + if (any(m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings)<-999)) then + call print_x_NW_FW(p, m, x, 'STP') + print*,'FVW_RK4: Attempting to convect FW with a wrong velocity' + STOP + endif + endif + endif + + k1%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = dt * m%dxdt_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + if ( m%nFW>0) then + k1%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = dt * m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + endif + + x_tmp%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + 0.5 * k1%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + if ( m%nFW>0) then + x_tmp%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + 0.5 * k1%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + endif + + ! interpolate u to find u_interp = u(t + dt/2) + CALL FVW_Input_ExtrapInterp(u(1:size(utimes)),utimes(:),u_interp, t+0.5*dt, ErrStat2, ErrMsg2) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + ! find dxdt at t + dt/2 + CALL FVW_CalcContStateDeriv( t + 0.5*dt, u_interp, p, x_tmp, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + m%dxdt_NW = dxdt%r_NW + m%dxdt_FW = dxdt%r_FW + + k2%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = dt * m%dxdt_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + if ( m%nFW>0) then + k2%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = dt * m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + endif + + x_tmp%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + 0.5 * k2%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + if ( m%nFW>0) then + x_tmp%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + 0.5 * k2%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + endif + + ! find dxdt at t + dt/2 + CALL FVW_CalcContStateDeriv( t + 0.5*dt, u_interp, p, x_tmp, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + m%dxdt_NW = dxdt%r_NW + m%dxdt_FW = dxdt%r_FW + + k3%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = dt * m%dxdt_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + if ( m%nFW>0) then + k3%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = dt * m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + endif + + x_tmp%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + k3%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + if ( m%nFW>0) then + x_tmp%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + k3%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + endif + + ! interpolate u to find u_interp = u(t + dt) + CALL FVW_Input_ExtrapInterp(u(1:size(utimes)),utimes(:),u_interp, t + dt, ErrStat2, ErrMsg2) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + + ! find dxdt at t + dt + CALL FVW_CalcContStateDeriv( t + dt, u_interp, p, x_tmp, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + m%dxdt_NW = dxdt%r_NW + m%dxdt_FW = dxdt%r_FW + + k4%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = dt * m%dxdt_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + if ( m%nFW>0) then + k4%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = dt * m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + endif + + !update positions + x%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + ( k1%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + 2. * k2%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + 2. * k3%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + k4%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) ) / 6. + if ( m%nFW>0) then + x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + ( k1%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + 2. * k2%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + 2. * k3%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + k4%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) ) / 6. + endif + + ! clean up local variables: + CALL ExitThisRoutine( ) + +CONTAINS + !............................................................................................................................... + SUBROUTINE ExitThisRoutine() + ! This subroutine destroys all the local variables + !............................................................................................................................... + + ! local variables + INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) + + + CALL FVW_DestroyContState( dxdt, ErrStat3, ErrMsg3 ) + CALL FVW_DestroyContState( k1, ErrStat3, ErrMsg3 ) + CALL FVW_DestroyContState( k2, ErrStat3, ErrMsg3 ) + CALL FVW_DestroyContState( k3, ErrStat3, ErrMsg3 ) + CALL FVW_DestroyContState( k4, ErrStat3, ErrMsg3 ) + CALL FVW_DestroyContState( x_tmp, ErrStat3, ErrMsg3 ) + + CALL FVW_DestroyInput( u_interp, ErrStat3, ErrMsg3 ) + + END SUBROUTINE ExitThisRoutine + !............................................................................................................................... + SUBROUTINE CheckError(ErrID,Msg) + ! This subroutine sets the error message and level and cleans up if the error + ! is >= AbortErrLev + !............................................................................................................................... + + ! Passed arguments + INTEGER(IntKi), INTENT(IN) :: ErrID ! The error identifier (ErrStat) + CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) + + ! local variables + INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) + + !............................................................................................................................ + ! Set error status/message; + !............................................................................................................................ + + IF ( ErrID /= ErrID_None ) THEN + + IF (ErrStat /= ErrID_None) ErrMsg = TRIM(ErrMsg)//NewLine + ErrMsg = TRIM(ErrMsg)//'FVW_RK4:'//TRIM(Msg) + ErrStat = MAX(ErrStat,ErrID) + + !......................................................................................................................... + ! Clean up if we're going to return on error: close files, deallocate + ! local arrays + !......................................................................................................................... + + IF ( ErrStat >= AbortErrLev ) CALL ExitThisRoutine( ) + + + END IF + + END SUBROUTINE CheckError + +END SUBROUTINE FVW_RK4 !---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/aerodyn/src/FVW_Subs.f90 b/modules/aerodyn/src/FVW_Subs.f90 index a252c098fe..e90061679d 100644 --- a/modules/aerodyn/src/FVW_Subs.f90 +++ b/modules/aerodyn/src/FVW_Subs.f90 @@ -19,7 +19,7 @@ module FVW_SUBS integer(IntKi), parameter :: idABM4 = 3 integer(IntKi), parameter :: idPredictor= 4 integer(IntKi), parameter :: idEuler1 = 5 - integer(IntKi), parameter, dimension(1) :: idIntMethodVALID = (/idEuler1 /) + integer(IntKi), parameter, dimension(2) :: idIntMethodVALID = (/idEuler1, idRK4 /) ! Diffusion method integer(IntKi), parameter :: idDiffusionNone = 0 integer(IntKi), parameter :: idDiffusionCoreSpread = 1 From dc319d0230b6973747e3ac57bd99e89ad69acdf1 Mon Sep 17 00:00:00 2001 From: Kelsey Shaler Date: Fri, 4 Dec 2020 11:08:41 -0700 Subject: [PATCH 04/27] Added RK4 option for OLAF --- .../{.FVW.f90.swp => .nfs000000012f610a3a000079ed} | Bin 1 file changed, 0 insertions(+), 0 deletions(-) rename modules/aerodyn/src/{.FVW.f90.swp => .nfs000000012f610a3a000079ed} (100%) diff --git a/modules/aerodyn/src/.FVW.f90.swp b/modules/aerodyn/src/.nfs000000012f610a3a000079ed similarity index 100% rename from modules/aerodyn/src/.FVW.f90.swp rename to modules/aerodyn/src/.nfs000000012f610a3a000079ed From 83239df16ba8c6e17461cf96c765423d11cc2cd5 Mon Sep 17 00:00:00 2001 From: Kelsey Shaler Date: Fri, 4 Dec 2020 11:12:23 -0700 Subject: [PATCH 05/27] Added RK4 option for OLAF --- modules/aerodyn/src/FVW.f90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index 4f06b78640..ced8e3c2e5 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -994,7 +994,7 @@ SUBROUTINE FVW_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg x_tmp%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + 0.5 * k1%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) if ( m%nFW>0) then - x_tmp%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + 0.5 * k1%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + x_tmp%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + 0.5 * k1%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) endif ! interpolate u to find u_interp = u(t + dt/2) @@ -1011,12 +1011,12 @@ SUBROUTINE FVW_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg k2%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = dt * m%dxdt_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) if ( m%nFW>0) then - k2%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = dt * m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + k2%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = dt * m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) endif x_tmp%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + 0.5 * k2%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) if ( m%nFW>0) then - x_tmp%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + 0.5 * k2%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + x_tmp%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + 0.5 * k2%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) endif ! find dxdt at t + dt/2 @@ -1028,12 +1028,12 @@ SUBROUTINE FVW_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg k3%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = dt * m%dxdt_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) if ( m%nFW>0) then - k3%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = dt * m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + k3%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = dt * m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) endif x_tmp%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + k3%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) if ( m%nFW>0) then - x_tmp%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + k3%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + x_tmp%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + k3%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) endif ! interpolate u to find u_interp = u(t + dt) @@ -1051,7 +1051,7 @@ SUBROUTINE FVW_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg k4%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = dt * m%dxdt_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) if ( m%nFW>0) then - k4%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = dt * m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + k4%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = dt * m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) endif !update positions From b1d30acf2f669a938013c24ec9aa76db73957a87 Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Mon, 14 Dec 2020 18:25:54 -0700 Subject: [PATCH 06/27] OLAF: 3d reg. param stored for panels as continuous state --- modules/aerodyn/src/FVW.f90 | 105 +- modules/aerodyn/src/FVW_IO.f90 | 6 +- modules/aerodyn/src/FVW_Registry.txt | 38 +- modules/aerodyn/src/FVW_Subs.f90 | 57 +- modules/aerodyn/src/FVW_Tests.f90 | 19 +- modules/aerodyn/src/FVW_Types.f90 | 6872 ++++++++++++----------- modules/aerodyn/src/FVW_VortexTools.f90 | 22 +- 7 files changed, 3647 insertions(+), 3472 deletions(-) diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index c5dffa1f3e..983de70f6c 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -133,7 +133,7 @@ subroutine FVW_Init(AFInfo, InitInp, u, p, x, xd, z, OtherState, y, m, Interval, ! Panelling wings based on initial input mesh provided ! This mesh is now a cousin of the BladeMotion mesh from AD. CALL Wings_Panelling (u%WingsMesh, p, m, ErrStat2, ErrMsg2); if(Failed()) return - CALL FVW_InitRegularization(p, m, ErrStat2, ErrMsg2); if(Failed()) return + CALL FVW_InitRegularization(x, p, m, ErrStat2, ErrMsg2); if(Failed()) return CALL FVW_ToString(p, m) ! Print to screen ! Mapping NW and FW (purely for esthetics, and maybe wind) ! TODO, just points @@ -219,8 +219,6 @@ subroutine FVW_InitMiscVars( p, m, ErrStat, ErrMsg ) call AllocAry( m%Vwnd_FW , 3 , FWnSpan+1 ,p%nFWMax+1, p%nWings, 'Wind on FW ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Vwnd_FW= -999_ReKi; call AllocAry( m%Vind_NW , 3 , p%nSpan+1 ,p%nNWMax+1, p%nWings, 'Vind on NW ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Vind_NW= -999_ReKi; call AllocAry( m%Vind_FW , 3 , FWnSpan+1 ,p%nFWMax+1, p%nWings, 'Vind on FW ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Vind_FW= -999_ReKi; - call AllocAry( m%dxdt_NW , 3 , p%nSpan+1 , p%nNWMax+1, p%nWings, 'NW dxdt' , ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%dxdt_NW = -999999_ReKi; - call AllocAry( m%dxdt_FW , 3 , FWnSpan+1 , p%nFWMax+1, p%nWings, 'FW dxdt' , ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%dxdt_FW = -999999_ReKi; ! Variables for optimizing outputs at blade nodes call AllocAry( m%BN_UrelWind_s, 3, p%nSpan+1 , p%nWings, 'Relative wind in section coordinates', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%BN_UrelWind_s= -999999_ReKi; call AllocAry( m%BN_AxInd , p%nSpan+1 , p%nWings, 'Axial induction', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%BN_AxInd = -999999_ReKi; @@ -239,6 +237,12 @@ subroutine FVW_InitMiscVars( p, m, ErrStat, ErrMsg ) call AllocAry( m%BN_Cy , p%nSpan+1 , p%nWings, 'Coefficient tangential (to plane)', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%BN_Cy = -999999_ReKi; + ! dxdt, to avoid realloc all the time, and storage for subcycling + call AllocAry( m%dxdt%r_NW , 3 , p%nSpan+1 , p%nNWMax+1, p%nWings, 'r NW dxdt' , ErrStat2, ErrMsg2);call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%dxdt%r_NW = -999999_ReKi; + call AllocAry( m%dxdt%r_FW , 3 , FWnSpan+1 , p%nFWMax+1, p%nWings, 'r FW dxdt' , ErrStat2, ErrMsg2);call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%dxdt%r_FW = -999999_ReKi; + call AllocAry( m%dxdt%Eps_NW, 3 , p%nSpan ,p%nNWMax , p%nWings, 'Eps NW dxdt', ErrStat2, ErrMsg2);call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%dxdt%Eps_NW = -999999_ReKi; + call AllocAry( m%dxdt%Eps_FW, 3 , FWnSpan ,p%nFWMax , p%nWings, 'Eps FW dxdt', ErrStat2, ErrMsg2);call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%dxdt%Eps_FW = -999999_ReKi; + ! Wind request points nMax = 0 nMax = nMax + p%nSpan * p%nWings ! Lifting line Control Points @@ -310,21 +314,18 @@ subroutine FVW_InitStates( x, p, ErrStat, ErrMsg ) call AllocAry( x%Gamma_NW, p%nSpan , p%nNWMax , p%nWings, 'NW Panels Circulation', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,'FVW_InitStates' ); call AllocAry( x%Gamma_FW, FWnSpan , p%nFWMax , p%nWings, 'FW Panels Circulation', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,'FVW_InitStates' ); + call AllocAry( x%Eps_NW , 3, p%nSpan , p%nNWMax , p%nWings, 'NW Panels Reg Param' , ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,'FVW_InitStates' ); + call AllocAry( x%Eps_FW , 3, FWnSpan , p%nFWMax , p%nWings, 'FW Panels Reg Param' , ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,'FVW_InitStates' ); ! set x%r_NW and x%r_FW to (0,0,0) so that InflowWind can shortcut the calculations call AllocAry( x%r_NW , 3, p%nSpan+1 , p%nNWMax+1, p%nWings, 'NW Panels Points' , ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,'FVW_InitStates' ); call AllocAry( x%r_FW , 3, FWnSpan+1 , p%nFWMax+1, p%nWings, 'FW Panels Points' , ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,'FVW_InitStates' ); - !if (DEV_VERSION) then - ! x%r_NW = -9999999_ReKi; - ! x%r_FW = -9999999_ReKi; - ! x%Gamma_NW = -999999_ReKi; - ! x%Gamma_FW = -999999_ReKi; - !else + if (ErrStat >= AbortErrLev) return x%r_NW = 0.0_ReKi x%r_FW = 0.0_ReKi x%Gamma_NW = 0.0_ReKi ! First call of calcoutput, states might not be set x%Gamma_FW = 0.0_ReKi ! NOTE, these values might be mapped from z%Gamma_LL at init - !endif - if (ErrStat >= AbortErrLev) return + x%Eps_NW = 0.0_ReKi + x%Eps_FW = 0.0_ReKi end subroutine FVW_InitStates ! ============================================================================== subroutine FVW_InitConstraint( z, p, m, ErrStat, ErrMsg ) @@ -724,7 +725,7 @@ subroutine FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSt type(FVW_ConstraintStateType), intent(in ) :: z !< Constraint states at t type(FVW_OtherStateType), intent(in ) :: OtherState !< Other states at t type(FVW_MiscVarType), intent(inout) :: m !< Misc variables for optimization (not copied in glue code) - type(FVW_ContinuousStateType), intent( out) :: dxdt !< Continuous state derivatives at t + type(FVW_ContinuousStateType), intent(inout) :: dxdt !< Continuous state derivatives at t integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local variables @@ -732,14 +733,17 @@ subroutine FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSt character(ErrMsgLen) :: ErrMsg2 ! temporary error message integer(IntKi) :: nFWEff ! Number of farwake panels that are free at current time step integer(IntKi) :: i,j,k + real(ReKi) :: visc_fact, age ! Viscosity factor for diffusion of reg param real(ReKi), dimension(3) :: VmeanFW, VmeanNW ! Mean velocity of the near wake and far wake ErrStat = ErrID_None ErrMsg = "" - call AllocAry( dxdt%r_NW , 3 , p%nSpan+1 ,p%nNWMax+1, p%nWings, 'Wind on NW ', ErrStat2, ErrMsg2); dxdt%r_NW= -999999_ReKi; - call AllocAry( dxdt%r_FW , 3 , FWnSpan+1 ,p%nFWMax+1, p%nWings, 'Wind on FW ', ErrStat2, ErrMsg2); dxdt%r_FW= -999999_ReKi; - if(Failed()) return + if (.not.allocated(dxdt%r_NW)) then + call AllocAry( dxdt%r_NW , 3 , p%nSpan+1 ,p%nNWMax+1, p%nWings, 'Wind on NW ', ErrStat2, ErrMsg2); dxdt%r_NW= -999999_ReKi; + call AllocAry( dxdt%r_FW , 3 , FWnSpan+1 ,p%nFWMax+1, p%nWings, 'Wind on FW ', ErrStat2, ErrMsg2); dxdt%r_FW= -999999_ReKi; + if(Failed()) return + endif ! Only calculate freewake after start time and if on a timestep when it should be calculated. if ((t>= p%FreeWakeStart)) then @@ -806,10 +810,34 @@ subroutine FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSt dxdt%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = m%Vwnd_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) endif ! First NW point does not convect (bound to LL) - dxdt%r_NW(1:3, :, 1:iNWStart-1, :)=0 + dxdt%r_NW(1:3, :, 1:iNWStart-1, :)=0.0_ReKi ! First FW point always convects (even if bound to NW) ! This is done for subcycling !dxdt%r_FW(1:3, :, 1, :)=0 + + ! --- Regularization + if (.not.allocated(dxdt%r_NW)) then + call AllocAry( dxdt%Eps_NW , 3 , p%nSpan ,p%nNWMax , p%nWings, 'Eps NW ', ErrStat2, ErrMsg2); + call AllocAry( dxdt%Eps_FW , 3 , FWnSpan ,p%nFWMax , p%nWings, 'Eps FW ', ErrStat2, ErrMsg2); + if(Failed()) return + endif + if (p%WakeRegMethod==idRegConstant) then + !SegEpsilon=p%WakeRegParam + dxdt%Eps_NW(1:3, :, :, :)=0.0_ReKi + dxdt%Eps_FW(1:3, :, :, :)=0.0_ReKi + + else if (p%WakeRegMethod==idRegStretching) then + ! TODO + else if (p%WakeRegMethod==idRegAge) then + visc_fact = 2.0_ReKi * CoreSpreadAlpha * p%CoreSpreadEddyVisc * p%KinVisc + visc_fact=visc_fact/sqrt(p%WakeRegParam**2 + 2*visc_fact*p%DTfvw) ! Might need to be adjusted + dxdt%Eps_NW(1:3, :, :, :) = visc_fact + dxdt%Eps_FW(1:3, :, :, :) = visc_fact + else + ErrStat = ErrID_Fatal + ErrMsg ='Regularization method not implemented' + endif + contains logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'FVW_CalcContStateDeriv') @@ -830,7 +858,6 @@ subroutine FVW_Euler1( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! local variables - type(FVW_ContinuousStateType) :: dxdt ! time derivatives of continuous states real(ReKi) :: dt integer(IntKi) :: ErrStat2 ! temporary error status of the operation character(ErrMsgLen) :: ErrMsg2 ! temporary error message @@ -841,37 +868,47 @@ subroutine FVW_Euler1( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) dt = real(p%DTaero,ReKi) ! NOTE: this is DTaero not DTfvw since we integrate at each sub time step ! Compute "right hand side" if (m%ComputeWakeInduced) then - CALL FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2); if (Failed()) return - ! Storage of convection velocity, purely for sub-cycling for now - ! Since Euler1 is linear we use partial increments of dtaero0) then + x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + dt * m%dxdt%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + endif + ! Update of Gamma + ! TODO, viscous diffusion, stretching + + ! Update of Reg param + x%Eps_NW(1:3, 1:p%nSpan, 1:m%nNW, 1:p%nWings) = x%Eps_NW(1:3, 1:p%nSpan, 1:m%nNW, 1:p%nWings) + dt * m%dxdt%Eps_NW(1:3, 1:p%nSpan, 1:m%nNW, 1:p%nWings) + if ( m%nFW>0) then + x%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) = x%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) + dt * m%dxdt%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) endif if (DEV_VERSION) then ! Additional checks - if (any(m%dxdt_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings)<-999)) then + if (any(m%dxdt%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings)<-999)) then print*,'FVW_Euler1: Attempting to convect NW with a wrong velocity' STOP endif if ( m%nFW>0) then - if (any(m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings)<-999)) then + if (any(m%dxdt%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings)<-999)) then call print_x_NW_FW(p, m, x, 'STP') print*,'FVW_Euler1: Attempting to convect FW with a wrong velocity' STOP endif endif + if (any(m%dxdt%Eps_NW(1:3, 1:p%nSpan, 1:m%nNW, 1:p%nWings)<-0)) then + print*,'FVW_Euler1: Wrong Epsilon NW' + STOP + endif + if ( m%nFW>0) then + if (any(m%dxdt%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings)<-999)) then + print*,'FVW_Euler1: Wrong Epsilon FW' + STOP + endif + endif endif - - ! Update of positions - x%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + dt * m%dxdt_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) - if ( m%nFW>0) then - x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + dt * m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) - endif - ! Update of Gamma - ! TODO, viscous diffusion, stretching - - call FVW_DestroyContState(dxdt, ErrStat2, ErrMsg2); if(Failed()) return contains logical function Failed() call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'FVW_Euler1') diff --git a/modules/aerodyn/src/FVW_IO.f90 b/modules/aerodyn/src/FVW_IO.f90 index 22b15491a5..078d4c4fd0 100644 --- a/modules/aerodyn/src/FVW_IO.f90 +++ b/modules/aerodyn/src/FVW_IO.f90 @@ -357,11 +357,11 @@ subroutine WrVTK_FVW(p, x, z, m, FileRootName, VTKcount, Twidth, bladeFrame, Hub write(Label,'(A,A)') 'NW.Bld', i2ABC(iW) Filename = TRIM(FileRootName)//'.'//trim(Label)//'.'//Tstr//'.vtk' if (m%FirstCall) then ! Small Hack - At t=0, NW not set, but first NW panel is the LL panel - allocate(dxdt_0(3, size(m%dxdt_NW,2) , m%nNW+1)); dxdt_0=0.0_ReKi + allocate(dxdt_0(3, size(m%dxdt%r_NW,2) , m%nNW+1)); dxdt_0=0.0_ReKi call WrVTK_Lattice(FileName, mvtk, m%r_LL(1:3,:,1:2,iW), m%Gamma_LL(:,iW:iW),dxdt_0, bladeFrame=bladeFrame) deallocate(dxdt_0) else - call WrVTK_Lattice(FileName, mvtk, x%r_NW(1:3,:,1:m%nNW+1,iW), x%Gamma_NW(:,1:m%nNW,iW), m%dxdt_NW(:,:,1:m%nNW+1,iW), bladeFrame=bladeFrame) + call WrVTK_Lattice(FileName, mvtk, x%r_NW(1:3,:,1:m%nNW+1,iW), x%Gamma_NW(:,1:m%nNW,iW), m%dxdt%r_NW(:,:,1:m%nNW+1,iW), bladeFrame=bladeFrame) endif enddo ! --------------------------------------------------------------------------------} @@ -371,7 +371,7 @@ subroutine WrVTK_FVW(p, x, z, m, FileRootName, VTKcount, Twidth, bladeFrame, Hub do iW=1,p%VTKBlades write(Label,'(A,A)') 'FW.Bld', i2ABC(iW) Filename = TRIM(FileRootName)//'.'//trim(Label)//'.'//Tstr//'.vtk' - call WrVTK_Lattice(FileName, mvtk, x%r_FW(1:3,1:FWnSpan+1,1:m%nFW+1,iW), x%Gamma_FW(1:FWnSpan,1:m%nFW,iW),m%dxdt_FW(:,:,1:m%nFW+1,iW), bladeFrame=bladeFrame) + call WrVTK_Lattice(FileName, mvtk, x%r_FW(1:3,1:FWnSpan+1,1:m%nFW+1,iW), x%Gamma_FW(1:FWnSpan,1:m%nFW,iW),m%dxdt%r_FW(:,:,1:m%nFW+1,iW), bladeFrame=bladeFrame) enddo ! --------------------------------------------------------------------------------} ! --- All Segments diff --git a/modules/aerodyn/src/FVW_Registry.txt b/modules/aerodyn/src/FVW_Registry.txt index eca57832cc..e08c21382f 100644 --- a/modules/aerodyn/src/FVW_Registry.txt +++ b/modules/aerodyn/src/FVW_Registry.txt @@ -77,6 +77,18 @@ typedef ^ ^ CHARACTER(1024) typedef ^ ^ CHARACTER(1024) VTK_OutFileBase - - - "Basename for writing VTK files" - typedef ^ ^ IntKi nGridOut - - - "Number of VTK grid to output" - +#.......... ContinuousStateType ...... +# FVW_ContinuousStateType +typedef FVW/FVW ContinuousStateType ReKi Gamma_NW ::: - - "Circulation of the near wake panels ( nSpan x nNW x nWings)" - +typedef ^ ^ ReKi Gamma_FW ::: - - "Circulation of the far wake panels ( nFWSpan x nFW x nWings)" - +typedef ^ ^ ReKi Eps_NW :::: - - "Reg param of the near wake panels (3 x nSpan x nNW x nWings)" - +typedef ^ ^ ReKi Eps_FW :::: - - "Reg param of the far wake panels (3 x nFWSpan x nFW x nWings)" - +typedef ^ ^ ReKi r_NW :::: - - "Position of the near wake panels (3 x nSpan+1 x nNW+1 x nWings) " - +typedef ^ ^ ReKi r_FW :::: - - "Position of the far wake panels (3 x nFWSpan+1 x nFW+1 x nWings)" - +# TODO UA +typedef ^ ^ UA_ContinuousStateType UA - - - "states for UnsteadyAero" - + + # ....... MiscVars ............ # FVW_MiscVarType typedef FVW/FVW MiscVarType Logical FirstCall - - - "True if this is the first call to update state (used in CalcOutput)" - @@ -115,8 +127,7 @@ typedef ^ ^ ReKi typedef ^ ^ Logical ComputeWakeInduced - - - "Compute induced velocities on this timestep" - typedef ^ ^ DbKi OldWakeTime - - - "Time the wake induction velocities were last calculated" s typedef ^ ^ ReKi tSpent - - - "Time spent in expensive Biot-Savart computation" s -typedef ^ ^ ReKi dxdt_NW :::: - - "State time derivatie, stored for subcylcing" - -typedef ^ ^ ReKi dxdt_FW :::: - - "State time derivatie, stored for subcylcing" - +typedef ^ ^ FVW_ContinuousStateType dxdt - - - "State time derivatie, stored for subcycling and convenience" - # Convenient storage typedef ^ ^ Reki alpha_LL :: - - "Angle of attack at lifting line CP, only computed with CircPolarData method" - typedef ^ ^ Reki Vreln_LL :: - - "Norm of Vrel on the lifting line" - @@ -126,13 +137,13 @@ typedef ^ ^ T_Sgmt typedef ^ ^ ReKi CPs :: - - "Control points used for wake rollup computation" - typedef ^ ^ ReKi Uind :: - - "Induced velocities obtained at control points" - # for calculating outputs at blade nodes -typedef ^ ^ ReKi BN_AxInd :: - - "Axial induction [size: (NumBlNds,numBlades)]" - -typedef ^ ^ ReKi BN_TanInd :: - - "Tangential induction [size: (NumBlNds,numBlades)]" - -typedef ^ ^ ReKi BN_Vrel :: - - "Relative velocity [size: (NumBlNds,numBlades)]" m/s -typedef ^ ^ ReKi BN_alpha :: - - "Angle of attack [size: (NumBlNds,numBlades)]" rad -typedef ^ ^ ReKi BN_phi :: - - "angle between the plane of rotation and the direction of the local wind [size: (NumBlNds,numBlades)]" rad -typedef ^ ^ ReKi BN_Re :: - - "Reynolds number [size: (NumBlNds,numBlades)]" - -typedef ^ ^ ReKi BN_URelWind_s ::: - - "Relative wind velocity in section coordinates [size: (3,NumBlNds,numBlades)]" m/s +typedef ^ ^ ReKi BN_AxInd :: - - "Axial induction [size (NumBlNds,numBlades)]" - +typedef ^ ^ ReKi BN_TanInd :: - - "Tangential induction [size (NumBlNds,numBlades)]" - +typedef ^ ^ ReKi BN_Vrel :: - - "Relative velocity [size (NumBlNds,numBlades)]" m/s +typedef ^ ^ ReKi BN_alpha :: - - "Angle of attack [size (NumBlNds,numBlades)]" rad +typedef ^ ^ ReKi BN_phi :: - - "angle between the plane of rotation and the direction of the local wind [size (NumBlNds,numBlades)]" rad +typedef ^ ^ ReKi BN_Re :: - - "Reynolds number [size (NumBlNds,numBlades)]" - +typedef ^ ^ ReKi BN_URelWind_s ::: - - "Relative wind velocity in section coordinates [size (3,NumBlNds,numBlades)]" m/s typedef ^ ^ ReKi BN_Cl_Static :: - - "Coefficient lift, excluding unsteady aero effects" - typedef ^ ^ ReKi BN_Cd_Static :: - - "Coefficient drag. excluding unsteady aero effects" - typedef ^ ^ ReKi BN_Cm_Static :: - - "Coefficient moment, excluding unsteady aero effects" - @@ -166,15 +177,6 @@ typedef ^ ^ ReKi typedef FVW/FVW OutputType ReKi Vind ::: - - "TODO mesh - Induced velocity vector. " - typedef ^ ^ ReKi Cl_KJ :: - - "Lift coefficient from circulation (Kutta-Joukowski)" - -#.......... ContinuousStateType ...... -# FVW_ContinuousStateType -typedef FVW/FVW ContinuousStateType ReKi Gamma_NW ::: - - "Circulation of the near wake panels" - -typedef ^ ^ ReKi Gamma_FW ::: - - "Circulation of the far wake panels" - -typedef ^ ^ ReKi r_NW :::: - - "Position of the near wake panels" - -typedef ^ ^ ReKi r_FW :::: - - "Position of the far wake panels" - -# TODO UA -typedef ^ ^ UA_ContinuousStateType UA - - - "states for UnsteadyAero" - - #.......... DiscreteStateType ...... # FVW_DiscreteStateType diff --git a/modules/aerodyn/src/FVW_Subs.f90 b/modules/aerodyn/src/FVW_Subs.f90 index a252c098fe..663cc74a38 100644 --- a/modules/aerodyn/src/FVW_Subs.f90 +++ b/modules/aerodyn/src/FVW_Subs.f90 @@ -49,7 +49,7 @@ module FVW_SUBS ! Implementation integer(IntKi), parameter :: iNWStart=2 !< Index in r%NW where the near wake start (if >1 then the Wing panels are included in r_NW) integer(IntKi), parameter :: FWnSpan=1 !< Number of spanwise far wake panels ! TODO make it an input later - logical , parameter :: DEV_VERSION=.False. + logical , parameter :: DEV_VERSION=.True. contains !========================================================================== @@ -243,6 +243,7 @@ subroutine Map_NW_FW(p, m, z, x, ErrStat, ErrMsg) character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None integer(IntKi) :: iW, iRoot real(ReKi), dimension(p%nWings) :: FWGamma + real(ReKi), dimension(3):: FWEps integer(IntKi), parameter :: iAgeFW=1 !< we update the first FW panel ErrStat = ErrID_None ErrMsg = "" @@ -252,10 +253,18 @@ subroutine Map_NW_FW(p, m, z, x, ErrStat, ErrMsg) FWGamma(:)=0.0_ReKi if (m%nNW==p%nNWMax) then ! First circulation of Farwake is taken as the max circulation of last NW column + ! Regularization of far wake is TODO, for now taken as max but should be ramped up do iW=1,p%nWings !FWGamma = sum(x%Gamma_NW(:,p%nNWMax,iW))/p%nSpan FWGamma(iW) = maxval(x%Gamma_NW(:,p%nNWMax,iW)) x%Gamma_FW(1:FWnSpan,iAgeFW,iW) = FWGamma(iW) + ! Regularization TODO (should be increased to account for the concentration of vorticity to 1 panel only + FWEps(1) = maxval(x%Eps_NW(1,:,p%nNWMax,iW)) + FWEps(2) = maxval(x%Eps_NW(2,:,p%nNWMax,iW)) + FWEps(3) = maxval(x%Eps_NW(3,:,p%nNWMax,iW)) + x%Eps_FW(1,1:FWnSpan,iAgeFW,iW) = FWEps(1) + x%Eps_FW(2,1:FWnSpan,iAgeFW,iW) = FWEps(2) + x%Eps_FW(3,1:FWnSpan,iAgeFW,iW) = FWEps(3) enddo endif @@ -309,9 +318,11 @@ subroutine PropagateWake(p, m, z, x, ErrStat, ErrMsg) do iAge=p%nFWMax,2,-1 do iSpan=1,FWnSpan x%Gamma_FW(iSpan,iAge,iW) = x%Gamma_FW(iSpan,iAge-1,iW) + x%Eps_FW(:,iSpan,iAge,iW) = x%Eps_FW(:,iSpan,iAge-1,iW) enddo enddo x%Gamma_FW(1,1:FWnSpan-1,iW) = -999.9_ReKi ! Nullified + !x%Gamma_FW(:,1,iW) = -999.9_ReKi ! Nullified ! TODO TODO TODO FIX BUG enddo endif ! --- Propagate near wake @@ -328,18 +339,21 @@ subroutine PropagateWake(p, m, z, x, ErrStat, ErrMsg) do iAge=p%nNWMax,iNWStart+1,-1 do iSpan=1,p%nSpan x%Gamma_NW(iSpan,iAge,iW) = x%Gamma_NW(iSpan,iAge-1,iW) + x%Eps_NW(:,iSpan,iAge,iW) = x%Eps_NW(:,iSpan,iAge-1,iW) enddo enddo x%Gamma_NW(:,1:iNWStart,iW) = -999.9_ReKi ! Nullified enddo endif + x%Eps_NW(1:3,:,iNWStart,:) = p%WakeRegParam ! Second age is always WakeRegParam + x%Eps_NW(1:3,:,1:iNWStart-1,:) = p%WingRegParam ! First age is always WingRegParam (LL) ! Temporary hack for sub-cycling since straight after wkae computation, the wake size will increase ! So we do a "fake" propagation here do iW=1,p%nWings do iAge=p%nFWMax+1,2,-1 ! do iSpan=1,FWnSpan+1 - m%dxdt_FW(1:3,iSpan,iAge,iW) = m%dxdt_FW(1:3,iSpan,iAge-1,iW) + m%dxdt%r_FW(1:3,iSpan,iAge,iW) = m%dxdt%r_FW(1:3,iSpan,iAge-1,iW) enddo enddo !m%dxdt_FW(1:3,1:FWnSpan+1,1,iW) = -999999_ReKi ! Important not nullified. The best would be to map the last NW convection velocity for this first row. @@ -347,10 +361,10 @@ subroutine PropagateWake(p, m, z, x, ErrStat, ErrMsg) do iW=1,p%nWings do iAge=p%nNWMax+1,iNWStart+1,-1 do iSpan=1,p%nSpan+1 - m%dxdt_NW(1:3,iSpan,iAge,iW) = m%dxdt_NW(1:3,iSpan,iAge-1,iW) + m%dxdt%r_NW(1:3,iSpan,iAge,iW) = m%dxdt%r_NW(1:3,iSpan,iAge-1,iW) enddo enddo - m%dxdt_NW(1:3,:,1:iNWStart,iW) = 0.0_ReKi ! Nullified, wing do no convect, handled by LL,NW mapping + m%dxdt%r_NW(1:3,:,1:iNWStart,iW) = 0.0_ReKi ! Nullified, wing do no convect, handled by LL,NW mapping enddo if (.false.) print*,m%nNW,z%Gamma_LL(1,1) ! Just to avoid unused var warning @@ -582,7 +596,7 @@ pure integer(IntKi) function CountCPs(p, nNW, nFWEff) result(nCPs) end function CountCPs -subroutine PackPanelsToSegments(p, m, x, iDepthStart, bMirror, SegConnct, SegPoints, SegGamma, nSeg, nSegP) +subroutine PackPanelsToSegments(p, m, x, iDepthStart, bMirror, SegConnct, SegPoints, SegGamma, SegEpsilon, nSeg, nSegP) type(FVW_ParameterType), intent(in ) :: p !< Parameters type(FVW_MiscVarType), intent(in ) :: m !< Initial misc/optimization variables type(FVW_ContinuousStateType), intent(in ) :: x !< States @@ -591,6 +605,7 @@ subroutine PackPanelsToSegments(p, m, x, iDepthStart, bMirror, SegConnct, SegPoi integer(IntKi),dimension(:,:), intent(inout) :: SegConnct !< Segment connectivity real(ReKi), dimension(:,:), intent(inout) :: SegPoints !< Segment Points real(ReKi), dimension(:) , intent(inout) :: SegGamma !< Segment Circulation + real(ReKi), dimension(:) , intent(inout) :: SegEpsilon !< Segment Circulation integer(IntKi), intent(out) :: nSeg !< Total number of segments after packing integer(IntKi), intent(out) :: nSegP !< Total number of segments points after packing ! Local @@ -615,13 +630,13 @@ subroutine PackPanelsToSegments(p, m, x, iDepthStart, bMirror, SegConnct, SegPoi iHeadC=1 if (nCNW>0) then do iW=1,p%nWings - CALL LatticeToSegments(x%r_NW(1:3,:,1:m%nNW+1,iW), x%Gamma_NW(:,1:m%nNW,iW), iDepthStart, SegPoints, SegConnct, SegGamma, iHeadP, iHeadC, .True., LastNWShed ) + call LatticeToSegments(x%r_NW(1:3,:,1:m%nNW+1,iW), x%Gamma_NW(:,1:m%nNW,iW), x%Eps_NW(1:3,:,1:m%nNW,iW), iDepthStart, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC, .True., LastNWShed ) enddo endif if (m%nFW>0) then iHeadC_bkp = iHeadC do iW=1,p%nWings - CALL LatticeToSegments(x%r_FW(1:3,:,1:m%nFW+1,iW), x%Gamma_FW(:,1:m%nFW,iW), 1, SegPoints, SegConnct, SegGamma, iHeadP, iHeadC , p%FWShedVorticity, p%FWShedVorticity) + call LatticeToSegments(x%r_FW(1:3,:,1:m%nFW+1,iW), x%Gamma_FW(:,1:m%nFW,iW), x%Eps_FW(1:3,:,1:m%nFW,iW), 1, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC , p%FWShedVorticity, p%FWShedVorticity) enddo SegConnct(3,iHeadC_bkp:) = SegConnct(3,iHeadC_bkp:) + m%nNW ! Increasing iDepth (or age) to account for NW endif @@ -670,7 +685,8 @@ end subroutine PackPanelsToSegments !> Set up regularization parameter based on diffusion method and regularization method !! NOTE: this should preferably be done at the "panel"/vortex sheet level -subroutine FVW_InitRegularization(p, m, ErrStat, ErrMsg) +subroutine FVW_InitRegularization(x, p, m, ErrStat, ErrMsg) + type(FVW_ContinuousStateType), intent(inout) :: x !< States type(FVW_ParameterType), intent(inout) :: p !< Parameters type(FVW_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables integer(IntKi), intent( out) :: ErrStat !< Error status of the operation @@ -712,20 +728,29 @@ subroutine FVW_InitRegularization(p, m, ErrStat, ErrMsg) print*,'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' print*,'!!! NOTE: using optmized wake regularization parameters is still a beta feature!' print*,'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' - p%WakeRegMethod = idRegConstant + p%WakeRegMethod = idRegAge p%RegFunction = idRegVatistas p%WakeRegParam = RegParam p%WingRegParam = RegParam - p%CoreSpreadEddyVisc = 100 + p%CoreSpreadEddyVisc = 1000 m%Sgmt%RegFunction = p%RegFunction write(*,'(A)' ) 'The following regularization parameters will be used:' write(*,'(A,I0)' ) 'WakeRegMethod : ', p%WakeRegMethod write(*,'(A,I0)' ) 'RegFunction : ', p%RegFunction write(*,'(A,1F8.4)') 'WakeRegParam : ', p%WakeRegParam write(*,'(A,1F8.4)') 'WingRegParam : ', p%WingRegParam - write(*,'(A,1F8.4)') 'CoreSpreadEddyVisc: ', p%CoreSpreadEddyVisc + write(*,'(A,1F9.4)') 'CoreSpreadEddyVisc: ', p%CoreSpreadEddyVisc + endif + ! Default init of reg param + x%Eps_NW(1:3,:,:,:) = 0.0_ReKi + x%Eps_FW(1:3,:,:,:) = 0.0_ReKi + ! Set reg param on wing and first NW + ! NOTE: setting the same in all three directions for now, TODO! + x%Eps_NW(1:3,:,1,:) = p%WingRegParam ! First age is always WingRegParam (LL) + if (p%nNWMax>1) then + x%Eps_NW(1:3,:,2,:) = p%WakeRegParam ! Second age is always WakeRegParam endif - ! KEEP ME: potentially perform pre-computation here + ! KEEP: potentially perform pre-computation here !if (p%WakeRegMethod==idRegConstant) then !else if (p%WakeRegMethod==idRegStretching) then !else if (p%WakeRegMethod==idRegAge) then @@ -863,13 +888,13 @@ subroutine InducedVelocitiesAll_Init(p, x, m, Sgmt, Part, Tree, ErrStat, ErrMsg bMirror = p%ShearModel==idShearMirror ! Whether or not we mirror the vorticity wrt ground ! --- Packing all vortex elements into a list of segments - call PackPanelsToSegments(p, m, x, 1, bMirror, Sgmt%Connct, Sgmt%Points, Sgmt%Gamma, nSeg, nSegP) + call PackPanelsToSegments(p, m, x, 1, bMirror, Sgmt%Connct, Sgmt%Points, Sgmt%Gamma, Sgmt%Epsilon, nSeg, nSegP) Sgmt%RegFunction=p%RegFunction Sgmt%nAct = nSeg Sgmt%nActP = nSegP ! --- Setting up regularization SegEpsilon - call WakeRegularization(p, x, m, Sgmt%Connct, Sgmt%Points, Sgmt%Gamma, Sgmt%Epsilon(1:nSeg), ErrStat, ErrMsg) + !call WakeRegularization(p, x, m, Sgmt%Connct, Sgmt%Points, Sgmt%Gamma, Sgmt%Epsilon(1:nSeg), ErrStat, ErrMsg) ! --- Converting to particles if ((p%VelocityMethod==idVelocityTree) .or. (p%VelocityMethod==idVelocityPart)) then @@ -1069,7 +1094,7 @@ subroutine LiftingLineInducedVelocities(p, x, iDepthStart, m, ErrStat, ErrMsg) bMirror = p%ShearModel==idShearMirror ! Whether or not we mirror the vorticity wrt ground ! --- Packing all vortex elements into a list of segments - call PackPanelsToSegments(p, m, x, iDepthStart, bMirror, m%Sgmt%Connct, m%Sgmt%Points, m%Sgmt%Gamma, nSeg, nSegP) + call PackPanelsToSegments(p, m, x, iDepthStart, bMirror, m%Sgmt%Connct, m%Sgmt%Points, m%Sgmt%Gamma, m%Sgmt%Epsilon, nSeg, nSegP) ! --- Computing induced velocity if (nSegP==0) then @@ -1080,7 +1105,7 @@ subroutine LiftingLineInducedVelocities(p, x, iDepthStart, m, ErrStat, ErrMsg) endif else ! --- Setting up regularization - call WakeRegularization(p, x, m, m%Sgmt%Connct(:,1:nSeg), m%Sgmt%Points(:,1:nSegP), m%Sgmt%Gamma(1:nSeg), m%Sgmt%Epsilon(1:nSeg), ErrStat, ErrMsg) + !call WakeRegularization(p, x, m, m%Sgmt%Connct(:,1:nSeg), m%Sgmt%Points(:,1:nSegP), m%Sgmt%Gamma(1:nSeg), m%Sgmt%Epsilon(1:nSeg), ErrStat, ErrMsg) nCPs=p%nWings * p%nSpan allocate(CPs (1:3,1:nCPs)) ! NOTE: here we do allocate CPs and Uind insteadof using Misc diff --git a/modules/aerodyn/src/FVW_Tests.f90 b/modules/aerodyn/src/FVW_Tests.f90 index 03dc1c19cf..b3144910fc 100644 --- a/modules/aerodyn/src/FVW_Tests.f90 +++ b/modules/aerodyn/src/FVW_Tests.f90 @@ -614,6 +614,8 @@ subroutine Test_LatticeToSegment(mvtk,iStat) real(ReKi), dimension(:,:,:), allocatable :: LatticePoints2 !< Lattice Points real(ReKi), dimension(:,:), allocatable :: LatticeGamma1 !< Lattice Circulation real(ReKi), dimension(:,:), allocatable :: LatticeGamma2 !< Lattice Circulation + real(ReKi), dimension(:,:,:), allocatable :: LatticeEps1 !< Lattice Reg Param + real(ReKi), dimension(:,:,:), allocatable :: LatticeEps2 !< Lattice Reg Param real(ReKi), dimension(:,:), allocatable :: CPs !< ControlPoints real(ReKi), dimension(:,:), allocatable :: Uind !< Induced velocity integer(IntKi) :: iHeadC @@ -632,13 +634,22 @@ subroutine Test_LatticeToSegment(mvtk,iStat) ! --- Creating two lattice allocate(LatticePoints1(3,2,2)) allocate(LatticePoints2(3,3,4)) + allocate(LatticeEps1(3,1,1)) + allocate(LatticeEps2(3,2,3)) allocate(LatticeGamma1(1,1)) ; allocate(LatticeGamma2(2,3)) ; LatticeGamma1=1 + LatticeEps1(1,:,:) = 1 + LatticeEps1(2,:,:) = 2 + LatticeEps1(3,:,:) = 3 ! Test shed vorticity LatticeGamma2(:,1)=1 LatticeGamma2(:,2)=2 LatticeGamma2(:,3)=3 + + LatticeEps2(:,:,1) = 1 + LatticeEps2(:,:,2) = 2 + LatticeEps2(:,:,3) = 3 ! Test trailed vorticity ! LatticeGamma2(1,:)=1 ! LatticeGamma2(2,:)=2 @@ -660,7 +671,7 @@ subroutine Test_LatticeToSegment(mvtk,iStat) iHeadP=1 iHeadC=1 - CALL LatticeToSegments(LatticePoints1, LatticeGamma1, 1, SegPoints, SegConnct, SegGamma, iHeadP, iHeadC, .true., .true. ) + CALL LatticeToSegments(LatticePoints1, LatticeGamma1, LatticeEps1, 1, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC, .true., .true. ) CALL printall() CALL WrVTK_Segments('Points1_seg.vtk', mvtk, SegPoints, SegConnct, SegGamma, SegEpsilon, bladeFrame) @@ -687,7 +698,7 @@ subroutine Test_LatticeToSegment(mvtk,iStat) allocate(SegGamma (1:nC2) ); SegGamma=-9999 iHeadP=1 iHeadC=1 - CALL LatticeToSegments(LatticePoints2, LatticeGamma2, 1, SegPoints, SegConnct, SegGamma, iHeadP, iHeadC , .true., .true.) + CALL LatticeToSegments(LatticePoints2, LatticeGamma2, LatticeEps2, 1, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC , .true., .true.) CALL printall() CALL WrVTK_Segments('Points2_seg.vtk', mvtk, SegPoints, SegConnct, SegGamma, SegEpsilon, bladeFrame) @@ -702,8 +713,8 @@ subroutine Test_LatticeToSegment(mvtk,iStat) allocate(SegConnct(1:2,1:nC)); SegConnct=-1 allocate(SegPoints(1:3,1:nP)); SegPoints=-1 allocate(SegGamma (1:nC) ); SegGamma=-9999 - CALL LatticeToSegments(LatticePoints1, LatticeGamma1, 1, SegPoints, SegConnct, SegGamma, iHeadP, iHeadC, .true. , .true.) - CALL LatticeToSegments(LatticePoints2, LatticeGamma2, 1, SegPoints, SegConnct, SegGamma, iHeadP, iHeadC, .true. , .true.) + CALL LatticeToSegments(LatticePoints1, LatticeGamma1, LatticeEps1, 1, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC, .true. , .true.) + CALL LatticeToSegments(LatticePoints2, LatticeGamma2, LatticeEps2, 1, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC, .true. , .true.) CALL printall() CALL WrVTK_Segments('PointsBoth_seg.vtk', mvtk, SegPoints, SegConnct, SegGamma, SegEpsilon, bladeFrame) diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index 517fc891e3..e603be393f 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -107,6 +107,17 @@ MODULE FVW_Types INTEGER(IntKi) :: nGridOut !< Number of VTK grid to output [-] END TYPE FVW_ParameterType ! ======================= +! ========= FVW_ContinuousStateType ======= + TYPE, PUBLIC :: FVW_ContinuousStateType + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Gamma_NW !< Circulation of the near wake panels ( nSpan x nNW x nWings) [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Gamma_FW !< Circulation of the far wake panels ( nFWSpan x nFW x nWings) [-] + REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: Eps_NW !< Reg param of the near wake panels (3 x nSpan x nNW x nWings) [-] + REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: Eps_FW !< Reg param of the far wake panels (3 x nFWSpan x nFW x nWings) [-] + REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: r_NW !< Position of the near wake panels (3 x nSpan+1 x nNW+1 x nWings) [-] + REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: r_FW !< Position of the far wake panels (3 x nFWSpan+1 x nFW+1 x nWings) [-] + TYPE(UA_ContinuousStateType) :: UA !< states for UnsteadyAero [-] + END TYPE FVW_ContinuousStateType +! ======================= ! ========= FVW_MiscVarType ======= TYPE, PUBLIC :: FVW_MiscVarType LOGICAL :: FirstCall !< True if this is the first call to update state (used in CalcOutput) [-] @@ -143,20 +154,19 @@ MODULE FVW_Types LOGICAL :: ComputeWakeInduced !< Compute induced velocities on this timestep [-] REAL(DbKi) :: OldWakeTime !< Time the wake induction velocities were last calculated [s] REAL(ReKi) :: tSpent !< Time spent in expensive Biot-Savart computation [s] - REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: dxdt_NW !< State time derivatie, stored for subcylcing [-] - REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: dxdt_FW !< State time derivatie, stored for subcylcing [-] + TYPE(FVW_ContinuousStateType) :: dxdt !< State time derivatie, stored for subcycling and convenience [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: alpha_LL !< Angle of attack at lifting line CP, only computed with CircPolarData method [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vreln_LL !< Norm of Vrel on the lifting line [-] TYPE(T_Sgmt) :: Sgmt !< Segments storage [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: CPs !< Control points used for wake rollup computation [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Uind !< Induced velocities obtained at control points [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_AxInd !< Axial induction [size: (NumBlNds,numBlades)] [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_TanInd !< Tangential induction [size: (NumBlNds,numBlades)] [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_Vrel !< Relative velocity [size: (NumBlNds,numBlades)] [m/s] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_alpha !< Angle of attack [size: (NumBlNds,numBlades)] [rad] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_phi !< angle between the plane of rotation and the direction of the local wind [size: (NumBlNds,numBlades)] [rad] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_Re !< Reynolds number [size: (NumBlNds,numBlades)] [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: BN_URelWind_s !< Relative wind velocity in section coordinates [size: (3,NumBlNds,numBlades)] [m/s] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_AxInd !< Axial induction [size (NumBlNds,numBlades)] [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_TanInd !< Tangential induction [size (NumBlNds,numBlades)] [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_Vrel !< Relative velocity [size (NumBlNds,numBlades)] [m/s] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_alpha !< Angle of attack [size (NumBlNds,numBlades)] [rad] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_phi !< angle between the plane of rotation and the direction of the local wind [size (NumBlNds,numBlades)] [rad] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_Re !< Reynolds number [size (NumBlNds,numBlades)] [-] + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: BN_URelWind_s !< Relative wind velocity in section coordinates [size (3,NumBlNds,numBlades)] [m/s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_Cl_Static !< Coefficient lift, excluding unsteady aero effects [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_Cd_Static !< Coefficient drag. excluding unsteady aero effects [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: BN_Cm_Static !< Coefficient moment, excluding unsteady aero effects [-] @@ -189,15 +199,6 @@ MODULE FVW_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Cl_KJ !< Lift coefficient from circulation (Kutta-Joukowski) [-] END TYPE FVW_OutputType ! ======================= -! ========= FVW_ContinuousStateType ======= - TYPE, PUBLIC :: FVW_ContinuousStateType - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Gamma_NW !< Circulation of the near wake panels [-] - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Gamma_FW !< Circulation of the far wake panels [-] - REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: r_NW !< Position of the near wake panels [-] - REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: r_FW !< Position of the far wake panels [-] - TYPE(UA_ContinuousStateType) :: UA !< states for UnsteadyAero [-] - END TYPE FVW_ContinuousStateType -! ======================= ! ========= FVW_DiscreteStateType ======= TYPE, PUBLIC :: FVW_DiscreteStateType REAL(ReKi) :: NULL !< Empty to satisfy framework [-] @@ -1489,9 +1490,9 @@ SUBROUTINE FVW_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Xferred = Int_Xferred + 1 END SUBROUTINE FVW_UnPackParam - SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(FVW_MiscVarType), INTENT(INOUT) :: DstMiscData + SUBROUTINE FVW_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FVW_ContinuousStateType), INTENT(IN) :: SrcContStateData + TYPE(FVW_ContinuousStateType), INTENT(INOUT) :: DstContStateData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -1503,388 +1504,1115 @@ SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) INTEGER(IntKi) :: i4, i4_l, i4_u ! bounds (upper/lower) for an array dimension 4 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyMisc' + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyContState' ! ErrStat = ErrID_None ErrMsg = "" - DstMiscData%FirstCall = SrcMiscData%FirstCall -IF (ALLOCATED(SrcMiscData%LE)) THEN - i1_l = LBOUND(SrcMiscData%LE,1) - i1_u = UBOUND(SrcMiscData%LE,1) - i2_l = LBOUND(SrcMiscData%LE,2) - i2_u = UBOUND(SrcMiscData%LE,2) - i3_l = LBOUND(SrcMiscData%LE,3) - i3_u = UBOUND(SrcMiscData%LE,3) - IF (.NOT. ALLOCATED(DstMiscData%LE)) THEN - ALLOCATE(DstMiscData%LE(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%LE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%LE = SrcMiscData%LE -ENDIF -IF (ALLOCATED(SrcMiscData%TE)) THEN - i1_l = LBOUND(SrcMiscData%TE,1) - i1_u = UBOUND(SrcMiscData%TE,1) - i2_l = LBOUND(SrcMiscData%TE,2) - i2_u = UBOUND(SrcMiscData%TE,2) - i3_l = LBOUND(SrcMiscData%TE,3) - i3_u = UBOUND(SrcMiscData%TE,3) - IF (.NOT. ALLOCATED(DstMiscData%TE)) THEN - ALLOCATE(DstMiscData%TE(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) +IF (ALLOCATED(SrcContStateData%Gamma_NW)) THEN + i1_l = LBOUND(SrcContStateData%Gamma_NW,1) + i1_u = UBOUND(SrcContStateData%Gamma_NW,1) + i2_l = LBOUND(SrcContStateData%Gamma_NW,2) + i2_u = UBOUND(SrcContStateData%Gamma_NW,2) + i3_l = LBOUND(SrcContStateData%Gamma_NW,3) + i3_u = UBOUND(SrcContStateData%Gamma_NW,3) + IF (.NOT. ALLOCATED(DstContStateData%Gamma_NW)) THEN + ALLOCATE(DstContStateData%Gamma_NW(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%TE.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%Gamma_NW.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMiscData%TE = SrcMiscData%TE + DstContStateData%Gamma_NW = SrcContStateData%Gamma_NW ENDIF -IF (ALLOCATED(SrcMiscData%r_LL)) THEN - i1_l = LBOUND(SrcMiscData%r_LL,1) - i1_u = UBOUND(SrcMiscData%r_LL,1) - i2_l = LBOUND(SrcMiscData%r_LL,2) - i2_u = UBOUND(SrcMiscData%r_LL,2) - i3_l = LBOUND(SrcMiscData%r_LL,3) - i3_u = UBOUND(SrcMiscData%r_LL,3) - i4_l = LBOUND(SrcMiscData%r_LL,4) - i4_u = UBOUND(SrcMiscData%r_LL,4) - IF (.NOT. ALLOCATED(DstMiscData%r_LL)) THEN - ALLOCATE(DstMiscData%r_LL(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) +IF (ALLOCATED(SrcContStateData%Gamma_FW)) THEN + i1_l = LBOUND(SrcContStateData%Gamma_FW,1) + i1_u = UBOUND(SrcContStateData%Gamma_FW,1) + i2_l = LBOUND(SrcContStateData%Gamma_FW,2) + i2_u = UBOUND(SrcContStateData%Gamma_FW,2) + i3_l = LBOUND(SrcContStateData%Gamma_FW,3) + i3_u = UBOUND(SrcContStateData%Gamma_FW,3) + IF (.NOT. ALLOCATED(DstContStateData%Gamma_FW)) THEN + ALLOCATE(DstContStateData%Gamma_FW(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%r_LL.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%Gamma_FW.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMiscData%r_LL = SrcMiscData%r_LL + DstContStateData%Gamma_FW = SrcContStateData%Gamma_FW ENDIF -IF (ALLOCATED(SrcMiscData%s_LL)) THEN - i1_l = LBOUND(SrcMiscData%s_LL,1) - i1_u = UBOUND(SrcMiscData%s_LL,1) - i2_l = LBOUND(SrcMiscData%s_LL,2) - i2_u = UBOUND(SrcMiscData%s_LL,2) - IF (.NOT. ALLOCATED(DstMiscData%s_LL)) THEN - ALLOCATE(DstMiscData%s_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%s_LL.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcContStateData%Eps_NW)) THEN + i1_l = LBOUND(SrcContStateData%Eps_NW,1) + i1_u = UBOUND(SrcContStateData%Eps_NW,1) + i2_l = LBOUND(SrcContStateData%Eps_NW,2) + i2_u = UBOUND(SrcContStateData%Eps_NW,2) + i3_l = LBOUND(SrcContStateData%Eps_NW,3) + i3_u = UBOUND(SrcContStateData%Eps_NW,3) + i4_l = LBOUND(SrcContStateData%Eps_NW,4) + i4_u = UBOUND(SrcContStateData%Eps_NW,4) + IF (.NOT. ALLOCATED(DstContStateData%Eps_NW)) THEN + ALLOCATE(DstContStateData%Eps_NW(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 DstContStateData%Eps_NW.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMiscData%s_LL = SrcMiscData%s_LL + DstContStateData%Eps_NW = SrcContStateData%Eps_NW ENDIF -IF (ALLOCATED(SrcMiscData%chord_LL)) THEN - i1_l = LBOUND(SrcMiscData%chord_LL,1) - i1_u = UBOUND(SrcMiscData%chord_LL,1) - i2_l = LBOUND(SrcMiscData%chord_LL,2) - i2_u = UBOUND(SrcMiscData%chord_LL,2) - IF (.NOT. ALLOCATED(DstMiscData%chord_LL)) THEN - ALLOCATE(DstMiscData%chord_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcContStateData%Eps_FW)) THEN + i1_l = LBOUND(SrcContStateData%Eps_FW,1) + i1_u = UBOUND(SrcContStateData%Eps_FW,1) + i2_l = LBOUND(SrcContStateData%Eps_FW,2) + i2_u = UBOUND(SrcContStateData%Eps_FW,2) + i3_l = LBOUND(SrcContStateData%Eps_FW,3) + i3_u = UBOUND(SrcContStateData%Eps_FW,3) + i4_l = LBOUND(SrcContStateData%Eps_FW,4) + i4_u = UBOUND(SrcContStateData%Eps_FW,4) + IF (.NOT. ALLOCATED(DstContStateData%Eps_FW)) THEN + ALLOCATE(DstContStateData%Eps_FW(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%chord_LL.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%Eps_FW.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMiscData%chord_LL = SrcMiscData%chord_LL + DstContStateData%Eps_FW = SrcContStateData%Eps_FW ENDIF -IF (ALLOCATED(SrcMiscData%s_CP_LL)) THEN - i1_l = LBOUND(SrcMiscData%s_CP_LL,1) - i1_u = UBOUND(SrcMiscData%s_CP_LL,1) - i2_l = LBOUND(SrcMiscData%s_CP_LL,2) - i2_u = UBOUND(SrcMiscData%s_CP_LL,2) - IF (.NOT. ALLOCATED(DstMiscData%s_CP_LL)) THEN - ALLOCATE(DstMiscData%s_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcContStateData%r_NW)) THEN + i1_l = LBOUND(SrcContStateData%r_NW,1) + i1_u = UBOUND(SrcContStateData%r_NW,1) + i2_l = LBOUND(SrcContStateData%r_NW,2) + i2_u = UBOUND(SrcContStateData%r_NW,2) + i3_l = LBOUND(SrcContStateData%r_NW,3) + i3_u = UBOUND(SrcContStateData%r_NW,3) + i4_l = LBOUND(SrcContStateData%r_NW,4) + i4_u = UBOUND(SrcContStateData%r_NW,4) + IF (.NOT. ALLOCATED(DstContStateData%r_NW)) THEN + ALLOCATE(DstContStateData%r_NW(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%s_CP_LL.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%r_NW.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMiscData%s_CP_LL = SrcMiscData%s_CP_LL + DstContStateData%r_NW = SrcContStateData%r_NW ENDIF -IF (ALLOCATED(SrcMiscData%chord_CP_LL)) THEN - i1_l = LBOUND(SrcMiscData%chord_CP_LL,1) - i1_u = UBOUND(SrcMiscData%chord_CP_LL,1) - i2_l = LBOUND(SrcMiscData%chord_CP_LL,2) - i2_u = UBOUND(SrcMiscData%chord_CP_LL,2) - IF (.NOT. ALLOCATED(DstMiscData%chord_CP_LL)) THEN - ALLOCATE(DstMiscData%chord_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcContStateData%r_FW)) THEN + i1_l = LBOUND(SrcContStateData%r_FW,1) + i1_u = UBOUND(SrcContStateData%r_FW,1) + i2_l = LBOUND(SrcContStateData%r_FW,2) + i2_u = UBOUND(SrcContStateData%r_FW,2) + i3_l = LBOUND(SrcContStateData%r_FW,3) + i3_u = UBOUND(SrcContStateData%r_FW,3) + i4_l = LBOUND(SrcContStateData%r_FW,4) + i4_u = UBOUND(SrcContStateData%r_FW,4) + IF (.NOT. ALLOCATED(DstContStateData%r_FW)) THEN + ALLOCATE(DstContStateData%r_FW(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%chord_CP_LL.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%r_FW.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMiscData%chord_CP_LL = SrcMiscData%chord_CP_LL + DstContStateData%r_FW = SrcContStateData%r_FW ENDIF -IF (ALLOCATED(SrcMiscData%CP_LL)) THEN - i1_l = LBOUND(SrcMiscData%CP_LL,1) - i1_u = UBOUND(SrcMiscData%CP_LL,1) - i2_l = LBOUND(SrcMiscData%CP_LL,2) - i2_u = UBOUND(SrcMiscData%CP_LL,2) - i3_l = LBOUND(SrcMiscData%CP_LL,3) - i3_u = UBOUND(SrcMiscData%CP_LL,3) - IF (.NOT. ALLOCATED(DstMiscData%CP_LL)) THEN - ALLOCATE(DstMiscData%CP_LL(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%CP_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%CP_LL = SrcMiscData%CP_LL + CALL UA_CopyContState( SrcContStateData%UA, DstContStateData%UA, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FVW_CopyContState + + SUBROUTINE FVW_DestroyContState( ContStateData, ErrStat, ErrMsg ) + TYPE(FVW_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyContState' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(ContStateData%Gamma_NW)) THEN + DEALLOCATE(ContStateData%Gamma_NW) ENDIF -IF (ALLOCATED(SrcMiscData%Tang)) THEN - i1_l = LBOUND(SrcMiscData%Tang,1) - i1_u = UBOUND(SrcMiscData%Tang,1) - i2_l = LBOUND(SrcMiscData%Tang,2) - i2_u = UBOUND(SrcMiscData%Tang,2) - i3_l = LBOUND(SrcMiscData%Tang,3) - i3_u = UBOUND(SrcMiscData%Tang,3) - IF (.NOT. ALLOCATED(DstMiscData%Tang)) THEN - ALLOCATE(DstMiscData%Tang(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%Tang.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Tang = SrcMiscData%Tang +IF (ALLOCATED(ContStateData%Gamma_FW)) THEN + DEALLOCATE(ContStateData%Gamma_FW) ENDIF -IF (ALLOCATED(SrcMiscData%Norm)) THEN - i1_l = LBOUND(SrcMiscData%Norm,1) - i1_u = UBOUND(SrcMiscData%Norm,1) - i2_l = LBOUND(SrcMiscData%Norm,2) - i2_u = UBOUND(SrcMiscData%Norm,2) - i3_l = LBOUND(SrcMiscData%Norm,3) - i3_u = UBOUND(SrcMiscData%Norm,3) - IF (.NOT. ALLOCATED(DstMiscData%Norm)) THEN - ALLOCATE(DstMiscData%Norm(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%Norm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Norm = SrcMiscData%Norm +IF (ALLOCATED(ContStateData%Eps_NW)) THEN + DEALLOCATE(ContStateData%Eps_NW) ENDIF -IF (ALLOCATED(SrcMiscData%Orth)) THEN - i1_l = LBOUND(SrcMiscData%Orth,1) - i1_u = UBOUND(SrcMiscData%Orth,1) - i2_l = LBOUND(SrcMiscData%Orth,2) - i2_u = UBOUND(SrcMiscData%Orth,2) - i3_l = LBOUND(SrcMiscData%Orth,3) - i3_u = UBOUND(SrcMiscData%Orth,3) - IF (.NOT. ALLOCATED(DstMiscData%Orth)) THEN - ALLOCATE(DstMiscData%Orth(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%Orth.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Orth = SrcMiscData%Orth +IF (ALLOCATED(ContStateData%Eps_FW)) THEN + DEALLOCATE(ContStateData%Eps_FW) ENDIF -IF (ALLOCATED(SrcMiscData%dl)) THEN - i1_l = LBOUND(SrcMiscData%dl,1) - i1_u = UBOUND(SrcMiscData%dl,1) - i2_l = LBOUND(SrcMiscData%dl,2) - i2_u = UBOUND(SrcMiscData%dl,2) - i3_l = LBOUND(SrcMiscData%dl,3) - i3_u = UBOUND(SrcMiscData%dl,3) - IF (.NOT. ALLOCATED(DstMiscData%dl)) THEN - ALLOCATE(DstMiscData%dl(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%dl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dl = SrcMiscData%dl +IF (ALLOCATED(ContStateData%r_NW)) THEN + DEALLOCATE(ContStateData%r_NW) ENDIF -IF (ALLOCATED(SrcMiscData%Area)) THEN - i1_l = LBOUND(SrcMiscData%Area,1) - i1_u = UBOUND(SrcMiscData%Area,1) - i2_l = LBOUND(SrcMiscData%Area,2) - i2_u = UBOUND(SrcMiscData%Area,2) - IF (.NOT. ALLOCATED(DstMiscData%Area)) THEN - ALLOCATE(DstMiscData%Area(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Area.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%Area = SrcMiscData%Area +IF (ALLOCATED(ContStateData%r_FW)) THEN + DEALLOCATE(ContStateData%r_FW) ENDIF -IF (ALLOCATED(SrcMiscData%diag_LL)) THEN - i1_l = LBOUND(SrcMiscData%diag_LL,1) - i1_u = UBOUND(SrcMiscData%diag_LL,1) - i2_l = LBOUND(SrcMiscData%diag_LL,2) - i2_u = UBOUND(SrcMiscData%diag_LL,2) - IF (.NOT. ALLOCATED(DstMiscData%diag_LL)) THEN - ALLOCATE(DstMiscData%diag_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%diag_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%diag_LL = SrcMiscData%diag_LL -ENDIF -IF (ALLOCATED(SrcMiscData%Gamma_LL)) THEN - i1_l = LBOUND(SrcMiscData%Gamma_LL,1) - i1_u = UBOUND(SrcMiscData%Gamma_LL,1) - i2_l = LBOUND(SrcMiscData%Gamma_LL,2) - i2_u = UBOUND(SrcMiscData%Gamma_LL,2) - IF (.NOT. ALLOCATED(DstMiscData%Gamma_LL)) THEN - ALLOCATE(DstMiscData%Gamma_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Gamma_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + CALL UA_DestroyContState( ContStateData%UA, ErrStat, ErrMsg ) + END SUBROUTINE FVW_DestroyContState + + SUBROUTINE FVW_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(FVW_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 = 'FVW_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 + Int_BufSz = Int_BufSz + 1 ! Gamma_NW allocated yes/no + IF ( ALLOCATED(InData%Gamma_NW) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Gamma_NW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Gamma_NW) ! Gamma_NW END IF - DstMiscData%Gamma_LL = SrcMiscData%Gamma_LL -ENDIF -IF (ALLOCATED(SrcMiscData%Vind_LL)) THEN - i1_l = LBOUND(SrcMiscData%Vind_LL,1) - i1_u = UBOUND(SrcMiscData%Vind_LL,1) - i2_l = LBOUND(SrcMiscData%Vind_LL,2) - i2_u = UBOUND(SrcMiscData%Vind_LL,2) - i3_l = LBOUND(SrcMiscData%Vind_LL,3) - i3_u = UBOUND(SrcMiscData%Vind_LL,3) - IF (.NOT. ALLOCATED(DstMiscData%Vind_LL)) THEN - ALLOCATE(DstMiscData%Vind_LL(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%Vind_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + Int_BufSz = Int_BufSz + 1 ! Gamma_FW allocated yes/no + IF ( ALLOCATED(InData%Gamma_FW) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Gamma_FW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Gamma_FW) ! Gamma_FW END IF - DstMiscData%Vind_LL = SrcMiscData%Vind_LL -ENDIF -IF (ALLOCATED(SrcMiscData%Vtot_LL)) THEN - i1_l = LBOUND(SrcMiscData%Vtot_LL,1) - i1_u = UBOUND(SrcMiscData%Vtot_LL,1) - i2_l = LBOUND(SrcMiscData%Vtot_LL,2) - i2_u = UBOUND(SrcMiscData%Vtot_LL,2) - i3_l = LBOUND(SrcMiscData%Vtot_LL,3) - i3_u = UBOUND(SrcMiscData%Vtot_LL,3) - IF (.NOT. ALLOCATED(DstMiscData%Vtot_LL)) THEN - ALLOCATE(DstMiscData%Vtot_LL(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%Vtot_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + Int_BufSz = Int_BufSz + 1 ! Eps_NW allocated yes/no + IF ( ALLOCATED(InData%Eps_NW) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! Eps_NW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Eps_NW) ! Eps_NW END IF - DstMiscData%Vtot_LL = SrcMiscData%Vtot_LL -ENDIF -IF (ALLOCATED(SrcMiscData%Vstr_LL)) THEN - i1_l = LBOUND(SrcMiscData%Vstr_LL,1) - i1_u = UBOUND(SrcMiscData%Vstr_LL,1) - i2_l = LBOUND(SrcMiscData%Vstr_LL,2) - i2_u = UBOUND(SrcMiscData%Vstr_LL,2) - i3_l = LBOUND(SrcMiscData%Vstr_LL,3) - i3_u = UBOUND(SrcMiscData%Vstr_LL,3) - IF (.NOT. ALLOCATED(DstMiscData%Vstr_LL)) THEN - ALLOCATE(DstMiscData%Vstr_LL(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%Vstr_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + Int_BufSz = Int_BufSz + 1 ! Eps_FW allocated yes/no + IF ( ALLOCATED(InData%Eps_FW) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! Eps_FW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Eps_FW) ! Eps_FW END IF - DstMiscData%Vstr_LL = SrcMiscData%Vstr_LL -ENDIF -IF (ALLOCATED(SrcMiscData%Vwnd_LL)) THEN - i1_l = LBOUND(SrcMiscData%Vwnd_LL,1) - i1_u = UBOUND(SrcMiscData%Vwnd_LL,1) - i2_l = LBOUND(SrcMiscData%Vwnd_LL,2) - i2_u = UBOUND(SrcMiscData%Vwnd_LL,2) - i3_l = LBOUND(SrcMiscData%Vwnd_LL,3) - i3_u = UBOUND(SrcMiscData%Vwnd_LL,3) - IF (.NOT. ALLOCATED(DstMiscData%Vwnd_LL)) THEN - ALLOCATE(DstMiscData%Vwnd_LL(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%Vwnd_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + Int_BufSz = Int_BufSz + 1 ! r_NW allocated yes/no + IF ( ALLOCATED(InData%r_NW) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! r_NW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%r_NW) ! r_NW END IF - DstMiscData%Vwnd_LL = SrcMiscData%Vwnd_LL -ENDIF -IF (ALLOCATED(SrcMiscData%Vwnd_NW)) THEN - i1_l = LBOUND(SrcMiscData%Vwnd_NW,1) - i1_u = UBOUND(SrcMiscData%Vwnd_NW,1) - i2_l = LBOUND(SrcMiscData%Vwnd_NW,2) - i2_u = UBOUND(SrcMiscData%Vwnd_NW,2) - i3_l = LBOUND(SrcMiscData%Vwnd_NW,3) - i3_u = UBOUND(SrcMiscData%Vwnd_NW,3) - i4_l = LBOUND(SrcMiscData%Vwnd_NW,4) - i4_u = UBOUND(SrcMiscData%Vwnd_NW,4) - IF (.NOT. ALLOCATED(DstMiscData%Vwnd_NW)) THEN - ALLOCATE(DstMiscData%Vwnd_NW(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%Vwnd_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + Int_BufSz = Int_BufSz + 1 ! r_FW allocated yes/no + IF ( ALLOCATED(InData%r_FW) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! r_FW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%r_FW) ! r_FW END IF - DstMiscData%Vwnd_NW = SrcMiscData%Vwnd_NW -ENDIF -IF (ALLOCATED(SrcMiscData%Vwnd_FW)) THEN - i1_l = LBOUND(SrcMiscData%Vwnd_FW,1) - i1_u = UBOUND(SrcMiscData%Vwnd_FW,1) - i2_l = LBOUND(SrcMiscData%Vwnd_FW,2) - i2_u = UBOUND(SrcMiscData%Vwnd_FW,2) - i3_l = LBOUND(SrcMiscData%Vwnd_FW,3) - i3_u = UBOUND(SrcMiscData%Vwnd_FW,3) - i4_l = LBOUND(SrcMiscData%Vwnd_FW,4) - i4_u = UBOUND(SrcMiscData%Vwnd_FW,4) - IF (.NOT. ALLOCATED(DstMiscData%Vwnd_FW)) THEN - ALLOCATE(DstMiscData%Vwnd_FW(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%Vwnd_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype + CALL UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, .TRUE. ) ! UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! UA + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! UA + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! UA + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + 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 - DstMiscData%Vwnd_FW = SrcMiscData%Vwnd_FW -ENDIF -IF (ALLOCATED(SrcMiscData%Vind_NW)) THEN - i1_l = LBOUND(SrcMiscData%Vind_NW,1) - i1_u = UBOUND(SrcMiscData%Vind_NW,1) - i2_l = LBOUND(SrcMiscData%Vind_NW,2) - i2_u = UBOUND(SrcMiscData%Vind_NW,2) - i3_l = LBOUND(SrcMiscData%Vind_NW,3) - i3_u = UBOUND(SrcMiscData%Vind_NW,3) - i4_l = LBOUND(SrcMiscData%Vind_NW,4) - i4_u = UBOUND(SrcMiscData%Vind_NW,4) - IF (.NOT. ALLOCATED(DstMiscData%Vind_NW)) THEN - ALLOCATE(DstMiscData%Vind_NW(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%Vind_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - 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 - DstMiscData%Vind_NW = SrcMiscData%Vind_NW -ENDIF -IF (ALLOCATED(SrcMiscData%Vind_FW)) THEN - i1_l = LBOUND(SrcMiscData%Vind_FW,1) - i1_u = UBOUND(SrcMiscData%Vind_FW,1) - i2_l = LBOUND(SrcMiscData%Vind_FW,2) - i2_u = UBOUND(SrcMiscData%Vind_FW,2) - i3_l = LBOUND(SrcMiscData%Vind_FW,3) - i3_u = UBOUND(SrcMiscData%Vind_FW,3) - i4_l = LBOUND(SrcMiscData%Vind_FW,4) - i4_u = UBOUND(SrcMiscData%Vind_FW,4) - IF (.NOT. ALLOCATED(DstMiscData%Vind_FW)) THEN - ALLOCATE(DstMiscData%Vind_FW(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%Vind_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - 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 - DstMiscData%Vind_FW = SrcMiscData%Vind_FW -ENDIF - DstMiscData%nNW = SrcMiscData%nNW - DstMiscData%nFW = SrcMiscData%nFW - DstMiscData%iStep = SrcMiscData%iStep - DstMiscData%VTKstep = SrcMiscData%VTKstep - DstMiscData%VTKlastTime = SrcMiscData%VTKlastTime -IF (ALLOCATED(SrcMiscData%r_wind)) THEN - i1_l = LBOUND(SrcMiscData%r_wind,1) - i1_u = UBOUND(SrcMiscData%r_wind,1) - i2_l = LBOUND(SrcMiscData%r_wind,2) - i2_u = UBOUND(SrcMiscData%r_wind,2) - IF (.NOT. ALLOCATED(DstMiscData%r_wind)) THEN - ALLOCATE(DstMiscData%r_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN + 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%Gamma_NW) ) 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%Gamma_NW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_NW,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_NW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_NW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_NW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_NW,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Gamma_NW,3), UBOUND(InData%Gamma_NW,3) + DO i2 = LBOUND(InData%Gamma_NW,2), UBOUND(InData%Gamma_NW,2) + DO i1 = LBOUND(InData%Gamma_NW,1), UBOUND(InData%Gamma_NW,1) + ReKiBuf(Re_Xferred) = InData%Gamma_NW(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Gamma_FW) ) 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%Gamma_FW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_FW,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_FW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_FW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_FW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_FW,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Gamma_FW,3), UBOUND(InData%Gamma_FW,3) + DO i2 = LBOUND(InData%Gamma_FW,2), UBOUND(InData%Gamma_FW,2) + DO i1 = LBOUND(InData%Gamma_FW,1), UBOUND(InData%Gamma_FW,1) + ReKiBuf(Re_Xferred) = InData%Gamma_FW(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Eps_NW) ) 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%Eps_NW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_NW,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_NW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_NW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_NW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_NW,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_NW,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_NW,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%Eps_NW,4), UBOUND(InData%Eps_NW,4) + DO i3 = LBOUND(InData%Eps_NW,3), UBOUND(InData%Eps_NW,3) + DO i2 = LBOUND(InData%Eps_NW,2), UBOUND(InData%Eps_NW,2) + DO i1 = LBOUND(InData%Eps_NW,1), UBOUND(InData%Eps_NW,1) + ReKiBuf(Re_Xferred) = InData%Eps_NW(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Eps_FW) ) 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%Eps_FW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_FW,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_FW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_FW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_FW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_FW,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Eps_FW,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Eps_FW,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%Eps_FW,4), UBOUND(InData%Eps_FW,4) + DO i3 = LBOUND(InData%Eps_FW,3), UBOUND(InData%Eps_FW,3) + DO i2 = LBOUND(InData%Eps_FW,2), UBOUND(InData%Eps_FW,2) + DO i1 = LBOUND(InData%Eps_FW,1), UBOUND(InData%Eps_FW,1) + ReKiBuf(Re_Xferred) = InData%Eps_FW(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%r_NW) ) 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%r_NW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_NW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_NW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_NW,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%r_NW,4), UBOUND(InData%r_NW,4) + DO i3 = LBOUND(InData%r_NW,3), UBOUND(InData%r_NW,3) + DO i2 = LBOUND(InData%r_NW,2), UBOUND(InData%r_NW,2) + DO i1 = LBOUND(InData%r_NW,1), UBOUND(InData%r_NW,1) + ReKiBuf(Re_Xferred) = InData%r_NW(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%r_FW) ) 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%r_FW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_FW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_FW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_FW,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,4) + Int_Xferred = Int_Xferred + 2 + + DO i4 = LBOUND(InData%r_FW,4), UBOUND(InData%r_FW,4) + DO i3 = LBOUND(InData%r_FW,3), UBOUND(InData%r_FW,3) + DO i2 = LBOUND(InData%r_FW,2), UBOUND(InData%r_FW,2) + DO i1 = LBOUND(InData%r_FW,1), UBOUND(InData%r_FW,1) + ReKiBuf(Re_Xferred) = InData%r_FW(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + CALL UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA + 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 SUBROUTINE FVW_PackContState + + SUBROUTINE FVW_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(FVW_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 + 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 = 'FVW_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 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma_NW 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%Gamma_NW)) DEALLOCATE(OutData%Gamma_NW) + ALLOCATE(OutData%Gamma_NW(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%Gamma_NW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Gamma_NW,3), UBOUND(OutData%Gamma_NW,3) + DO i2 = LBOUND(OutData%Gamma_NW,2), UBOUND(OutData%Gamma_NW,2) + DO i1 = LBOUND(OutData%Gamma_NW,1), UBOUND(OutData%Gamma_NW,1) + OutData%Gamma_NW(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma_FW 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%Gamma_FW)) DEALLOCATE(OutData%Gamma_FW) + ALLOCATE(OutData%Gamma_FW(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%Gamma_FW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Gamma_FW,3), UBOUND(OutData%Gamma_FW,3) + DO i2 = LBOUND(OutData%Gamma_FW,2), UBOUND(OutData%Gamma_FW,2) + DO i1 = LBOUND(OutData%Gamma_FW,1), UBOUND(OutData%Gamma_FW,1) + OutData%Gamma_FW(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Eps_NW 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%Eps_NW)) DEALLOCATE(OutData%Eps_NW) + ALLOCATE(OutData%Eps_NW(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%Eps_NW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%Eps_NW,4), UBOUND(OutData%Eps_NW,4) + DO i3 = LBOUND(OutData%Eps_NW,3), UBOUND(OutData%Eps_NW,3) + DO i2 = LBOUND(OutData%Eps_NW,2), UBOUND(OutData%Eps_NW,2) + DO i1 = LBOUND(OutData%Eps_NW,1), UBOUND(OutData%Eps_NW,1) + OutData%Eps_NW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Eps_FW 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%Eps_FW)) DEALLOCATE(OutData%Eps_FW) + ALLOCATE(OutData%Eps_FW(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%Eps_FW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%Eps_FW,4), UBOUND(OutData%Eps_FW,4) + DO i3 = LBOUND(OutData%Eps_FW,3), UBOUND(OutData%Eps_FW,3) + DO i2 = LBOUND(OutData%Eps_FW,2), UBOUND(OutData%Eps_FW,2) + DO i1 = LBOUND(OutData%Eps_FW,1), UBOUND(OutData%Eps_FW,1) + OutData%Eps_FW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_NW 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%r_NW)) DEALLOCATE(OutData%r_NW) + ALLOCATE(OutData%r_NW(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%r_NW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%r_NW,4), UBOUND(OutData%r_NW,4) + DO i3 = LBOUND(OutData%r_NW,3), UBOUND(OutData%r_NW,3) + DO i2 = LBOUND(OutData%r_NW,2), UBOUND(OutData%r_NW,2) + DO i1 = LBOUND(OutData%r_NW,1), UBOUND(OutData%r_NW,1) + OutData%r_NW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_FW 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%r_FW)) DEALLOCATE(OutData%r_FW) + ALLOCATE(OutData%r_FW(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%r_FW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i4 = LBOUND(OutData%r_FW,4), UBOUND(OutData%r_FW,4) + DO i3 = LBOUND(OutData%r_FW,3), UBOUND(OutData%r_FW,3) + DO i2 = LBOUND(OutData%r_FW,2), UBOUND(OutData%r_FW,2) + DO i1 = LBOUND(OutData%r_FW,1), UBOUND(OutData%r_FW,1) + OutData%r_FW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + 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 UA_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%UA, ErrStat2, ErrMsg2 ) ! UA + 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 SUBROUTINE FVW_UnPackContState + + SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FVW_MiscVarType), INTENT(IN) :: SrcMiscData + TYPE(FVW_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 = 'FVW_CopyMisc' +! + ErrStat = ErrID_None + ErrMsg = "" + DstMiscData%FirstCall = SrcMiscData%FirstCall +IF (ALLOCATED(SrcMiscData%LE)) THEN + i1_l = LBOUND(SrcMiscData%LE,1) + i1_u = UBOUND(SrcMiscData%LE,1) + i2_l = LBOUND(SrcMiscData%LE,2) + i2_u = UBOUND(SrcMiscData%LE,2) + i3_l = LBOUND(SrcMiscData%LE,3) + i3_u = UBOUND(SrcMiscData%LE,3) + IF (.NOT. ALLOCATED(DstMiscData%LE)) THEN + ALLOCATE(DstMiscData%LE(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%LE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%LE = SrcMiscData%LE +ENDIF +IF (ALLOCATED(SrcMiscData%TE)) THEN + i1_l = LBOUND(SrcMiscData%TE,1) + i1_u = UBOUND(SrcMiscData%TE,1) + i2_l = LBOUND(SrcMiscData%TE,2) + i2_u = UBOUND(SrcMiscData%TE,2) + i3_l = LBOUND(SrcMiscData%TE,3) + i3_u = UBOUND(SrcMiscData%TE,3) + IF (.NOT. ALLOCATED(DstMiscData%TE)) THEN + ALLOCATE(DstMiscData%TE(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%TE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%TE = SrcMiscData%TE +ENDIF +IF (ALLOCATED(SrcMiscData%r_LL)) THEN + i1_l = LBOUND(SrcMiscData%r_LL,1) + i1_u = UBOUND(SrcMiscData%r_LL,1) + i2_l = LBOUND(SrcMiscData%r_LL,2) + i2_u = UBOUND(SrcMiscData%r_LL,2) + i3_l = LBOUND(SrcMiscData%r_LL,3) + i3_u = UBOUND(SrcMiscData%r_LL,3) + i4_l = LBOUND(SrcMiscData%r_LL,4) + i4_u = UBOUND(SrcMiscData%r_LL,4) + IF (.NOT. ALLOCATED(DstMiscData%r_LL)) THEN + ALLOCATE(DstMiscData%r_LL(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%r_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%r_LL = SrcMiscData%r_LL +ENDIF +IF (ALLOCATED(SrcMiscData%s_LL)) THEN + i1_l = LBOUND(SrcMiscData%s_LL,1) + i1_u = UBOUND(SrcMiscData%s_LL,1) + i2_l = LBOUND(SrcMiscData%s_LL,2) + i2_u = UBOUND(SrcMiscData%s_LL,2) + IF (.NOT. ALLOCATED(DstMiscData%s_LL)) THEN + ALLOCATE(DstMiscData%s_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%s_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%s_LL = SrcMiscData%s_LL +ENDIF +IF (ALLOCATED(SrcMiscData%chord_LL)) THEN + i1_l = LBOUND(SrcMiscData%chord_LL,1) + i1_u = UBOUND(SrcMiscData%chord_LL,1) + i2_l = LBOUND(SrcMiscData%chord_LL,2) + i2_u = UBOUND(SrcMiscData%chord_LL,2) + IF (.NOT. ALLOCATED(DstMiscData%chord_LL)) THEN + ALLOCATE(DstMiscData%chord_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%chord_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%chord_LL = SrcMiscData%chord_LL +ENDIF +IF (ALLOCATED(SrcMiscData%s_CP_LL)) THEN + i1_l = LBOUND(SrcMiscData%s_CP_LL,1) + i1_u = UBOUND(SrcMiscData%s_CP_LL,1) + i2_l = LBOUND(SrcMiscData%s_CP_LL,2) + i2_u = UBOUND(SrcMiscData%s_CP_LL,2) + IF (.NOT. ALLOCATED(DstMiscData%s_CP_LL)) THEN + ALLOCATE(DstMiscData%s_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%s_CP_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%s_CP_LL = SrcMiscData%s_CP_LL +ENDIF +IF (ALLOCATED(SrcMiscData%chord_CP_LL)) THEN + i1_l = LBOUND(SrcMiscData%chord_CP_LL,1) + i1_u = UBOUND(SrcMiscData%chord_CP_LL,1) + i2_l = LBOUND(SrcMiscData%chord_CP_LL,2) + i2_u = UBOUND(SrcMiscData%chord_CP_LL,2) + IF (.NOT. ALLOCATED(DstMiscData%chord_CP_LL)) THEN + ALLOCATE(DstMiscData%chord_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%chord_CP_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%chord_CP_LL = SrcMiscData%chord_CP_LL +ENDIF +IF (ALLOCATED(SrcMiscData%CP_LL)) THEN + i1_l = LBOUND(SrcMiscData%CP_LL,1) + i1_u = UBOUND(SrcMiscData%CP_LL,1) + i2_l = LBOUND(SrcMiscData%CP_LL,2) + i2_u = UBOUND(SrcMiscData%CP_LL,2) + i3_l = LBOUND(SrcMiscData%CP_LL,3) + i3_u = UBOUND(SrcMiscData%CP_LL,3) + IF (.NOT. ALLOCATED(DstMiscData%CP_LL)) THEN + ALLOCATE(DstMiscData%CP_LL(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%CP_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%CP_LL = SrcMiscData%CP_LL +ENDIF +IF (ALLOCATED(SrcMiscData%Tang)) THEN + i1_l = LBOUND(SrcMiscData%Tang,1) + i1_u = UBOUND(SrcMiscData%Tang,1) + i2_l = LBOUND(SrcMiscData%Tang,2) + i2_u = UBOUND(SrcMiscData%Tang,2) + i3_l = LBOUND(SrcMiscData%Tang,3) + i3_u = UBOUND(SrcMiscData%Tang,3) + IF (.NOT. ALLOCATED(DstMiscData%Tang)) THEN + ALLOCATE(DstMiscData%Tang(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%Tang.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Tang = SrcMiscData%Tang +ENDIF +IF (ALLOCATED(SrcMiscData%Norm)) THEN + i1_l = LBOUND(SrcMiscData%Norm,1) + i1_u = UBOUND(SrcMiscData%Norm,1) + i2_l = LBOUND(SrcMiscData%Norm,2) + i2_u = UBOUND(SrcMiscData%Norm,2) + i3_l = LBOUND(SrcMiscData%Norm,3) + i3_u = UBOUND(SrcMiscData%Norm,3) + IF (.NOT. ALLOCATED(DstMiscData%Norm)) THEN + ALLOCATE(DstMiscData%Norm(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%Norm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Norm = SrcMiscData%Norm +ENDIF +IF (ALLOCATED(SrcMiscData%Orth)) THEN + i1_l = LBOUND(SrcMiscData%Orth,1) + i1_u = UBOUND(SrcMiscData%Orth,1) + i2_l = LBOUND(SrcMiscData%Orth,2) + i2_u = UBOUND(SrcMiscData%Orth,2) + i3_l = LBOUND(SrcMiscData%Orth,3) + i3_u = UBOUND(SrcMiscData%Orth,3) + IF (.NOT. ALLOCATED(DstMiscData%Orth)) THEN + ALLOCATE(DstMiscData%Orth(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%Orth.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Orth = SrcMiscData%Orth +ENDIF +IF (ALLOCATED(SrcMiscData%dl)) THEN + i1_l = LBOUND(SrcMiscData%dl,1) + i1_u = UBOUND(SrcMiscData%dl,1) + i2_l = LBOUND(SrcMiscData%dl,2) + i2_u = UBOUND(SrcMiscData%dl,2) + i3_l = LBOUND(SrcMiscData%dl,3) + i3_u = UBOUND(SrcMiscData%dl,3) + IF (.NOT. ALLOCATED(DstMiscData%dl)) THEN + ALLOCATE(DstMiscData%dl(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%dl.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%dl = SrcMiscData%dl +ENDIF +IF (ALLOCATED(SrcMiscData%Area)) THEN + i1_l = LBOUND(SrcMiscData%Area,1) + i1_u = UBOUND(SrcMiscData%Area,1) + i2_l = LBOUND(SrcMiscData%Area,2) + i2_u = UBOUND(SrcMiscData%Area,2) + IF (.NOT. ALLOCATED(DstMiscData%Area)) THEN + ALLOCATE(DstMiscData%Area(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Area.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Area = SrcMiscData%Area +ENDIF +IF (ALLOCATED(SrcMiscData%diag_LL)) THEN + i1_l = LBOUND(SrcMiscData%diag_LL,1) + i1_u = UBOUND(SrcMiscData%diag_LL,1) + i2_l = LBOUND(SrcMiscData%diag_LL,2) + i2_u = UBOUND(SrcMiscData%diag_LL,2) + IF (.NOT. ALLOCATED(DstMiscData%diag_LL)) THEN + ALLOCATE(DstMiscData%diag_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%diag_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%diag_LL = SrcMiscData%diag_LL +ENDIF +IF (ALLOCATED(SrcMiscData%Gamma_LL)) THEN + i1_l = LBOUND(SrcMiscData%Gamma_LL,1) + i1_u = UBOUND(SrcMiscData%Gamma_LL,1) + i2_l = LBOUND(SrcMiscData%Gamma_LL,2) + i2_u = UBOUND(SrcMiscData%Gamma_LL,2) + IF (.NOT. ALLOCATED(DstMiscData%Gamma_LL)) THEN + ALLOCATE(DstMiscData%Gamma_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%Gamma_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Gamma_LL = SrcMiscData%Gamma_LL +ENDIF +IF (ALLOCATED(SrcMiscData%Vind_LL)) THEN + i1_l = LBOUND(SrcMiscData%Vind_LL,1) + i1_u = UBOUND(SrcMiscData%Vind_LL,1) + i2_l = LBOUND(SrcMiscData%Vind_LL,2) + i2_u = UBOUND(SrcMiscData%Vind_LL,2) + i3_l = LBOUND(SrcMiscData%Vind_LL,3) + i3_u = UBOUND(SrcMiscData%Vind_LL,3) + IF (.NOT. ALLOCATED(DstMiscData%Vind_LL)) THEN + ALLOCATE(DstMiscData%Vind_LL(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%Vind_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Vind_LL = SrcMiscData%Vind_LL +ENDIF +IF (ALLOCATED(SrcMiscData%Vtot_LL)) THEN + i1_l = LBOUND(SrcMiscData%Vtot_LL,1) + i1_u = UBOUND(SrcMiscData%Vtot_LL,1) + i2_l = LBOUND(SrcMiscData%Vtot_LL,2) + i2_u = UBOUND(SrcMiscData%Vtot_LL,2) + i3_l = LBOUND(SrcMiscData%Vtot_LL,3) + i3_u = UBOUND(SrcMiscData%Vtot_LL,3) + IF (.NOT. ALLOCATED(DstMiscData%Vtot_LL)) THEN + ALLOCATE(DstMiscData%Vtot_LL(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%Vtot_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Vtot_LL = SrcMiscData%Vtot_LL +ENDIF +IF (ALLOCATED(SrcMiscData%Vstr_LL)) THEN + i1_l = LBOUND(SrcMiscData%Vstr_LL,1) + i1_u = UBOUND(SrcMiscData%Vstr_LL,1) + i2_l = LBOUND(SrcMiscData%Vstr_LL,2) + i2_u = UBOUND(SrcMiscData%Vstr_LL,2) + i3_l = LBOUND(SrcMiscData%Vstr_LL,3) + i3_u = UBOUND(SrcMiscData%Vstr_LL,3) + IF (.NOT. ALLOCATED(DstMiscData%Vstr_LL)) THEN + ALLOCATE(DstMiscData%Vstr_LL(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%Vstr_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Vstr_LL = SrcMiscData%Vstr_LL +ENDIF +IF (ALLOCATED(SrcMiscData%Vwnd_LL)) THEN + i1_l = LBOUND(SrcMiscData%Vwnd_LL,1) + i1_u = UBOUND(SrcMiscData%Vwnd_LL,1) + i2_l = LBOUND(SrcMiscData%Vwnd_LL,2) + i2_u = UBOUND(SrcMiscData%Vwnd_LL,2) + i3_l = LBOUND(SrcMiscData%Vwnd_LL,3) + i3_u = UBOUND(SrcMiscData%Vwnd_LL,3) + IF (.NOT. ALLOCATED(DstMiscData%Vwnd_LL)) THEN + ALLOCATE(DstMiscData%Vwnd_LL(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%Vwnd_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Vwnd_LL = SrcMiscData%Vwnd_LL +ENDIF +IF (ALLOCATED(SrcMiscData%Vwnd_NW)) THEN + i1_l = LBOUND(SrcMiscData%Vwnd_NW,1) + i1_u = UBOUND(SrcMiscData%Vwnd_NW,1) + i2_l = LBOUND(SrcMiscData%Vwnd_NW,2) + i2_u = UBOUND(SrcMiscData%Vwnd_NW,2) + i3_l = LBOUND(SrcMiscData%Vwnd_NW,3) + i3_u = UBOUND(SrcMiscData%Vwnd_NW,3) + i4_l = LBOUND(SrcMiscData%Vwnd_NW,4) + i4_u = UBOUND(SrcMiscData%Vwnd_NW,4) + IF (.NOT. ALLOCATED(DstMiscData%Vwnd_NW)) THEN + ALLOCATE(DstMiscData%Vwnd_NW(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%Vwnd_NW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Vwnd_NW = SrcMiscData%Vwnd_NW +ENDIF +IF (ALLOCATED(SrcMiscData%Vwnd_FW)) THEN + i1_l = LBOUND(SrcMiscData%Vwnd_FW,1) + i1_u = UBOUND(SrcMiscData%Vwnd_FW,1) + i2_l = LBOUND(SrcMiscData%Vwnd_FW,2) + i2_u = UBOUND(SrcMiscData%Vwnd_FW,2) + i3_l = LBOUND(SrcMiscData%Vwnd_FW,3) + i3_u = UBOUND(SrcMiscData%Vwnd_FW,3) + i4_l = LBOUND(SrcMiscData%Vwnd_FW,4) + i4_u = UBOUND(SrcMiscData%Vwnd_FW,4) + IF (.NOT. ALLOCATED(DstMiscData%Vwnd_FW)) THEN + ALLOCATE(DstMiscData%Vwnd_FW(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%Vwnd_FW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Vwnd_FW = SrcMiscData%Vwnd_FW +ENDIF +IF (ALLOCATED(SrcMiscData%Vind_NW)) THEN + i1_l = LBOUND(SrcMiscData%Vind_NW,1) + i1_u = UBOUND(SrcMiscData%Vind_NW,1) + i2_l = LBOUND(SrcMiscData%Vind_NW,2) + i2_u = UBOUND(SrcMiscData%Vind_NW,2) + i3_l = LBOUND(SrcMiscData%Vind_NW,3) + i3_u = UBOUND(SrcMiscData%Vind_NW,3) + i4_l = LBOUND(SrcMiscData%Vind_NW,4) + i4_u = UBOUND(SrcMiscData%Vind_NW,4) + IF (.NOT. ALLOCATED(DstMiscData%Vind_NW)) THEN + ALLOCATE(DstMiscData%Vind_NW(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%Vind_NW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Vind_NW = SrcMiscData%Vind_NW +ENDIF +IF (ALLOCATED(SrcMiscData%Vind_FW)) THEN + i1_l = LBOUND(SrcMiscData%Vind_FW,1) + i1_u = UBOUND(SrcMiscData%Vind_FW,1) + i2_l = LBOUND(SrcMiscData%Vind_FW,2) + i2_u = UBOUND(SrcMiscData%Vind_FW,2) + i3_l = LBOUND(SrcMiscData%Vind_FW,3) + i3_u = UBOUND(SrcMiscData%Vind_FW,3) + i4_l = LBOUND(SrcMiscData%Vind_FW,4) + i4_u = UBOUND(SrcMiscData%Vind_FW,4) + IF (.NOT. ALLOCATED(DstMiscData%Vind_FW)) THEN + ALLOCATE(DstMiscData%Vind_FW(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%Vind_FW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscData%Vind_FW = SrcMiscData%Vind_FW +ENDIF + DstMiscData%nNW = SrcMiscData%nNW + DstMiscData%nFW = SrcMiscData%nFW + DstMiscData%iStep = SrcMiscData%iStep + DstMiscData%VTKstep = SrcMiscData%VTKstep + DstMiscData%VTKlastTime = SrcMiscData%VTKlastTime +IF (ALLOCATED(SrcMiscData%r_wind)) THEN + i1_l = LBOUND(SrcMiscData%r_wind,1) + i1_u = UBOUND(SrcMiscData%r_wind,1) + i2_l = LBOUND(SrcMiscData%r_wind,2) + i2_u = UBOUND(SrcMiscData%r_wind,2) + IF (.NOT. ALLOCATED(DstMiscData%r_wind)) THEN + ALLOCATE(DstMiscData%r_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%r_wind.', ErrStat, ErrMsg,RoutineName) RETURN END IF @@ -1908,42 +2636,9 @@ SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%ComputeWakeInduced = SrcMiscData%ComputeWakeInduced DstMiscData%OldWakeTime = SrcMiscData%OldWakeTime DstMiscData%tSpent = SrcMiscData%tSpent -IF (ALLOCATED(SrcMiscData%dxdt_NW)) THEN - i1_l = LBOUND(SrcMiscData%dxdt_NW,1) - i1_u = UBOUND(SrcMiscData%dxdt_NW,1) - i2_l = LBOUND(SrcMiscData%dxdt_NW,2) - i2_u = UBOUND(SrcMiscData%dxdt_NW,2) - i3_l = LBOUND(SrcMiscData%dxdt_NW,3) - i3_u = UBOUND(SrcMiscData%dxdt_NW,3) - i4_l = LBOUND(SrcMiscData%dxdt_NW,4) - i4_u = UBOUND(SrcMiscData%dxdt_NW,4) - IF (.NOT. ALLOCATED(DstMiscData%dxdt_NW)) THEN - ALLOCATE(DstMiscData%dxdt_NW(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%dxdt_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dxdt_NW = SrcMiscData%dxdt_NW -ENDIF -IF (ALLOCATED(SrcMiscData%dxdt_FW)) THEN - i1_l = LBOUND(SrcMiscData%dxdt_FW,1) - i1_u = UBOUND(SrcMiscData%dxdt_FW,1) - i2_l = LBOUND(SrcMiscData%dxdt_FW,2) - i2_u = UBOUND(SrcMiscData%dxdt_FW,2) - i3_l = LBOUND(SrcMiscData%dxdt_FW,3) - i3_u = UBOUND(SrcMiscData%dxdt_FW,3) - i4_l = LBOUND(SrcMiscData%dxdt_FW,4) - i4_u = UBOUND(SrcMiscData%dxdt_FW,4) - IF (.NOT. ALLOCATED(DstMiscData%dxdt_FW)) THEN - ALLOCATE(DstMiscData%dxdt_FW(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%dxdt_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%dxdt_FW = SrcMiscData%dxdt_FW -ENDIF + CALL FVW_CopyContState( SrcMiscData%dxdt, DstMiscData%dxdt, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN IF (ALLOCATED(SrcMiscData%alpha_LL)) THEN i1_l = LBOUND(SrcMiscData%alpha_LL,1) i1_u = UBOUND(SrcMiscData%alpha_LL,1) @@ -2351,12 +3046,7 @@ SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg ) IF (ALLOCATED(MiscData%PitchAndTwist)) THEN DEALLOCATE(MiscData%PitchAndTwist) ENDIF -IF (ALLOCATED(MiscData%dxdt_NW)) THEN - DEALLOCATE(MiscData%dxdt_NW) -ENDIF -IF (ALLOCATED(MiscData%dxdt_FW)) THEN - DEALLOCATE(MiscData%dxdt_FW) -ENDIF + CALL FVW_DestroyContState( MiscData%dxdt, ErrStat, ErrMsg ) IF (ALLOCATED(MiscData%alpha_LL)) THEN DEALLOCATE(MiscData%alpha_LL) ENDIF @@ -2537,1571 +3227,957 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*2 ! Area upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%Area) ! Area END IF - Int_BufSz = Int_BufSz + 1 ! diag_LL allocated yes/no - IF ( ALLOCATED(InData%diag_LL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! diag_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%diag_LL) ! diag_LL - END IF - Int_BufSz = Int_BufSz + 1 ! Gamma_LL allocated yes/no - IF ( ALLOCATED(InData%Gamma_LL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Gamma_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Gamma_LL) ! Gamma_LL - END IF - Int_BufSz = Int_BufSz + 1 ! Vind_LL allocated yes/no - IF ( ALLOCATED(InData%Vind_LL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vind_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind_LL) ! Vind_LL - END IF - Int_BufSz = Int_BufSz + 1 ! Vtot_LL allocated yes/no - IF ( ALLOCATED(InData%Vtot_LL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vtot_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vtot_LL) ! Vtot_LL - END IF - Int_BufSz = Int_BufSz + 1 ! Vstr_LL allocated yes/no - IF ( ALLOCATED(InData%Vstr_LL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vstr_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vstr_LL) ! Vstr_LL - END IF - Int_BufSz = Int_BufSz + 1 ! Vwnd_LL allocated yes/no - IF ( ALLOCATED(InData%Vwnd_LL) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vwnd_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_LL) ! Vwnd_LL - END IF - Int_BufSz = Int_BufSz + 1 ! Vwnd_NW allocated yes/no - IF ( ALLOCATED(InData%Vwnd_NW) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vwnd_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_NW) ! Vwnd_NW - END IF - Int_BufSz = Int_BufSz + 1 ! Vwnd_FW allocated yes/no - IF ( ALLOCATED(InData%Vwnd_FW) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vwnd_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_FW) ! Vwnd_FW - END IF - Int_BufSz = Int_BufSz + 1 ! Vind_NW allocated yes/no - IF ( ALLOCATED(InData%Vind_NW) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vind_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind_NW) ! Vind_NW - END IF - Int_BufSz = Int_BufSz + 1 ! Vind_FW allocated yes/no - IF ( ALLOCATED(InData%Vind_FW) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! Vind_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind_FW) ! Vind_FW - END IF - Int_BufSz = Int_BufSz + 1 ! nNW - Int_BufSz = Int_BufSz + 1 ! nFW - Int_BufSz = Int_BufSz + 1 ! iStep - Int_BufSz = Int_BufSz + 1 ! VTKstep - Db_BufSz = Db_BufSz + 1 ! VTKlastTime - Int_BufSz = Int_BufSz + 1 ! r_wind allocated yes/no - IF ( ALLOCATED(InData%r_wind) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! r_wind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_wind) ! r_wind - END IF - Int_BufSz = Int_BufSz + 1 ! PitchAndTwist allocated yes/no - IF ( ALLOCATED(InData%PitchAndTwist) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! PitchAndTwist upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%PitchAndTwist) ! PitchAndTwist - END IF - Int_BufSz = Int_BufSz + 1 ! ComputeWakeInduced - Db_BufSz = Db_BufSz + 1 ! OldWakeTime - Re_BufSz = Re_BufSz + 1 ! tSpent - Int_BufSz = Int_BufSz + 1 ! dxdt_NW allocated yes/no - IF ( ALLOCATED(InData%dxdt_NW) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! dxdt_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dxdt_NW) ! dxdt_NW - END IF - Int_BufSz = Int_BufSz + 1 ! dxdt_FW allocated yes/no - IF ( ALLOCATED(InData%dxdt_FW) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! dxdt_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%dxdt_FW) ! dxdt_FW - END IF - Int_BufSz = Int_BufSz + 1 ! alpha_LL allocated yes/no - IF ( ALLOCATED(InData%alpha_LL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! alpha_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%alpha_LL) ! alpha_LL - END IF - Int_BufSz = Int_BufSz + 1 ! Vreln_LL allocated yes/no - IF ( ALLOCATED(InData%Vreln_LL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Vreln_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vreln_LL) ! Vreln_LL - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! Sgmt: size of buffers for each call to pack subtype - CALL FVW_Packt_sgmt( Re_Buf, Db_Buf, Int_Buf, InData%Sgmt, ErrStat2, ErrMsg2, .TRUE. ) ! Sgmt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Sgmt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Sgmt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Sgmt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! CPs allocated yes/no - IF ( ALLOCATED(InData%CPs) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! CPs upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%CPs) ! CPs - END IF - Int_BufSz = Int_BufSz + 1 ! Uind allocated yes/no - IF ( ALLOCATED(InData%Uind) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Uind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Uind) ! Uind - END IF - Int_BufSz = Int_BufSz + 1 ! BN_AxInd allocated yes/no - IF ( ALLOCATED(InData%BN_AxInd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BN_AxInd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_AxInd) ! BN_AxInd - END IF - Int_BufSz = Int_BufSz + 1 ! BN_TanInd allocated yes/no - IF ( ALLOCATED(InData%BN_TanInd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BN_TanInd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_TanInd) ! BN_TanInd - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Vrel allocated yes/no - IF ( ALLOCATED(InData%BN_Vrel) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BN_Vrel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Vrel) ! BN_Vrel - END IF - Int_BufSz = Int_BufSz + 1 ! BN_alpha allocated yes/no - IF ( ALLOCATED(InData%BN_alpha) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BN_alpha upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_alpha) ! BN_alpha - END IF - Int_BufSz = Int_BufSz + 1 ! BN_phi allocated yes/no - IF ( ALLOCATED(InData%BN_phi) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BN_phi upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_phi) ! BN_phi - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Re allocated yes/no - IF ( ALLOCATED(InData%BN_Re) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BN_Re upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Re) ! BN_Re - END IF - Int_BufSz = Int_BufSz + 1 ! BN_URelWind_s allocated yes/no - IF ( ALLOCATED(InData%BN_URelWind_s) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! BN_URelWind_s upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_URelWind_s) ! BN_URelWind_s - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cl_Static allocated yes/no - IF ( ALLOCATED(InData%BN_Cl_Static) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BN_Cl_Static upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cl_Static) ! BN_Cl_Static - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cd_Static allocated yes/no - IF ( ALLOCATED(InData%BN_Cd_Static) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BN_Cd_Static upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cd_Static) ! BN_Cd_Static - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cm_Static allocated yes/no - IF ( ALLOCATED(InData%BN_Cm_Static) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BN_Cm_Static upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cm_Static) ! BN_Cm_Static - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cl allocated yes/no - IF ( ALLOCATED(InData%BN_Cl) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BN_Cl upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cl) ! BN_Cl - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cd allocated yes/no - IF ( ALLOCATED(InData%BN_Cd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BN_Cd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cd) ! BN_Cd - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cm allocated yes/no - IF ( ALLOCATED(InData%BN_Cm) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BN_Cm upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cm) ! BN_Cm - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cx allocated yes/no - IF ( ALLOCATED(InData%BN_Cx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BN_Cx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cx) ! BN_Cx - END IF - Int_BufSz = Int_BufSz + 1 ! BN_Cy allocated yes/no - IF ( ALLOCATED(InData%BN_Cy) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! BN_Cy upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%BN_Cy) ! BN_Cy - END IF - Int_BufSz = Int_BufSz + 1 ! GridOutputs allocated yes/no - IF ( ALLOCATED(InData%GridOutputs) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GridOutputs upper/lower bounds for each dimension - DO i1 = LBOUND(InData%GridOutputs,1), UBOUND(InData%GridOutputs,1) - Int_BufSz = Int_BufSz + 3 ! GridOutputs: size of buffers for each call to pack subtype - CALL FVW_Packgridouttype( Re_Buf, Db_Buf, Int_Buf, InData%GridOutputs(i1), ErrStat2, ErrMsg2, .TRUE. ) ! GridOutputs - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! GridOutputs - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! GridOutputs - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! GridOutputs - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + Int_BufSz = Int_BufSz + 1 ! diag_LL allocated yes/no + IF ( ALLOCATED(InData%diag_LL) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! diag_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%diag_LL) ! diag_LL END IF - Int_BufSz = Int_BufSz + 1 ! u_UA allocated yes/no - IF ( ALLOCATED(InData%u_UA) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! u_UA upper/lower bounds for each dimension - DO i3 = LBOUND(InData%u_UA,3), UBOUND(InData%u_UA,3) - DO i2 = LBOUND(InData%u_UA,2), UBOUND(InData%u_UA,2) - DO i1 = LBOUND(InData%u_UA,1), UBOUND(InData%u_UA,1) - Int_BufSz = Int_BufSz + 3 ! u_UA: size of buffers for each call to pack subtype - CALL UA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2, .TRUE. ) ! u_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END DO + Int_BufSz = Int_BufSz + 1 ! Gamma_LL allocated yes/no + IF ( ALLOCATED(InData%Gamma_LL) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Gamma_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Gamma_LL) ! Gamma_LL END IF - Int_BufSz = Int_BufSz + 3 ! m_UA: size of buffers for each call to pack subtype - CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_UA, ErrStat2, ErrMsg2, .TRUE. ) ! m_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y_UA: size of buffers for each call to pack subtype - CALL UA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_UA, ErrStat2, ErrMsg2, .TRUE. ) ! y_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p_UA: size of buffers for each call to pack subtype - CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_UA, ErrStat2, ErrMsg2, .TRUE. ) ! p_UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p_UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p_UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p_UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! UA_Flag - 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 + Int_BufSz = Int_BufSz + 1 ! Vind_LL allocated yes/no + IF ( ALLOCATED(InData%Vind_LL) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Vind_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vind_LL) ! Vind_LL 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 + Int_BufSz = Int_BufSz + 1 ! Vtot_LL allocated yes/no + IF ( ALLOCATED(InData%Vtot_LL) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Vtot_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vtot_LL) ! Vtot_LL 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 + Int_BufSz = Int_BufSz + 1 ! Vstr_LL allocated yes/no + IF ( ALLOCATED(InData%Vstr_LL) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Vstr_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vstr_LL) ! Vstr_LL 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) = TRANSFER(InData%FirstCall, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%LE) ) 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%LE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%LE,3), UBOUND(InData%LE,3) - DO i2 = LBOUND(InData%LE,2), UBOUND(InData%LE,2) - DO i1 = LBOUND(InData%LE,1), UBOUND(InData%LE,1) - ReKiBuf(Re_Xferred) = InData%LE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO + Int_BufSz = Int_BufSz + 1 ! Vwnd_LL allocated yes/no + IF ( ALLOCATED(InData%Vwnd_LL) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Vwnd_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_LL) ! Vwnd_LL END IF - IF ( .NOT. ALLOCATED(InData%TE) ) 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%TE,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TE,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TE,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TE,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TE,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TE,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%TE,3), UBOUND(InData%TE,3) - DO i2 = LBOUND(InData%TE,2), UBOUND(InData%TE,2) - DO i1 = LBOUND(InData%TE,1), UBOUND(InData%TE,1) - ReKiBuf(Re_Xferred) = InData%TE(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO + Int_BufSz = Int_BufSz + 1 ! Vwnd_NW allocated yes/no + IF ( ALLOCATED(InData%Vwnd_NW) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! Vwnd_NW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_NW) ! Vwnd_NW END IF - IF ( .NOT. ALLOCATED(InData%r_LL) ) 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%r_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_LL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_LL,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%r_LL,4), UBOUND(InData%r_LL,4) - DO i3 = LBOUND(InData%r_LL,3), UBOUND(InData%r_LL,3) - DO i2 = LBOUND(InData%r_LL,2), UBOUND(InData%r_LL,2) - DO i1 = LBOUND(InData%r_LL,1), UBOUND(InData%r_LL,1) - ReKiBuf(Re_Xferred) = InData%r_LL(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO + Int_BufSz = Int_BufSz + 1 ! Vwnd_FW allocated yes/no + IF ( ALLOCATED(InData%Vwnd_FW) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! Vwnd_FW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_FW) ! Vwnd_FW END IF - IF ( .NOT. ALLOCATED(InData%s_LL) ) 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%s_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%s_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_LL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%s_LL,2), UBOUND(InData%s_LL,2) - DO i1 = LBOUND(InData%s_LL,1), UBOUND(InData%s_LL,1) - ReKiBuf(Re_Xferred) = InData%s_LL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + Int_BufSz = Int_BufSz + 1 ! Vind_NW allocated yes/no + IF ( ALLOCATED(InData%Vind_NW) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! Vind_NW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vind_NW) ! Vind_NW + END IF + Int_BufSz = Int_BufSz + 1 ! Vind_FW allocated yes/no + IF ( ALLOCATED(InData%Vind_FW) ) THEN + Int_BufSz = Int_BufSz + 2*4 ! Vind_FW upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vind_FW) ! Vind_FW + END IF + Int_BufSz = Int_BufSz + 1 ! nNW + Int_BufSz = Int_BufSz + 1 ! nFW + Int_BufSz = Int_BufSz + 1 ! iStep + Int_BufSz = Int_BufSz + 1 ! VTKstep + Db_BufSz = Db_BufSz + 1 ! VTKlastTime + Int_BufSz = Int_BufSz + 1 ! r_wind allocated yes/no + IF ( ALLOCATED(InData%r_wind) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! r_wind upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%r_wind) ! r_wind + END IF + Int_BufSz = Int_BufSz + 1 ! PitchAndTwist allocated yes/no + IF ( ALLOCATED(InData%PitchAndTwist) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! PitchAndTwist upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%PitchAndTwist) ! PitchAndTwist END IF - IF ( .NOT. ALLOCATED(InData%chord_LL) ) 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%chord_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_LL,2) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! ComputeWakeInduced + Db_BufSz = Db_BufSz + 1 ! OldWakeTime + Re_BufSz = Re_BufSz + 1 ! tSpent + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! dxdt: size of buffers for each call to pack subtype + CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%dxdt, ErrStat2, ErrMsg2, .TRUE. ) ! dxdt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - DO i2 = LBOUND(InData%chord_LL,2), UBOUND(InData%chord_LL,2) - DO i1 = LBOUND(InData%chord_LL,1), UBOUND(InData%chord_LL,1) - ReKiBuf(Re_Xferred) = InData%chord_LL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + IF(ALLOCATED(Re_Buf)) THEN ! dxdt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! dxdt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! dxdt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! alpha_LL allocated yes/no + IF ( ALLOCATED(InData%alpha_LL) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! alpha_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%alpha_LL) ! alpha_LL END IF - IF ( .NOT. ALLOCATED(InData%s_CP_LL) ) 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%s_CP_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_CP_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%s_CP_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_CP_LL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%s_CP_LL,2), UBOUND(InData%s_CP_LL,2) - DO i1 = LBOUND(InData%s_CP_LL,1), UBOUND(InData%s_CP_LL,1) - ReKiBuf(Re_Xferred) = InData%s_CP_LL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + Int_BufSz = Int_BufSz + 1 ! Vreln_LL allocated yes/no + IF ( ALLOCATED(InData%Vreln_LL) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Vreln_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vreln_LL) ! Vreln_LL END IF - IF ( .NOT. ALLOCATED(InData%chord_CP_LL) ) 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%chord_CP_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_CP_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord_CP_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_CP_LL,2) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 3 ! Sgmt: size of buffers for each call to pack subtype + CALL FVW_Packt_sgmt( Re_Buf, Db_Buf, Int_Buf, InData%Sgmt, ErrStat2, ErrMsg2, .TRUE. ) ! Sgmt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - DO i2 = LBOUND(InData%chord_CP_LL,2), UBOUND(InData%chord_CP_LL,2) - DO i1 = LBOUND(InData%chord_CP_LL,1), UBOUND(InData%chord_CP_LL,1) - ReKiBuf(Re_Xferred) = InData%chord_CP_LL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + IF(ALLOCATED(Re_Buf)) THEN ! Sgmt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Sgmt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Sgmt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! CPs allocated yes/no + IF ( ALLOCATED(InData%CPs) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! CPs upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%CPs) ! CPs END IF - IF ( .NOT. ALLOCATED(InData%CP_LL) ) 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%CP_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CP_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CP_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CP_LL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CP_LL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CP_LL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%CP_LL,3), UBOUND(InData%CP_LL,3) - DO i2 = LBOUND(InData%CP_LL,2), UBOUND(InData%CP_LL,2) - DO i1 = LBOUND(InData%CP_LL,1), UBOUND(InData%CP_LL,1) - ReKiBuf(Re_Xferred) = InData%CP_LL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO + Int_BufSz = Int_BufSz + 1 ! Uind allocated yes/no + IF ( ALLOCATED(InData%Uind) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Uind upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Uind) ! Uind END IF - IF ( .NOT. ALLOCATED(InData%Tang) ) 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%Tang,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tang,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Tang,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tang,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Tang,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tang,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Tang,3), UBOUND(InData%Tang,3) - DO i2 = LBOUND(InData%Tang,2), UBOUND(InData%Tang,2) - DO i1 = LBOUND(InData%Tang,1), UBOUND(InData%Tang,1) - ReKiBuf(Re_Xferred) = InData%Tang(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO + Int_BufSz = Int_BufSz + 1 ! BN_AxInd allocated yes/no + IF ( ALLOCATED(InData%BN_AxInd) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_AxInd upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_AxInd) ! BN_AxInd END IF - IF ( .NOT. ALLOCATED(InData%Norm) ) 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%Norm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Norm,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Norm,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Norm,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Norm,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Norm,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Norm,3), UBOUND(InData%Norm,3) - DO i2 = LBOUND(InData%Norm,2), UBOUND(InData%Norm,2) - DO i1 = LBOUND(InData%Norm,1), UBOUND(InData%Norm,1) - ReKiBuf(Re_Xferred) = InData%Norm(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO + Int_BufSz = Int_BufSz + 1 ! BN_TanInd allocated yes/no + IF ( ALLOCATED(InData%BN_TanInd) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_TanInd upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_TanInd) ! BN_TanInd END IF - IF ( .NOT. ALLOCATED(InData%Orth) ) 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%Orth,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Orth,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Orth,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Orth,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Orth,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Orth,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Orth,3), UBOUND(InData%Orth,3) - DO i2 = LBOUND(InData%Orth,2), UBOUND(InData%Orth,2) - DO i1 = LBOUND(InData%Orth,1), UBOUND(InData%Orth,1) - ReKiBuf(Re_Xferred) = InData%Orth(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO + Int_BufSz = Int_BufSz + 1 ! BN_Vrel allocated yes/no + IF ( ALLOCATED(InData%BN_Vrel) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_Vrel upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_Vrel) ! BN_Vrel END IF - IF ( .NOT. ALLOCATED(InData%dl) ) 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%dl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dl,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dl,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%dl,3), UBOUND(InData%dl,3) - DO i2 = LBOUND(InData%dl,2), UBOUND(InData%dl,2) - DO i1 = LBOUND(InData%dl,1), UBOUND(InData%dl,1) - ReKiBuf(Re_Xferred) = InData%dl(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO + Int_BufSz = Int_BufSz + 1 ! BN_alpha allocated yes/no + IF ( ALLOCATED(InData%BN_alpha) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_alpha upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_alpha) ! BN_alpha + END IF + Int_BufSz = Int_BufSz + 1 ! BN_phi allocated yes/no + IF ( ALLOCATED(InData%BN_phi) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_phi upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_phi) ! BN_phi + END IF + Int_BufSz = Int_BufSz + 1 ! BN_Re allocated yes/no + IF ( ALLOCATED(InData%BN_Re) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_Re upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_Re) ! BN_Re + END IF + Int_BufSz = Int_BufSz + 1 ! BN_URelWind_s allocated yes/no + IF ( ALLOCATED(InData%BN_URelWind_s) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! BN_URelWind_s upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_URelWind_s) ! BN_URelWind_s + END IF + Int_BufSz = Int_BufSz + 1 ! BN_Cl_Static allocated yes/no + IF ( ALLOCATED(InData%BN_Cl_Static) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_Cl_Static upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_Cl_Static) ! BN_Cl_Static END IF - IF ( .NOT. ALLOCATED(InData%Area) ) 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%Area,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Area,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Area,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Area,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Area,2), UBOUND(InData%Area,2) - DO i1 = LBOUND(InData%Area,1), UBOUND(InData%Area,1) - ReKiBuf(Re_Xferred) = InData%Area(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + Int_BufSz = Int_BufSz + 1 ! BN_Cd_Static allocated yes/no + IF ( ALLOCATED(InData%BN_Cd_Static) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_Cd_Static upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_Cd_Static) ! BN_Cd_Static END IF - IF ( .NOT. ALLOCATED(InData%diag_LL) ) 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%diag_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%diag_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%diag_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%diag_LL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%diag_LL,2), UBOUND(InData%diag_LL,2) - DO i1 = LBOUND(InData%diag_LL,1), UBOUND(InData%diag_LL,1) - ReKiBuf(Re_Xferred) = InData%diag_LL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + Int_BufSz = Int_BufSz + 1 ! BN_Cm_Static allocated yes/no + IF ( ALLOCATED(InData%BN_Cm_Static) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_Cm_Static upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_Cm_Static) ! BN_Cm_Static END IF - IF ( .NOT. ALLOCATED(InData%Gamma_LL) ) 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%Gamma_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_LL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Gamma_LL,2), UBOUND(InData%Gamma_LL,2) - DO i1 = LBOUND(InData%Gamma_LL,1), UBOUND(InData%Gamma_LL,1) - ReKiBuf(Re_Xferred) = InData%Gamma_LL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + Int_BufSz = Int_BufSz + 1 ! BN_Cl allocated yes/no + IF ( ALLOCATED(InData%BN_Cl) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_Cl upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_Cl) ! BN_Cl END IF - IF ( .NOT. ALLOCATED(InData%Vind_LL) ) 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%Vind_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_LL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_LL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_LL,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vind_LL,3), UBOUND(InData%Vind_LL,3) - DO i2 = LBOUND(InData%Vind_LL,2), UBOUND(InData%Vind_LL,2) - DO i1 = LBOUND(InData%Vind_LL,1), UBOUND(InData%Vind_LL,1) - ReKiBuf(Re_Xferred) = InData%Vind_LL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO + Int_BufSz = Int_BufSz + 1 ! BN_Cd allocated yes/no + IF ( ALLOCATED(InData%BN_Cd) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_Cd upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_Cd) ! BN_Cd END IF - IF ( .NOT. ALLOCATED(InData%Vtot_LL) ) 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%Vtot_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vtot_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vtot_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vtot_LL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vtot_LL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vtot_LL,3) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! BN_Cm allocated yes/no + IF ( ALLOCATED(InData%BN_Cm) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_Cm upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_Cm) ! BN_Cm + END IF + Int_BufSz = Int_BufSz + 1 ! BN_Cx allocated yes/no + IF ( ALLOCATED(InData%BN_Cx) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_Cx upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_Cx) ! BN_Cx + END IF + Int_BufSz = Int_BufSz + 1 ! BN_Cy allocated yes/no + IF ( ALLOCATED(InData%BN_Cy) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! BN_Cy upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BN_Cy) ! BN_Cy + END IF + Int_BufSz = Int_BufSz + 1 ! GridOutputs allocated yes/no + IF ( ALLOCATED(InData%GridOutputs) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! GridOutputs upper/lower bounds for each dimension + DO i1 = LBOUND(InData%GridOutputs,1), UBOUND(InData%GridOutputs,1) + Int_BufSz = Int_BufSz + 3 ! GridOutputs: size of buffers for each call to pack subtype + CALL FVW_Packgridouttype( Re_Buf, Db_Buf, Int_Buf, InData%GridOutputs(i1), ErrStat2, ErrMsg2, .TRUE. ) ! GridOutputs + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - DO i3 = LBOUND(InData%Vtot_LL,3), UBOUND(InData%Vtot_LL,3) - DO i2 = LBOUND(InData%Vtot_LL,2), UBOUND(InData%Vtot_LL,2) - DO i1 = LBOUND(InData%Vtot_LL,1), UBOUND(InData%Vtot_LL,1) - ReKiBuf(Re_Xferred) = InData%Vtot_LL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO + IF(ALLOCATED(Re_Buf)) THEN ! GridOutputs + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! GridOutputs + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! GridOutputs + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%Vstr_LL) ) 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%Vstr_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vstr_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vstr_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vstr_LL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vstr_LL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vstr_LL,3) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! u_UA allocated yes/no + IF ( ALLOCATED(InData%u_UA) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! u_UA upper/lower bounds for each dimension + DO i3 = LBOUND(InData%u_UA,3), UBOUND(InData%u_UA,3) + DO i2 = LBOUND(InData%u_UA,2), UBOUND(InData%u_UA,2) + DO i1 = LBOUND(InData%u_UA,1), UBOUND(InData%u_UA,1) + Int_BufSz = Int_BufSz + 3 ! u_UA: size of buffers for each call to pack subtype + CALL UA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2, .TRUE. ) ! u_UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - DO i3 = LBOUND(InData%Vstr_LL,3), UBOUND(InData%Vstr_LL,3) - DO i2 = LBOUND(InData%Vstr_LL,2), UBOUND(InData%Vstr_LL,2) - DO i1 = LBOUND(InData%Vstr_LL,1), UBOUND(InData%Vstr_LL,1) - ReKiBuf(Re_Xferred) = InData%Vstr_LL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO + IF(ALLOCATED(Re_Buf)) THEN ! u_UA + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_UA + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_UA + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%Vwnd_LL) ) 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%Vwnd_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LL,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LL,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LL,3) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 3 ! m_UA: size of buffers for each call to pack subtype + CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_UA, ErrStat2, ErrMsg2, .TRUE. ) ! m_UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m_UA + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m_UA + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m_UA + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y_UA: size of buffers for each call to pack subtype + CALL UA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_UA, ErrStat2, ErrMsg2, .TRUE. ) ! y_UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_UA + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_UA + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_UA + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! p_UA: size of buffers for each call to pack subtype + CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_UA, ErrStat2, ErrMsg2, .TRUE. ) ! p_UA + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - DO i3 = LBOUND(InData%Vwnd_LL,3), UBOUND(InData%Vwnd_LL,3) - DO i2 = LBOUND(InData%Vwnd_LL,2), UBOUND(InData%Vwnd_LL,2) - DO i1 = LBOUND(InData%Vwnd_LL,1), UBOUND(InData%Vwnd_LL,1) - ReKiBuf(Re_Xferred) = InData%Vwnd_LL(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO + IF(ALLOCATED(Re_Buf)) THEN ! p_UA + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p_UA + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p_UA + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! UA_Flag + 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 ( .NOT. ALLOCATED(InData%Vwnd_NW) ) 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%Vwnd_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_NW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_NW,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vwnd_NW,4), UBOUND(InData%Vwnd_NW,4) - DO i3 = LBOUND(InData%Vwnd_NW,3), UBOUND(InData%Vwnd_NW,3) - DO i2 = LBOUND(InData%Vwnd_NW,2), UBOUND(InData%Vwnd_NW,2) - DO i1 = LBOUND(InData%Vwnd_NW,1), UBOUND(InData%Vwnd_NW,1) - ReKiBuf(Re_Xferred) = InData%Vwnd_NW(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO + 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 ( .NOT. ALLOCATED(InData%Vwnd_FW) ) 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%Vwnd_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_FW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_FW,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,4) - Int_Xferred = Int_Xferred + 2 - - DO i4 = LBOUND(InData%Vwnd_FW,4), UBOUND(InData%Vwnd_FW,4) - DO i3 = LBOUND(InData%Vwnd_FW,3), UBOUND(InData%Vwnd_FW,3) - DO i2 = LBOUND(InData%Vwnd_FW,2), UBOUND(InData%Vwnd_FW,2) - DO i1 = LBOUND(InData%Vwnd_FW,1), UBOUND(InData%Vwnd_FW,1) - ReKiBuf(Re_Xferred) = InData%Vwnd_FW(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO + 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 ( .NOT. ALLOCATED(InData%Vind_NW) ) 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%Vind_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_NW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_NW,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,4) - Int_Xferred = Int_Xferred + 2 + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - DO i4 = LBOUND(InData%Vind_NW,4), UBOUND(InData%Vind_NW,4) - DO i3 = LBOUND(InData%Vind_NW,3), UBOUND(InData%Vind_NW,3) - DO i2 = LBOUND(InData%Vind_NW,2), UBOUND(InData%Vind_NW,2) - DO i1 = LBOUND(InData%Vind_NW,1), UBOUND(InData%Vind_NW,1) - ReKiBuf(Re_Xferred) = InData%Vind_NW(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Vind_FW) ) THEN + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstCall, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%LE) ) 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%Vind_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%LE,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_FW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,3) + IntKiBuf( Int_Xferred ) = LBOUND(InData%LE,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE,2) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_FW,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,4) + IntKiBuf( Int_Xferred ) = LBOUND(InData%LE,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LE,3) Int_Xferred = Int_Xferred + 2 - DO i4 = LBOUND(InData%Vind_FW,4), UBOUND(InData%Vind_FW,4) - DO i3 = LBOUND(InData%Vind_FW,3), UBOUND(InData%Vind_FW,3) - DO i2 = LBOUND(InData%Vind_FW,2), UBOUND(InData%Vind_FW,2) - DO i1 = LBOUND(InData%Vind_FW,1), UBOUND(InData%Vind_FW,1) - ReKiBuf(Re_Xferred) = InData%Vind_FW(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO + DO i3 = LBOUND(InData%LE,3), UBOUND(InData%LE,3) + DO i2 = LBOUND(InData%LE,2), UBOUND(InData%LE,2) + DO i1 = LBOUND(InData%LE,1), UBOUND(InData%LE,1) + ReKiBuf(Re_Xferred) = InData%LE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 END DO END DO END DO END IF - IntKiBuf(Int_Xferred) = InData%nNW - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%nFW - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iStep - Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%VTKstep - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%VTKlastTime - Db_Xferred = Db_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%r_wind) ) THEN + IF ( .NOT. ALLOCATED(InData%TE) ) 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%r_wind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_wind,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_wind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_wind,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%TE,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TE,1) Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%r_wind,2), UBOUND(InData%r_wind,2) - DO i1 = LBOUND(InData%r_wind,1), UBOUND(InData%r_wind,1) - ReKiBuf(Re_Xferred) = InData%r_wind(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%PitchAndTwist) ) 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%PitchAndTwist,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAndTwist,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%TE,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TE,2) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%PitchAndTwist,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAndTwist,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%TE,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TE,3) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%PitchAndTwist,2), UBOUND(InData%PitchAndTwist,2) - DO i1 = LBOUND(InData%PitchAndTwist,1), UBOUND(InData%PitchAndTwist,1) - ReKiBuf(Re_Xferred) = InData%PitchAndTwist(i1,i2) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(InData%TE,3), UBOUND(InData%TE,3) + DO i2 = LBOUND(InData%TE,2), UBOUND(InData%TE,2) + DO i1 = LBOUND(InData%TE,1), UBOUND(InData%TE,1) + ReKiBuf(Re_Xferred) = InData%TE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO END DO END DO END IF - IntKiBuf(Int_Xferred) = TRANSFER(InData%ComputeWakeInduced, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - DbKiBuf(Db_Xferred) = InData%OldWakeTime - Db_Xferred = Db_Xferred + 1 - ReKiBuf(Re_Xferred) = InData%tSpent - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%dxdt_NW) ) THEN + IF ( .NOT. ALLOCATED(InData%r_LL) ) 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%dxdt_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxdt_NW,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dxdt_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxdt_NW,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,2) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dxdt_NW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxdt_NW,3) + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_LL,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,3) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dxdt_NW,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxdt_NW,4) + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_LL,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_LL,4) Int_Xferred = Int_Xferred + 2 - DO i4 = LBOUND(InData%dxdt_NW,4), UBOUND(InData%dxdt_NW,4) - DO i3 = LBOUND(InData%dxdt_NW,3), UBOUND(InData%dxdt_NW,3) - DO i2 = LBOUND(InData%dxdt_NW,2), UBOUND(InData%dxdt_NW,2) - DO i1 = LBOUND(InData%dxdt_NW,1), UBOUND(InData%dxdt_NW,1) - ReKiBuf(Re_Xferred) = InData%dxdt_NW(i1,i2,i3,i4) + DO i4 = LBOUND(InData%r_LL,4), UBOUND(InData%r_LL,4) + DO i3 = LBOUND(InData%r_LL,3), UBOUND(InData%r_LL,3) + DO i2 = LBOUND(InData%r_LL,2), UBOUND(InData%r_LL,2) + DO i1 = LBOUND(InData%r_LL,1), UBOUND(InData%r_LL,1) + ReKiBuf(Re_Xferred) = InData%r_LL(i1,i2,i3,i4) Re_Xferred = Re_Xferred + 1 END DO END DO END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%dxdt_FW) ) THEN + IF ( .NOT. ALLOCATED(InData%s_LL) ) 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%dxdt_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxdt_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dxdt_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxdt_FW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dxdt_FW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxdt_FW,3) + IntKiBuf( Int_Xferred ) = LBOUND(InData%s_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_LL,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%dxdt_FW,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dxdt_FW,4) + IntKiBuf( Int_Xferred ) = LBOUND(InData%s_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_LL,2) Int_Xferred = Int_Xferred + 2 - DO i4 = LBOUND(InData%dxdt_FW,4), UBOUND(InData%dxdt_FW,4) - DO i3 = LBOUND(InData%dxdt_FW,3), UBOUND(InData%dxdt_FW,3) - DO i2 = LBOUND(InData%dxdt_FW,2), UBOUND(InData%dxdt_FW,2) - DO i1 = LBOUND(InData%dxdt_FW,1), UBOUND(InData%dxdt_FW,1) - ReKiBuf(Re_Xferred) = InData%dxdt_FW(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + DO i2 = LBOUND(InData%s_LL,2), UBOUND(InData%s_LL,2) + DO i1 = LBOUND(InData%s_LL,1), UBOUND(InData%s_LL,1) + ReKiBuf(Re_Xferred) = InData%s_LL(i1,i2) + Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%alpha_LL) ) THEN + IF ( .NOT. ALLOCATED(InData%chord_LL) ) 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%alpha_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_LL,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%chord_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_LL,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_LL,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%chord_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_LL,2) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%alpha_LL,2), UBOUND(InData%alpha_LL,2) - DO i1 = LBOUND(InData%alpha_LL,1), UBOUND(InData%alpha_LL,1) - ReKiBuf(Re_Xferred) = InData%alpha_LL(i1,i2) + DO i2 = LBOUND(InData%chord_LL,2), UBOUND(InData%chord_LL,2) + DO i1 = LBOUND(InData%chord_LL,1), UBOUND(InData%chord_LL,1) + ReKiBuf(Re_Xferred) = InData%chord_LL(i1,i2) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%Vreln_LL) ) THEN + IF ( .NOT. ALLOCATED(InData%s_CP_LL) ) 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%Vreln_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vreln_LL,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%s_CP_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_CP_LL,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vreln_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vreln_LL,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%s_CP_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_CP_LL,2) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%Vreln_LL,2), UBOUND(InData%Vreln_LL,2) - DO i1 = LBOUND(InData%Vreln_LL,1), UBOUND(InData%Vreln_LL,1) - ReKiBuf(Re_Xferred) = InData%Vreln_LL(i1,i2) + DO i2 = LBOUND(InData%s_CP_LL,2), UBOUND(InData%s_CP_LL,2) + DO i1 = LBOUND(InData%s_CP_LL,1), UBOUND(InData%s_CP_LL,1) + ReKiBuf(Re_Xferred) = InData%s_CP_LL(i1,i2) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - CALL FVW_Packt_sgmt( Re_Buf, Db_Buf, Int_Buf, InData%Sgmt, ErrStat2, ErrMsg2, OnlySize ) ! Sgmt - 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 - IF ( .NOT. ALLOCATED(InData%CPs) ) THEN + IF ( .NOT. ALLOCATED(InData%chord_CP_LL) ) 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%CPs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CPs,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%chord_CP_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_CP_LL,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%CPs,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CPs,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%chord_CP_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_CP_LL,2) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%CPs,2), UBOUND(InData%CPs,2) - DO i1 = LBOUND(InData%CPs,1), UBOUND(InData%CPs,1) - ReKiBuf(Re_Xferred) = InData%CPs(i1,i2) + DO i2 = LBOUND(InData%chord_CP_LL,2), UBOUND(InData%chord_CP_LL,2) + DO i1 = LBOUND(InData%chord_CP_LL,1), UBOUND(InData%chord_CP_LL,1) + ReKiBuf(Re_Xferred) = InData%chord_CP_LL(i1,i2) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%Uind) ) THEN + IF ( .NOT. ALLOCATED(InData%CP_LL) ) 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%Uind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Uind,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%CP_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CP_LL,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Uind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Uind,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%CP_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CP_LL,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%CP_LL,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CP_LL,3) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%Uind,2), UBOUND(InData%Uind,2) - DO i1 = LBOUND(InData%Uind,1), UBOUND(InData%Uind,1) - ReKiBuf(Re_Xferred) = InData%Uind(i1,i2) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(InData%CP_LL,3), UBOUND(InData%CP_LL,3) + DO i2 = LBOUND(InData%CP_LL,2), UBOUND(InData%CP_LL,2) + DO i1 = LBOUND(InData%CP_LL,1), UBOUND(InData%CP_LL,1) + ReKiBuf(Re_Xferred) = InData%CP_LL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%BN_AxInd) ) THEN + IF ( .NOT. ALLOCATED(InData%Tang) ) 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%BN_AxInd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_AxInd,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Tang,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tang,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_AxInd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_AxInd,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Tang,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tang,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Tang,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tang,3) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%BN_AxInd,2), UBOUND(InData%BN_AxInd,2) - DO i1 = LBOUND(InData%BN_AxInd,1), UBOUND(InData%BN_AxInd,1) - ReKiBuf(Re_Xferred) = InData%BN_AxInd(i1,i2) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(InData%Tang,3), UBOUND(InData%Tang,3) + DO i2 = LBOUND(InData%Tang,2), UBOUND(InData%Tang,2) + DO i1 = LBOUND(InData%Tang,1), UBOUND(InData%Tang,1) + ReKiBuf(Re_Xferred) = InData%Tang(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%BN_TanInd) ) THEN + IF ( .NOT. ALLOCATED(InData%Norm) ) 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%BN_TanInd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_TanInd,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Norm,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Norm,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_TanInd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_TanInd,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Norm,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Norm,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Norm,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Norm,3) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%BN_TanInd,2), UBOUND(InData%BN_TanInd,2) - DO i1 = LBOUND(InData%BN_TanInd,1), UBOUND(InData%BN_TanInd,1) - ReKiBuf(Re_Xferred) = InData%BN_TanInd(i1,i2) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(InData%Norm,3), UBOUND(InData%Norm,3) + DO i2 = LBOUND(InData%Norm,2), UBOUND(InData%Norm,2) + DO i1 = LBOUND(InData%Norm,1), UBOUND(InData%Norm,1) + ReKiBuf(Re_Xferred) = InData%Norm(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%BN_Vrel) ) THEN + IF ( .NOT. ALLOCATED(InData%Orth) ) 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%BN_Vrel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Vrel,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Orth,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Orth,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Vrel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Vrel,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Orth,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Orth,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Orth,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Orth,3) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%BN_Vrel,2), UBOUND(InData%BN_Vrel,2) - DO i1 = LBOUND(InData%BN_Vrel,1), UBOUND(InData%BN_Vrel,1) - ReKiBuf(Re_Xferred) = InData%BN_Vrel(i1,i2) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(InData%Orth,3), UBOUND(InData%Orth,3) + DO i2 = LBOUND(InData%Orth,2), UBOUND(InData%Orth,2) + DO i1 = LBOUND(InData%Orth,1), UBOUND(InData%Orth,1) + ReKiBuf(Re_Xferred) = InData%Orth(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%BN_alpha) ) THEN + IF ( .NOT. ALLOCATED(InData%dl) ) 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%BN_alpha,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_alpha,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%dl,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_alpha,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_alpha,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%dl,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%dl,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dl,3) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%BN_alpha,2), UBOUND(InData%BN_alpha,2) - DO i1 = LBOUND(InData%BN_alpha,1), UBOUND(InData%BN_alpha,1) - ReKiBuf(Re_Xferred) = InData%BN_alpha(i1,i2) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(InData%dl,3), UBOUND(InData%dl,3) + DO i2 = LBOUND(InData%dl,2), UBOUND(InData%dl,2) + DO i1 = LBOUND(InData%dl,1), UBOUND(InData%dl,1) + ReKiBuf(Re_Xferred) = InData%dl(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%BN_phi) ) THEN + IF ( .NOT. ALLOCATED(InData%Area) ) 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%BN_phi,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_phi,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Area,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Area,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_phi,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_phi,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Area,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Area,2) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%BN_phi,2), UBOUND(InData%BN_phi,2) - DO i1 = LBOUND(InData%BN_phi,1), UBOUND(InData%BN_phi,1) - ReKiBuf(Re_Xferred) = InData%BN_phi(i1,i2) + DO i2 = LBOUND(InData%Area,2), UBOUND(InData%Area,2) + DO i1 = LBOUND(InData%Area,1), UBOUND(InData%Area,1) + ReKiBuf(Re_Xferred) = InData%Area(i1,i2) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%BN_Re) ) THEN + IF ( .NOT. ALLOCATED(InData%diag_LL) ) 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%BN_Re,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Re,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%diag_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%diag_LL,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Re,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Re,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%diag_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%diag_LL,2) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%BN_Re,2), UBOUND(InData%BN_Re,2) - DO i1 = LBOUND(InData%BN_Re,1), UBOUND(InData%BN_Re,1) - ReKiBuf(Re_Xferred) = InData%BN_Re(i1,i2) + DO i2 = LBOUND(InData%diag_LL,2), UBOUND(InData%diag_LL,2) + DO i1 = LBOUND(InData%diag_LL,1), UBOUND(InData%diag_LL,1) + ReKiBuf(Re_Xferred) = InData%diag_LL(i1,i2) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%BN_URelWind_s) ) THEN + IF ( .NOT. ALLOCATED(InData%Gamma_LL) ) 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%BN_URelWind_s,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_URelWind_s,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_URelWind_s,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_URelWind_s,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_LL,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_URelWind_s,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_URelWind_s,3) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_LL,2) Int_Xferred = Int_Xferred + 2 - DO i3 = LBOUND(InData%BN_URelWind_s,3), UBOUND(InData%BN_URelWind_s,3) - DO i2 = LBOUND(InData%BN_URelWind_s,2), UBOUND(InData%BN_URelWind_s,2) - DO i1 = LBOUND(InData%BN_URelWind_s,1), UBOUND(InData%BN_URelWind_s,1) - ReKiBuf(Re_Xferred) = InData%BN_URelWind_s(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO + DO i2 = LBOUND(InData%Gamma_LL,2), UBOUND(InData%Gamma_LL,2) + DO i1 = LBOUND(InData%Gamma_LL,1), UBOUND(InData%Gamma_LL,1) + ReKiBuf(Re_Xferred) = InData%Gamma_LL(i1,i2) + Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%BN_Cl_Static) ) THEN + IF ( .NOT. ALLOCATED(InData%Vind_LL) ) 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%BN_Cl_Static,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cl_Static,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_LL,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cl_Static,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cl_Static,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_LL,2) Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%BN_Cl_Static,2), UBOUND(InData%BN_Cl_Static,2) - DO i1 = LBOUND(InData%BN_Cl_Static,1), UBOUND(InData%BN_Cl_Static,1) - ReKiBuf(Re_Xferred) = InData%BN_Cl_Static(i1,i2) - Re_Xferred = Re_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_LL,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_LL,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Vind_LL,3), UBOUND(InData%Vind_LL,3) + DO i2 = LBOUND(InData%Vind_LL,2), UBOUND(InData%Vind_LL,2) + DO i1 = LBOUND(InData%Vind_LL,1), UBOUND(InData%Vind_LL,1) + ReKiBuf(Re_Xferred) = InData%Vind_LL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%BN_Cd_Static) ) THEN + IF ( .NOT. ALLOCATED(InData%Vtot_LL) ) 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%BN_Cd_Static,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cd_Static,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vtot_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vtot_LL,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cd_Static,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cd_Static,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vtot_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vtot_LL,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vtot_LL,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vtot_LL,3) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%BN_Cd_Static,2), UBOUND(InData%BN_Cd_Static,2) - DO i1 = LBOUND(InData%BN_Cd_Static,1), UBOUND(InData%BN_Cd_Static,1) - ReKiBuf(Re_Xferred) = InData%BN_Cd_Static(i1,i2) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(InData%Vtot_LL,3), UBOUND(InData%Vtot_LL,3) + DO i2 = LBOUND(InData%Vtot_LL,2), UBOUND(InData%Vtot_LL,2) + DO i1 = LBOUND(InData%Vtot_LL,1), UBOUND(InData%Vtot_LL,1) + ReKiBuf(Re_Xferred) = InData%Vtot_LL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%BN_Cm_Static) ) THEN + IF ( .NOT. ALLOCATED(InData%Vstr_LL) ) 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%BN_Cm_Static,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cm_Static,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vstr_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vstr_LL,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cm_Static,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cm_Static,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vstr_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vstr_LL,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vstr_LL,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vstr_LL,3) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%BN_Cm_Static,2), UBOUND(InData%BN_Cm_Static,2) - DO i1 = LBOUND(InData%BN_Cm_Static,1), UBOUND(InData%BN_Cm_Static,1) - ReKiBuf(Re_Xferred) = InData%BN_Cm_Static(i1,i2) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(InData%Vstr_LL,3), UBOUND(InData%Vstr_LL,3) + DO i2 = LBOUND(InData%Vstr_LL,2), UBOUND(InData%Vstr_LL,2) + DO i1 = LBOUND(InData%Vstr_LL,1), UBOUND(InData%Vstr_LL,1) + ReKiBuf(Re_Xferred) = InData%Vstr_LL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%BN_Cl) ) THEN + IF ( .NOT. ALLOCATED(InData%Vwnd_LL) ) 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%BN_Cl,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cl,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LL,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cl,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cl,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LL,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LL,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LL,3) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%BN_Cl,2), UBOUND(InData%BN_Cl,2) - DO i1 = LBOUND(InData%BN_Cl,1), UBOUND(InData%BN_Cl,1) - ReKiBuf(Re_Xferred) = InData%BN_Cl(i1,i2) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(InData%Vwnd_LL,3), UBOUND(InData%Vwnd_LL,3) + DO i2 = LBOUND(InData%Vwnd_LL,2), UBOUND(InData%Vwnd_LL,2) + DO i1 = LBOUND(InData%Vwnd_LL,1), UBOUND(InData%Vwnd_LL,1) + ReKiBuf(Re_Xferred) = InData%Vwnd_LL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%BN_Cd) ) THEN + IF ( .NOT. ALLOCATED(InData%Vwnd_NW) ) 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%BN_Cd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cd,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_NW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cd,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_NW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_NW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_NW,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_NW,4) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%BN_Cd,2), UBOUND(InData%BN_Cd,2) - DO i1 = LBOUND(InData%BN_Cd,1), UBOUND(InData%BN_Cd,1) - ReKiBuf(Re_Xferred) = InData%BN_Cd(i1,i2) - Re_Xferred = Re_Xferred + 1 + DO i4 = LBOUND(InData%Vwnd_NW,4), UBOUND(InData%Vwnd_NW,4) + DO i3 = LBOUND(InData%Vwnd_NW,3), UBOUND(InData%Vwnd_NW,3) + DO i2 = LBOUND(InData%Vwnd_NW,2), UBOUND(InData%Vwnd_NW,2) + DO i1 = LBOUND(InData%Vwnd_NW,1), UBOUND(InData%Vwnd_NW,1) + ReKiBuf(Re_Xferred) = InData%Vwnd_NW(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%BN_Cm) ) THEN + IF ( .NOT. ALLOCATED(InData%Vwnd_FW) ) 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%BN_Cm,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cm,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_FW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cm,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cm,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_FW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_FW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_FW,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_FW,4) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%BN_Cm,2), UBOUND(InData%BN_Cm,2) - DO i1 = LBOUND(InData%BN_Cm,1), UBOUND(InData%BN_Cm,1) - ReKiBuf(Re_Xferred) = InData%BN_Cm(i1,i2) - Re_Xferred = Re_Xferred + 1 + DO i4 = LBOUND(InData%Vwnd_FW,4), UBOUND(InData%Vwnd_FW,4) + DO i3 = LBOUND(InData%Vwnd_FW,3), UBOUND(InData%Vwnd_FW,3) + DO i2 = LBOUND(InData%Vwnd_FW,2), UBOUND(InData%Vwnd_FW,2) + DO i1 = LBOUND(InData%Vwnd_FW,1), UBOUND(InData%Vwnd_FW,1) + ReKiBuf(Re_Xferred) = InData%Vwnd_FW(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%BN_Cx) ) THEN + IF ( .NOT. ALLOCATED(InData%Vind_NW) ) 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%BN_Cx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cx,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_NW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cx,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_NW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_NW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_NW,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_NW,4) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%BN_Cx,2), UBOUND(InData%BN_Cx,2) - DO i1 = LBOUND(InData%BN_Cx,1), UBOUND(InData%BN_Cx,1) - ReKiBuf(Re_Xferred) = InData%BN_Cx(i1,i2) - Re_Xferred = Re_Xferred + 1 + DO i4 = LBOUND(InData%Vind_NW,4), UBOUND(InData%Vind_NW,4) + DO i3 = LBOUND(InData%Vind_NW,3), UBOUND(InData%Vind_NW,3) + DO i2 = LBOUND(InData%Vind_NW,2), UBOUND(InData%Vind_NW,2) + DO i1 = LBOUND(InData%Vind_NW,1), UBOUND(InData%Vind_NW,1) + ReKiBuf(Re_Xferred) = InData%Vind_NW(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%BN_Cy) ) THEN + IF ( .NOT. ALLOCATED(InData%Vind_FW) ) 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%BN_Cy,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cy,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_FW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cy,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cy,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_FW,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_FW,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,3) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind_FW,4) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind_FW,4) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%BN_Cy,2), UBOUND(InData%BN_Cy,2) - DO i1 = LBOUND(InData%BN_Cy,1), UBOUND(InData%BN_Cy,1) - ReKiBuf(Re_Xferred) = InData%BN_Cy(i1,i2) - Re_Xferred = Re_Xferred + 1 + DO i4 = LBOUND(InData%Vind_FW,4), UBOUND(InData%Vind_FW,4) + DO i3 = LBOUND(InData%Vind_FW,3), UBOUND(InData%Vind_FW,3) + DO i2 = LBOUND(InData%Vind_FW,2), UBOUND(InData%Vind_FW,2) + DO i1 = LBOUND(InData%Vind_FW,1), UBOUND(InData%Vind_FW,1) + ReKiBuf(Re_Xferred) = InData%Vind_FW(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%GridOutputs) ) THEN + IntKiBuf(Int_Xferred) = InData%nNW + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nFW + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%iStep + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VTKstep + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%VTKlastTime + Db_Xferred = Db_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%r_wind) ) 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%GridOutputs,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GridOutputs,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_wind,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_wind,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%r_wind,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_wind,2) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%GridOutputs,1), UBOUND(InData%GridOutputs,1) - CALL FVW_Packgridouttype( Re_Buf, Db_Buf, Int_Buf, InData%GridOutputs(i1), ErrStat2, ErrMsg2, OnlySize ) ! GridOutputs - 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 + DO i2 = LBOUND(InData%r_wind,2), UBOUND(InData%r_wind,2) + DO i1 = LBOUND(InData%r_wind,1), UBOUND(InData%r_wind,1) + ReKiBuf(Re_Xferred) = InData%r_wind(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%u_UA) ) THEN + IF ( .NOT. ALLOCATED(InData%PitchAndTwist) ) THEN IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,2) + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%PitchAndTwist,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAndTwist,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,3) + IntKiBuf( Int_Xferred ) = LBOUND(InData%PitchAndTwist,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAndTwist,2) Int_Xferred = Int_Xferred + 2 - DO i3 = LBOUND(InData%u_UA,3), UBOUND(InData%u_UA,3) - DO i2 = LBOUND(InData%u_UA,2), UBOUND(InData%u_UA,2) - DO i1 = LBOUND(InData%u_UA,1), UBOUND(InData%u_UA,1) - CALL UA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2, OnlySize ) ! u_UA - 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 DO - END DO + DO i2 = LBOUND(InData%PitchAndTwist,2), UBOUND(InData%PitchAndTwist,2) + DO i1 = LBOUND(InData%PitchAndTwist,1), UBOUND(InData%PitchAndTwist,1) + ReKiBuf(Re_Xferred) = InData%PitchAndTwist(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_UA, ErrStat2, ErrMsg2, OnlySize ) ! m_UA - 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 - CALL UA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_UA, ErrStat2, ErrMsg2, OnlySize ) ! y_UA - 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 - CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_UA, ErrStat2, ErrMsg2, OnlySize ) ! p_UA + IntKiBuf(Int_Xferred) = TRANSFER(InData%ComputeWakeInduced, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%OldWakeTime + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tSpent + Re_Xferred = Re_Xferred + 1 + CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%dxdt, ErrStat2, ErrMsg2, OnlySize ) ! dxdt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4129,611 +4205,632 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_PackMisc - - SUBROUTINE FVW_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(FVW_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 - 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 = 'FVW_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 - OutData%FirstCall = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstCall) - Int_Xferred = Int_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LE 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%LE)) DEALLOCATE(OutData%LE) - ALLOCATE(OutData%LE(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%LE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%LE,3), UBOUND(OutData%LE,3) - DO i2 = LBOUND(OutData%LE,2), UBOUND(OutData%LE,2) - DO i1 = LBOUND(OutData%LE,1), UBOUND(OutData%LE,1) - OutData%LE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TE not allocated + IF ( .NOT. ALLOCATED(InData%alpha_LL) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_LL,1) Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%alpha_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_LL,2) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TE)) DEALLOCATE(OutData%TE) - ALLOCATE(OutData%TE(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%TE.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%TE,3), UBOUND(OutData%TE,3) - DO i2 = LBOUND(OutData%TE,2), UBOUND(OutData%TE,2) - DO i1 = LBOUND(OutData%TE,1), UBOUND(OutData%TE,1) - OutData%TE(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO + + DO i2 = LBOUND(InData%alpha_LL,2), UBOUND(InData%alpha_LL,2) + DO i1 = LBOUND(InData%alpha_LL,1), UBOUND(InData%alpha_LL,1) + ReKiBuf(Re_Xferred) = InData%alpha_LL(i1,i2) + Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_LL not allocated + IF ( .NOT. ALLOCATED(InData%Vreln_LL) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vreln_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vreln_LL,1) Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vreln_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vreln_LL,2) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%r_LL)) DEALLOCATE(OutData%r_LL) - ALLOCATE(OutData%r_LL(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%r_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%r_LL,4), UBOUND(OutData%r_LL,4) - DO i3 = LBOUND(OutData%r_LL,3), UBOUND(OutData%r_LL,3) - DO i2 = LBOUND(OutData%r_LL,2), UBOUND(OutData%r_LL,2) - DO i1 = LBOUND(OutData%r_LL,1), UBOUND(OutData%r_LL,1) - OutData%r_LL(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + + DO i2 = LBOUND(InData%Vreln_LL,2), UBOUND(InData%Vreln_LL,2) + DO i1 = LBOUND(InData%Vreln_LL,1), UBOUND(InData%Vreln_LL,1) + ReKiBuf(Re_Xferred) = InData%Vreln_LL(i1,i2) + Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s_LL not allocated + CALL FVW_Packt_sgmt( Re_Buf, Db_Buf, Int_Buf, InData%Sgmt, ErrStat2, ErrMsg2, OnlySize ) ! Sgmt + 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 + IF ( .NOT. ALLOCATED(InData%CPs) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%CPs,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CPs,1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%CPs,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CPs,2) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%s_LL)) DEALLOCATE(OutData%s_LL) - ALLOCATE(OutData%s_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%s_LL,2), UBOUND(OutData%s_LL,2) - DO i1 = LBOUND(OutData%s_LL,1), UBOUND(OutData%s_LL,1) - OutData%s_LL(i1,i2) = ReKiBuf(Re_Xferred) + + DO i2 = LBOUND(InData%CPs,2), UBOUND(InData%CPs,2) + DO i1 = LBOUND(InData%CPs,1), UBOUND(InData%CPs,1) + ReKiBuf(Re_Xferred) = InData%CPs(i1,i2) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord_LL not allocated + IF ( .NOT. ALLOCATED(InData%Uind) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Uind,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Uind,1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Uind,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Uind,2) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%chord_LL)) DEALLOCATE(OutData%chord_LL) - ALLOCATE(OutData%chord_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%chord_LL,2), UBOUND(OutData%chord_LL,2) - DO i1 = LBOUND(OutData%chord_LL,1), UBOUND(OutData%chord_LL,1) - OutData%chord_LL(i1,i2) = ReKiBuf(Re_Xferred) + + DO i2 = LBOUND(InData%Uind,2), UBOUND(InData%Uind,2) + DO i1 = LBOUND(InData%Uind,1), UBOUND(InData%Uind,1) + ReKiBuf(Re_Xferred) = InData%Uind(i1,i2) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s_CP_LL not allocated + IF ( .NOT. ALLOCATED(InData%BN_AxInd) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_AxInd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_AxInd,1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_AxInd,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_AxInd,2) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%s_CP_LL)) DEALLOCATE(OutData%s_CP_LL) - ALLOCATE(OutData%s_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_CP_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%s_CP_LL,2), UBOUND(OutData%s_CP_LL,2) - DO i1 = LBOUND(OutData%s_CP_LL,1), UBOUND(OutData%s_CP_LL,1) - OutData%s_CP_LL(i1,i2) = ReKiBuf(Re_Xferred) + + DO i2 = LBOUND(InData%BN_AxInd,2), UBOUND(InData%BN_AxInd,2) + DO i1 = LBOUND(InData%BN_AxInd,1), UBOUND(InData%BN_AxInd,1) + ReKiBuf(Re_Xferred) = InData%BN_AxInd(i1,i2) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord_CP_LL not allocated + IF ( .NOT. ALLOCATED(InData%BN_TanInd) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_TanInd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_TanInd,1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_TanInd,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_TanInd,2) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%chord_CP_LL)) DEALLOCATE(OutData%chord_CP_LL) - ALLOCATE(OutData%chord_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_CP_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%chord_CP_LL,2), UBOUND(OutData%chord_CP_LL,2) - DO i1 = LBOUND(OutData%chord_CP_LL,1), UBOUND(OutData%chord_CP_LL,1) - OutData%chord_CP_LL(i1,i2) = ReKiBuf(Re_Xferred) + + DO i2 = LBOUND(InData%BN_TanInd,2), UBOUND(InData%BN_TanInd,2) + DO i1 = LBOUND(InData%BN_TanInd,1), UBOUND(InData%BN_TanInd,1) + ReKiBuf(Re_Xferred) = InData%BN_TanInd(i1,i2) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CP_LL not allocated + IF ( .NOT. ALLOCATED(InData%BN_Vrel) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Vrel,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Vrel,1) Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Vrel,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Vrel,2) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CP_LL)) DEALLOCATE(OutData%CP_LL) - ALLOCATE(OutData%CP_LL(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%CP_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%CP_LL,3), UBOUND(OutData%CP_LL,3) - DO i2 = LBOUND(OutData%CP_LL,2), UBOUND(OutData%CP_LL,2) - DO i1 = LBOUND(OutData%CP_LL,1), UBOUND(OutData%CP_LL,1) - OutData%CP_LL(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO + + DO i2 = LBOUND(InData%BN_Vrel,2), UBOUND(InData%BN_Vrel,2) + DO i1 = LBOUND(InData%BN_Vrel,1), UBOUND(InData%BN_Vrel,1) + ReKiBuf(Re_Xferred) = InData%BN_Vrel(i1,i2) + Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Tang not allocated + IF ( .NOT. ALLOCATED(InData%BN_alpha) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_alpha,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_alpha,1) Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_alpha,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_alpha,2) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Tang)) DEALLOCATE(OutData%Tang) - ALLOCATE(OutData%Tang(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%Tang.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Tang,3), UBOUND(OutData%Tang,3) - DO i2 = LBOUND(OutData%Tang,2), UBOUND(OutData%Tang,2) - DO i1 = LBOUND(OutData%Tang,1), UBOUND(OutData%Tang,1) - OutData%Tang(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO + + DO i2 = LBOUND(InData%BN_alpha,2), UBOUND(InData%BN_alpha,2) + DO i1 = LBOUND(InData%BN_alpha,1), UBOUND(InData%BN_alpha,1) + ReKiBuf(Re_Xferred) = InData%BN_alpha(i1,i2) + Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Norm not allocated + IF ( .NOT. ALLOCATED(InData%BN_phi) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_phi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_phi,1) Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_phi,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_phi,2) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Norm)) DEALLOCATE(OutData%Norm) - ALLOCATE(OutData%Norm(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%Norm.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Norm,3), UBOUND(OutData%Norm,3) - DO i2 = LBOUND(OutData%Norm,2), UBOUND(OutData%Norm,2) - DO i1 = LBOUND(OutData%Norm,1), UBOUND(OutData%Norm,1) - OutData%Norm(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO + + DO i2 = LBOUND(InData%BN_phi,2), UBOUND(InData%BN_phi,2) + DO i1 = LBOUND(InData%BN_phi,1), UBOUND(InData%BN_phi,1) + ReKiBuf(Re_Xferred) = InData%BN_phi(i1,i2) + Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Orth not allocated + IF ( .NOT. ALLOCATED(InData%BN_Re) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Re,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Re,1) Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Re,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Re,2) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Orth)) DEALLOCATE(OutData%Orth) - ALLOCATE(OutData%Orth(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%Orth.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Orth,3), UBOUND(OutData%Orth,3) - DO i2 = LBOUND(OutData%Orth,2), UBOUND(OutData%Orth,2) - DO i1 = LBOUND(OutData%Orth,1), UBOUND(OutData%Orth,1) - OutData%Orth(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO + + DO i2 = LBOUND(InData%BN_Re,2), UBOUND(InData%BN_Re,2) + DO i1 = LBOUND(InData%BN_Re,1), UBOUND(InData%BN_Re,1) + ReKiBuf(Re_Xferred) = InData%BN_Re(i1,i2) + Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dl not allocated + IF ( .NOT. ALLOCATED(InData%BN_URelWind_s) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_URelWind_s,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_URelWind_s,1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_URelWind_s,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_URelWind_s,2) Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_URelWind_s,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_URelWind_s,3) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%dl)) DEALLOCATE(OutData%dl) - ALLOCATE(OutData%dl(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%dl.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%dl,3), UBOUND(OutData%dl,3) - DO i2 = LBOUND(OutData%dl,2), UBOUND(OutData%dl,2) - DO i1 = LBOUND(OutData%dl,1), UBOUND(OutData%dl,1) - OutData%dl(i1,i2,i3) = ReKiBuf(Re_Xferred) + + DO i3 = LBOUND(InData%BN_URelWind_s,3), UBOUND(InData%BN_URelWind_s,3) + DO i2 = LBOUND(InData%BN_URelWind_s,2), UBOUND(InData%BN_URelWind_s,2) + DO i1 = LBOUND(InData%BN_URelWind_s,1), UBOUND(InData%BN_URelWind_s,1) + ReKiBuf(Re_Xferred) = InData%BN_URelWind_s(i1,i2,i3) Re_Xferred = Re_Xferred + 1 END DO END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Area not allocated + IF ( .NOT. ALLOCATED(InData%BN_Cl_Static) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cl_Static,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cl_Static,1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cl_Static,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cl_Static,2) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Area)) DEALLOCATE(OutData%Area) - ALLOCATE(OutData%Area(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Area.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Area,2), UBOUND(OutData%Area,2) - DO i1 = LBOUND(OutData%Area,1), UBOUND(OutData%Area,1) - OutData%Area(i1,i2) = ReKiBuf(Re_Xferred) + + DO i2 = LBOUND(InData%BN_Cl_Static,2), UBOUND(InData%BN_Cl_Static,2) + DO i1 = LBOUND(InData%BN_Cl_Static,1), UBOUND(InData%BN_Cl_Static,1) + ReKiBuf(Re_Xferred) = InData%BN_Cl_Static(i1,i2) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! diag_LL not allocated + IF ( .NOT. ALLOCATED(InData%BN_Cd_Static) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cd_Static,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cd_Static,1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cd_Static,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cd_Static,2) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%diag_LL)) DEALLOCATE(OutData%diag_LL) - ALLOCATE(OutData%diag_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%diag_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%diag_LL,2), UBOUND(OutData%diag_LL,2) - DO i1 = LBOUND(OutData%diag_LL,1), UBOUND(OutData%diag_LL,1) - OutData%diag_LL(i1,i2) = ReKiBuf(Re_Xferred) + + DO i2 = LBOUND(InData%BN_Cd_Static,2), UBOUND(InData%BN_Cd_Static,2) + DO i1 = LBOUND(InData%BN_Cd_Static,1), UBOUND(InData%BN_Cd_Static,1) + ReKiBuf(Re_Xferred) = InData%BN_Cd_Static(i1,i2) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma_LL not allocated + IF ( .NOT. ALLOCATED(InData%BN_Cm_Static) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cm_Static,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cm_Static,1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cm_Static,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cm_Static,2) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Gamma_LL)) DEALLOCATE(OutData%Gamma_LL) - ALLOCATE(OutData%Gamma_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Gamma_LL,2), UBOUND(OutData%Gamma_LL,2) - DO i1 = LBOUND(OutData%Gamma_LL,1), UBOUND(OutData%Gamma_LL,1) - OutData%Gamma_LL(i1,i2) = ReKiBuf(Re_Xferred) + + DO i2 = LBOUND(InData%BN_Cm_Static,2), UBOUND(InData%BN_Cm_Static,2) + DO i1 = LBOUND(InData%BN_Cm_Static,1), UBOUND(InData%BN_Cm_Static,1) + ReKiBuf(Re_Xferred) = InData%BN_Cm_Static(i1,i2) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind_LL not allocated + IF ( .NOT. ALLOCATED(InData%BN_Cl) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cl,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cl,1) Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cl,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cl,2) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vind_LL)) DEALLOCATE(OutData%Vind_LL) - ALLOCATE(OutData%Vind_LL(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%Vind_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vind_LL,3), UBOUND(OutData%Vind_LL,3) - DO i2 = LBOUND(OutData%Vind_LL,2), UBOUND(OutData%Vind_LL,2) - DO i1 = LBOUND(OutData%Vind_LL,1), UBOUND(OutData%Vind_LL,1) - OutData%Vind_LL(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO + + DO i2 = LBOUND(InData%BN_Cl,2), UBOUND(InData%BN_Cl,2) + DO i1 = LBOUND(InData%BN_Cl,1), UBOUND(InData%BN_Cl,1) + ReKiBuf(Re_Xferred) = InData%BN_Cl(i1,i2) + Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vtot_LL not allocated + IF ( .NOT. ALLOCATED(InData%BN_Cd) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cd,1) Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cd,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cd,2) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vtot_LL)) DEALLOCATE(OutData%Vtot_LL) - ALLOCATE(OutData%Vtot_LL(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%Vtot_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vtot_LL,3), UBOUND(OutData%Vtot_LL,3) - DO i2 = LBOUND(OutData%Vtot_LL,2), UBOUND(OutData%Vtot_LL,2) - DO i1 = LBOUND(OutData%Vtot_LL,1), UBOUND(OutData%Vtot_LL,1) - OutData%Vtot_LL(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO + + DO i2 = LBOUND(InData%BN_Cd,2), UBOUND(InData%BN_Cd,2) + DO i1 = LBOUND(InData%BN_Cd,1), UBOUND(InData%BN_Cd,1) + ReKiBuf(Re_Xferred) = InData%BN_Cd(i1,i2) + Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vstr_LL not allocated + IF ( .NOT. ALLOCATED(InData%BN_Cm) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cm,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cm,1) Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cm,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cm,2) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vstr_LL)) DEALLOCATE(OutData%Vstr_LL) - ALLOCATE(OutData%Vstr_LL(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%Vstr_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vstr_LL,3), UBOUND(OutData%Vstr_LL,3) - DO i2 = LBOUND(OutData%Vstr_LL,2), UBOUND(OutData%Vstr_LL,2) - DO i1 = LBOUND(OutData%Vstr_LL,1), UBOUND(OutData%Vstr_LL,1) - OutData%Vstr_LL(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO + + DO i2 = LBOUND(InData%BN_Cm,2), UBOUND(InData%BN_Cm,2) + DO i1 = LBOUND(InData%BN_Cm,1), UBOUND(InData%BN_Cm,1) + ReKiBuf(Re_Xferred) = InData%BN_Cm(i1,i2) + Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_LL not allocated + IF ( .NOT. ALLOCATED(InData%BN_Cx) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cx,1) Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cx,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cx,2) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vwnd_LL)) DEALLOCATE(OutData%Vwnd_LL) - ALLOCATE(OutData%Vwnd_LL(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%Vwnd_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vwnd_LL,3), UBOUND(OutData%Vwnd_LL,3) - DO i2 = LBOUND(OutData%Vwnd_LL,2), UBOUND(OutData%Vwnd_LL,2) - DO i1 = LBOUND(OutData%Vwnd_LL,1), UBOUND(OutData%Vwnd_LL,1) - OutData%Vwnd_LL(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO + + DO i2 = LBOUND(InData%BN_Cx,2), UBOUND(InData%BN_Cx,2) + DO i1 = LBOUND(InData%BN_Cx,1), UBOUND(InData%BN_Cx,1) + ReKiBuf(Re_Xferred) = InData%BN_Cx(i1,i2) + Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_NW not allocated + IF ( .NOT. ALLOCATED(InData%BN_Cy) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 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) + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cy,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cy,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vwnd_NW)) DEALLOCATE(OutData%Vwnd_NW) - ALLOCATE(OutData%Vwnd_NW(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%Vwnd_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vwnd_NW,4), UBOUND(OutData%Vwnd_NW,4) - DO i3 = LBOUND(OutData%Vwnd_NW,3), UBOUND(OutData%Vwnd_NW,3) - DO i2 = LBOUND(OutData%Vwnd_NW,2), UBOUND(OutData%Vwnd_NW,2) - DO i1 = LBOUND(OutData%Vwnd_NW,1), UBOUND(OutData%Vwnd_NW,1) - OutData%Vwnd_NW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + IntKiBuf( Int_Xferred ) = LBOUND(InData%BN_Cy,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BN_Cy,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%BN_Cy,2), UBOUND(InData%BN_Cy,2) + DO i1 = LBOUND(InData%BN_Cy,1), UBOUND(InData%BN_Cy,1) + ReKiBuf(Re_Xferred) = InData%BN_Cy(i1,i2) + Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_FW not allocated + IF ( .NOT. ALLOCATED(InData%GridOutputs) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%GridOutputs,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GridOutputs,1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) + + DO i1 = LBOUND(InData%GridOutputs,1), UBOUND(InData%GridOutputs,1) + CALL FVW_Packgridouttype( Re_Buf, Db_Buf, Int_Buf, InData%GridOutputs(i1), ErrStat2, ErrMsg2, OnlySize ) ! GridOutputs + 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%u_UA) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,1) Int_Xferred = Int_Xferred + 2 - i3_l = IntKiBuf( Int_Xferred ) - i3_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,2) Int_Xferred = Int_Xferred + 2 - i4_l = IntKiBuf( Int_Xferred ) - i4_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_UA,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_UA,3) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vwnd_FW)) DEALLOCATE(OutData%Vwnd_FW) - ALLOCATE(OutData%Vwnd_FW(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%Vwnd_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vwnd_FW,4), UBOUND(OutData%Vwnd_FW,4) - DO i3 = LBOUND(OutData%Vwnd_FW,3), UBOUND(OutData%Vwnd_FW,3) - DO i2 = LBOUND(OutData%Vwnd_FW,2), UBOUND(OutData%Vwnd_FW,2) - DO i1 = LBOUND(OutData%Vwnd_FW,1), UBOUND(OutData%Vwnd_FW,1) - OutData%Vwnd_FW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO + + DO i3 = LBOUND(InData%u_UA,3), UBOUND(InData%u_UA,3) + DO i2 = LBOUND(InData%u_UA,2), UBOUND(InData%u_UA,2) + DO i1 = LBOUND(InData%u_UA,1), UBOUND(InData%u_UA,1) + CALL UA_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2, OnlySize ) ! u_UA + 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 DO + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind_NW not allocated + CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m_UA, ErrStat2, ErrMsg2, OnlySize ) ! m_UA + 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 + CALL UA_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_UA, ErrStat2, ErrMsg2, OnlySize ) ! y_UA + 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 + CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_UA, ErrStat2, ErrMsg2, OnlySize ) ! p_UA + 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 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE FVW_PackMisc + + SUBROUTINE FVW_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(FVW_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 + 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 = 'FVW_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 + OutData%FirstCall = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstCall) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LE not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -4746,27 +4843,22 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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%Vind_NW)) DEALLOCATE(OutData%Vind_NW) - ALLOCATE(OutData%Vind_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%LE)) DEALLOCATE(OutData%LE) + ALLOCATE(OutData%LE(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%Vind_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%Vind_NW,4), UBOUND(OutData%Vind_NW,4) - DO i3 = LBOUND(OutData%Vind_NW,3), UBOUND(OutData%Vind_NW,3) - DO i2 = LBOUND(OutData%Vind_NW,2), UBOUND(OutData%Vind_NW,2) - DO i1 = LBOUND(OutData%Vind_NW,1), UBOUND(OutData%Vind_NW,1) - OutData%Vind_NW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LE.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%LE,3), UBOUND(OutData%LE,3) + DO i2 = LBOUND(OutData%LE,2), UBOUND(OutData%LE,2) + DO i1 = LBOUND(OutData%LE,1), UBOUND(OutData%LE,1) + OutData%LE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END DO END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind_FW not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TE not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -4779,37 +4871,22 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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%Vind_FW)) DEALLOCATE(OutData%Vind_FW) - ALLOCATE(OutData%Vind_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%TE)) DEALLOCATE(OutData%TE) + ALLOCATE(OutData%TE(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%Vind_FW.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i4 = LBOUND(OutData%Vind_FW,4), UBOUND(OutData%Vind_FW,4) - DO i3 = LBOUND(OutData%Vind_FW,3), UBOUND(OutData%Vind_FW,3) - DO i2 = LBOUND(OutData%Vind_FW,2), UBOUND(OutData%Vind_FW,2) - DO i1 = LBOUND(OutData%Vind_FW,1), UBOUND(OutData%Vind_FW,1) - OutData%Vind_FW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO + DO i3 = LBOUND(OutData%TE,3), UBOUND(OutData%TE,3) + DO i2 = LBOUND(OutData%TE,2), UBOUND(OutData%TE,2) + DO i1 = LBOUND(OutData%TE,1), UBOUND(OutData%TE,1) + OutData%TE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END DO END DO END DO END IF - OutData%nNW = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%nFW = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%iStep = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKstep = IntKiBuf(Int_Xferred) - Int_Xferred = Int_Xferred + 1 - OutData%VTKlastTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_wind not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_LL not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -4819,20 +4896,30 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%r_wind)) DEALLOCATE(OutData%r_wind) - ALLOCATE(OutData%r_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + 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%r_LL)) DEALLOCATE(OutData%r_LL) + ALLOCATE(OutData%r_LL(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%r_wind.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_LL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%r_wind,2), UBOUND(OutData%r_wind,2) - DO i1 = LBOUND(OutData%r_wind,1), UBOUND(OutData%r_wind,1) - OutData%r_wind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 + DO i4 = LBOUND(OutData%r_LL,4), UBOUND(OutData%r_LL,4) + DO i3 = LBOUND(OutData%r_LL,3), UBOUND(OutData%r_LL,3) + DO i2 = LBOUND(OutData%r_LL,2), UBOUND(OutData%r_LL,2) + DO i1 = LBOUND(OutData%r_LL,1), UBOUND(OutData%r_LL,1) + OutData%r_LL(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitchAndTwist not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s_LL not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -4842,26 +4929,20 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%PitchAndTwist)) DEALLOCATE(OutData%PitchAndTwist) - ALLOCATE(OutData%PitchAndTwist(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%s_LL)) DEALLOCATE(OutData%s_LL) + ALLOCATE(OutData%s_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAndTwist.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_LL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%PitchAndTwist,2), UBOUND(OutData%PitchAndTwist,2) - DO i1 = LBOUND(OutData%PitchAndTwist,1), UBOUND(OutData%PitchAndTwist,1) - OutData%PitchAndTwist(i1,i2) = ReKiBuf(Re_Xferred) + DO i2 = LBOUND(OutData%s_LL,2), UBOUND(OutData%s_LL,2) + DO i1 = LBOUND(OutData%s_LL,1), UBOUND(OutData%s_LL,1) + OutData%s_LL(i1,i2) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - OutData%ComputeWakeInduced = TRANSFER(IntKiBuf(Int_Xferred), OutData%ComputeWakeInduced) - Int_Xferred = Int_Xferred + 1 - OutData%OldWakeTime = DbKiBuf(Db_Xferred) - Db_Xferred = Db_Xferred + 1 - OutData%tSpent = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dxdt_NW not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord_LL not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -4871,30 +4952,20 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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%dxdt_NW)) DEALLOCATE(OutData%dxdt_NW) - ALLOCATE(OutData%dxdt_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%chord_LL)) DEALLOCATE(OutData%chord_LL) + ALLOCATE(OutData%chord_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dxdt_NW.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_LL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i4 = LBOUND(OutData%dxdt_NW,4), UBOUND(OutData%dxdt_NW,4) - DO i3 = LBOUND(OutData%dxdt_NW,3), UBOUND(OutData%dxdt_NW,3) - DO i2 = LBOUND(OutData%dxdt_NW,2), UBOUND(OutData%dxdt_NW,2) - DO i1 = LBOUND(OutData%dxdt_NW,1), UBOUND(OutData%dxdt_NW,1) - OutData%dxdt_NW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + DO i2 = LBOUND(OutData%chord_LL,2), UBOUND(OutData%chord_LL,2) + DO i1 = LBOUND(OutData%chord_LL,1), UBOUND(OutData%chord_LL,1) + OutData%chord_LL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dxdt_FW not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s_CP_LL not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -4904,30 +4975,20 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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%dxdt_FW)) DEALLOCATE(OutData%dxdt_FW) - ALLOCATE(OutData%dxdt_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%s_CP_LL)) DEALLOCATE(OutData%s_CP_LL) + ALLOCATE(OutData%s_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dxdt_FW.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_CP_LL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i4 = LBOUND(OutData%dxdt_FW,4), UBOUND(OutData%dxdt_FW,4) - DO i3 = LBOUND(OutData%dxdt_FW,3), UBOUND(OutData%dxdt_FW,3) - DO i2 = LBOUND(OutData%dxdt_FW,2), UBOUND(OutData%dxdt_FW,2) - DO i1 = LBOUND(OutData%dxdt_FW,1), UBOUND(OutData%dxdt_FW,1) - OutData%dxdt_FW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + DO i2 = LBOUND(OutData%s_CP_LL,2), UBOUND(OutData%s_CP_LL,2) + DO i1 = LBOUND(OutData%s_CP_LL,1), UBOUND(OutData%s_CP_LL,1) + OutData%s_CP_LL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_LL not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord_CP_LL not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -4937,20 +4998,20 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%alpha_LL)) DEALLOCATE(OutData%alpha_LL) - ALLOCATE(OutData%alpha_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%chord_CP_LL)) DEALLOCATE(OutData%chord_CP_LL) + ALLOCATE(OutData%chord_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_LL.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_CP_LL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%alpha_LL,2), UBOUND(OutData%alpha_LL,2) - DO i1 = LBOUND(OutData%alpha_LL,1), UBOUND(OutData%alpha_LL,1) - OutData%alpha_LL(i1,i2) = ReKiBuf(Re_Xferred) + DO i2 = LBOUND(OutData%chord_CP_LL,2), UBOUND(OutData%chord_CP_LL,2) + DO i1 = LBOUND(OutData%chord_CP_LL,1), UBOUND(OutData%chord_CP_LL,1) + OutData%chord_CP_LL(i1,i2) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vreln_LL not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CP_LL not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -4960,60 +5021,25 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vreln_LL)) DEALLOCATE(OutData%Vreln_LL) - ALLOCATE(OutData%Vreln_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%CP_LL)) DEALLOCATE(OutData%CP_LL) + ALLOCATE(OutData%CP_LL(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%Vreln_LL.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CP_LL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%Vreln_LL,2), UBOUND(OutData%Vreln_LL,2) - DO i1 = LBOUND(OutData%Vreln_LL,1), UBOUND(OutData%Vreln_LL,1) - OutData%Vreln_LL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(OutData%CP_LL,3), UBOUND(OutData%CP_LL,3) + DO i2 = LBOUND(OutData%CP_LL,2), UBOUND(OutData%CP_LL,2) + DO i1 = LBOUND(OutData%CP_LL,1), UBOUND(OutData%CP_LL,1) + OutData%CP_LL(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END DO END DO 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 FVW_Unpackt_sgmt( Re_Buf, Db_Buf, Int_Buf, OutData%Sgmt, ErrStat2, ErrMsg2 ) ! Sgmt - 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) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CPs not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Tang not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -5023,20 +5049,25 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%CPs)) DEALLOCATE(OutData%CPs) - ALLOCATE(OutData%CPs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Tang)) DEALLOCATE(OutData%Tang) + ALLOCATE(OutData%Tang(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%CPs.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Tang.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%CPs,2), UBOUND(OutData%CPs,2) - DO i1 = LBOUND(OutData%CPs,1), UBOUND(OutData%CPs,1) - OutData%CPs(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(OutData%Tang,3), UBOUND(OutData%Tang,3) + DO i2 = LBOUND(OutData%Tang,2), UBOUND(OutData%Tang,2) + DO i1 = LBOUND(OutData%Tang,1), UBOUND(OutData%Tang,1) + OutData%Tang(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Uind not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Norm not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -5046,20 +5077,25 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Uind)) DEALLOCATE(OutData%Uind) - ALLOCATE(OutData%Uind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Norm)) DEALLOCATE(OutData%Norm) + ALLOCATE(OutData%Norm(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%Uind.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Norm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%Uind,2), UBOUND(OutData%Uind,2) - DO i1 = LBOUND(OutData%Uind,1), UBOUND(OutData%Uind,1) - OutData%Uind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(OutData%Norm,3), UBOUND(OutData%Norm,3) + DO i2 = LBOUND(OutData%Norm,2), UBOUND(OutData%Norm,2) + DO i1 = LBOUND(OutData%Norm,1), UBOUND(OutData%Norm,1) + OutData%Norm(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_AxInd not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Orth not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -5069,20 +5105,25 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_AxInd)) DEALLOCATE(OutData%BN_AxInd) - ALLOCATE(OutData%BN_AxInd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Orth)) DEALLOCATE(OutData%Orth) + ALLOCATE(OutData%Orth(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%BN_AxInd.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Orth.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%BN_AxInd,2), UBOUND(OutData%BN_AxInd,2) - DO i1 = LBOUND(OutData%BN_AxInd,1), UBOUND(OutData%BN_AxInd,1) - OutData%BN_AxInd(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(OutData%Orth,3), UBOUND(OutData%Orth,3) + DO i2 = LBOUND(OutData%Orth,2), UBOUND(OutData%Orth,2) + DO i1 = LBOUND(OutData%Orth,1), UBOUND(OutData%Orth,1) + OutData%Orth(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_TanInd not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dl not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -5092,20 +5133,25 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_TanInd)) DEALLOCATE(OutData%BN_TanInd) - ALLOCATE(OutData%BN_TanInd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%dl)) DEALLOCATE(OutData%dl) + ALLOCATE(OutData%dl(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%BN_TanInd.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dl.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%BN_TanInd,2), UBOUND(OutData%BN_TanInd,2) - DO i1 = LBOUND(OutData%BN_TanInd,1), UBOUND(OutData%BN_TanInd,1) - OutData%BN_TanInd(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(OutData%dl,3), UBOUND(OutData%dl,3) + DO i2 = LBOUND(OutData%dl,2), UBOUND(OutData%dl,2) + DO i1 = LBOUND(OutData%dl,1), UBOUND(OutData%dl,1) + OutData%dl(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Vrel not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Area not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -5115,20 +5161,20 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Vrel)) DEALLOCATE(OutData%BN_Vrel) - ALLOCATE(OutData%BN_Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Area)) DEALLOCATE(OutData%Area) + ALLOCATE(OutData%Area(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Vrel.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Area.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%BN_Vrel,2), UBOUND(OutData%BN_Vrel,2) - DO i1 = LBOUND(OutData%BN_Vrel,1), UBOUND(OutData%BN_Vrel,1) - OutData%BN_Vrel(i1,i2) = ReKiBuf(Re_Xferred) + DO i2 = LBOUND(OutData%Area,2), UBOUND(OutData%Area,2) + DO i1 = LBOUND(OutData%Area,1), UBOUND(OutData%Area,1) + OutData%Area(i1,i2) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_alpha not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! diag_LL not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -5138,20 +5184,20 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_alpha)) DEALLOCATE(OutData%BN_alpha) - ALLOCATE(OutData%BN_alpha(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%diag_LL)) DEALLOCATE(OutData%diag_LL) + ALLOCATE(OutData%diag_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_alpha.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%diag_LL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%BN_alpha,2), UBOUND(OutData%BN_alpha,2) - DO i1 = LBOUND(OutData%BN_alpha,1), UBOUND(OutData%BN_alpha,1) - OutData%BN_alpha(i1,i2) = ReKiBuf(Re_Xferred) + DO i2 = LBOUND(OutData%diag_LL,2), UBOUND(OutData%diag_LL,2) + DO i1 = LBOUND(OutData%diag_LL,1), UBOUND(OutData%diag_LL,1) + OutData%diag_LL(i1,i2) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_phi not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma_LL not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -5161,20 +5207,20 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_phi)) DEALLOCATE(OutData%BN_phi) - ALLOCATE(OutData%BN_phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Gamma_LL)) DEALLOCATE(OutData%Gamma_LL) + ALLOCATE(OutData%Gamma_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_phi.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gamma_LL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%BN_phi,2), UBOUND(OutData%BN_phi,2) - DO i1 = LBOUND(OutData%BN_phi,1), UBOUND(OutData%BN_phi,1) - OutData%BN_phi(i1,i2) = ReKiBuf(Re_Xferred) + DO i2 = LBOUND(OutData%Gamma_LL,2), UBOUND(OutData%Gamma_LL,2) + DO i1 = LBOUND(OutData%Gamma_LL,1), UBOUND(OutData%Gamma_LL,1) + OutData%Gamma_LL(i1,i2) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Re not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind_LL not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -5184,20 +5230,25 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Re)) DEALLOCATE(OutData%BN_Re) - ALLOCATE(OutData%BN_Re(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Vind_LL)) DEALLOCATE(OutData%Vind_LL) + ALLOCATE(OutData%Vind_LL(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%BN_Re.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_LL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%BN_Re,2), UBOUND(OutData%BN_Re,2) - DO i1 = LBOUND(OutData%BN_Re,1), UBOUND(OutData%BN_Re,1) - OutData%BN_Re(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(OutData%Vind_LL,3), UBOUND(OutData%Vind_LL,3) + DO i2 = LBOUND(OutData%Vind_LL,2), UBOUND(OutData%Vind_LL,2) + DO i1 = LBOUND(OutData%Vind_LL,1), UBOUND(OutData%Vind_LL,1) + OutData%Vind_LL(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_URelWind_s not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vtot_LL not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -5210,22 +5261,22 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i3_l = IntKiBuf( Int_Xferred ) i3_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_URelWind_s)) DEALLOCATE(OutData%BN_URelWind_s) - ALLOCATE(OutData%BN_URelWind_s(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Vtot_LL)) DEALLOCATE(OutData%Vtot_LL) + ALLOCATE(OutData%Vtot_LL(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%BN_URelWind_s.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vtot_LL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i3 = LBOUND(OutData%BN_URelWind_s,3), UBOUND(OutData%BN_URelWind_s,3) - DO i2 = LBOUND(OutData%BN_URelWind_s,2), UBOUND(OutData%BN_URelWind_s,2) - DO i1 = LBOUND(OutData%BN_URelWind_s,1), UBOUND(OutData%BN_URelWind_s,1) - OutData%BN_URelWind_s(i1,i2,i3) = ReKiBuf(Re_Xferred) + DO i3 = LBOUND(OutData%Vtot_LL,3), UBOUND(OutData%Vtot_LL,3) + DO i2 = LBOUND(OutData%Vtot_LL,2), UBOUND(OutData%Vtot_LL,2) + DO i1 = LBOUND(OutData%Vtot_LL,1), UBOUND(OutData%Vtot_LL,1) + OutData%Vtot_LL(i1,i2,i3) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cl_Static not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vstr_LL not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -5235,20 +5286,25 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Cl_Static)) DEALLOCATE(OutData%BN_Cl_Static) - ALLOCATE(OutData%BN_Cl_Static(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Vstr_LL)) DEALLOCATE(OutData%Vstr_LL) + ALLOCATE(OutData%Vstr_LL(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%BN_Cl_Static.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vstr_LL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%BN_Cl_Static,2), UBOUND(OutData%BN_Cl_Static,2) - DO i1 = LBOUND(OutData%BN_Cl_Static,1), UBOUND(OutData%BN_Cl_Static,1) - OutData%BN_Cl_Static(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(OutData%Vstr_LL,3), UBOUND(OutData%Vstr_LL,3) + DO i2 = LBOUND(OutData%Vstr_LL,2), UBOUND(OutData%Vstr_LL,2) + DO i1 = LBOUND(OutData%Vstr_LL,1), UBOUND(OutData%Vstr_LL,1) + OutData%Vstr_LL(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cd_Static not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_LL not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -5258,20 +5314,25 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Cd_Static)) DEALLOCATE(OutData%BN_Cd_Static) - ALLOCATE(OutData%BN_Cd_Static(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Vwnd_LL)) DEALLOCATE(OutData%Vwnd_LL) + ALLOCATE(OutData%Vwnd_LL(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%BN_Cd_Static.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_LL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%BN_Cd_Static,2), UBOUND(OutData%BN_Cd_Static,2) - DO i1 = LBOUND(OutData%BN_Cd_Static,1), UBOUND(OutData%BN_Cd_Static,1) - OutData%BN_Cd_Static(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(OutData%Vwnd_LL,3), UBOUND(OutData%Vwnd_LL,3) + DO i2 = LBOUND(OutData%Vwnd_LL,2), UBOUND(OutData%Vwnd_LL,2) + DO i1 = LBOUND(OutData%Vwnd_LL,1), UBOUND(OutData%Vwnd_LL,1) + OutData%Vwnd_LL(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cm_Static not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_NW not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -5281,20 +5342,30 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Cm_Static)) DEALLOCATE(OutData%BN_Cm_Static) - ALLOCATE(OutData%BN_Cm_Static(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + 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%Vwnd_NW)) DEALLOCATE(OutData%Vwnd_NW) + ALLOCATE(OutData%Vwnd_NW(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%BN_Cm_Static.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_NW.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%BN_Cm_Static,2), UBOUND(OutData%BN_Cm_Static,2) - DO i1 = LBOUND(OutData%BN_Cm_Static,1), UBOUND(OutData%BN_Cm_Static,1) - OutData%BN_Cm_Static(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 + DO i4 = LBOUND(OutData%Vwnd_NW,4), UBOUND(OutData%Vwnd_NW,4) + DO i3 = LBOUND(OutData%Vwnd_NW,3), UBOUND(OutData%Vwnd_NW,3) + DO i2 = LBOUND(OutData%Vwnd_NW,2), UBOUND(OutData%Vwnd_NW,2) + DO i1 = LBOUND(OutData%Vwnd_NW,1), UBOUND(OutData%Vwnd_NW,1) + OutData%Vwnd_NW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cl not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_FW not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -5304,20 +5375,30 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Cl)) DEALLOCATE(OutData%BN_Cl) - ALLOCATE(OutData%BN_Cl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + 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%Vwnd_FW)) DEALLOCATE(OutData%Vwnd_FW) + ALLOCATE(OutData%Vwnd_FW(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%BN_Cl.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_FW.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%BN_Cl,2), UBOUND(OutData%BN_Cl,2) - DO i1 = LBOUND(OutData%BN_Cl,1), UBOUND(OutData%BN_Cl,1) - OutData%BN_Cl(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 + DO i4 = LBOUND(OutData%Vwnd_FW,4), UBOUND(OutData%Vwnd_FW,4) + DO i3 = LBOUND(OutData%Vwnd_FW,3), UBOUND(OutData%Vwnd_FW,3) + DO i2 = LBOUND(OutData%Vwnd_FW,2), UBOUND(OutData%Vwnd_FW,2) + DO i1 = LBOUND(OutData%Vwnd_FW,1), UBOUND(OutData%Vwnd_FW,1) + OutData%Vwnd_FW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cd not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind_NW not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -5327,20 +5408,30 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Cd)) DEALLOCATE(OutData%BN_Cd) - ALLOCATE(OutData%BN_Cd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + 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%Vind_NW)) DEALLOCATE(OutData%Vind_NW) + ALLOCATE(OutData%Vind_NW(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%BN_Cd.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_NW.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%BN_Cd,2), UBOUND(OutData%BN_Cd,2) - DO i1 = LBOUND(OutData%BN_Cd,1), UBOUND(OutData%BN_Cd,1) - OutData%BN_Cd(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 + DO i4 = LBOUND(OutData%Vind_NW,4), UBOUND(OutData%Vind_NW,4) + DO i3 = LBOUND(OutData%Vind_NW,3), UBOUND(OutData%Vind_NW,3) + DO i2 = LBOUND(OutData%Vind_NW,2), UBOUND(OutData%Vind_NW,2) + DO i1 = LBOUND(OutData%Vind_NW,1), UBOUND(OutData%Vind_NW,1) + OutData%Vind_NW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cm not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind_FW not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -5350,20 +5441,40 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Cm)) DEALLOCATE(OutData%BN_Cm) - ALLOCATE(OutData%BN_Cm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + 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%Vind_FW)) DEALLOCATE(OutData%Vind_FW) + ALLOCATE(OutData%Vind_FW(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%BN_Cm.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind_FW.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%BN_Cm,2), UBOUND(OutData%BN_Cm,2) - DO i1 = LBOUND(OutData%BN_Cm,1), UBOUND(OutData%BN_Cm,1) - OutData%BN_Cm(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 + DO i4 = LBOUND(OutData%Vind_FW,4), UBOUND(OutData%Vind_FW,4) + DO i3 = LBOUND(OutData%Vind_FW,3), UBOUND(OutData%Vind_FW,3) + DO i2 = LBOUND(OutData%Vind_FW,2), UBOUND(OutData%Vind_FW,2) + DO i1 = LBOUND(OutData%Vind_FW,1), UBOUND(OutData%Vind_FW,1) + OutData%Vind_FW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cx not allocated + OutData%nNW = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nFW = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%iStep = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTKstep = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTKlastTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_wind not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -5373,20 +5484,20 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Cx)) DEALLOCATE(OutData%BN_Cx) - ALLOCATE(OutData%BN_Cx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%r_wind)) DEALLOCATE(OutData%r_wind) + ALLOCATE(OutData%r_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cx.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_wind.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%BN_Cx,2), UBOUND(OutData%BN_Cx,2) - DO i1 = LBOUND(OutData%BN_Cx,1), UBOUND(OutData%BN_Cx,1) - OutData%BN_Cx(i1,i2) = ReKiBuf(Re_Xferred) + DO i2 = LBOUND(OutData%r_wind,2), UBOUND(OutData%r_wind,2) + DO i1 = LBOUND(OutData%r_wind,1), UBOUND(OutData%r_wind,1) + OutData%r_wind(i1,i2) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cy not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitchAndTwist not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -5396,33 +5507,25 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BN_Cy)) DEALLOCATE(OutData%BN_Cy) - ALLOCATE(OutData%BN_Cy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%PitchAndTwist)) DEALLOCATE(OutData%PitchAndTwist) + ALLOCATE(OutData%PitchAndTwist(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cy.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAndTwist.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%BN_Cy,2), UBOUND(OutData%BN_Cy,2) - DO i1 = LBOUND(OutData%BN_Cy,1), UBOUND(OutData%BN_Cy,1) - OutData%BN_Cy(i1,i2) = ReKiBuf(Re_Xferred) + DO i2 = LBOUND(OutData%PitchAndTwist,2), UBOUND(OutData%PitchAndTwist,2) + DO i1 = LBOUND(OutData%PitchAndTwist,1), UBOUND(OutData%PitchAndTwist,1) + OutData%PitchAndTwist(i1,i2) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GridOutputs not allocated - Int_Xferred = Int_Xferred + 1 - ELSE + OutData%ComputeWakeInduced = TRANSFER(IntKiBuf(Int_Xferred), OutData%ComputeWakeInduced) Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GridOutputs)) DEALLOCATE(OutData%GridOutputs) - ALLOCATE(OutData%GridOutputs(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GridOutputs.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%GridOutputs,1), UBOUND(OutData%GridOutputs,1) + OutData%OldWakeTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%tSpent = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5456,16 +5559,14 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FVW_Unpackgridouttype( Re_Buf, Db_Buf, Int_Buf, OutData%GridOutputs(i1), ErrStat2, ErrMsg2 ) ! GridOutputs + CALL FVW_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%dxdt, ErrStat2, ErrMsg2 ) ! dxdt 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 ! u_UA not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_LL not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -5475,61 +5576,41 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg 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) + IF (ALLOCATED(OutData%alpha_LL)) DEALLOCATE(OutData%alpha_LL) + ALLOCATE(OutData%alpha_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%alpha_LL,2), UBOUND(OutData%alpha_LL,2) + DO i1 = LBOUND(OutData%alpha_LL,1), UBOUND(OutData%alpha_LL,1) + OutData%alpha_LL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vreln_LL not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_UA)) DEALLOCATE(OutData%u_UA) - ALLOCATE(OutData%u_UA(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Vreln_LL)) DEALLOCATE(OutData%Vreln_LL) + ALLOCATE(OutData%Vreln_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_UA.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vreln_LL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i3 = LBOUND(OutData%u_UA,3), UBOUND(OutData%u_UA,3) - DO i2 = LBOUND(OutData%u_UA,2), UBOUND(OutData%u_UA,2) - DO i1 = LBOUND(OutData%u_UA,1), UBOUND(OutData%u_UA,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 UA_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2 ) ! u_UA - 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 DO - END DO + DO i2 = LBOUND(OutData%Vreln_LL,2), UBOUND(OutData%Vreln_LL,2) + DO i1 = LBOUND(OutData%Vreln_LL,1), UBOUND(OutData%Vreln_LL,1) + OutData%Vreln_LL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -5564,468 +5645,611 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL UA_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m_UA, ErrStat2, ErrMsg2 ) ! m_UA - 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) - 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 UA_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_UA, ErrStat2, ErrMsg2 ) ! y_UA - 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) - 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 UA_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p_UA, ErrStat2, ErrMsg2 ) ! p_UA + CALL FVW_Unpackt_sgmt( Re_Buf, Db_Buf, Int_Buf, OutData%Sgmt, ErrStat2, ErrMsg2 ) ! Sgmt 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%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CPs not allocated Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FVW_UnPackMisc - - SUBROUTINE FVW_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_InputType), INTENT(INOUT) :: SrcInputData - TYPE(FVW_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) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyInput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcInputData%WingsMesh)) THEN - i1_l = LBOUND(SrcInputData%WingsMesh,1) - i1_u = UBOUND(SrcInputData%WingsMesh,1) - IF (.NOT. ALLOCATED(DstInputData%WingsMesh)) THEN - ALLOCATE(DstInputData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) + 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%CPs)) DEALLOCATE(OutData%CPs) + ALLOCATE(OutData%CPs(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CPs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%CPs,2), UBOUND(OutData%CPs,2) + DO i1 = LBOUND(OutData%CPs,1), UBOUND(OutData%CPs,1) + OutData%CPs(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Uind 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%Uind)) DEALLOCATE(OutData%Uind) + ALLOCATE(OutData%Uind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%WingsMesh.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Uind.', ErrStat, ErrMsg,RoutineName) + RETURN END IF + DO i2 = LBOUND(OutData%Uind,2), UBOUND(OutData%Uind,2) + DO i1 = LBOUND(OutData%Uind,1), UBOUND(OutData%Uind,1) + OutData%Uind(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - DO i1 = LBOUND(SrcInputData%WingsMesh,1), UBOUND(SrcInputData%WingsMesh,1) - CALL MeshCopy( SrcInputData%WingsMesh(i1), DstInputData%WingsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcInputData%V_wind)) THEN - i1_l = LBOUND(SrcInputData%V_wind,1) - i1_u = UBOUND(SrcInputData%V_wind,1) - i2_l = LBOUND(SrcInputData%V_wind,2) - i2_u = UBOUND(SrcInputData%V_wind,2) - IF (.NOT. ALLOCATED(DstInputData%V_wind)) THEN - ALLOCATE(DstInputData%V_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_AxInd 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%BN_AxInd)) DEALLOCATE(OutData%BN_AxInd) + ALLOCATE(OutData%BN_AxInd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%V_wind.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_AxInd.', ErrStat, ErrMsg,RoutineName) + RETURN END IF + DO i2 = LBOUND(OutData%BN_AxInd,2), UBOUND(OutData%BN_AxInd,2) + DO i1 = LBOUND(OutData%BN_AxInd,1), UBOUND(OutData%BN_AxInd,1) + OutData%BN_AxInd(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - DstInputData%V_wind = SrcInputData%V_wind -ENDIF - DstInputData%HubOrientation = SrcInputData%HubOrientation - DstInputData%HubPosition = SrcInputData%HubPosition -IF (ALLOCATED(SrcInputData%Vwnd_LLMP)) THEN - i1_l = LBOUND(SrcInputData%Vwnd_LLMP,1) - i1_u = UBOUND(SrcInputData%Vwnd_LLMP,1) - i2_l = LBOUND(SrcInputData%Vwnd_LLMP,2) - i2_u = UBOUND(SrcInputData%Vwnd_LLMP,2) - i3_l = LBOUND(SrcInputData%Vwnd_LLMP,3) - i3_u = UBOUND(SrcInputData%Vwnd_LLMP,3) - IF (.NOT. ALLOCATED(DstInputData%Vwnd_LLMP)) THEN - ALLOCATE(DstInputData%Vwnd_LLMP(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_TanInd 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%BN_TanInd)) DEALLOCATE(OutData%BN_TanInd) + ALLOCATE(OutData%BN_TanInd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vwnd_LLMP.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_TanInd.', ErrStat, ErrMsg,RoutineName) + RETURN END IF + DO i2 = LBOUND(OutData%BN_TanInd,2), UBOUND(OutData%BN_TanInd,2) + DO i1 = LBOUND(OutData%BN_TanInd,1), UBOUND(OutData%BN_TanInd,1) + OutData%BN_TanInd(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - DstInputData%Vwnd_LLMP = SrcInputData%Vwnd_LLMP -ENDIF -IF (ALLOCATED(SrcInputData%omega_z)) THEN - i1_l = LBOUND(SrcInputData%omega_z,1) - i1_u = UBOUND(SrcInputData%omega_z,1) - i2_l = LBOUND(SrcInputData%omega_z,2) - i2_u = UBOUND(SrcInputData%omega_z,2) - IF (.NOT. ALLOCATED(DstInputData%omega_z)) THEN - ALLOCATE(DstInputData%omega_z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_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%BN_Vrel)) DEALLOCATE(OutData%BN_Vrel) + ALLOCATE(OutData%BN_Vrel(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%omega_z.', ErrStat, ErrMsg,RoutineName) - RETURN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Vrel.', ErrStat, ErrMsg,RoutineName) + RETURN END IF + DO i2 = LBOUND(OutData%BN_Vrel,2), UBOUND(OutData%BN_Vrel,2) + DO i1 = LBOUND(OutData%BN_Vrel,1), UBOUND(OutData%BN_Vrel,1) + OutData%BN_Vrel(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - DstInputData%omega_z = SrcInputData%omega_z -ENDIF - END SUBROUTINE FVW_CopyInput - - SUBROUTINE FVW_DestroyInput( InputData, ErrStat, ErrMsg ) - TYPE(FVW_InputType), INTENT(INOUT) :: InputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(InputData%WingsMesh)) THEN -DO i1 = LBOUND(InputData%WingsMesh,1), UBOUND(InputData%WingsMesh,1) - CALL MeshDestroy( InputData%WingsMesh(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(InputData%WingsMesh) -ENDIF -IF (ALLOCATED(InputData%V_wind)) THEN - DEALLOCATE(InputData%V_wind) -ENDIF -IF (ALLOCATED(InputData%Vwnd_LLMP)) THEN - DEALLOCATE(InputData%Vwnd_LLMP) -ENDIF -IF (ALLOCATED(InputData%omega_z)) THEN - DEALLOCATE(InputData%omega_z) -ENDIF - END SUBROUTINE FVW_DestroyInput - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! WingsMesh allocated yes/no - IF ( ALLOCATED(InData%WingsMesh) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! WingsMesh upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) - Int_BufSz = Int_BufSz + 3 ! WingsMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! WingsMesh - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! WingsMesh - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! WingsMesh - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! WingsMesh - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_alpha 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%BN_alpha)) DEALLOCATE(OutData%BN_alpha) + ALLOCATE(OutData%BN_alpha(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_alpha.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_alpha,2), UBOUND(OutData%BN_alpha,2) + DO i1 = LBOUND(OutData%BN_alpha,1), UBOUND(OutData%BN_alpha,1) + OutData%BN_alpha(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - Int_BufSz = Int_BufSz + 1 ! V_wind allocated yes/no - IF ( ALLOCATED(InData%V_wind) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! V_wind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%V_wind) ! V_wind + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_phi 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%BN_phi)) DEALLOCATE(OutData%BN_phi) + ALLOCATE(OutData%BN_phi(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_phi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_phi,2), UBOUND(OutData%BN_phi,2) + DO i1 = LBOUND(OutData%BN_phi,1), UBOUND(OutData%BN_phi,1) + OutData%BN_phi(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - Re_BufSz = Re_BufSz + SIZE(InData%HubOrientation) ! HubOrientation - Re_BufSz = Re_BufSz + SIZE(InData%HubPosition) ! HubPosition - Int_BufSz = Int_BufSz + 1 ! Vwnd_LLMP allocated yes/no - IF ( ALLOCATED(InData%Vwnd_LLMP) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vwnd_LLMP upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_LLMP) ! Vwnd_LLMP + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Re 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%BN_Re)) DEALLOCATE(OutData%BN_Re) + ALLOCATE(OutData%BN_Re(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Re.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_Re,2), UBOUND(OutData%BN_Re,2) + DO i1 = LBOUND(OutData%BN_Re,1), UBOUND(OutData%BN_Re,1) + OutData%BN_Re(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - Int_BufSz = Int_BufSz + 1 ! omega_z allocated yes/no - IF ( ALLOCATED(InData%omega_z) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! omega_z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%omega_z) ! omega_z + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_URelWind_s 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%BN_URelWind_s)) DEALLOCATE(OutData%BN_URelWind_s) + ALLOCATE(OutData%BN_URelWind_s(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%BN_URelWind_s.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%BN_URelWind_s,3), UBOUND(OutData%BN_URelWind_s,3) + DO i2 = LBOUND(OutData%BN_URelWind_s,2), UBOUND(OutData%BN_URelWind_s,2) + DO i1 = LBOUND(OutData%BN_URelWind_s,1), UBOUND(OutData%BN_URelWind_s,1) + OutData%BN_URelWind_s(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + 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) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cl_Static 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%BN_Cl_Static)) DEALLOCATE(OutData%BN_Cl_Static) + ALLOCATE(OutData%BN_Cl_Static(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cl_Static.', ErrStat, ErrMsg,RoutineName) RETURN - END IF + END IF + DO i2 = LBOUND(OutData%BN_Cl_Static,2), UBOUND(OutData%BN_Cl_Static,2) + DO i1 = LBOUND(OutData%BN_Cl_Static,1), UBOUND(OutData%BN_Cl_Static,1) + OutData%BN_Cl_Static(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO 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) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cd_Static 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%BN_Cd_Static)) DEALLOCATE(OutData%BN_Cd_Static) + ALLOCATE(OutData%BN_Cd_Static(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cd_Static.', ErrStat, ErrMsg,RoutineName) RETURN - END IF + END IF + DO i2 = LBOUND(OutData%BN_Cd_Static,2), UBOUND(OutData%BN_Cd_Static,2) + DO i1 = LBOUND(OutData%BN_Cd_Static,1), UBOUND(OutData%BN_Cd_Static,1) + OutData%BN_Cd_Static(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO 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) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cm_Static 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%BN_Cm_Static)) DEALLOCATE(OutData%BN_Cm_Static) + ALLOCATE(OutData%BN_Cm_Static(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cm_Static.', ErrStat, ErrMsg,RoutineName) RETURN - END IF + END IF + DO i2 = LBOUND(OutData%BN_Cm_Static,2), UBOUND(OutData%BN_Cm_Static,2) + DO i1 = LBOUND(OutData%BN_Cm_Static,1), UBOUND(OutData%BN_Cm_Static,1) + OutData%BN_Cm_Static(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO 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%WingsMesh) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cl not allocated Int_Xferred = Int_Xferred + 1 ELSE - IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%WingsMesh,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WingsMesh,1) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) - CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! WingsMesh - 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 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BN_Cl)) DEALLOCATE(OutData%BN_Cl) + ALLOCATE(OutData%BN_Cl(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cl.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_Cl,2), UBOUND(OutData%BN_Cl,2) + DO i1 = LBOUND(OutData%BN_Cl,1), UBOUND(OutData%BN_Cl,1) + OutData%BN_Cl(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%V_wind) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cd not allocated Int_Xferred = Int_Xferred + 1 ELSE - IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_wind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_wind,1) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%V_wind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_wind,2) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%V_wind,2), UBOUND(InData%V_wind,2) - DO i1 = LBOUND(InData%V_wind,1), UBOUND(InData%V_wind,1) - ReKiBuf(Re_Xferred) = InData%V_wind(i1,i2) + IF (ALLOCATED(OutData%BN_Cd)) DEALLOCATE(OutData%BN_Cd) + ALLOCATE(OutData%BN_Cd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_Cd,2), UBOUND(OutData%BN_Cd,2) + DO i1 = LBOUND(OutData%BN_Cd,1), UBOUND(OutData%BN_Cd,1) + OutData%BN_Cd(i1,i2) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - DO i2 = LBOUND(InData%HubOrientation,2), UBOUND(InData%HubOrientation,2) - DO i1 = LBOUND(InData%HubOrientation,1), UBOUND(InData%HubOrientation,1) - ReKiBuf(Re_Xferred) = InData%HubOrientation(i1,i2) - Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cm 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%BN_Cm)) DEALLOCATE(OutData%BN_Cm) + ALLOCATE(OutData%BN_Cm(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_Cm,2), UBOUND(OutData%BN_Cm,2) + DO i1 = LBOUND(OutData%BN_Cm,1), UBOUND(OutData%BN_Cm,1) + OutData%BN_Cm(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END DO - END DO - DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) - ReKiBuf(Re_Xferred) = InData%HubPosition(i1) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( .NOT. ALLOCATED(InData%Vwnd_LLMP) ) THEN - IntKiBuf( Int_Xferred ) = 0 + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cx not allocated Int_Xferred = Int_Xferred + 1 ELSE - IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LLMP,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LLMP,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LLMP,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LLMP,2) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LLMP,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LLMP,3) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vwnd_LLMP,3), UBOUND(InData%Vwnd_LLMP,3) - DO i2 = LBOUND(InData%Vwnd_LLMP,2), UBOUND(InData%Vwnd_LLMP,2) - DO i1 = LBOUND(InData%Vwnd_LLMP,1), UBOUND(InData%Vwnd_LLMP,1) - ReKiBuf(Re_Xferred) = InData%Vwnd_LLMP(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO + IF (ALLOCATED(OutData%BN_Cx)) DEALLOCATE(OutData%BN_Cx) + ALLOCATE(OutData%BN_Cx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_Cx,2), UBOUND(OutData%BN_Cx,2) + DO i1 = LBOUND(OutData%BN_Cx,1), UBOUND(OutData%BN_Cx,1) + OutData%BN_Cx(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%omega_z) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BN_Cy not allocated Int_Xferred = Int_Xferred + 1 ELSE - IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omega_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_z,1) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%omega_z,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_z,2) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%omega_z,2), UBOUND(InData%omega_z,2) - DO i1 = LBOUND(InData%omega_z,1), UBOUND(InData%omega_z,1) - ReKiBuf(Re_Xferred) = InData%omega_z(i1,i2) + IF (ALLOCATED(OutData%BN_Cy)) DEALLOCATE(OutData%BN_Cy) + ALLOCATE(OutData%BN_Cy(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BN_Cy.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%BN_Cy,2), UBOUND(OutData%BN_Cy,2) + DO i1 = LBOUND(OutData%BN_Cy,1), UBOUND(OutData%BN_Cy,1) + OutData%BN_Cy(i1,i2) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - END SUBROUTINE FVW_PackInput + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GridOutputs 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%GridOutputs)) DEALLOCATE(OutData%GridOutputs) + ALLOCATE(OutData%GridOutputs(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GridOutputs.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%GridOutputs,1), UBOUND(OutData%GridOutputs,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 FVW_Unpackgridouttype( Re_Buf, Db_Buf, Int_Buf, OutData%GridOutputs(i1), ErrStat2, ErrMsg2 ) ! GridOutputs + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE FVW_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(FVW_InputType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: 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 = 'FVW_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 ! WingsMesh not allocated + 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 ! u_UA 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%WingsMesh)) DEALLOCATE(OutData%WingsMesh) - ALLOCATE(OutData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) + 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%u_UA)) DEALLOCATE(OutData%u_UA) + ALLOCATE(OutData%u_UA(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%WingsMesh.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_UA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%WingsMesh,1), UBOUND(OutData%WingsMesh,1) + DO i3 = LBOUND(OutData%u_UA,3), UBOUND(OutData%u_UA,3) + DO i2 = LBOUND(OutData%u_UA,2), UBOUND(OutData%u_UA,2) + DO i1 = LBOUND(OutData%u_UA,1), UBOUND(OutData%u_UA,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 UA_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_UA(i1,i2,i3), ErrStat2, ErrMsg2 ) ! u_UA + 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 DO + END DO + 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 UA_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m_UA, ErrStat2, ErrMsg2 ) ! m_UA + 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) + 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 UA_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_UA, ErrStat2, ErrMsg2 ) ! y_UA + 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) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -6059,110 +6283,20 @@ SUBROUTINE FVW_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! WingsMesh + CALL UA_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p_UA, ErrStat2, ErrMsg2 ) ! p_UA 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 ! V_wind 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%V_wind)) DEALLOCATE(OutData%V_wind) - ALLOCATE(OutData%V_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_wind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%V_wind,2), UBOUND(OutData%V_wind,2) - DO i1 = LBOUND(OutData%V_wind,1), UBOUND(OutData%V_wind,1) - OutData%V_wind(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - i1_l = LBOUND(OutData%HubOrientation,1) - i1_u = UBOUND(OutData%HubOrientation,1) - i2_l = LBOUND(OutData%HubOrientation,2) - i2_u = UBOUND(OutData%HubOrientation,2) - DO i2 = LBOUND(OutData%HubOrientation,2), UBOUND(OutData%HubOrientation,2) - DO i1 = LBOUND(OutData%HubOrientation,1), UBOUND(OutData%HubOrientation,1) - OutData%HubOrientation(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - i1_l = LBOUND(OutData%HubPosition,1) - i1_u = UBOUND(OutData%HubPosition,1) - DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) - OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_LLMP 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%Vwnd_LLMP)) DEALLOCATE(OutData%Vwnd_LLMP) - ALLOCATE(OutData%Vwnd_LLMP(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%Vwnd_LLMP.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vwnd_LLMP,3), UBOUND(OutData%Vwnd_LLMP,3) - DO i2 = LBOUND(OutData%Vwnd_LLMP,2), UBOUND(OutData%Vwnd_LLMP,2) - DO i1 = LBOUND(OutData%Vwnd_LLMP,1), UBOUND(OutData%Vwnd_LLMP,1) - OutData%Vwnd_LLMP(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! omega_z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE + OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) 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%omega_z)) DEALLOCATE(OutData%omega_z) - ALLOCATE(OutData%omega_z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%omega_z,2), UBOUND(OutData%omega_z,2) - DO i1 = LBOUND(OutData%omega_z,1), UBOUND(OutData%omega_z,1) - OutData%omega_z(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FVW_UnPackInput + END SUBROUTINE FVW_UnPackMisc - SUBROUTINE FVW_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_OutputType), INTENT(IN) :: SrcOutputData - TYPE(FVW_OutputType), INTENT(INOUT) :: DstOutputData + SUBROUTINE FVW_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FVW_InputType), INTENT(INOUT) :: SrcInputData + TYPE(FVW_InputType), INTENT(INOUT) :: DstInputData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -6173,64 +6307,105 @@ SUBROUTINE FVW_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyOutput' + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyInput' ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(SrcOutputData%Vind)) THEN - i1_l = LBOUND(SrcOutputData%Vind,1) - i1_u = UBOUND(SrcOutputData%Vind,1) - i2_l = LBOUND(SrcOutputData%Vind,2) - i2_u = UBOUND(SrcOutputData%Vind,2) - i3_l = LBOUND(SrcOutputData%Vind,3) - i3_u = UBOUND(SrcOutputData%Vind,3) - IF (.NOT. ALLOCATED(DstOutputData%Vind)) THEN - ALLOCATE(DstOutputData%Vind(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) +IF (ALLOCATED(SrcInputData%WingsMesh)) THEN + i1_l = LBOUND(SrcInputData%WingsMesh,1) + i1_u = UBOUND(SrcInputData%WingsMesh,1) + IF (.NOT. ALLOCATED(DstInputData%WingsMesh)) THEN + ALLOCATE(DstInputData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vind.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%WingsMesh.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstOutputData%Vind = SrcOutputData%Vind + DO i1 = LBOUND(SrcInputData%WingsMesh,1), UBOUND(SrcInputData%WingsMesh,1) + CALL MeshCopy( SrcInputData%WingsMesh(i1), DstInputData%WingsMesh(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcOutputData%Cl_KJ)) THEN - i1_l = LBOUND(SrcOutputData%Cl_KJ,1) - i1_u = UBOUND(SrcOutputData%Cl_KJ,1) - i2_l = LBOUND(SrcOutputData%Cl_KJ,2) - i2_u = UBOUND(SrcOutputData%Cl_KJ,2) - IF (.NOT. ALLOCATED(DstOutputData%Cl_KJ)) THEN - ALLOCATE(DstOutputData%Cl_KJ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcInputData%V_wind)) THEN + i1_l = LBOUND(SrcInputData%V_wind,1) + i1_u = UBOUND(SrcInputData%V_wind,1) + i2_l = LBOUND(SrcInputData%V_wind,2) + i2_u = UBOUND(SrcInputData%V_wind,2) + IF (.NOT. ALLOCATED(DstInputData%V_wind)) THEN + ALLOCATE(DstInputData%V_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cl_KJ.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%V_wind.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstOutputData%Cl_KJ = SrcOutputData%Cl_KJ + DstInputData%V_wind = SrcInputData%V_wind ENDIF - END SUBROUTINE FVW_CopyOutput + DstInputData%HubOrientation = SrcInputData%HubOrientation + DstInputData%HubPosition = SrcInputData%HubPosition +IF (ALLOCATED(SrcInputData%Vwnd_LLMP)) THEN + i1_l = LBOUND(SrcInputData%Vwnd_LLMP,1) + i1_u = UBOUND(SrcInputData%Vwnd_LLMP,1) + i2_l = LBOUND(SrcInputData%Vwnd_LLMP,2) + i2_u = UBOUND(SrcInputData%Vwnd_LLMP,2) + i3_l = LBOUND(SrcInputData%Vwnd_LLMP,3) + i3_u = UBOUND(SrcInputData%Vwnd_LLMP,3) + IF (.NOT. ALLOCATED(DstInputData%Vwnd_LLMP)) THEN + ALLOCATE(DstInputData%Vwnd_LLMP(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%Vwnd_LLMP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputData%Vwnd_LLMP = SrcInputData%Vwnd_LLMP +ENDIF +IF (ALLOCATED(SrcInputData%omega_z)) THEN + i1_l = LBOUND(SrcInputData%omega_z,1) + i1_u = UBOUND(SrcInputData%omega_z,1) + i2_l = LBOUND(SrcInputData%omega_z,2) + i2_u = UBOUND(SrcInputData%omega_z,2) + IF (.NOT. ALLOCATED(DstInputData%omega_z)) THEN + ALLOCATE(DstInputData%omega_z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%omega_z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputData%omega_z = SrcInputData%omega_z +ENDIF + END SUBROUTINE FVW_CopyInput - SUBROUTINE FVW_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(FVW_OutputType), INTENT(INOUT) :: OutputData + SUBROUTINE FVW_DestroyInput( InputData, ErrStat, ErrMsg ) + TYPE(FVW_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyOutput' + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyInput' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(OutputData%Vind)) THEN - DEALLOCATE(OutputData%Vind) +IF (ALLOCATED(InputData%WingsMesh)) THEN +DO i1 = LBOUND(InputData%WingsMesh,1), UBOUND(InputData%WingsMesh,1) + CALL MeshDestroy( InputData%WingsMesh(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(InputData%WingsMesh) ENDIF -IF (ALLOCATED(OutputData%Cl_KJ)) THEN - DEALLOCATE(OutputData%Cl_KJ) +IF (ALLOCATED(InputData%V_wind)) THEN + DEALLOCATE(InputData%V_wind) ENDIF - END SUBROUTINE FVW_DestroyOutput +IF (ALLOCATED(InputData%Vwnd_LLMP)) THEN + DEALLOCATE(InputData%Vwnd_LLMP) +ENDIF +IF (ALLOCATED(InputData%omega_z)) THEN + DEALLOCATE(InputData%omega_z) +ENDIF + END SUBROUTINE FVW_DestroyInput - SUBROUTINE FVW_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FVW_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(FVW_OutputType), INTENT(IN) :: InData + TYPE(FVW_InputType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -6245,7 +6420,7 @@ SUBROUTINE FVW_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackOutput' + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackInput' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -6261,15 +6436,46 @@ SUBROUTINE FVW_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Vind allocated yes/no - IF ( ALLOCATED(InData%Vind) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind) ! Vind + Int_BufSz = Int_BufSz + 1 ! WingsMesh allocated yes/no + IF ( ALLOCATED(InData%WingsMesh) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! WingsMesh upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) + Int_BufSz = Int_BufSz + 3 ! WingsMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! WingsMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! WingsMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! WingsMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! WingsMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - Int_BufSz = Int_BufSz + 1 ! Cl_KJ allocated yes/no - IF ( ALLOCATED(InData%Cl_KJ) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cl_KJ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cl_KJ) ! Cl_KJ + Int_BufSz = Int_BufSz + 1 ! V_wind allocated yes/no + IF ( ALLOCATED(InData%V_wind) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! V_wind upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%V_wind) ! V_wind + END IF + Re_BufSz = Re_BufSz + SIZE(InData%HubOrientation) ! HubOrientation + Re_BufSz = Re_BufSz + SIZE(InData%HubPosition) ! HubPosition + Int_BufSz = Int_BufSz + 1 ! Vwnd_LLMP allocated yes/no + IF ( ALLOCATED(InData%Vwnd_LLMP) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Vwnd_LLMP upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vwnd_LLMP) ! Vwnd_LLMP + END IF + Int_BufSz = Int_BufSz + 1 ! omega_z allocated yes/no + IF ( ALLOCATED(InData%omega_z) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! omega_z upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%omega_z) ! omega_z END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -6298,58 +6504,129 @@ SUBROUTINE FVW_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IF ( .NOT. ALLOCATED(InData%Vind) ) THEN + IF ( .NOT. ALLOCATED(InData%WingsMesh) ) 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%Vind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%WingsMesh,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WingsMesh,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,2) + + DO i1 = LBOUND(InData%WingsMesh,1), UBOUND(InData%WingsMesh,1) + CALL MeshPack( InData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! WingsMesh + 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%V_wind) ) 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%V_wind,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_wind,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,3) + IntKiBuf( Int_Xferred ) = LBOUND(InData%V_wind,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V_wind,2) Int_Xferred = Int_Xferred + 2 - DO i3 = LBOUND(InData%Vind,3), UBOUND(InData%Vind,3) - DO i2 = LBOUND(InData%Vind,2), UBOUND(InData%Vind,2) - DO i1 = LBOUND(InData%Vind,1), UBOUND(InData%Vind,1) - ReKiBuf(Re_Xferred) = InData%Vind(i1,i2,i3) + DO i2 = LBOUND(InData%V_wind,2), UBOUND(InData%V_wind,2) + DO i1 = LBOUND(InData%V_wind,1), UBOUND(InData%V_wind,1) + ReKiBuf(Re_Xferred) = InData%V_wind(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO i2 = LBOUND(InData%HubOrientation,2), UBOUND(InData%HubOrientation,2) + DO i1 = LBOUND(InData%HubOrientation,1), UBOUND(InData%HubOrientation,1) + ReKiBuf(Re_Xferred) = InData%HubOrientation(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) + ReKiBuf(Re_Xferred) = InData%HubPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IF ( .NOT. ALLOCATED(InData%Vwnd_LLMP) ) 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%Vwnd_LLMP,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LLMP,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LLMP,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LLMP,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vwnd_LLMP,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vwnd_LLMP,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Vwnd_LLMP,3), UBOUND(InData%Vwnd_LLMP,3) + DO i2 = LBOUND(InData%Vwnd_LLMP,2), UBOUND(InData%Vwnd_LLMP,2) + DO i1 = LBOUND(InData%Vwnd_LLMP,1), UBOUND(InData%Vwnd_LLMP,1) + ReKiBuf(Re_Xferred) = InData%Vwnd_LLMP(i1,i2,i3) Re_Xferred = Re_Xferred + 1 END DO END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%Cl_KJ) ) THEN + IF ( .NOT. ALLOCATED(InData%omega_z) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cl_KJ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cl_KJ,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%omega_z,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_z,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cl_KJ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cl_KJ,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%omega_z,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%omega_z,2) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%Cl_KJ,2), UBOUND(InData%Cl_KJ,2) - DO i1 = LBOUND(InData%Cl_KJ,1), UBOUND(InData%Cl_KJ,1) - ReKiBuf(Re_Xferred) = InData%Cl_KJ(i1,i2) + DO i2 = LBOUND(InData%omega_z,2), UBOUND(InData%omega_z,2) + DO i1 = LBOUND(InData%omega_z,1), UBOUND(InData%omega_z,1) + ReKiBuf(Re_Xferred) = InData%omega_z(i1,i2) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - END SUBROUTINE FVW_PackOutput + END SUBROUTINE FVW_PackInput - SUBROUTINE FVW_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FVW_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(FVW_OutputType), INTENT(INOUT) :: OutData + TYPE(FVW_InputType), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -6363,7 +6640,7 @@ SUBROUTINE FVW_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackOutput' + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackInput' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -6374,7 +6651,102 @@ SUBROUTINE FVW_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WingsMesh 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%WingsMesh)) DEALLOCATE(OutData%WingsMesh) + ALLOCATE(OutData%WingsMesh(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WingsMesh.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%WingsMesh,1), UBOUND(OutData%WingsMesh,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 MeshUnpack( OutData%WingsMesh(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! WingsMesh + 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 ! V_wind 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%V_wind)) DEALLOCATE(OutData%V_wind) + ALLOCATE(OutData%V_wind(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V_wind.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%V_wind,2), UBOUND(OutData%V_wind,2) + DO i1 = LBOUND(OutData%V_wind,1), UBOUND(OutData%V_wind,1) + OutData%V_wind(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + i1_l = LBOUND(OutData%HubOrientation,1) + i1_u = UBOUND(OutData%HubOrientation,1) + i2_l = LBOUND(OutData%HubOrientation,2) + i2_u = UBOUND(OutData%HubOrientation,2) + DO i2 = LBOUND(OutData%HubOrientation,2), UBOUND(OutData%HubOrientation,2) + DO i1 = LBOUND(OutData%HubOrientation,1), UBOUND(OutData%HubOrientation,1) + OutData%HubOrientation(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + i1_l = LBOUND(OutData%HubPosition,1) + i1_u = UBOUND(OutData%HubPosition,1) + DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) + OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vwnd_LLMP not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -6387,22 +6759,22 @@ SUBROUTINE FVW_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs i3_l = IntKiBuf( Int_Xferred ) i3_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vind)) DEALLOCATE(OutData%Vind) - ALLOCATE(OutData%Vind(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Vwnd_LLMP)) DEALLOCATE(OutData%Vwnd_LLMP) + ALLOCATE(OutData%Vwnd_LLMP(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%Vind.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vwnd_LLMP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i3 = LBOUND(OutData%Vind,3), UBOUND(OutData%Vind,3) - DO i2 = LBOUND(OutData%Vind,2), UBOUND(OutData%Vind,2) - DO i1 = LBOUND(OutData%Vind,1), UBOUND(OutData%Vind,1) - OutData%Vind(i1,i2,i3) = ReKiBuf(Re_Xferred) + DO i3 = LBOUND(OutData%Vwnd_LLMP,3), UBOUND(OutData%Vwnd_LLMP,3) + DO i2 = LBOUND(OutData%Vwnd_LLMP,2), UBOUND(OutData%Vwnd_LLMP,2) + DO i1 = LBOUND(OutData%Vwnd_LLMP,1), UBOUND(OutData%Vwnd_LLMP,1) + OutData%Vwnd_LLMP(i1,i2,i3) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cl_KJ not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! omega_z not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -6412,24 +6784,24 @@ SUBROUTINE FVW_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Cl_KJ)) DEALLOCATE(OutData%Cl_KJ) - ALLOCATE(OutData%Cl_KJ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%omega_z)) DEALLOCATE(OutData%omega_z) + ALLOCATE(OutData%omega_z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cl_KJ.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%omega_z.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%Cl_KJ,2), UBOUND(OutData%Cl_KJ,2) - DO i1 = LBOUND(OutData%Cl_KJ,1), UBOUND(OutData%Cl_KJ,1) - OutData%Cl_KJ(i1,i2) = ReKiBuf(Re_Xferred) + DO i2 = LBOUND(OutData%omega_z,2), UBOUND(OutData%omega_z,2) + DO i1 = LBOUND(OutData%omega_z,1), UBOUND(OutData%omega_z,1) + OutData%omega_z(i1,i2) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END DO END IF - END SUBROUTINE FVW_UnPackOutput + END SUBROUTINE FVW_UnPackInput - SUBROUTINE FVW_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_ContinuousStateType), INTENT(IN) :: SrcContStateData - TYPE(FVW_ContinuousStateType), INTENT(INOUT) :: DstContStateData + SUBROUTINE FVW_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FVW_OutputType), INTENT(IN) :: SrcOutputData + TYPE(FVW_OutputType), INTENT(INOUT) :: DstOutputData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -6438,115 +6810,66 @@ SUBROUTINE FVW_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrS 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 = 'FVW_CopyContState' + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyOutput' ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(SrcContStateData%Gamma_NW)) THEN - i1_l = LBOUND(SrcContStateData%Gamma_NW,1) - i1_u = UBOUND(SrcContStateData%Gamma_NW,1) - i2_l = LBOUND(SrcContStateData%Gamma_NW,2) - i2_u = UBOUND(SrcContStateData%Gamma_NW,2) - i3_l = LBOUND(SrcContStateData%Gamma_NW,3) - i3_u = UBOUND(SrcContStateData%Gamma_NW,3) - IF (.NOT. ALLOCATED(DstContStateData%Gamma_NW)) THEN - ALLOCATE(DstContStateData%Gamma_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%Gamma_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%Gamma_NW = SrcContStateData%Gamma_NW -ENDIF -IF (ALLOCATED(SrcContStateData%Gamma_FW)) THEN - i1_l = LBOUND(SrcContStateData%Gamma_FW,1) - i1_u = UBOUND(SrcContStateData%Gamma_FW,1) - i2_l = LBOUND(SrcContStateData%Gamma_FW,2) - i2_u = UBOUND(SrcContStateData%Gamma_FW,2) - i3_l = LBOUND(SrcContStateData%Gamma_FW,3) - i3_u = UBOUND(SrcContStateData%Gamma_FW,3) - IF (.NOT. ALLOCATED(DstContStateData%Gamma_FW)) THEN - ALLOCATE(DstContStateData%Gamma_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%Gamma_FW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstContStateData%Gamma_FW = SrcContStateData%Gamma_FW -ENDIF -IF (ALLOCATED(SrcContStateData%r_NW)) THEN - i1_l = LBOUND(SrcContStateData%r_NW,1) - i1_u = UBOUND(SrcContStateData%r_NW,1) - i2_l = LBOUND(SrcContStateData%r_NW,2) - i2_u = UBOUND(SrcContStateData%r_NW,2) - i3_l = LBOUND(SrcContStateData%r_NW,3) - i3_u = UBOUND(SrcContStateData%r_NW,3) - i4_l = LBOUND(SrcContStateData%r_NW,4) - i4_u = UBOUND(SrcContStateData%r_NW,4) - IF (.NOT. ALLOCATED(DstContStateData%r_NW)) THEN - ALLOCATE(DstContStateData%r_NW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) +IF (ALLOCATED(SrcOutputData%Vind)) THEN + i1_l = LBOUND(SrcOutputData%Vind,1) + i1_u = UBOUND(SrcOutputData%Vind,1) + i2_l = LBOUND(SrcOutputData%Vind,2) + i2_u = UBOUND(SrcOutputData%Vind,2) + i3_l = LBOUND(SrcOutputData%Vind,3) + i3_u = UBOUND(SrcOutputData%Vind,3) + IF (.NOT. ALLOCATED(DstOutputData%Vind)) THEN + ALLOCATE(DstOutputData%Vind(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%r_NW.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vind.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstContStateData%r_NW = SrcContStateData%r_NW + DstOutputData%Vind = SrcOutputData%Vind ENDIF -IF (ALLOCATED(SrcContStateData%r_FW)) THEN - i1_l = LBOUND(SrcContStateData%r_FW,1) - i1_u = UBOUND(SrcContStateData%r_FW,1) - i2_l = LBOUND(SrcContStateData%r_FW,2) - i2_u = UBOUND(SrcContStateData%r_FW,2) - i3_l = LBOUND(SrcContStateData%r_FW,3) - i3_u = UBOUND(SrcContStateData%r_FW,3) - i4_l = LBOUND(SrcContStateData%r_FW,4) - i4_u = UBOUND(SrcContStateData%r_FW,4) - IF (.NOT. ALLOCATED(DstContStateData%r_FW)) THEN - ALLOCATE(DstContStateData%r_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) +IF (ALLOCATED(SrcOutputData%Cl_KJ)) THEN + i1_l = LBOUND(SrcOutputData%Cl_KJ,1) + i1_u = UBOUND(SrcOutputData%Cl_KJ,1) + i2_l = LBOUND(SrcOutputData%Cl_KJ,2) + i2_u = UBOUND(SrcOutputData%Cl_KJ,2) + IF (.NOT. ALLOCATED(DstOutputData%Cl_KJ)) THEN + ALLOCATE(DstOutputData%Cl_KJ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstContStateData%r_FW.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cl_KJ.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstContStateData%r_FW = SrcContStateData%r_FW + DstOutputData%Cl_KJ = SrcOutputData%Cl_KJ ENDIF - CALL UA_CopyContState( SrcContStateData%UA, DstContStateData%UA, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FVW_CopyContState + END SUBROUTINE FVW_CopyOutput - SUBROUTINE FVW_DestroyContState( ContStateData, ErrStat, ErrMsg ) - TYPE(FVW_ContinuousStateType), INTENT(INOUT) :: ContStateData + SUBROUTINE FVW_DestroyOutput( OutputData, ErrStat, ErrMsg ) + TYPE(FVW_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyContState' + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyOutput' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(ContStateData%Gamma_NW)) THEN - DEALLOCATE(ContStateData%Gamma_NW) -ENDIF -IF (ALLOCATED(ContStateData%Gamma_FW)) THEN - DEALLOCATE(ContStateData%Gamma_FW) -ENDIF -IF (ALLOCATED(ContStateData%r_NW)) THEN - DEALLOCATE(ContStateData%r_NW) +IF (ALLOCATED(OutputData%Vind)) THEN + DEALLOCATE(OutputData%Vind) ENDIF -IF (ALLOCATED(ContStateData%r_FW)) THEN - DEALLOCATE(ContStateData%r_FW) +IF (ALLOCATED(OutputData%Cl_KJ)) THEN + DEALLOCATE(OutputData%Cl_KJ) ENDIF - CALL UA_DestroyContState( ContStateData%UA, ErrStat, ErrMsg ) - END SUBROUTINE FVW_DestroyContState + END SUBROUTINE FVW_DestroyOutput - SUBROUTINE FVW_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FVW_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(FVW_ContinuousStateType), INTENT(IN) :: InData + TYPE(FVW_OutputType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -6561,7 +6884,7 @@ SUBROUTINE FVW_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackContState' + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_PackOutput' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -6577,44 +6900,16 @@ SUBROUTINE FVW_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Gamma_NW allocated yes/no - IF ( ALLOCATED(InData%Gamma_NW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Gamma_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Gamma_NW) ! Gamma_NW - END IF - Int_BufSz = Int_BufSz + 1 ! Gamma_FW allocated yes/no - IF ( ALLOCATED(InData%Gamma_FW) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Gamma_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Gamma_FW) ! Gamma_FW - END IF - Int_BufSz = Int_BufSz + 1 ! r_NW allocated yes/no - IF ( ALLOCATED(InData%r_NW) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! r_NW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_NW) ! r_NW + Int_BufSz = Int_BufSz + 1 ! Vind allocated yes/no + IF ( ALLOCATED(InData%Vind) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Vind upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vind) ! Vind END IF - Int_BufSz = Int_BufSz + 1 ! r_FW allocated yes/no - IF ( ALLOCATED(InData%r_FW) ) THEN - Int_BufSz = Int_BufSz + 2*4 ! r_FW upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%r_FW) ! r_FW + Int_BufSz = Int_BufSz + 1 ! Cl_KJ allocated yes/no + IF ( ALLOCATED(InData%Cl_KJ) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Cl_KJ upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Cl_KJ) ! Cl_KJ END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! UA: size of buffers for each call to pack subtype - CALL UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, .TRUE. ) ! UA - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! UA - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! UA - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! UA - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -6624,169 +6919,76 @@ SUBROUTINE FVW_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs 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%Gamma_NW) ) 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%Gamma_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_NW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_NW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_NW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_NW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Gamma_NW,3), UBOUND(InData%Gamma_NW,3) - DO i2 = LBOUND(InData%Gamma_NW,2), UBOUND(InData%Gamma_NW,2) - DO i1 = LBOUND(InData%Gamma_NW,1), UBOUND(InData%Gamma_NW,1) - ReKiBuf(Re_Xferred) = InData%Gamma_NW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Gamma_FW) ) 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%Gamma_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_FW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Gamma_FW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gamma_FW,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Gamma_FW,3), UBOUND(InData%Gamma_FW,3) - DO i2 = LBOUND(InData%Gamma_FW,2), UBOUND(InData%Gamma_FW,2) - DO i1 = LBOUND(InData%Gamma_FW,1), UBOUND(InData%Gamma_FW,1) - ReKiBuf(Re_Xferred) = InData%Gamma_FW(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( .NOT. ALLOCATED(InData%r_NW) ) THEN + 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%Vind) ) 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%r_NW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_NW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_NW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,3) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,2) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_NW,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_NW,4) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,3) Int_Xferred = Int_Xferred + 2 - DO i4 = LBOUND(InData%r_NW,4), UBOUND(InData%r_NW,4) - DO i3 = LBOUND(InData%r_NW,3), UBOUND(InData%r_NW,3) - DO i2 = LBOUND(InData%r_NW,2), UBOUND(InData%r_NW,2) - DO i1 = LBOUND(InData%r_NW,1), UBOUND(InData%r_NW,1) - ReKiBuf(Re_Xferred) = InData%r_NW(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO + DO i3 = LBOUND(InData%Vind,3), UBOUND(InData%Vind,3) + DO i2 = LBOUND(InData%Vind,2), UBOUND(InData%Vind,2) + DO i1 = LBOUND(InData%Vind,1), UBOUND(InData%Vind,1) + ReKiBuf(Re_Xferred) = InData%Vind(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 END DO END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%r_FW) ) THEN + IF ( .NOT. ALLOCATED(InData%Cl_KJ) ) 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%r_FW,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_FW,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_FW,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,3) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Cl_KJ,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cl_KJ,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%r_FW,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_FW,4) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Cl_KJ,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cl_KJ,2) Int_Xferred = Int_Xferred + 2 - DO i4 = LBOUND(InData%r_FW,4), UBOUND(InData%r_FW,4) - DO i3 = LBOUND(InData%r_FW,3), UBOUND(InData%r_FW,3) - DO i2 = LBOUND(InData%r_FW,2), UBOUND(InData%r_FW,2) - DO i1 = LBOUND(InData%r_FW,1), UBOUND(InData%r_FW,1) - ReKiBuf(Re_Xferred) = InData%r_FW(i1,i2,i3,i4) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + DO i2 = LBOUND(InData%Cl_KJ,2), UBOUND(InData%Cl_KJ,2) + DO i1 = LBOUND(InData%Cl_KJ,1), UBOUND(InData%Cl_KJ,1) + ReKiBuf(Re_Xferred) = InData%Cl_KJ(i1,i2) + Re_Xferred = Re_Xferred + 1 END DO END DO END IF - CALL UA_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA - 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 SUBROUTINE FVW_PackContState + END SUBROUTINE FVW_PackOutput - SUBROUTINE FVW_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FVW_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(FVW_ContinuousStateType), INTENT(INOUT) :: OutData + TYPE(FVW_OutputType), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -6798,10 +7000,9 @@ SUBROUTINE FVW_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er 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 = 'FVW_UnPackContState' + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_UnPackOutput' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -6812,35 +7013,7 @@ SUBROUTINE FVW_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma_NW 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%Gamma_NW)) DEALLOCATE(OutData%Gamma_NW) - ALLOCATE(OutData%Gamma_NW(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%Gamma_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Gamma_NW,3), UBOUND(OutData%Gamma_NW,3) - DO i2 = LBOUND(OutData%Gamma_NW,2), UBOUND(OutData%Gamma_NW,2) - DO i1 = LBOUND(OutData%Gamma_NW,1), UBOUND(OutData%Gamma_NW,1) - OutData%Gamma_NW(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gamma_FW not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vind not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -6853,55 +7026,22 @@ SUBROUTINE FVW_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er i3_l = IntKiBuf( Int_Xferred ) i3_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Gamma_FW)) DEALLOCATE(OutData%Gamma_FW) - ALLOCATE(OutData%Gamma_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Vind)) DEALLOCATE(OutData%Vind) + ALLOCATE(OutData%Vind(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%Gamma_FW.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vind.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i3 = LBOUND(OutData%Gamma_FW,3), UBOUND(OutData%Gamma_FW,3) - DO i2 = LBOUND(OutData%Gamma_FW,2), UBOUND(OutData%Gamma_FW,2) - DO i1 = LBOUND(OutData%Gamma_FW,1), UBOUND(OutData%Gamma_FW,1) - OutData%Gamma_FW(i1,i2,i3) = ReKiBuf(Re_Xferred) + DO i3 = LBOUND(OutData%Vind,3), UBOUND(OutData%Vind,3) + DO i2 = LBOUND(OutData%Vind,2), UBOUND(OutData%Vind,2) + DO i1 = LBOUND(OutData%Vind,1), UBOUND(OutData%Vind,1) + OutData%Vind(i1,i2,i3) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_NW 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%r_NW)) DEALLOCATE(OutData%r_NW) - ALLOCATE(OutData%r_NW(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%r_NW.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i4 = LBOUND(OutData%r_NW,4), UBOUND(OutData%r_NW,4) - DO i3 = LBOUND(OutData%r_NW,3), UBOUND(OutData%r_NW,3) - DO i2 = LBOUND(OutData%r_NW,2), UBOUND(OutData%r_NW,2) - DO i1 = LBOUND(OutData%r_NW,1), UBOUND(OutData%r_NW,1) - OutData%r_NW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_FW not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cl_KJ not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -6911,70 +7051,20 @@ SUBROUTINE FVW_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er 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%r_FW)) DEALLOCATE(OutData%r_FW) - ALLOCATE(OutData%r_FW(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%Cl_KJ)) DEALLOCATE(OutData%Cl_KJ) + ALLOCATE(OutData%Cl_KJ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_FW.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cl_KJ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i4 = LBOUND(OutData%r_FW,4), UBOUND(OutData%r_FW,4) - DO i3 = LBOUND(OutData%r_FW,3), UBOUND(OutData%r_FW,3) - DO i2 = LBOUND(OutData%r_FW,2), UBOUND(OutData%r_FW,2) - DO i1 = LBOUND(OutData%r_FW,1), UBOUND(OutData%r_FW,1) - OutData%r_FW(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO + DO i2 = LBOUND(OutData%Cl_KJ,2), UBOUND(OutData%Cl_KJ,2) + DO i1 = LBOUND(OutData%Cl_KJ,1), UBOUND(OutData%Cl_KJ,1) + OutData%Cl_KJ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END DO END DO 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 UA_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%UA, ErrStat2, ErrMsg2 ) ! UA - 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 SUBROUTINE FVW_UnPackContState + END SUBROUTINE FVW_UnPackOutput SUBROUTINE FVW_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(FVW_DiscreteStateType), INTENT(IN) :: SrcDiscStateData diff --git a/modules/aerodyn/src/FVW_VortexTools.f90 b/modules/aerodyn/src/FVW_VortexTools.f90 index 1fa8856f03..181dba4e06 100644 --- a/modules/aerodyn/src/FVW_VortexTools.f90 +++ b/modules/aerodyn/src/FVW_VortexTools.f90 @@ -121,13 +121,15 @@ subroutine LatticeToPoints(LatticePoints, iDepthStart, Points, iHeadP) endsubroutine LatticeToPoints - subroutine LatticeToSegments(LatticePoints, LatticeGamma, iDepthStart, SegPoints, SegConnct, SegGamma, iHeadP, iHeadC, bShedVorticity, bShedLastVorticity ) - real(Reki), dimension(:,:,:), intent(in ) :: LatticePoints !< Points 3 x nSpan x nDepth - real(Reki), dimension(:,:), intent(in ) :: LatticeGamma !< GammaPanl nSpan x nDepth + subroutine LatticeToSegments(LatticePoints, LatticeGamma, LatticeEpsilon, iDepthStart, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC, bShedVorticity, bShedLastVorticity ) + real(Reki), dimension(:,:,:), intent(in ) :: LatticePoints !< Points 3 x nSpan x nDepth + real(Reki), dimension(:,:), intent(in ) :: LatticeGamma !< GammaPanl nSpan x nDepth + real(Reki), dimension(:,:,:), intent(in ) :: LatticeEpsilon !< EpsPanl 3 x nSpan x nDepth (one per dimension) integer(IntKi), intent(in ) :: iDepthStart !< Start index for depth dimension real(ReKi), dimension(:,:), intent(inout) :: SegPoints !< integer(IntKi), dimension(:,:), intent(inout) :: SegConnct !< real(ReKi), dimension(:), intent(inout) :: SegGamma !< + real(ReKi), dimension(:), intent(inout) :: SegEpsilon !< integer(IntKi), intent(inout) :: iHeadP !< Index indicating where to start in SegPoints integer(IntKi), intent(inout) :: iHeadC !< Index indicating where to start in SegConnct logical , intent(in ) :: bShedVorticity !< Shed vorticity is included if true @@ -136,8 +138,8 @@ subroutine LatticeToSegments(LatticePoints, LatticeGamma, iDepthStart, SegPoints integer(IntKi) :: nSpan, nDepth integer(IntKi) :: iSpan, iDepth integer(IntKi) :: iHeadP0, iseg1, iseg2, iseg3 ,iseg4 !< Index indicating where to start in SegPoints - real(ReKi) :: Gamma12 - real(ReKi) :: Gamma41 + real(ReKi) :: Gamma12, Eps12 + real(ReKi) :: Gamma41, Eps41 nSpan = size(LatticePoints,2) nDepth= size(LatticePoints,3) @@ -170,13 +172,17 @@ subroutine LatticeToSegments(LatticePoints, LatticeGamma, iDepthStart, SegPoints iseg4 = iHeadP0 + (iSpan-1) +(iDepth -iDepthStart+1)*nSpan ! Point 4 if (iDepth==iDepthStart) then Gamma12 = LatticeGamma(iSpan,iDepth) + Eps12 = LatticeEpsilon(1,iSpan,iDepth) ! Using epsilon x for seg12&43. TODO might change in the future else Gamma12 = LatticeGamma(iSpan,iDepth)-LatticeGamma(iSpan,iDepth-1) + Eps12 = (LatticeEpsilon(1,iSpan,iDepth)+LatticeEpsilon(1,iSpan,iDepth-1))/2.0_ReKi endif if (iSpan==1) then Gamma41 = LatticeGamma(iSpan,iDepth) + Eps41 = LatticeEpsilon(3,iSpan,iDepth) ! Using epsilon z for seg23&41. TODO might change in the future else Gamma41 = LatticeGamma(iSpan,iDepth)-LatticeGamma(iSpan-1,iDepth) + Eps41 = (LatticeEpsilon(3,iSpan,iDepth)+LatticeEpsilon(3,iSpan-1,iDepth))/2.0_ReKi endif ! Segment 1-2 if (bShedVorticity) then @@ -184,7 +190,8 @@ subroutine LatticeToSegments(LatticePoints, LatticeGamma, iDepthStart, SegPoints SegConnct(2,iHeadC) = iseg2 SegConnct(3,iHeadC) = iDepth SegConnct(4,iHeadC) = iSpan - SegGamma (iHeadC ) = Gamma12 + SegGamma (iHeadC ) = Gamma12 + SegEpsilon(iHeadC ) = Eps12 iHeadC=iHeadC+1 endif ! Segment 1-4 @@ -193,6 +200,7 @@ subroutine LatticeToSegments(LatticePoints, LatticeGamma, iDepthStart, SegPoints SegConnct(3,iHeadC) = iDepth SegConnct(4,iHeadC) = iSpan SegGamma (iHeadC ) = -Gamma41 + SegEpsilon(iHeadC ) = Eps41 iHeadC=iHeadC+1 ! Segment 4-3 if (iDepth==nDepth-1) then @@ -202,6 +210,7 @@ subroutine LatticeToSegments(LatticePoints, LatticeGamma, iDepthStart, SegPoints SegConnct(3,iHeadC) = iDepth SegConnct(4,iHeadC) = iSpan SegGamma (iHeadC ) = - LatticeGamma(iSpan,iDepth) + SegEpsilon(iHeadC ) = LatticeEpsilon(1,iSpan,iDepth) ! Using epsilon x iHeadC=iHeadC+1 endif endif @@ -212,6 +221,7 @@ subroutine LatticeToSegments(LatticePoints, LatticeGamma, iDepthStart, SegPoints SegConnct(3,iHeadC) = iDepth SegConnct(4,iHeadC) = iSpan SegGamma (iHeadC ) = LatticeGamma(iSpan,iDepth) + SegEpsilon(iHeadC ) = LatticeEpsilon(3,iSpan,iDepth) ! Using epsilon z iHeadC=iHeadC+1 endif enddo From 1e286494be2cf3976406b1847721722a71e4c4ee Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Mon, 11 Jan 2021 15:03:44 -0700 Subject: [PATCH 07/27] FVW: RK4 for regularization --- modules/aerodyn/src/FVW.f90 | 193 ++++++++++++++---------------------- 1 file changed, 74 insertions(+), 119 deletions(-) diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index 4265573757..8730561f78 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -817,7 +817,7 @@ subroutine FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSt !dxdt%r_FW(1:3, :, 1, :)=0 ! --- Regularization - if (.not.allocated(dxdt%r_NW)) then + if (.not.allocated(dxdt%Eps_NW)) then call AllocAry( dxdt%Eps_NW , 3 , p%nSpan ,p%nNWMax , p%nWings, 'Eps NW ', ErrStat2, ErrMsg2); call AllocAry( dxdt%Eps_FW , 3 , FWnSpan ,p%nFWMax , p%nWings, 'Eps FW ', ErrStat2, ErrMsg2); if(Failed()) return @@ -916,7 +916,7 @@ logical function Failed() Failed = ErrStat >= AbortErrLev end function Failed end subroutine FVW_Euler1 -!---------------------------------------------------------------------------------------------------------------------------------- + !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine implements the fourth-order Runge-Kutta Method (RK4) for !numerically integrating ordinary differential equations: @@ -938,8 +938,6 @@ end subroutine FVW_Euler1 !Art of Scientific Computing, 2nd ed. Cambridge, England: !! Cambridge University Press, pp. 704-716, 1992. SUBROUTINE FVW_RK4( 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 !< time step number TYPE(FVW_InputType), INTENT(INOUT) :: u(:) !< Inputs at t (out only for mesh record-keeping in ExtrapInterp routine) @@ -952,10 +950,7 @@ SUBROUTINE FVW_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg TYPE(FVW_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(FVW_ContinuousStateType) :: dxdt ! time derivatives of continuous states real(ReKi) :: dt TYPE(FVW_ContinuousStateType) :: k1 ! RK4 constant; see above TYPE(FVW_ContinuousStateType) :: k2 ! RK4 constant; see above @@ -963,60 +958,37 @@ SUBROUTINE FVW_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg TYPE(FVW_ContinuousStateType) :: k4 ! RK4 constant; see above TYPE(FVW_ContinuousStateType) :: x_tmp ! Holds temporary modification to x TYPE(FVW_InputType) :: u_interp ! interpolated value of inputs - INTEGER(IntKi) :: ErrStat2 ! local error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message (ErrMsg) - - ! Initialize ErrStat - ErrStat = ErrID_None ErrMsg = "" dt = real(p%DTaero,ReKi) ! NOTE: this is DTaero not DTfvw since we integrate at each sub time step - if (m%ComputeWakeInduced) then - CALL FVW_CopyContState( x, k1, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - CALL FVW_CopyContState( x, k2, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - CALL FVW_CopyContState( x, k3, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - CALL FVW_CopyContState( x, k4, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - CALL FVW_CopyContState( x, x_tmp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - CALL FVW_CopyContState( x, x_tmp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - - - CALL FVW_CopyInput( u(1), u_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! interpolate u to find u_interp = u(t) - CALL FVW_Input_ExtrapInterp( u(1:size(utimes)),utimes(:),u_interp, t, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - - ! find dxdt at t - CALL FVW_CalcContStateDeriv( t, u_interp, p, x, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - - m%dxdt_NW = dxdt%r_NW - m%dxdt_FW = dxdt%r_FW - end if + CALL FVW_CopyContState( x, k1, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); CALL CheckError(ErrStat2,ErrMsg2) + CALL FVW_CopyContState( x, k2, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); CALL CheckError(ErrStat2,ErrMsg2) + CALL FVW_CopyContState( x, k3, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); CALL CheckError(ErrStat2,ErrMsg2) + CALL FVW_CopyContState( x, k4, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); CALL CheckError(ErrStat2,ErrMsg2) + CALL FVW_CopyContState( x, x_tmp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + CALL FVW_CopyInput( u(1), u_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); CALL CheckError(ErrStat2,ErrMsg2); IF ( ErrStat >= AbortErrLev ) RETURN + + ! interpolate u to find u_interp = u(t) + CALL FVW_Input_ExtrapInterp( u(1:size(utimes)),utimes(:),u_interp, t, ErrStat2, ErrMsg2 ); CALL CheckError(ErrStat2,ErrMsg2); IF ( ErrStat >= AbortErrLev ) RETURN + + ! find dxdt at t + CALL FVW_CalcContStateDeriv( t, u_interp, p, x, xd, z, OtherState, m, m%dxdt, ErrStat2, ErrMsg2 ); CALL CheckError(ErrStat2,ErrMsg2); IF ( ErrStat >= AbortErrLev ) RETURN if (DEV_VERSION) then ! Additional checks - if (any(m%dxdt_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings)<-999)) then + if (any(m%dxdt%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings)<-999)) then print*,'FVW_RK4: Attempting to convect NW with a wrong velocity' STOP endif if ( m%nFW>0) then - if (any(m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings)<-999)) then + if (any(m%dxdt%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings)<-999)) then call print_x_NW_FW(p, m, x, 'STP') print*,'FVW_RK4: Attempting to convect FW with a wrong velocity' STOP @@ -1024,139 +996,122 @@ SUBROUTINE FVW_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg endif endif - k1%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = dt * m%dxdt_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + k1%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = dt * m%dxdt%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + k1%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW, 1:p%nWings) = dt * m%dxdt%Eps_NW(1:3, 1:p%nSpan, 1:m%nNW, 1:p%nWings) if ( m%nFW>0) then - k1%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = dt * m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + k1%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = dt * m%dxdt%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + k1%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) = dt * m%dxdt%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) endif - x_tmp%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + 0.5 * k1%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + x_tmp%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + 0.5 * k1%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + x_tmp%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW, 1:p%nWings) = x%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW, 1:p%nWings) + 0.5 * k1%Eps_NW(1:3, 1:p%nSpan, 1:m%nNW, 1:p%nWings) if ( m%nFW>0) then - x_tmp%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + 0.5 * k1%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + x_tmp%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + 0.5 * k1%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + x_tmp%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) = x%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) + 0.5 * k1%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) endif ! interpolate u to find u_interp = u(t + dt/2) - CALL FVW_Input_ExtrapInterp(u(1:size(utimes)),utimes(:),u_interp, t+0.5*dt, ErrStat2, ErrMsg2) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN + CALL FVW_Input_ExtrapInterp(u(1:size(utimes)),utimes(:),u_interp, t+0.5*dt, ErrStat2, ErrMsg2); CALL CheckError(ErrStat2,ErrMsg2); IF ( ErrStat >= AbortErrLev ) RETURN ! find dxdt at t + dt/2 - CALL FVW_CalcContStateDeriv( t + 0.5*dt, u_interp, p, x_tmp, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - m%dxdt_NW = dxdt%r_NW - m%dxdt_FW = dxdt%r_FW + CALL FVW_CalcContStateDeriv( t + 0.5*dt, u_interp, p, x_tmp, xd, z, OtherState, m, m%dxdt, ErrStat2, ErrMsg2 ); CALL CheckError(ErrStat2,ErrMsg2); IF ( ErrStat >= AbortErrLev ) RETURN - k2%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = dt * m%dxdt_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + k2%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = dt * m%dxdt%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + k2%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW, 1:p%nWings) = dt * m%dxdt%Eps_NW(1:3, 1:p%nSpan, 1:m%nNW, 1:p%nWings) if ( m%nFW>0) then - k2%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = dt * m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + k2%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = dt * m%dxdt%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + k2%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) = dt * m%dxdt%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) endif - x_tmp%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + 0.5 * k2%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + x_tmp%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + 0.5 * k2%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + x_tmp%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW, 1:p%nWings) = x%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW, 1:p%nWings) + 0.5 * k2%Eps_NW(1:3, 1:p%nSpan, 1:m%nNW, 1:p%nWings) if ( m%nFW>0) then - x_tmp%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + 0.5 * k2%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + x_tmp%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + 0.5 * k2%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + x_tmp%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) = x%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) + 0.5 * k2%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) endif ! find dxdt at t + dt/2 - CALL FVW_CalcContStateDeriv( t + 0.5*dt, u_interp, p, x_tmp, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - m%dxdt_NW = dxdt%r_NW - m%dxdt_FW = dxdt%r_FW + CALL FVW_CalcContStateDeriv( t + 0.5*dt, u_interp, p, x_tmp, xd, z, OtherState, m, m%dxdt, ErrStat2, ErrMsg2 ); CALL CheckError(ErrStat2,ErrMsg2); IF ( ErrStat >= AbortErrLev ) RETURN - k3%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = dt * m%dxdt_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + k3%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = dt * m%dxdt%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + k3%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW, 1:p%nWings) = dt * m%dxdt%Eps_NW(1:3, 1:p%nSpan, 1:m%nNW, 1:p%nWings) if ( m%nFW>0) then - k3%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = dt * m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + k3%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = dt * m%dxdt%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + k3%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) = dt * m%dxdt%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) endif - x_tmp%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + k3%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + x_tmp%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + k3%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + x_tmp%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW, 1:p%nWings) = x%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW, 1:p%nWings) + k3%Eps_NW(1:3, 1:p%nSpan, 1:m%nNW, 1:p%nWings) if ( m%nFW>0) then - x_tmp%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + k3%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + x_tmp%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + k3%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + x_tmp%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) = x%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) + k3%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) endif ! interpolate u to find u_interp = u(t + dt) - CALL FVW_Input_ExtrapInterp(u(1:size(utimes)),utimes(:),u_interp, t + dt, ErrStat2, ErrMsg2) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - + CALL FVW_Input_ExtrapInterp(u(1:size(utimes)),utimes(:),u_interp, t + dt, ErrStat2, ErrMsg2); CALL CheckError(ErrStat2,ErrMsg2); IF ( ErrStat >= AbortErrLev ) RETURN ! find dxdt at t + dt - CALL FVW_CalcContStateDeriv( t + dt, u_interp, p, x_tmp, xd, z, OtherState, m, dxdt, ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - IF ( ErrStat >= AbortErrLev ) RETURN - m%dxdt_NW = dxdt%r_NW - m%dxdt_FW = dxdt%r_FW + CALL FVW_CalcContStateDeriv( t + dt, u_interp, p, x_tmp, xd, z, OtherState, m, m%dxdt, ErrStat2, ErrMsg2 ); CALL CheckError(ErrStat2,ErrMsg2); IF ( ErrStat >= AbortErrLev ) RETURN - k4%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = dt * m%dxdt_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + k4%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = dt * m%dxdt%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + k4%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW, 1:p%nWings) = dt * m%dxdt%Eps_NW(1:3, 1:p%nSpan, 1:m%nNW, 1:p%nWings) if ( m%nFW>0) then - k4%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = dt * m%dxdt_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + k4%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = dt * m%dxdt%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + k4%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) = dt * m%dxdt%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) + endif + + ! Compute and store combined dx = (k1/6 + k2/3 + k3/3 + k4/6) ! NOTE: this has dt, it's not a true dxdt yet + m%dxdt%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = ( k1%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + 2._ReKi * k2%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + 2._ReKi * k3%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + k4%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) ) / 6._ReKi + m%dxdt%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW , 1:p%nWings) = ( k1%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW , 1:p%nWings) + 2._ReKi * k2%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW , 1:p%nWings) + 2._ReKi * k3%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW , 1:p%nWings) + k4%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW , 1:p%nWings) ) / 6._ReKi + if ( m%nFW>0) then + m%dxdt%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = ( k1%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + 2._ReKi * k2%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + 2._ReKi * k3%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + k4%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) ) / 6._ReKi + m%dxdt%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) = ( k1%Eps_FW(1:3, 1:FWnSpan , 1:m%nFW , 1:p%nWings) + 2._ReKi * k2%Eps_FW(1:3, 1:FWnSpan , 1:m%nFW , 1:p%nWings) + 2._ReKi * k3%Eps_FW(1:3, 1:FWnSpan , 1:m%nFW , 1:p%nWings) + k4%Eps_FW(1:3, 1:FWnSpan , 1:m%nFW , 1:p%nWings) ) / 6._ReKi endif !update positions - x%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + ( k1%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + 2. * k2%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + 2. * k3%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + k4%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) ) / 6. + x%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + m%dxdt%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + x%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW , 1:p%nWings) = x%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW , 1:p%nWings) + m%dxdt%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW , 1:p%nWings) + if ( m%nFW>0) then + x%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + m%dxdt%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + x%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) = x%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) + m%dxdt%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) + endif + + ! Store true dxdt = (k1/6 + k2/3 + k3/3 + k4/6)/dt + m%dxdt%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = m%dxdt%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings)/dt + m%dxdt%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW , 1:p%nWings) = m%dxdt%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW , 1:p%nWings)/dt if ( m%nFW>0) then - x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + ( k1%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + 2. * k2%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + 2. * k3%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + k4%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) ) / 6. + m%dxdt%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = m%dxdt%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings)/dt + m%dxdt%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) = m%dxdt%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings)/dt endif - ! clean up local variables: + ! clean up local variables: CALL ExitThisRoutine( ) CONTAINS - !............................................................................................................................... + !> This subroutine destroys all the local variables SUBROUTINE ExitThisRoutine() - ! This subroutine destroys all the local variables - !............................................................................................................................... - - ! local variables INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) - - - CALL FVW_DestroyContState( dxdt, ErrStat3, ErrMsg3 ) CALL FVW_DestroyContState( k1, ErrStat3, ErrMsg3 ) CALL FVW_DestroyContState( k2, ErrStat3, ErrMsg3 ) CALL FVW_DestroyContState( k3, ErrStat3, ErrMsg3 ) CALL FVW_DestroyContState( k4, ErrStat3, ErrMsg3 ) CALL FVW_DestroyContState( x_tmp, ErrStat3, ErrMsg3 ) - CALL FVW_DestroyInput( u_interp, ErrStat3, ErrMsg3 ) - END SUBROUTINE ExitThisRoutine - !............................................................................................................................... + !> This subroutine sets the error message and level and cleans up if the error is >= AbortErrLev SUBROUTINE CheckError(ErrID,Msg) - ! This subroutine sets the error message and level and cleans up if the error - ! is >= AbortErrLev - !............................................................................................................................... - - ! Passed arguments INTEGER(IntKi), INTENT(IN) :: ErrID ! The error identifier (ErrStat) CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) - - ! local variables INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) - - !............................................................................................................................ - ! Set error status/message; - !............................................................................................................................ - IF ( ErrID /= ErrID_None ) THEN - IF (ErrStat /= ErrID_None) ErrMsg = TRIM(ErrMsg)//NewLine ErrMsg = TRIM(ErrMsg)//'FVW_RK4:'//TRIM(Msg) ErrStat = MAX(ErrStat,ErrID) - - !......................................................................................................................... - ! Clean up if we're going to return on error: close files, deallocate - ! local arrays - !......................................................................................................................... - IF ( ErrStat >= AbortErrLev ) CALL ExitThisRoutine( ) - - END IF - END SUBROUTINE CheckError - END SUBROUTINE FVW_RK4 From c04dfaed0a214998cf7ce9310260d74498c575e5 Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Thu, 21 Jan 2021 09:59:04 -0700 Subject: [PATCH 08/27] FVW: small cleanup --- modules/aerodyn/src/FVW.f90 | 29 +++++++++++------------------ 1 file changed, 11 insertions(+), 18 deletions(-) diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index 8730561f78..db179e917c 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -550,7 +550,6 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m ErrStat = ErrID_None ErrMsg = "" - ! --- Handling of time step, and time compared to previous call m%iStep = n ! Reevaluation: two repetitive calls starting from the same time, we will roll back the wake emission @@ -574,13 +573,9 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m call date_and_time(values=time1) endif - nP = p%nWings * ( (p%nSpan+1)*(m%nNW-1+2) +(FWnSpan+1)*(m%nFW+1) ) nFWEff = min(m%nFW, p%nFWFree) ! --- Display some status to screen -!FIXME: this conflicts with the SimStatus WrOver from the FAST_Subs.f90. Leaving out for now. -! Ideally we put this into a log file. -! if (mod(n,10)==0) print'(A,F10.3,A,I0,A,I0,A,I0,A,I0,A,I0,A,I0,A,I0,A,I0,A,F7.2,A)','FVW status - t:',t,' n:',n,' nNW:',m%nNW-1,'/',p%nNWMax-1,' nFW:',nFWEff, '+',m%nFW-nFWEff,'=',m%nFW,'/',p%nFWMax,' nP:',nP,' spent:', m%tSpent, 's' if (DEV_VERSION) print'(A,F10.3,A,I0,A,I0,A,I0,A,I0,A,I0,A,I0,A,I0,A,I0,A,F7.2,A,L1)','FVW status - t:',t,' n:',n,' nNW:',m%nNW-1,'/',p%nNWMax-1,' nFW:',nFWEff, '+',m%nFW-nFWEff,'=',m%nFW,'/',p%nFWMax,' nP:',nP,' spent:', m%tSpent, 's Comp:',m%ComputeWakeInduced ! --- Evaluation at t @@ -593,6 +588,7 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m CALL DistributeRequestedWind(u(1)%V_wind, p, m) ! --- Solve for quasi steady circulation at t + ! TODO: this shouldn't be necessary ! Returns: z%Gamma_LL (at t) call AllocAry( z_guess%Gamma_LL, p%nSpan, p%nWings, 'Lifting line Circulation', ErrStat, ErrMsg ); z_guess%Gamma_LL = m%Gamma_LL @@ -606,6 +602,7 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m end if ! Map circulation and positions between LL and NW and then NW and FW + ! TODO this shouldn't be necessary ! Changes: x only ShedScale = 1.0_ReKi call Map_LL_NW(p, m, z, x, ShedScale, ErrStat2, ErrMsg2); if(Failed()) return @@ -618,7 +615,7 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m if (p%IntMethod .eq. idEuler1) then call FVW_Euler1( t, uInterp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2); if(Failed()) return elseif (p%IntMethod .eq. idRK4) then - call FVW_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ); if(Failed()) return + call FVW_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2); if(Failed()) return !elseif (p%IntMethod .eq. idAB4) then ! call FVW_AB4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) !elseif (p%IntMethod .eq. idABM4) then @@ -655,8 +652,6 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m ! Returns: z%Gamma_LL (at t+p%DTaero) z_guess%Gamma_LL = z%Gamma_LL ! We use as guess the circulation from the previous time step (see above) call FVW_CalcConstrStateResidual(t+p%DTaero, uInterp, p, x, xd, z_guess, OtherState, m, z, AFInfo, ErrStat2, ErrMsg2, 2); if(Failed()) return -! print*,'US: z_Gamma',x%Gamma_NW(1,1,1) -! print*,'US: x_Gamma',z%Gamma_LL(1,1) ! Compute UA inputs at t+DTaero and integrate UA states between t and t+dtAero if (m%UA_Flag) then call CalculateInputsAndOtherStatesForUA(2, uInterp, p, x, xd, z, OtherState, AFInfo, m, ErrStat2, ErrMsg2); if(Failed()) return @@ -870,21 +865,19 @@ subroutine FVW_Euler1( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) ! Compute "right hand side" if (m%ComputeWakeInduced) then CALL FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, m%dxdt, ErrStat2, ErrMsg2); if (Failed()) return + else + ! Potentially used something better than the "constant" dxdt being used endif - ! Update of positions - x%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + dt * m%dxdt%r_NW(1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + ! Update of positions and reg param + x%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + dt * m%dxdt%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + x%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW , 1:p%nWings) = x%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW , 1:p%nWings) + dt * m%dxdt%Eps_NW(1:3, 1:p%nSpan , 1:m%nNW , 1:p%nWings) if ( m%nFW>0) then - x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + dt * m%dxdt%r_FW(1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + x%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) = x%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + dt * m%dxdt%r_FW (1:3, 1:FWnSpan+1, 1:m%nFW+1, 1:p%nWings) + x%Eps_FW(1:3, 1:FWnSpan , 1:m%nFW , 1:p%nWings) = x%Eps_FW(1:3, 1:FWnSpan , 1:m%nFW , 1:p%nWings) + dt * m%dxdt%Eps_FW(1:3, 1:FWnSpan , 1:m%nFW , 1:p%nWings) endif - ! Update of Gamma - ! TODO, viscous diffusion, stretching + ! Update of Gamma TODO (viscous diffusion, stretching) - ! Update of Reg param - x%Eps_NW(1:3, 1:p%nSpan, 1:m%nNW, 1:p%nWings) = x%Eps_NW(1:3, 1:p%nSpan, 1:m%nNW, 1:p%nWings) + dt * m%dxdt%Eps_NW(1:3, 1:p%nSpan, 1:m%nNW, 1:p%nWings) - if ( m%nFW>0) then - x%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) = x%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) + dt * m%dxdt%Eps_FW(1:3, 1:FWnSpan, 1:m%nFW, 1:p%nWings) - endif if (DEV_VERSION) then ! Additional checks From e09ddc6833edcdf68f944dc086ec65d0ffefdc20 Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Thu, 21 Jan 2021 19:14:51 -0700 Subject: [PATCH 09/27] OLAF: implemented linear interpolation for subcycling --- modules/aerodyn/src/FVW.f90 | 111 ++++++++++----- modules/aerodyn/src/FVW_IO.f90 | 4 - modules/aerodyn/src/FVW_Registry.txt | 7 +- modules/aerodyn/src/FVW_Subs.f90 | 2 +- modules/aerodyn/src/FVW_Types.f90 | 196 ++++++++++++++++++++++++++- 5 files changed, 279 insertions(+), 41 deletions(-) diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index db179e917c..e81f85a0cb 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -546,12 +546,15 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m integer, dimension(8) :: time1, time2, time_diff real(ReKi) :: ShedScale !< Scaling factor for shed vorticity (for sub-cycling), 1 if no subcycling logical :: bReevaluation + logical :: bOverCycling ErrStat = ErrID_None ErrMsg = "" ! --- Handling of time step, and time compared to previous call m%iStep = n + ! OverCycling DTfvw> DTaero + bOverCycling = p%DTfvw > p%DTaero ! Reevaluation: two repetitive calls starting from the same time, we will roll back the wake emission bReevaluation=.False. if (abs(t-m%OldWakeTime)<0.25_ReKi* p%DTaero) then @@ -609,30 +612,41 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m call Map_NW_FW(p, m, z, x, ErrStat2, ErrMsg2); if(Failed()) return !call print_x_NW_FW(p, m, x,'Map_') - ! --- Integration between t and t+DTaero - ! NOTE: when sub-cycling, the previous convection velocity is used - ! If dtfvw = n dtaero, we assume xdot_local dtaero = xdot_stored * dtfvw/n - if (p%IntMethod .eq. idEuler1) then - call FVW_Euler1( t, uInterp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2); if(Failed()) return - elseif (p%IntMethod .eq. idRK4) then - call FVW_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2); if(Failed()) return - !elseif (p%IntMethod .eq. idAB4) then - ! call FVW_AB4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) - !elseif (p%IntMethod .eq. idABM4) then - ! call FVW_ABM4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) - else - call SetErrStat(ErrID_Fatal,'Invalid time integration method:'//Num2LStr(p%IntMethod),ErrStat,ErrMsg,'FVW_UpdateState') - end IF - !call print_x_NW_FW(p, m, x,'Conv') - + ! --- Integration between t and t+DTfvw if (m%ComputeWakeInduced) then + if (bOverCycling) then + call FVW_CopyContState(x, m%x1, 0, ErrStat2, ErrMsg2) ! Backup current state at t + m%t1=t + endif + if (p%IntMethod .eq. idEuler1) then + call FVW_Euler1( t, uInterp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2); if(Failed()) return + elseif (p%IntMethod .eq. idRK4) then + call FVW_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2); if(Failed()) return + !elseif (p%IntMethod .eq. idAB4) then + ! call FVW_AB4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + !elseif (p%IntMethod .eq. idABM4) then + ! call FVW_ABM4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) + else + call SetErrStat(ErrID_Fatal,'Invalid time integration method:'//Num2LStr(p%IntMethod),ErrStat,ErrMsg,'FVW_UpdateState') + end if + ! We extend the wake length, i.e. we emit a new panel of vorticity at the TE ! NOTE: this will be rolled back if UpdateState is called at the same starting time again call PrepareNextTimeStep() - ! --- t+DTaero + ! --- t+DTfvw ! Propagation/creation of new layer of panels call PropagateWake(p, m, z, x, ErrStat2, ErrMsg2); if(Failed()) return - !call print_x_NW_FW(p, m, x,'Prop_') + + if (bOverCycling) then + call PropagateWake(p, m, z, m%x1, ErrStat2, ErrMsg2); if(Failed()) return + call FVW_CopyContState(x, m%x2, 0, ErrStat2, ErrMsg2) ! Backup current state at t+DTfvw + m%t2=t+p%DTfvw + endif + endif + ! --- Integration between t and t+DTaero if DTaero/=DTfvw + if (bOverCycling) then + ! Linear interpolation of states between t and dtaero + call FVW_ContStates_Interp(t+p%DTaero, (/m%x1, m%x2/), (/m%t1, m%t2/), p, m, x, ErrStat2, ErrMsg2); if(Failed()) return endif ! Inputs at t+DTaero @@ -808,7 +822,7 @@ subroutine FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSt ! First NW point does not convect (bound to LL) dxdt%r_NW(1:3, :, 1:iNWStart-1, :)=0.0_ReKi ! First FW point always convects (even if bound to NW) - ! This is done for subcycling + ! This is done for overcycling !dxdt%r_FW(1:3, :, 1, :)=0 ! --- Regularization @@ -841,6 +855,42 @@ logical function Failed() end function Failed end subroutine FVW_CalcContStateDeriv + +!> Interpolate states to the current time +!! For now: linear interpolation, two states, with t1=times(2)) then + ErrStat = ErrID_Fatal + ErrMsg = "FVW_ContStates_Interp: t1 must be < t2" + endif + + fact = (t-times(1))/(times(2)-times(1)) + !print*,'Fact',fact, 't',t + + x%r_NW = (1_ReKi-fact) * states(1)%r_NW + fact * states(2)%r_NW + x%r_FW = (1_ReKi-fact) * states(1)%r_FW + fact * states(2)%r_FW + x%Eps_NW = (1_ReKi-fact) * states(1)%Eps_NW + fact * states(2)%Eps_NW + x%Eps_FW = (1_ReKi-fact) * states(1)%Eps_FW + fact * states(2)%Eps_FW + x%Gamma_NW = (1_ReKi-fact) * states(1)%Gamma_NW + fact * states(2)%Gamma_NW + x%Gamma_FW = (1_ReKi-fact) * states(1)%Gamma_FW + fact * states(2)%Gamma_FW + +end subroutine FVW_ContStates_Interp + !---------------------------------------------------------------------------------------------------------------------------------- subroutine FVW_Euler1( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) real(DbKi), intent(in ) :: t !< Current simulation time in seconds @@ -861,13 +911,9 @@ subroutine FVW_Euler1( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" - dt = real(p%DTaero,ReKi) ! NOTE: this is DTaero not DTfvw since we integrate at each sub time step + dt = real(p%DTfvw,ReKi) ! NOTE: this is DTfvw ! Compute "right hand side" - if (m%ComputeWakeInduced) then - CALL FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, m%dxdt, ErrStat2, ErrMsg2); if (Failed()) return - else - ! Potentially used something better than the "constant" dxdt being used - endif + CALL FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, m%dxdt, ErrStat2, ErrMsg2); if (Failed()) return ! Update of positions and reg param x%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) = x%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) + dt * m%dxdt%r_NW (1:3, 1:p%nSpan+1, 1:m%nNW+1, 1:p%nWings) @@ -957,7 +1003,7 @@ SUBROUTINE FVW_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ErrStat = ErrID_None ErrMsg = "" - dt = real(p%DTaero,ReKi) ! NOTE: this is DTaero not DTfvw since we integrate at each sub time step + dt = real(p%DTfvw,ReKi) ! NOTE: this is DTfvw CALL FVW_CopyContState( x, k1, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); CALL CheckError(ErrStat2,ErrMsg2) CALL FVW_CopyContState( x, k2, MESH_NEWCOPY, ErrStat2, ErrMsg2 ); CALL CheckError(ErrStat2,ErrMsg2) @@ -1140,12 +1186,6 @@ end subroutine FVW_CalcConstrStateResidual !---------------------------------------------------------------------------------------------------------------------------------- !> 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. -! NOTE: no matter how many channels are selected for output, all of the outputs are calculated -! 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. subroutine FVW_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, ErrMsg ) use FVW_VTK, only: set_vtk_coordinate_transform use FVW_VortexTools, only: interpextrap_cp2node @@ -1169,6 +1209,7 @@ subroutine FVW_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, logical :: bGridOutNeeded character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CalcOutput' + logical :: bOverCycling ErrStat = ErrID_None ErrMsg = "" @@ -1177,6 +1218,9 @@ subroutine FVW_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, print'(A,F10.3,A,L1,A,I0,A,I0)','CalcOutput t:',t,' ',m%FirstCall,' nNW:',m%nNW,' nFW:',m%nFW endif + ! OverCycling DTfvw> DTaero + bOverCycling = p%DTfvw > p%DTaero + ! Set the wind velocity at vortex CALL DistributeRequestedWind(u%V_wind, p, m) @@ -1184,13 +1228,12 @@ subroutine FVW_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, ! Compute m%Gamma_LL CALL Wings_ComputeCirculation(t, m%Gamma_LL, z%Gamma_LL, u, p, x, m, AFInfo, ErrStat2, ErrMsg2, 0); if(Failed()) return ! For plotting only - ! Induction on the lifting line control point ! Set m%Vind_LL m%Vind_LL=-9999.0_ReKi call LiftingLineInducedVelocities(p, x, 1, m, ErrStat2, ErrMsg2); if(Failed()) return - ! Induction on the mesh points (AeroDyn nodes) + ! Induction on the mesh points (AeroDyn nodes) n=p%nSpan y%Vind(1:3,:,:) = 0.0_ReKi do iW=1,p%nWings diff --git a/modules/aerodyn/src/FVW_IO.f90 b/modules/aerodyn/src/FVW_IO.f90 index 078d4c4fd0..ee2f0ded62 100644 --- a/modules/aerodyn/src/FVW_IO.f90 +++ b/modules/aerodyn/src/FVW_IO.f90 @@ -114,10 +114,6 @@ SUBROUTINE FVW_ReadInputFile( FileName, p, m, Inp, ErrStat, ErrMsg ) if (Check(.not.(ANY(idVelocityVALID ==Inp%VelocityMethod )), 'Velocity method (VelocityMethod) not valid: '//trim(Num2LStr(Inp%VelocityMethod)))) return if (Check( Inp%DTfvw < p%DTaero, 'DTfvw must be >= DTaero from AD15.')) return - if (abs(Inp%DTfvw-p%DTaero)>epsilon(1.0_ReKi)) then - ! subcycling - if (Check(Inp%IntMethod/=idEuler1 , 'Sub-cycling (DTfvw>DTaro) is only possible with Forward Euler `IntMethod`')) return - endif if (Inp%CirculationMethod == idCircPolarData) then if (Check( Inp%nNWPanels<1 , 'Number of near wake panels (`nNWPanels`) must be >=1 when using circulation solving with polar data (`CircSolvingMethod=1`)')) return endif diff --git a/modules/aerodyn/src/FVW_Registry.txt b/modules/aerodyn/src/FVW_Registry.txt index e08c21382f..6b7ebb6209 100644 --- a/modules/aerodyn/src/FVW_Registry.txt +++ b/modules/aerodyn/src/FVW_Registry.txt @@ -127,7 +127,12 @@ typedef ^ ^ ReKi typedef ^ ^ Logical ComputeWakeInduced - - - "Compute induced velocities on this timestep" - typedef ^ ^ DbKi OldWakeTime - - - "Time the wake induction velocities were last calculated" s typedef ^ ^ ReKi tSpent - - - "Time spent in expensive Biot-Savart computation" s -typedef ^ ^ FVW_ContinuousStateType dxdt - - - "State time derivatie, stored for subcycling and convenience" - +typedef ^ ^ FVW_ContinuousStateType dxdt - - - "State time derivatie, stored for overcycling and convenience" - +typedef ^ ^ FVW_ContinuousStateType x1 - - - "States at t (for overcycling) " - +typedef ^ ^ FVW_ContinuousStateType x2 - - - "States at t+DTFVW (for overcycling)" - +typedef ^ ^ DbKi t1 - - - "Time of x1 (for overcycling) " - +typedef ^ ^ DbKi t2 - - - "Time of x2 t+DTFVW (for overcycling)" - + # Convenient storage typedef ^ ^ Reki alpha_LL :: - - "Angle of attack at lifting line CP, only computed with CircPolarData method" - typedef ^ ^ Reki Vreln_LL :: - - "Norm of Vrel on the lifting line" - diff --git a/modules/aerodyn/src/FVW_Subs.f90 b/modules/aerodyn/src/FVW_Subs.f90 index 90a1cb0b6c..30da127cf5 100644 --- a/modules/aerodyn/src/FVW_Subs.f90 +++ b/modules/aerodyn/src/FVW_Subs.f90 @@ -49,7 +49,7 @@ module FVW_SUBS ! Implementation integer(IntKi), parameter :: iNWStart=2 !< Index in r%NW where the near wake start (if >1 then the Wing panels are included in r_NW) integer(IntKi), parameter :: FWnSpan=1 !< Number of spanwise far wake panels ! TODO make it an input later - logical , parameter :: DEV_VERSION=.True. + logical , parameter :: DEV_VERSION=.False. contains !========================================================================== diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index e603be393f..212bd6a812 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -154,7 +154,11 @@ MODULE FVW_Types LOGICAL :: ComputeWakeInduced !< Compute induced velocities on this timestep [-] REAL(DbKi) :: OldWakeTime !< Time the wake induction velocities were last calculated [s] REAL(ReKi) :: tSpent !< Time spent in expensive Biot-Savart computation [s] - TYPE(FVW_ContinuousStateType) :: dxdt !< State time derivatie, stored for subcycling and convenience [-] + TYPE(FVW_ContinuousStateType) :: dxdt !< State time derivatie, stored for overcycling and convenience [-] + TYPE(FVW_ContinuousStateType) :: x1 !< States at t (for overcycling) [-] + TYPE(FVW_ContinuousStateType) :: x2 !< States at t+DTFVW (for overcycling) [-] + REAL(DbKi) :: t1 !< Time of x1 (for overcycling) [-] + REAL(DbKi) :: t2 !< Time of x2 t+DTFVW (for overcycling) [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: alpha_LL !< Angle of attack at lifting line CP, only computed with CircPolarData method [-] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Vreln_LL !< Norm of Vrel on the lifting line [-] TYPE(T_Sgmt) :: Sgmt !< Segments storage [-] @@ -2639,6 +2643,14 @@ SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) CALL FVW_CopyContState( SrcMiscData%dxdt, DstMiscData%dxdt, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN + CALL FVW_CopyContState( SrcMiscData%x1, DstMiscData%x1, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FVW_CopyContState( SrcMiscData%x2, DstMiscData%x2, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstMiscData%t1 = SrcMiscData%t1 + DstMiscData%t2 = SrcMiscData%t2 IF (ALLOCATED(SrcMiscData%alpha_LL)) THEN i1_l = LBOUND(SrcMiscData%alpha_LL,1) i1_u = UBOUND(SrcMiscData%alpha_LL,1) @@ -3047,6 +3059,8 @@ SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg ) DEALLOCATE(MiscData%PitchAndTwist) ENDIF CALL FVW_DestroyContState( MiscData%dxdt, ErrStat, ErrMsg ) + CALL FVW_DestroyContState( MiscData%x1, ErrStat, ErrMsg ) + CALL FVW_DestroyContState( MiscData%x2, ErrStat, ErrMsg ) IF (ALLOCATED(MiscData%alpha_LL)) THEN DEALLOCATE(MiscData%alpha_LL) ENDIF @@ -3313,6 +3327,42 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 3 ! x1: size of buffers for each call to pack subtype + CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x1, ErrStat2, ErrMsg2, .TRUE. ) ! x1 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x1 + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x1 + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x1 + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! x2: size of buffers for each call to pack subtype + CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x2, ErrStat2, ErrMsg2, .TRUE. ) ! x2 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x2 + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x2 + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x2 + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Db_BufSz = Db_BufSz + 1 ! t1 + Db_BufSz = Db_BufSz + 1 ! t2 Int_BufSz = Int_BufSz + 1 ! alpha_LL allocated yes/no IF ( ALLOCATED(InData%alpha_LL) ) THEN Int_BufSz = Int_BufSz + 2*2 ! alpha_LL upper/lower bounds for each dimension @@ -4205,6 +4255,66 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x1, ErrStat2, ErrMsg2, OnlySize ) ! x1 + 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 + CALL FVW_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x2, ErrStat2, ErrMsg2, OnlySize ) ! x2 + 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 + DbKiBuf(Db_Xferred) = InData%t1 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%t2 + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%alpha_LL) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5566,6 +5676,90 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + 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 FVW_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x1, ErrStat2, ErrMsg2 ) ! x1 + 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) + 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 FVW_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x2, ErrStat2, ErrMsg2 ) ! x2 + 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%t1 = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%t2 = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_LL not allocated Int_Xferred = Int_Xferred + 1 ELSE From 4d5c682b5d81b75c44c282d7138e93dd4e59d298 Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Fri, 22 Jan 2021 18:35:52 -0700 Subject: [PATCH 10/27] OLAF: wind inputs handled directly, some m put in p --- modules/aerodyn/src/FVW.f90 | 89 +++-- modules/aerodyn/src/FVW_Registry.txt | 9 +- modules/aerodyn/src/FVW_Subs.f90 | 60 +-- modules/aerodyn/src/FVW_Types.f90 | 528 +++++++++++++-------------- modules/aerodyn/src/FVW_Wings.f90 | 28 +- 5 files changed, 366 insertions(+), 348 deletions(-) diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index e81f85a0cb..2226983f1d 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -147,8 +147,6 @@ subroutine FVW_Init(AFInfo, InitInp, u, p, x, xd, z, OtherState, y, m, Interval, CALL SetRequestedWindPoints(m%r_wind, x, p, m ) ! Return anything in FVW_InitOutput that should be passed back to the calling code here - - ! --- UA ! NOTE: quick and dirty since this should belong to AD interval = InitInp%DTAero ! important, gluecode and UA, needs proper interval @@ -193,15 +191,11 @@ subroutine FVW_InitMiscVars( p, m, ErrStat, ErrMsg ) call AllocAry( m%LE , 3 , p%nSpan+1 , p%nWings, 'Leading Edge Points', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%LE = -999999_ReKi; call AllocAry( m%TE , 3 , p%nSpan+1 , p%nWings, 'TrailingEdge Points', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%TE = -999999_ReKi; - call AllocAry( m%s_LL , p%nSpan+1 , p%nWings, 'Spanwise coord LL ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%s_LL= -999999_ReKi; - call AllocAry( m%chord_LL , p%nSpan+1 , p%nWings, 'Chord on LL ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%chord_LL= -999999_ReKi; call AllocAry( m%PitchAndTwist , p%nSpan+1 , p%nWings, 'Pitch and twist ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%PitchAndTwist= -999999_ReKi; call AllocAry( m%alpha_LL, p%nSpan , p%nWings, 'Wind on CP ll ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%alpha_LL= -999999_ReKi; call AllocAry( m%Vreln_LL, p%nSpan , p%nWings, 'Wind on CP ll ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Vreln_LL = -999999_ReKi; ! Variables at control points/elements call AllocAry( m%Gamma_LL, p%nSpan , p%nWings, 'Lifting line Circulation', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Gamma_LL = -999999_ReKi; - call AllocAry( m%chord_CP_LL , p%nSpan , p%nWings, 'Chord on CP LL ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%chord_CP_LL= -999999_ReKi; - call AllocAry( m%s_CP_LL , p%nSpan , p%nWings, 'Spanwise coord CPll', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%s_CP_LL= -999999_ReKi; call AllocAry( m%CP_LL , 3 , p%nSpan , p%nWings, 'Control points LL ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%CP_LL= -999999_ReKi; call AllocAry( m%Tang , 3 , p%nSpan , p%nWings, 'Tangential vector ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Tang= -999999_ReKi; call AllocAry( m%Norm , 3 , p%nSpan , p%nWings, 'Normal vector ', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%Norm= -999999_ReKi; @@ -387,8 +381,8 @@ SUBROUTINE FVW_SetParametersFromInputs( InitInp, p, ErrStat, ErrMsg ) character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local variables character(1024) :: rootDir, baseName ! Simulation root dir and basename - !integer(IntKi) :: ErrStat2 - !character(ErrMsgLen) :: ErrMsg2 + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_SetParametersFromInputs' ErrStat = ErrID_None ErrMsg = "" @@ -407,6 +401,10 @@ SUBROUTINE FVW_SetParametersFromInputs( InitInp, p, ErrStat, ErrMsg ) ! Set the Chord values call move_alloc(InitInp%Chord, p%Chord) + call AllocAry(p%s_LL , p%nSpan+1 , p%nWings, 'Spanwise coord LL ', ErrStat2, ErrMsg2);call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); p%s_LL= -999999_ReKi; + call AllocAry(p%s_CP_LL , p%nSpan , p%nWings, 'Spanwise coord CPll', ErrStat2, ErrMsg2);call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); p%s_CP_LL= -999999_ReKi; + call AllocAry(p%chord_LL , p%nSpan+1 , p%nWings, 'Chord on LL ', ErrStat2, ErrMsg2);call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); p%chord_LL= -999999_ReKi; + call AllocAry(p%chord_CP_LL , p%nSpan , p%nWings, 'Chord on CP LL ', ErrStat2, ErrMsg2);call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); p%chord_CP_LL= -999999_ReKi; end subroutine FVW_SetParametersFromInputs ! ============================================================================== @@ -452,12 +450,12 @@ SUBROUTINE FVW_SetParametersFromInputFile( InputFileData, p, m, ErrStat, ErrMsg if (allocated(p%PrescribedCirculation)) deallocate(p%PrescribedCirculation) if (InputFileData%CirculationMethod==idCircPrescribed) then call AllocAry( p%PrescribedCirculation, p%nSpan, 'Prescribed Circulation', ErrStat2, ErrMsg2 ); call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,'FVW_SetParameters' ); p%PrescribedCirculation = -999999_ReKi; - if (.not. allocated(m%s_CP_LL)) then + if (.not. allocated(p%s_CP_LL)) then ErrMsg = 'Spanwise coordinate not allocated.' ErrStat = ErrID_Fatal return endif - call ReadAndInterpGamma(trim(InputFileData%CirculationFile), m%s_CP_LL(1:p%nSpan,1), m%s_LL(p%nSpan+1,1), p%PrescribedCirculation, ErrStat2, ErrMsg2) + call ReadAndInterpGamma(trim(InputFileData%CirculationFile), p%s_CP_LL(1:p%nSpan,1), p%s_LL(p%nSpan+1,1), p%PrescribedCirculation, ErrStat2, ErrMsg2) call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,'FVW_SetParameters' ); endif @@ -587,16 +585,6 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m call FVW_Input_ExtrapInterp(u(1:size(utimes)),utimes(:),uInterp,t, ErrStat2, ErrMsg2); if(Failed()) return call Wings_Panelling(uInterp%WingsMesh, p, m, ErrStat2, ErrMsg2); if(Failed()) return - ! Distribute the Wind we requested to Inflow wind to storage Misc arrays - CALL DistributeRequestedWind(u(1)%V_wind, p, m) - - ! --- Solve for quasi steady circulation at t - ! TODO: this shouldn't be necessary - ! Returns: z%Gamma_LL (at t) - call AllocAry( z_guess%Gamma_LL, p%nSpan, p%nWings, 'Lifting line Circulation', ErrStat, ErrMsg ); - z_guess%Gamma_LL = m%Gamma_LL - call FVW_CalcConstrStateResidual(t, uInterp, p, x, xd, z_guess, OtherState, m, z, AFInfo, ErrStat2, ErrMsg2, 1); if(Failed()) return - ! TODO convert quasi steady Gamma to unsteady gamma with UA states ! Compute UA inputs at t @@ -604,20 +592,13 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m call CalculateInputsAndOtherStatesForUA(1, uInterp, p, x, xd, z, OtherState, AFInfo, m, ErrStat2, ErrMsg2); if(Failed()) return end if - ! Map circulation and positions between LL and NW and then NW and FW - ! TODO this shouldn't be necessary - ! Changes: x only - ShedScale = 1.0_ReKi - call Map_LL_NW(p, m, z, x, ShedScale, ErrStat2, ErrMsg2); if(Failed()) return - call Map_NW_FW(p, m, z, x, ErrStat2, ErrMsg2); if(Failed()) return - !call print_x_NW_FW(p, m, x,'Map_') - ! --- Integration between t and t+DTfvw if (m%ComputeWakeInduced) then if (bOverCycling) then call FVW_CopyContState(x, m%x1, 0, ErrStat2, ErrMsg2) ! Backup current state at t m%t1=t endif + print*,'t',t,'t+dt',t+p%DTfvw,'ut',utimes if (p%IntMethod .eq. idEuler1) then call FVW_Euler1( t, uInterp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2); if(Failed()) return elseif (p%IntMethod .eq. idRK4) then @@ -638,6 +619,10 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m call PropagateWake(p, m, z, x, ErrStat2, ErrMsg2); if(Failed()) return if (bOverCycling) then + ! NOTE:l + ! - we need to propagate the states at t to match the memory of state t+DTfvw + ! - the positions and intensities for the LL and 1st NW panels are NaN for x1 and x2, + ! but that's fine since these are always overwritten by the mapping call PropagateWake(p, m, z, m%x1, ErrStat2, ErrMsg2); if(Failed()) return call FVW_CopyContState(x, m%x2, 0, ErrStat2, ErrMsg2) ! Backup current state at t+DTfvw m%t2=t+p%DTfvw @@ -724,7 +709,7 @@ end subroutine FVW_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- -!> This is a tight coupling routine for computing derivatives of continuous states. +!> This is a tight coupling routine for computing derivatives of continuous states. (CCSD) subroutine FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrStat, ErrMsg ) !.................................................................................................................................. real(DbKi), intent(in ) :: t !< Current simulation time in seconds @@ -755,6 +740,10 @@ subroutine FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSt if(Failed()) return endif + ! Distribute the Wind we requested to Inflow wind to storage Misc arrays + ! TODO ANDY: replace with direct call to inflow wind at r_NW and r_FW locations + CALL DistributeRequestedWind_NWFW(u%V_wind, p, m%Vwnd_NW, m%Vwnd_FW) + ! Only calculate freewake after start time and if on a timestep when it should be calculated. if ((t>= p%FreeWakeStart)) then nFWEff = min(m%nFW, p%nFWFree) @@ -880,7 +869,6 @@ subroutine FVW_ContStates_Interp(t, states, times, p, m, x, ErrStat, ErrMsg ) endif fact = (t-times(1))/(times(2)-times(1)) - !print*,'Fact',fact, 't',t x%r_NW = (1_ReKi-fact) * states(1)%r_NW + fact * states(2)%r_NW x%r_FW = (1_ReKi-fact) * states(1)%r_FW + fact * states(2)%r_FW @@ -1174,6 +1162,11 @@ subroutine FVW_CalcConstrStateResidual( t, u, p, x, xd, z_guess, OtherState, m, ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" + + ! Distribute the Wind we requested to Inflow wind to storage Misc arrays + ! TODO ANDY: replace with direct call to inflow wind at m%CP_LL location + CALL DistributeRequestedWind_LL(u%V_wind, p, m%Vwnd_LL) + ! Solve for the residual of the constraint state functions here: !z%residual = 0.0_ReKi !z%Gamma_LL = 0.0_ReKi @@ -1221,8 +1214,12 @@ subroutine FVW_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, ! OverCycling DTfvw> DTaero bOverCycling = p%DTfvw > p%DTaero - ! Set the wind velocity at vortex - CALL DistributeRequestedWind(u%V_wind, p, m) + ! Distribute the Wind we requested to Inflow wind to storage Misc arrays + ! TODO ANDY: replace with direct call to inflow wind at m%CP_LL location + CALL DistributeRequestedWind_LL(u%V_wind, p, m%Vwnd_LL) + + ! Control points location and structrual velocity + CALL Wings_Panelling(u%WingsMesh, p, m, ErrStat2, ErrMsg2); if(Failed()) return ! if we are on a correction step, CalcOutput may be called again with different inputs ! Compute m%Gamma_LL @@ -1238,18 +1235,11 @@ subroutine FVW_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, y%Vind(1:3,:,:) = 0.0_ReKi do iW=1,p%nWings ! --- Linear interpolation for interior points and extrapolations at boundaries - call interpextrap_cp2node(m%s_CP_LL(:,iW), m%Vind_LL(1,:,iW), m%s_LL(:,iW), y%Vind(1,:,iW)) - call interpextrap_cp2node(m%s_CP_LL(:,iW), m%Vind_LL(2,:,iW), m%s_LL(:,iW), y%Vind(2,:,iW)) - call interpextrap_cp2node(m%s_CP_LL(:,iW), m%Vind_LL(3,:,iW), m%s_LL(:,iW), y%Vind(3,:,iW)) + call interpextrap_cp2node(p%s_CP_LL(:,iW), m%Vind_LL(1,:,iW), p%s_LL(:,iW), y%Vind(1,:,iW)) + call interpextrap_cp2node(p%s_CP_LL(:,iW), m%Vind_LL(2,:,iW), p%s_LL(:,iW), y%Vind(2,:,iW)) + call interpextrap_cp2node(p%s_CP_LL(:,iW), m%Vind_LL(3,:,iW), p%s_LL(:,iW), y%Vind(3,:,iW)) enddo - ! For plotting only - m%Vtot_ll = m%Vind_LL + m%Vwnd_LL - m%Vstr_ll - if (DEV_VERSION) then - call print_mean_3d(m%Vind_LL,'Mean induced vel. LL') - call print_mean_3d(m%Vtot_LL,'Mean relativevel. LL') - endif - ! --- Write to local VTK at fps requested if (m%VTKStep==-1) then m%VTKStep = 0 ! Has never been called, special handling for init @@ -1260,6 +1250,12 @@ subroutine FVW_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, if (m%FirstCall) then call MKDIR(p%VTK_OutFileRoot) endif + ! For plotting only + m%Vtot_LL = m%Vind_LL + m%Vwnd_LL - m%Vstr_LL + if (DEV_VERSION) then + call print_mean_3d(m%Vind_LL,'Mean induced vel. LL') + call print_mean_3d(m%Vtot_LL,'Mean relativevel. LL') + endif if ( ( t - m%VTKlastTime ) >= p%DTvtk*OneMinusEpsilon ) then m%VTKlastTime = t if ((p%VTKCoord==2).or.(p%VTKCoord==3)) then @@ -1279,6 +1275,9 @@ subroutine FVW_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, if (m%FirstCall) then call MKDIR(p%VTK_OutFileRoot) endif + ! Distribute the Wind we requested to Inflow wind to storage Misc arrays + ! TODO ANDY: replace with direct call to inflow wind at Grid points + CALL DistributeRequestedWind_Grid(u%V_wind, p, m) do iGrid=1,p%nGridOut if ( ( t - m%GridOutputs(iGrid)%tLastOutput) >= m%GridOutputs(iGrid)%DTout * OneMinusEpsilon ) then ! Compute induced velocity on grid, TODO use the same Tree for all CalcOutput @@ -1421,9 +1420,9 @@ subroutine CalculateInputsAndOtherStatesForUA(InputIndex, u, p, x, xd, z, OtherS do j = 1,p%nWings ! Induced velocity at Nodes (NOTE: we rely on storage done when computing Circulation) if (m%nNW>1) then - call interpextrap_cp2node(m%s_CP_LL(:,j), m%Vind_LL(1,:,j), m%s_LL(:,j), Vind_node(1,:)) - call interpextrap_cp2node(m%s_CP_LL(:,j), m%Vind_LL(2,:,j), m%s_LL(:,j), Vind_node(2,:)) - call interpextrap_cp2node(m%s_CP_LL(:,j), m%Vind_LL(3,:,j), m%s_LL(:,j), Vind_node(3,:)) + call interpextrap_cp2node(p%s_CP_LL(:,j), m%Vind_LL(1,:,j), p%s_LL(:,j), Vind_node(1,:)) + call interpextrap_cp2node(p%s_CP_LL(:,j), m%Vind_LL(2,:,j), p%s_LL(:,j), Vind_node(2,:)) + call interpextrap_cp2node(p%s_CP_LL(:,j), m%Vind_LL(3,:,j), p%s_LL(:,j), Vind_node(3,:)) else Vind_node=0.0_ReKi endif diff --git a/modules/aerodyn/src/FVW_Registry.txt b/modules/aerodyn/src/FVW_Registry.txt index 6b7ebb6209..7fcf05471b 100644 --- a/modules/aerodyn/src/FVW_Registry.txt +++ b/modules/aerodyn/src/FVW_Registry.txt @@ -67,6 +67,11 @@ typedef ^ ^ IntKi typedef ^ ^ DbKi DTaero - - - "Time interval for calls calculations" s typedef ^ ^ DbKi DTfvw - - - "Time interval for calculating wake induced velocities" s typedef ^ ^ ReKi KinVisc - - - "Kinematic air viscosity" m^2/s +# Lifting line and CP +typedef ^ ^ ReKi s_LL :: - - "Spanwise coordinate of LL elements" m +typedef ^ ^ ReKi s_CP_LL :: - - "Spanwise coordinate of LL CP" m +typedef ^ ^ ReKi chord_LL :: - - "chord on LL nodes " m +typedef ^ ^ ReKi chord_CP_LL :: - - "chord on LL cp " m # Parametesr output options typedef ^ ^ IntKi WrVTK - - - "Outputs VTK at each calcoutput call, even if main fst doesnt do it" - typedef ^ ^ IntKi VTKBlades - - - "Outputs VTk for each blade 0=no blade, 1=Bld 1" - @@ -96,11 +101,7 @@ typedef FVW/FVW MiscVarType Logical typedef ^ ^ ReKi LE ::: - - "Leading edge points" - typedef ^ ^ ReKi TE ::: - - "Trailing edge points" - typedef ^ ^ ReKi r_LL :::: - - "Position of the Lifting line panels" - -typedef ^ ^ ReKi s_LL :: - - "Spanwise coordinate of LL elements" m -typedef ^ ^ ReKi chord_LL :: - - "chord on LL nodes " m # Variables at control point - Dimensions nSpan -typedef ^ ^ ReKi s_CP_LL :: - - "Spanwise coordinate of LL CP" m -typedef ^ ^ ReKi chord_CP_LL :: - - "chord on LL cp " m typedef ^ ^ ReKi CP_LL ::: - - "Coordinates of LL CP" - typedef ^ ^ ReKi Tang ::: - - "Unit Tangential vector on LL CP" - typedef ^ ^ ReKi Norm ::: - - "Unit Normal vector on LL CP " - diff --git a/modules/aerodyn/src/FVW_Subs.f90 b/modules/aerodyn/src/FVW_Subs.f90 index 30da127cf5..dd0a5abf86 100644 --- a/modules/aerodyn/src/FVW_Subs.f90 +++ b/modules/aerodyn/src/FVW_Subs.f90 @@ -509,29 +509,50 @@ end subroutine SetRequestedWindPoints !> Set the requested wind into the correponding misc variables -subroutine DistributeRequestedWind(V_wind, p, m) - real(ReKi), dimension(:,:), intent(in ) :: V_wind !< Position where wind is requested +subroutine DistributeRequestedWind_LL(V_wind, p, Vwnd_LL) + real(ReKi), dimension(:,:), intent(in ) :: V_wind !< Requested wind, packed type(FVW_ParameterType), intent(in ) :: p !< Parameters - type(FVW_MiscVarType), target, intent(inout) :: m !< Initial misc/optimization variables + real(ReKi), dimension(:,:,:), intent(inout) :: Vwnd_LL !< Wind on lifting line integer(IntKi) :: iP_start,iP_end ! Current index of point, start and end of range - integer(IntKi) :: iGrid,i,j,k - type(GridOutType), pointer :: g - ! Using array reshaping to ensure a given near or far wake point is always at the same location in the array. ! NOTE: Maximum number of points are passed, whether they "exist" or not. ! --- LL CP iP_start=1 iP_end=p%nWings*p%nSpan - m%Vwnd_LL(1:3,1:p%nSpan,1:p%nWings) = reshape( V_wind(1:3,iP_start:iP_end), (/ 3, p%nSpan, p%nWings /)) + Vwnd_LL(1:3,1:p%nSpan,1:p%nWings) = reshape( V_wind(1:3,iP_start:iP_end), (/ 3, p%nSpan, p%nWings /)) +end subroutine DistributeRequestedWind_LL + +subroutine DistributeRequestedWind_NWFW(V_wind, p, Vwnd_NW, Vwnd_FW) + real(ReKi), dimension(:,:), intent(in ) :: V_wind !< Requested wind, packed + type(FVW_ParameterType), intent(in ) :: p !< Parameters + real(ReKi), dimension(:,:,:,:), intent(inout) :: Vwnd_NW !< Wind on near wake panels + real(ReKi), dimension(:,:,:,:), intent(inout) :: Vwnd_FW !< Wind on near wake panels + integer(IntKi) :: iP_start,iP_end ! Current index of point, start and end of range ! --- NW points - iP_start=iP_end+1 + iP_start=p%nWings*p%nSpan+1 iP_end=iP_start-1+(p%nSpan+1)*(p%nNWMax+1)*p%nWings - m%Vwnd_NW(1:3,1:p%nSpan+1,1:p%nNWMax+1,1:p%nWings) = reshape( V_wind(1:3,iP_start:iP_end), (/ 3, p%nSpan+1, p%nNWMax+1, p%nWings/)) + Vwnd_NW(1:3,1:p%nSpan+1,1:p%nNWMax+1,1:p%nWings) = reshape( V_wind(1:3,iP_start:iP_end), (/ 3, p%nSpan+1, p%nNWMax+1, p%nWings/)) ! --- FW points if (p%nFWMax>0) then iP_start=iP_end+1 iP_end=iP_start-1+(FWnSpan+1)*(p%nFWMax+1)*p%nWings - m%Vwnd_FW(1:3,1:FWnSpan+1,1:p%nFWMax+1,1:p%nWings) = reshape( V_wind(1:3,iP_start:iP_end), (/ 3, FWnSpan+1, p%nFWMax+1, p%nWings /)) + Vwnd_FW(1:3,1:FWnSpan+1,1:p%nFWMax+1,1:p%nWings) = reshape( V_wind(1:3,iP_start:iP_end), (/ 3, FWnSpan+1, p%nFWMax+1, p%nWings /)) + endif +end subroutine DistributeRequestedWind_NWFW + +!> Set the requested wind into the correponding misc variables +subroutine DistributeRequestedWind_Grid(V_wind, p, m) + real(ReKi), dimension(:,:), intent(in ) :: V_wind !< Requested wind, packed + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_MiscVarType), target, intent(inout) :: m !< Initial misc/optimization variables + integer(IntKi) :: iP_start,iP_end ! Current index of point, start and end of range + integer(IntKi) :: iGrid,i,j,k + type(GridOutType), pointer :: g + ! --- LL CP + iP_end =p%nWings*p%nSpan+1-1+(p%nSpan+1)*(p%nNWMax+1)*p%nWings + ! --- FW points + if (p%nFWMax>0) then + iP_end=iP_end+1-1+(FWnSpan+1)*(p%nFWMax+1)*p%nWings endif ! --- VTK points ! TODO optimize this @@ -547,8 +568,8 @@ subroutine DistributeRequestedWind(V_wind, p, m) enddo enddo ! Loop on x enddo ! Loop on grids +end subroutine DistributeRequestedWind_Grid -end subroutine DistributeRequestedWind !> Count how many segments are needed to represent the Near wake and far wakes, starting at a given depth @@ -702,16 +723,16 @@ subroutine FVW_InitRegularization(x, p, m, ErrStat, ErrMsg) ErrMsg = "" ! --- Compute min max and mean spanwise section lengths iW =1 - ds_min = minval(m%s_ll(2:p%nSpan+1,iW)-m%s_ll(1:p%nSpan,iW)) - ds_max = maxval(m%s_ll(2:p%nSpan+1,iW)-m%s_ll(1:p%nSpan,iW)) - ds_mean = sum(m%s_ll(2:p%nSpan+1,iW)-m%s_ll(1:p%nSpan,iW))/(p%nSpan+1) - c_min = minval(m%chord_LL(:,iW)) - c_max = maxval(m%chord_LL(:,iW)) - c_mean = sum (m%chord_LL(:,iW))/(p%nSpan+1) + ds_min = minval(p%s_LL(2:p%nSpan+1,iW)-p%s_LL(1:p%nSpan,iW)) + ds_max = maxval(p%s_LL(2:p%nSpan+1,iW)-p%s_LL(1:p%nSpan,iW)) + ds_mean = sum(p%s_LL(2:p%nSpan+1,iW)-p%s_LL(1:p%nSpan,iW))/(p%nSpan+1) + c_min = minval(p%chord_LL(:,iW)) + c_max = maxval(p%chord_LL(:,iW)) + c_mean = sum (p%chord_LL(:,iW))/(p%nSpan+1) d_min = minval(m%diag_LL(:,iW)) d_max = maxval(m%diag_LL(:,iW)) d_mean = sum (m%diag_LL(:,iW))/(p%nSpan+1) - Span = m%s_ll(p%nSpan+1,iW)-m%s_ll(1,iW) + Span = p%s_LL(p%nSpan+1,iW)-p%s_LL(1,iW) RegParam = ds_mean*2 if (DEV_VERSION) then write(*,'(A)')'-----------------------------------------------------------------------------------------' @@ -1104,9 +1125,6 @@ subroutine LiftingLineInducedVelocities(p, x, iDepthStart, m, ErrStat, ErrMsg) print'(A,I0,A,I0,A,I0,A)','Induction - nSeg:',nSeg,' - nSegP:',nSegP, ' - nCPs:',nCPs, ' -> No induction' endif else - ! --- Setting up regularization - !call WakeRegularization(p, x, m, m%Sgmt%Connct(:,1:nSeg), m%Sgmt%Points(:,1:nSegP), m%Sgmt%Gamma(1:nSeg), m%Sgmt%Epsilon(1:nSeg), ErrStat, ErrMsg) - nCPs=p%nWings * p%nSpan allocate(CPs (1:3,1:nCPs)) ! NOTE: here we do allocate CPs and Uind insteadof using Misc allocate(Uind(1:3,1:nCPs)) ! The size is reasonably small, and m%Uind then stay filled with "rollup velocities" (for export) diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index 212bd6a812..d09ae406c2 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -97,6 +97,10 @@ MODULE FVW_Types REAL(DbKi) :: DTaero !< Time interval for calls calculations [s] REAL(DbKi) :: DTfvw !< Time interval for calculating wake induced velocities [s] REAL(ReKi) :: KinVisc !< Kinematic air viscosity [m^2/s] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: s_LL !< Spanwise coordinate of LL elements [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: s_CP_LL !< Spanwise coordinate of LL CP [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: chord_LL !< chord on LL nodes [m] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: chord_CP_LL !< chord on LL cp [m] INTEGER(IntKi) :: WrVTK !< Outputs VTK at each calcoutput call, even if main fst doesnt do it [-] INTEGER(IntKi) :: VTKBlades !< Outputs VTk for each blade 0=no blade, 1=Bld 1 [-] REAL(DbKi) :: DTvtk !< DT between vtk writes [s] @@ -124,10 +128,6 @@ MODULE FVW_Types REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: LE !< Leading edge points [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: TE !< Trailing edge points [-] REAL(ReKi) , DIMENSION(:,:,:,:), ALLOCATABLE :: r_LL !< Position of the Lifting line panels [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: s_LL !< Spanwise coordinate of LL elements [m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: chord_LL !< chord on LL nodes [m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: s_CP_LL !< Spanwise coordinate of LL CP [m] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: chord_CP_LL !< chord on LL cp [m] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: CP_LL !< Coordinates of LL CP [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Tang !< Unit Tangential vector on LL CP [-] REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Norm !< Unit Normal vector on LL CP [-] @@ -1039,6 +1039,62 @@ SUBROUTINE FVW_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%DTaero = SrcParamData%DTaero DstParamData%DTfvw = SrcParamData%DTfvw DstParamData%KinVisc = SrcParamData%KinVisc +IF (ALLOCATED(SrcParamData%s_LL)) THEN + i1_l = LBOUND(SrcParamData%s_LL,1) + i1_u = UBOUND(SrcParamData%s_LL,1) + i2_l = LBOUND(SrcParamData%s_LL,2) + i2_u = UBOUND(SrcParamData%s_LL,2) + IF (.NOT. ALLOCATED(DstParamData%s_LL)) THEN + ALLOCATE(DstParamData%s_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%s_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%s_LL = SrcParamData%s_LL +ENDIF +IF (ALLOCATED(SrcParamData%s_CP_LL)) THEN + i1_l = LBOUND(SrcParamData%s_CP_LL,1) + i1_u = UBOUND(SrcParamData%s_CP_LL,1) + i2_l = LBOUND(SrcParamData%s_CP_LL,2) + i2_u = UBOUND(SrcParamData%s_CP_LL,2) + IF (.NOT. ALLOCATED(DstParamData%s_CP_LL)) THEN + ALLOCATE(DstParamData%s_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%s_CP_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%s_CP_LL = SrcParamData%s_CP_LL +ENDIF +IF (ALLOCATED(SrcParamData%chord_LL)) THEN + i1_l = LBOUND(SrcParamData%chord_LL,1) + i1_u = UBOUND(SrcParamData%chord_LL,1) + i2_l = LBOUND(SrcParamData%chord_LL,2) + i2_u = UBOUND(SrcParamData%chord_LL,2) + IF (.NOT. ALLOCATED(DstParamData%chord_LL)) THEN + ALLOCATE(DstParamData%chord_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%chord_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%chord_LL = SrcParamData%chord_LL +ENDIF +IF (ALLOCATED(SrcParamData%chord_CP_LL)) THEN + i1_l = LBOUND(SrcParamData%chord_CP_LL,1) + i1_u = UBOUND(SrcParamData%chord_CP_LL,1) + i2_l = LBOUND(SrcParamData%chord_CP_LL,2) + i2_u = UBOUND(SrcParamData%chord_CP_LL,2) + IF (.NOT. ALLOCATED(DstParamData%chord_CP_LL)) THEN + ALLOCATE(DstParamData%chord_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%chord_CP_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%chord_CP_LL = SrcParamData%chord_CP_LL +ENDIF DstParamData%WrVTK = SrcParamData%WrVTK DstParamData%VTKBlades = SrcParamData%VTKBlades DstParamData%DTvtk = SrcParamData%DTvtk @@ -1066,6 +1122,18 @@ SUBROUTINE FVW_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(ParamData%PrescribedCirculation)) THEN DEALLOCATE(ParamData%PrescribedCirculation) +ENDIF +IF (ALLOCATED(ParamData%s_LL)) THEN + DEALLOCATE(ParamData%s_LL) +ENDIF +IF (ALLOCATED(ParamData%s_CP_LL)) THEN + DEALLOCATE(ParamData%s_CP_LL) +ENDIF +IF (ALLOCATED(ParamData%chord_LL)) THEN + DEALLOCATE(ParamData%chord_LL) +ENDIF +IF (ALLOCATED(ParamData%chord_CP_LL)) THEN + DEALLOCATE(ParamData%chord_CP_LL) ENDIF END SUBROUTINE FVW_DestroyParam @@ -1148,6 +1216,26 @@ SUBROUTINE FVW_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_BufSz = Db_BufSz + 1 ! DTaero Db_BufSz = Db_BufSz + 1 ! DTfvw Re_BufSz = Re_BufSz + 1 ! KinVisc + Int_BufSz = Int_BufSz + 1 ! s_LL allocated yes/no + IF ( ALLOCATED(InData%s_LL) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! s_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%s_LL) ! s_LL + END IF + Int_BufSz = Int_BufSz + 1 ! s_CP_LL allocated yes/no + IF ( ALLOCATED(InData%s_CP_LL) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! s_CP_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%s_CP_LL) ! s_CP_LL + END IF + Int_BufSz = Int_BufSz + 1 ! chord_LL allocated yes/no + IF ( ALLOCATED(InData%chord_LL) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! chord_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%chord_LL) ! chord_LL + END IF + Int_BufSz = Int_BufSz + 1 ! chord_CP_LL allocated yes/no + IF ( ALLOCATED(InData%chord_CP_LL) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! chord_CP_LL upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%chord_CP_LL) ! chord_CP_LL + END IF Int_BufSz = Int_BufSz + 1 ! WrVTK Int_BufSz = Int_BufSz + 1 ! VTKBlades Db_BufSz = Db_BufSz + 1 ! DTvtk @@ -1296,6 +1384,86 @@ SUBROUTINE FVW_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = Db_Xferred + 1 ReKiBuf(Re_Xferred) = InData%KinVisc Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%s_LL) ) 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%s_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_LL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%s_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_LL,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%s_LL,2), UBOUND(InData%s_LL,2) + DO i1 = LBOUND(InData%s_LL,1), UBOUND(InData%s_LL,1) + ReKiBuf(Re_Xferred) = InData%s_LL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%s_CP_LL) ) 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%s_CP_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_CP_LL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%s_CP_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_CP_LL,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%s_CP_LL,2), UBOUND(InData%s_CP_LL,2) + DO i1 = LBOUND(InData%s_CP_LL,1), UBOUND(InData%s_CP_LL,1) + ReKiBuf(Re_Xferred) = InData%s_CP_LL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%chord_LL) ) 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%chord_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_LL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%chord_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_LL,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%chord_LL,2), UBOUND(InData%chord_LL,2) + DO i1 = LBOUND(InData%chord_LL,1), UBOUND(InData%chord_LL,1) + ReKiBuf(Re_Xferred) = InData%chord_LL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%chord_CP_LL) ) 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%chord_CP_LL,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_CP_LL,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%chord_CP_LL,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_CP_LL,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%chord_CP_LL,2), UBOUND(InData%chord_CP_LL,2) + DO i1 = LBOUND(InData%chord_CP_LL,1), UBOUND(InData%chord_CP_LL,1) + ReKiBuf(Re_Xferred) = InData%chord_CP_LL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF IntKiBuf(Int_Xferred) = InData%WrVTK Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%VTKBlades @@ -1470,6 +1638,98 @@ SUBROUTINE FVW_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Db_Xferred = Db_Xferred + 1 OutData%KinVisc = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s_LL 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%s_LL)) DEALLOCATE(OutData%s_LL) + ALLOCATE(OutData%s_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%s_LL,2), UBOUND(OutData%s_LL,2) + DO i1 = LBOUND(OutData%s_LL,1), UBOUND(OutData%s_LL,1) + OutData%s_LL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s_CP_LL 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%s_CP_LL)) DEALLOCATE(OutData%s_CP_LL) + ALLOCATE(OutData%s_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_CP_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%s_CP_LL,2), UBOUND(OutData%s_CP_LL,2) + DO i1 = LBOUND(OutData%s_CP_LL,1), UBOUND(OutData%s_CP_LL,1) + OutData%s_CP_LL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord_LL 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%chord_LL)) DEALLOCATE(OutData%chord_LL) + ALLOCATE(OutData%chord_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%chord_LL,2), UBOUND(OutData%chord_LL,2) + DO i1 = LBOUND(OutData%chord_LL,1), UBOUND(OutData%chord_LL,1) + OutData%chord_LL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord_CP_LL 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%chord_CP_LL)) DEALLOCATE(OutData%chord_CP_LL) + ALLOCATE(OutData%chord_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_CP_LL.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%chord_CP_LL,2), UBOUND(OutData%chord_CP_LL,2) + DO i1 = LBOUND(OutData%chord_CP_LL,1), UBOUND(OutData%chord_CP_LL,1) + OutData%chord_CP_LL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF OutData%WrVTK = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%VTKBlades = IntKiBuf(Int_Xferred) @@ -2290,62 +2550,6 @@ SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) END IF DstMiscData%r_LL = SrcMiscData%r_LL ENDIF -IF (ALLOCATED(SrcMiscData%s_LL)) THEN - i1_l = LBOUND(SrcMiscData%s_LL,1) - i1_u = UBOUND(SrcMiscData%s_LL,1) - i2_l = LBOUND(SrcMiscData%s_LL,2) - i2_u = UBOUND(SrcMiscData%s_LL,2) - IF (.NOT. ALLOCATED(DstMiscData%s_LL)) THEN - ALLOCATE(DstMiscData%s_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%s_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%s_LL = SrcMiscData%s_LL -ENDIF -IF (ALLOCATED(SrcMiscData%chord_LL)) THEN - i1_l = LBOUND(SrcMiscData%chord_LL,1) - i1_u = UBOUND(SrcMiscData%chord_LL,1) - i2_l = LBOUND(SrcMiscData%chord_LL,2) - i2_u = UBOUND(SrcMiscData%chord_LL,2) - IF (.NOT. ALLOCATED(DstMiscData%chord_LL)) THEN - ALLOCATE(DstMiscData%chord_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%chord_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%chord_LL = SrcMiscData%chord_LL -ENDIF -IF (ALLOCATED(SrcMiscData%s_CP_LL)) THEN - i1_l = LBOUND(SrcMiscData%s_CP_LL,1) - i1_u = UBOUND(SrcMiscData%s_CP_LL,1) - i2_l = LBOUND(SrcMiscData%s_CP_LL,2) - i2_u = UBOUND(SrcMiscData%s_CP_LL,2) - IF (.NOT. ALLOCATED(DstMiscData%s_CP_LL)) THEN - ALLOCATE(DstMiscData%s_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%s_CP_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%s_CP_LL = SrcMiscData%s_CP_LL -ENDIF -IF (ALLOCATED(SrcMiscData%chord_CP_LL)) THEN - i1_l = LBOUND(SrcMiscData%chord_CP_LL,1) - i1_u = UBOUND(SrcMiscData%chord_CP_LL,1) - i2_l = LBOUND(SrcMiscData%chord_CP_LL,2) - i2_u = UBOUND(SrcMiscData%chord_CP_LL,2) - IF (.NOT. ALLOCATED(DstMiscData%chord_CP_LL)) THEN - ALLOCATE(DstMiscData%chord_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%chord_CP_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMiscData%chord_CP_LL = SrcMiscData%chord_CP_LL -ENDIF IF (ALLOCATED(SrcMiscData%CP_LL)) THEN i1_l = LBOUND(SrcMiscData%CP_LL,1) i1_u = UBOUND(SrcMiscData%CP_LL,1) @@ -2992,18 +3196,6 @@ SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg ) IF (ALLOCATED(MiscData%r_LL)) THEN DEALLOCATE(MiscData%r_LL) ENDIF -IF (ALLOCATED(MiscData%s_LL)) THEN - DEALLOCATE(MiscData%s_LL) -ENDIF -IF (ALLOCATED(MiscData%chord_LL)) THEN - DEALLOCATE(MiscData%chord_LL) -ENDIF -IF (ALLOCATED(MiscData%s_CP_LL)) THEN - DEALLOCATE(MiscData%s_CP_LL) -ENDIF -IF (ALLOCATED(MiscData%chord_CP_LL)) THEN - DEALLOCATE(MiscData%chord_CP_LL) -ENDIF IF (ALLOCATED(MiscData%CP_LL)) THEN DEALLOCATE(MiscData%CP_LL) ENDIF @@ -3191,26 +3383,6 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*4 ! r_LL upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%r_LL) ! r_LL END IF - Int_BufSz = Int_BufSz + 1 ! s_LL allocated yes/no - IF ( ALLOCATED(InData%s_LL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! s_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%s_LL) ! s_LL - END IF - Int_BufSz = Int_BufSz + 1 ! chord_LL allocated yes/no - IF ( ALLOCATED(InData%chord_LL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! chord_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chord_LL) ! chord_LL - END IF - Int_BufSz = Int_BufSz + 1 ! s_CP_LL allocated yes/no - IF ( ALLOCATED(InData%s_CP_LL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! s_CP_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%s_CP_LL) ! s_CP_LL - END IF - Int_BufSz = Int_BufSz + 1 ! chord_CP_LL allocated yes/no - IF ( ALLOCATED(InData%chord_CP_LL) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! chord_CP_LL upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%chord_CP_LL) ! chord_CP_LL - END IF Int_BufSz = Int_BufSz + 1 ! CP_LL allocated yes/no IF ( ALLOCATED(InData%CP_LL) ) THEN Int_BufSz = Int_BufSz + 2*3 ! CP_LL upper/lower bounds for each dimension @@ -3686,86 +3858,6 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si END DO END DO END IF - IF ( .NOT. ALLOCATED(InData%s_LL) ) 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%s_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%s_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_LL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%s_LL,2), UBOUND(InData%s_LL,2) - DO i1 = LBOUND(InData%s_LL,1), UBOUND(InData%s_LL,1) - ReKiBuf(Re_Xferred) = InData%s_LL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%chord_LL) ) 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%chord_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_LL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%chord_LL,2), UBOUND(InData%chord_LL,2) - DO i1 = LBOUND(InData%chord_LL,1), UBOUND(InData%chord_LL,1) - ReKiBuf(Re_Xferred) = InData%chord_LL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%s_CP_LL) ) 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%s_CP_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_CP_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%s_CP_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s_CP_LL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%s_CP_LL,2), UBOUND(InData%s_CP_LL,2) - DO i1 = LBOUND(InData%s_CP_LL,1), UBOUND(InData%s_CP_LL,1) - ReKiBuf(Re_Xferred) = InData%s_CP_LL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%chord_CP_LL) ) 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%chord_CP_LL,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_CP_LL,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%chord_CP_LL,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord_CP_LL,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%chord_CP_LL,2), UBOUND(InData%chord_CP_LL,2) - DO i1 = LBOUND(InData%chord_CP_LL,1), UBOUND(InData%chord_CP_LL,1) - ReKiBuf(Re_Xferred) = InData%chord_CP_LL(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF IF ( .NOT. ALLOCATED(InData%CP_LL) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5029,98 +5121,6 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s_LL 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%s_LL)) DEALLOCATE(OutData%s_LL) - ALLOCATE(OutData%s_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%s_LL,2), UBOUND(OutData%s_LL,2) - DO i1 = LBOUND(OutData%s_LL,1), UBOUND(OutData%s_LL,1) - OutData%s_LL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord_LL 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%chord_LL)) DEALLOCATE(OutData%chord_LL) - ALLOCATE(OutData%chord_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%chord_LL,2), UBOUND(OutData%chord_LL,2) - DO i1 = LBOUND(OutData%chord_LL,1), UBOUND(OutData%chord_LL,1) - OutData%chord_LL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s_CP_LL 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%s_CP_LL)) DEALLOCATE(OutData%s_CP_LL) - ALLOCATE(OutData%s_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s_CP_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%s_CP_LL,2), UBOUND(OutData%s_CP_LL,2) - DO i1 = LBOUND(OutData%s_CP_LL,1), UBOUND(OutData%s_CP_LL,1) - OutData%s_CP_LL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord_CP_LL 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%chord_CP_LL)) DEALLOCATE(OutData%chord_CP_LL) - ALLOCATE(OutData%chord_CP_LL(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord_CP_LL.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%chord_CP_LL,2), UBOUND(OutData%chord_CP_LL,2) - DO i1 = LBOUND(OutData%chord_CP_LL,1), UBOUND(OutData%chord_CP_LL,1) - OutData%chord_CP_LL(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CP_LL not allocated Int_Xferred = Int_Xferred + 1 ELSE diff --git a/modules/aerodyn/src/FVW_Wings.f90 b/modules/aerodyn/src/FVW_Wings.f90 index 431ab3403b..e5ace16dc1 100644 --- a/modules/aerodyn/src/FVW_Wings.f90 +++ b/modules/aerodyn/src/FVW_Wings.f90 @@ -65,7 +65,7 @@ end subroutine Meshing !! - chord_LL_CP: chord on LL cp subroutine Wings_Panelling_Init(Meshes, p, m, ErrStat, ErrMsg ) type(MeshType), dimension(:), intent(in ) :: Meshes !< Wings mesh - type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_ParameterType), intent(inout) :: p !< Parameters type(FVW_MiscVarType), intent(inout) :: 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 @@ -100,15 +100,15 @@ subroutine Wings_Panelling_Init(Meshes, p, m, ErrStat, ErrMsg ) ErrMsg ='TODO different discretization InputMesh / vortex code'; ErrStat=ErrID_Fatal; return endif do iSpan = 1, p%nSpan+1 - m%s_LL (iSpan, iW) = s_in(iSpan) - m%chord_LL(iSpan, iW) = p%chord(iSpan,iW) + p%s_LL (iSpan, iW) = s_in(iSpan) + p%chord_LL(iSpan, iW) = p%chord(iSpan,iW) enddo ! --- Control points spanwise location ! NOTE: we use the cos approximation of VanGarrel. For equispacing, it returns mid point ! otherwise, points are slightly closer to panels that are shorter - !call Meshing('middle' , m%s_LL(:,iW), p%nSpan, m%s_CP_LL(:,iW)) - call Meshing('fullcosineapprox' , m%s_LL(:,iW), p%nSpan, m%s_CP_LL(:,iW)) - call InterpArray(m%s_LL(:,iW), m%chord_LL(:,iW), m%s_CP_LL(:,iW), m%chord_CP_LL(:,iW)) + !call Meshing('middle' , p%s_LL(:,iW), p%nSpan, p%s_CP_LL(:,iW)) + call Meshing('fullcosineapprox' , p%s_LL(:,iW), p%nSpan, p%s_CP_LL(:,iW)) + call InterpArray(p%s_LL(:,iW), p%chord_LL(:,iW), p%s_CP_LL(:,iW), p%chord_CP_LL(:,iW)) enddo end subroutine Wings_Panelling_Init !---------------------------------------------------------------------------------------------------------------------------------- @@ -144,9 +144,9 @@ subroutine Wings_Panelling(Meshes, p, m, ErrStat, ErrMsg ) do iSpan = 1,p%nSpan+1 P_ref = Meshes(iW)%Position(1:3, iSpan )+Meshes(iW)%TranslationDisp(1:3, iSpan) DP_LE(1:3) = 0.0 - DP_LE(1) = -m%chord_LL(iSpan,iW)/4. + DP_LE(1) = -p%chord_LL(iSpan,iW)/4. DP_TE(1:3) = 0.0 - DP_TE(1) = +3.*m%chord_LL(iSpan,iW)/4. + DP_TE(1) = +3.*p%chord_LL(iSpan,iW)/4. m%LE(1:3, iSpan, iW) = P_ref + DP_LE(1)*Meshes(iW)%Orientation(2,1:3,iSpan) m%TE(1:3, iSpan, iW) = P_ref + DP_TE(1)*Meshes(iW)%Orientation(2,1:3,iSpan) enddo @@ -201,17 +201,17 @@ subroutine Wings_Panelling(Meshes, p, m, ErrStat, ErrMsg ) ! For now: placed exactly on the LL panel ! NOTE: separated from other loops just in case a special discretization is used do iW = 1,p%nWings - call InterpArray(m%s_LL(:,iW), m%r_LL(1,:,1,iW), m%s_CP_LL(:,iW), m%CP_LL(1,:,iW)) - call InterpArray(m%s_LL(:,iW), m%r_LL(2,:,1,iW), m%s_CP_LL(:,iW), m%CP_LL(2,:,iW)) - call InterpArray(m%s_LL(:,iW), m%r_LL(3,:,1,iW), m%s_CP_LL(:,iW), m%CP_LL(3,:,iW)) + call InterpArray(p%s_LL(:,iW), m%r_LL(1,:,1,iW), p%s_CP_LL(:,iW), m%CP_LL(1,:,iW)) + call InterpArray(p%s_LL(:,iW), m%r_LL(2,:,1,iW), p%s_CP_LL(:,iW), m%CP_LL(2,:,iW)) + call InterpArray(p%s_LL(:,iW), m%r_LL(3,:,1,iW), p%s_CP_LL(:,iW), m%CP_LL(3,:,iW)) enddo ! --- Structural velocity on LL ! TODO: difference meshes in/LL do iW = 1,p%nWings - call InterpArray(m%s_LL(:,iW), Meshes(iW)%TranslationVel(1,:) ,m%s_CP_LL(:,iW), m%Vstr_LL(1,:,iW)) - call InterpArray(m%s_LL(:,iW), Meshes(iW)%TranslationVel(2,:) ,m%s_CP_LL(:,iW), m%Vstr_LL(2,:,iW)) - call InterpArray(m%s_LL(:,iW), Meshes(iW)%TranslationVel(3,:) ,m%s_CP_LL(:,iW), m%Vstr_LL(3,:,iW)) + call InterpArray(p%s_LL(:,iW), Meshes(iW)%TranslationVel(1,:) ,p%s_CP_LL(:,iW), m%Vstr_LL(1,:,iW)) + call InterpArray(p%s_LL(:,iW), Meshes(iW)%TranslationVel(2,:) ,p%s_CP_LL(:,iW), m%Vstr_LL(2,:,iW)) + call InterpArray(p%s_LL(:,iW), Meshes(iW)%TranslationVel(3,:) ,p%s_CP_LL(:,iW), m%Vstr_LL(3,:,iW)) enddo end subroutine Wings_Panelling From be241431340532f62f83d3123558b3347a644fc8 Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Fri, 22 Jan 2021 22:14:11 -0700 Subject: [PATCH 11/27] OLAF: splitting of calcoutput, explicit variables (instead of misc) in some functions NOTE: overcylcing will still introduce frequencies, even without rollup and prescribed gamma. results are worst at tip when rotating. --- modules/aerodyn/src/FVW.f90 | 235 ++++++++----- modules/aerodyn/src/FVW_Registry.txt | 9 +- modules/aerodyn/src/FVW_Subs.f90 | 33 +- modules/aerodyn/src/FVW_Types.f90 | 497 +++++++++++---------------- modules/aerodyn/src/FVW_Wings.f90 | 3 +- 5 files changed, 370 insertions(+), 407 deletions(-) diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index 2226983f1d..3e3744643e 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -141,7 +141,7 @@ subroutine FVW_Init(AFInfo, InitInp, u, p, x, xd, z, OtherState, y, m, Interval, call Map_NW_FW(p, m, z, x, ErrStat2, ErrMsg2); if(Failed()) return ! Initialize input guess and output - CALL FVW_Init_U_Y( p, u, y, ErrStat2, ErrMsg2); if(Failed()) return + CALL FVW_Init_U_Y( p, u, y, m, ErrStat2, ErrMsg2); if(Failed()) return ! Returned guessed locations where wind will be required CALL SetRequestedWindPoints(m%r_wind, x, p, m ) @@ -344,9 +344,10 @@ subroutine FVW_InitConstraint( z, p, m, ErrStat, ErrMsg ) end subroutine FVW_InitConstraint ! ============================================================================== !> Init/allocate inputs and outputs -subroutine FVW_Init_U_Y( p, u, y, ErrStat, ErrMsg ) +subroutine FVW_Init_U_Y( p, u, y, m, ErrStat, ErrMsg ) type(FVW_ParameterType), intent(in ) :: p !< Parameters type(FVW_InputType), intent(inout) :: u !< An initial guess for the input; input mesh must be defined + type(FVW_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables type(FVW_OutputType), intent( out) :: y !< Constraints integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -367,7 +368,7 @@ subroutine FVW_Init_U_Y( p, u, y, ErrStat, ErrMsg ) call AllocAry( y%Vind , 3, p%nSpan+1, p%nWings, 'Induced velocity vector', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName) call AllocAry( u%omega_z, p%nSpan+1, p%nWings, 'Section torsion rate' , ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName) call AllocAry( u%Vwnd_LLMP,3, p%nSpan+1, p%nWings, 'Dist. wind at LL nodes', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName) - y%Vind = 0.0_ReKi ! TODO check if 0 is somehow required? + y%Vind = -9999.9_ReKi u%V_wind = -9999.9_ReKi u%Vwnd_LLMP = -9999.9_ReKi u%omega_z = -9999.9_ReKi @@ -595,10 +596,10 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m ! --- Integration between t and t+DTfvw if (m%ComputeWakeInduced) then if (bOverCycling) then - call FVW_CopyContState(x, m%x1, 0, ErrStat2, ErrMsg2) ! Backup current state at t - m%t1=t + ! Store states at t, and use this opportunity to store outputs at t + call FVW_CopyContState(x, m%x1, 0, ErrStat2, ErrMsg2) ! Backup current state at t + m%t1=t endif - print*,'t',t,'t+dt',t+p%DTfvw,'ut',utimes if (p%IntMethod .eq. idEuler1) then call FVW_Euler1( t, uInterp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2); if(Failed()) return elseif (p%IntMethod .eq. idRK4) then @@ -619,13 +620,35 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m call PropagateWake(p, m, z, x, ErrStat2, ErrMsg2); if(Failed()) return if (bOverCycling) then - ! NOTE:l + ! States x1 ! - we need to propagate the states at t to match the memory of state t+DTfvw ! - the positions and intensities for the LL and 1st NW panels are NaN for x1 and x2, - ! but that's fine since these are always overwritten by the mapping + ! so we need to remap them call PropagateWake(p, m, z, m%x1, ErrStat2, ErrMsg2); if(Failed()) return + !call Map_LL_NW(p, m, z, m%x1, ShedScale, ErrStat2, ErrMsg2); if(Failed()) return + !call Map_NW_FW(p, m, z, m%x1, ErrStat2, ErrMsg2); if(Failed()) return + + ! States x2 call FVW_CopyContState(x, m%x2, 0, ErrStat2, ErrMsg2) ! Backup current state at t+DTfvw m%t2=t+p%DTfvw + !! Inputs at t+DTfvw (Wings Panelling updates CP_LL, and Vstr_LL) + !call FVW_Input_ExtrapInterp(u(1:size(utimes)),utimes,uInterp,t+p%DTfvw, ErrStat2, ErrMsg2); if(Failed()) return + !call Wings_Panelling(uInterp%WingsMesh, p, m, ErrStat2, ErrMsg2); if(Failed()) return + !! Updating positions of first NW and FW panels (Circulation also updated but irrelevant) + !call Map_LL_NW(p, m, z, m%x2, 1.0, ErrStat2, ErrMsg2); if(Failed()) return + !call Map_NW_FW(p, m, z, m%x2, ErrStat2, ErrMsg2); if(Failed()) return + !! --- Solve for quasi steady circulation at t+p%DTfvw + !! Returns: z%Gamma_LL (at t+p%DTfvw) + !z_guess%Gamma_LL = z%Gamma_LL ! We use as guess the circulation from the previous time step (see above) + !call FVW_CalcConstrStateResidual(t+p%DTfvw, uInterp, p, m%x2, xd, z_guess, OtherState, m, z, AFInfo, ErrStat2, ErrMsg2, 2); if(Failed()) return + !! Compute UA inputs at t+DTfvw and integrate UA states between t and t+dtAero + !if (m%UA_Flag) then + ! call CalculateInputsAndOtherStatesForUA(2, uInterp, p, m%x2, xd, z, OtherState, AFInfo, m, ErrStat2, ErrMsg2); if(Failed()) return + ! call UA_UpdateState_Wrapper(AFInfo, t, n, (/t,t+p%DTfvw/), p, m%x2, xd, OtherState, m, ErrStat2, ErrMsg2); if(Failed()) return + !end if + !! Updating circulation of near wake panel (and position but irrelevant) + !call Map_LL_NW(p, m, z, m%x2, ShedScale, ErrStat2, ErrMsg2); if(Failed()) return + !call Map_NW_FW(p, m, z, m%x2, ErrStat2, ErrMsg2); if(Failed()) return endif endif ! --- Integration between t and t+DTaero if DTaero/=DTfvw @@ -634,10 +657,8 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m call FVW_ContStates_Interp(t+p%DTaero, (/m%x1, m%x2/), (/m%t1, m%t2/), p, m, x, ErrStat2, ErrMsg2); if(Failed()) return endif - ! Inputs at t+DTaero + ! Inputs at t+DTaero (Wings Panelling updates CP_LL, and Vstr_LL) call FVW_Input_ExtrapInterp(u(1:size(utimes)),utimes,uInterp,t+p%DTaero, ErrStat2, ErrMsg2); if(Failed()) return - - ! Panelling wings based on input mesh at t+p%DTaero call Wings_Panelling(uInterp%WingsMesh, p, m, ErrStat2, ErrMsg2); if(Failed()) return ! Updating positions of first NW and FW panels (Circulation also updated but irrelevant) @@ -829,7 +850,7 @@ subroutine FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSt ! TODO else if (p%WakeRegMethod==idRegAge) then visc_fact = 2.0_ReKi * CoreSpreadAlpha * p%CoreSpreadEddyVisc * p%KinVisc - visc_fact=visc_fact/sqrt(p%WakeRegParam**2 + 2*visc_fact*p%DTfvw) ! Might need to be adjusted + visc_fact=visc_fact/sqrt(p%WakeRegParam**2 + 2*visc_fact*p%DTaero) ! NOTE: using DTaero to be consisten with OverCycling dxdt%Eps_NW(1:3, :, :, :) = visc_fact dxdt%Eps_FW(1:3, :, :, :) = visc_fact else @@ -876,6 +897,8 @@ subroutine FVW_ContStates_Interp(t, states, times, p, m, x, ErrStat, ErrMsg ) x%Eps_FW = (1_ReKi-fact) * states(1)%Eps_FW + fact * states(2)%Eps_FW x%Gamma_NW = (1_ReKi-fact) * states(1)%Gamma_NW + fact * states(2)%Gamma_NW x%Gamma_FW = (1_ReKi-fact) * states(1)%Gamma_FW + fact * states(2)%Gamma_FW + !print*,'fact',fact,states(1)%Gamma_NW(29,iNWStart+1,1),x%Gamma_NW(29,iNWStart+1,1),states(2)%Gamma_NW(29,iNWStart+1,1) + !print*,'fact',fact,states(1)%r_NW(1,29,iNWStart+1,1),x%r_NW(1,29,iNWStart+1,1),states(2)%r_NW(1,29,iNWStart+1,1) end subroutine FVW_ContStates_Interp @@ -1177,9 +1200,57 @@ subroutine FVW_CalcConstrStateResidual( t, u, p, x, xd, z_guess, OtherState, m, end subroutine FVW_CalcConstrStateResidual + +subroutine CalcOutputForAD(t, u, p, x, y, m, AFInfo, ErrStat, ErrMsg) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + type(FVW_InputType), intent(in ) :: u !< Inputs at Time t + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_ContinuousStateType), intent(in ) :: x !< Continuous states at t + type(FVW_OutputType), intent(inout) :: y !< Outputs computed at t (Input only so that mesh con- + type(FVW_MiscVarType), intent(inout) :: m !< Misc/optimization variables + type(AFI_ParameterType), intent(in ) :: AFInfo(:) !< The airfoil parameter data + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + integer(IntKi) :: iW, n + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CalcOutput' + + ErrStat = ErrID_None + ErrMsg = "" +! ! --- NOTE: this below might not be needed +! ! Distribute the Wind we requested to Inflow wind to storage Misc arrays +! ! TODO ANDY: replace with direct call to inflow wind at m%CP_LL location +! CALL DistributeRequestedWind_LL(u%V_wind, p, m%Vwnd_LL) +! +! ! Control points location and structrual velocity + call Wings_Panelling(u%WingsMesh, p, m, ErrStat2, ErrMsg2); + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +! +! ! if we are on a correction step, CalcOutput may be called again with different inputs +! ! Compute m%Gamma_LL +! CALL Wings_ComputeCirculation(t, m%Gamma_LL, z%Gamma_LL, u, p, x, m, AFInfo, ErrStat2, ErrMsg2, 0); if(Failed()) return ! For plotting only + !--- + + ! Induction on the lifting line control point + ! Compute m%Vind_LL + m%Vind_LL=-9999.0_ReKi + call LiftingLineInducedVelocities(m%CP_LL, p, x, 1, m, m%Vind_LL, ErrStat2, ErrMsg2); + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Induction on the mesh points (AeroDyn nodes) + n=p%nSpan + y%Vind(1:3,:,:) = 0.0_ReKi + do iW=1,p%nWings + ! --- Linear interpolation for interior points and extrapolations at boundaries + call interpextrap_cp2node(p%s_CP_LL(:,iW), m%Vind_LL(1,:,iW), p%s_LL(:,iW), y%Vind(1,:,iW)) + call interpextrap_cp2node(p%s_CP_LL(:,iW), m%Vind_LL(2,:,iW), p%s_LL(:,iW), y%Vind(2,:,iW)) + call interpextrap_cp2node(p%s_CP_LL(:,iW), m%Vind_LL(3,:,iW), p%s_LL(:,iW), y%Vind(3,:,iW)) + enddo +end subroutine CalcOutputForAD !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. -subroutine FVW_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, ErrMsg ) +subroutine FVW_CalcOutput(t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, ErrMsg) use FVW_VTK, only: set_vtk_coordinate_transform use FVW_VortexTools, only: interpextrap_cp2node real(DbKi), intent(in ) :: t !< Current simulation time in seconds @@ -1197,16 +1268,13 @@ subroutine FVW_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local variables - integer(IntKi) :: iW, n, i0, i1, i2, iGrid integer(IntKi) :: ErrStat2 - logical :: bGridOutNeeded character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'FVW_CalcOutput' logical :: bOverCycling - + real(ReKi) :: fact ErrStat = ErrID_None ErrMsg = "" - if (DEV_VERSION) then print'(A,F10.3,A,L1,A,I0,A,I0)','CalcOutput t:',t,' ',m%FirstCall,' nNW:',m%nNW,' nFW:',m%nFW endif @@ -1214,89 +1282,68 @@ subroutine FVW_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, ! OverCycling DTfvw> DTaero bOverCycling = p%DTfvw > p%DTaero - ! Distribute the Wind we requested to Inflow wind to storage Misc arrays - ! TODO ANDY: replace with direct call to inflow wind at m%CP_LL location - CALL DistributeRequestedWind_LL(u%V_wind, p, m%Vwnd_LL) - - ! Control points location and structrual velocity - CALL Wings_Panelling(u%WingsMesh, p, m, ErrStat2, ErrMsg2); if(Failed()) return - - ! if we are on a correction step, CalcOutput may be called again with different inputs - ! Compute m%Gamma_LL - CALL Wings_ComputeCirculation(t, m%Gamma_LL, z%Gamma_LL, u, p, x, m, AFInfo, ErrStat2, ErrMsg2, 0); if(Failed()) return ! For plotting only - - ! Induction on the lifting line control point - ! Set m%Vind_LL - m%Vind_LL=-9999.0_ReKi - call LiftingLineInducedVelocities(p, x, 1, m, ErrStat2, ErrMsg2); if(Failed()) return + ! Compute induced velocity at AD nodes + call CalcOutputForAD(t,u,p,x,y,m,AFInfo, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Export to VTK + call WriteVTKOutputs() - ! Induction on the mesh points (AeroDyn nodes) - n=p%nSpan - y%Vind(1:3,:,:) = 0.0_ReKi - do iW=1,p%nWings - ! --- Linear interpolation for interior points and extrapolations at boundaries - call interpextrap_cp2node(p%s_CP_LL(:,iW), m%Vind_LL(1,:,iW), p%s_LL(:,iW), y%Vind(1,:,iW)) - call interpextrap_cp2node(p%s_CP_LL(:,iW), m%Vind_LL(2,:,iW), p%s_LL(:,iW), y%Vind(2,:,iW)) - call interpextrap_cp2node(p%s_CP_LL(:,iW), m%Vind_LL(3,:,iW), p%s_LL(:,iW), y%Vind(3,:,iW)) - enddo +contains - ! --- Write to local VTK at fps requested - if (m%VTKStep==-1) then - m%VTKStep = 0 ! Has never been called, special handling for init - else - m%VTKStep = m%iStep+1 ! We use glue code step number for outputs - endif - if (p%WrVTK==1) then - if (m%FirstCall) then - call MKDIR(p%VTK_OutFileRoot) - endif - ! For plotting only - m%Vtot_LL = m%Vind_LL + m%Vwnd_LL - m%Vstr_LL - if (DEV_VERSION) then - call print_mean_3d(m%Vind_LL,'Mean induced vel. LL') - call print_mean_3d(m%Vtot_LL,'Mean relativevel. LL') + !> Write to local VTK at fps requested + subroutine WriteVTKOutputs() + logical :: bGridOutNeeded + integer(IntKi) :: iW, iGrid + integer(IntKi) :: nSeg, nSegP + if (m%VTKStep==-1) then + m%VTKStep = 0 ! Has never been called, special handling for init + else + m%VTKStep = m%iStep+1 ! We use glue code step number for outputs endif - if ( ( t - m%VTKlastTime ) >= p%DTvtk*OneMinusEpsilon ) then - m%VTKlastTime = t - if ((p%VTKCoord==2).or.(p%VTKCoord==3)) then - ! Hub reference coordinates, for export only, ALL VTK Will be exported in this coordinate system! - ! Note: hubOrientation and HubPosition are optional, but required for bladeFrame==TRUE - call WrVTK_FVW(p, x, z, m, trim(p%VTK_OutFileBase)//'FVW_Hub', m%VTKStep, 9, bladeFrame=.TRUE., & - HubOrientation=real(u%HubOrientation,ReKi),HubPosition=real(u%HubPosition,ReKi)) + if (p%WrVTK==1) then + if (m%FirstCall) then + call MKDIR(p%VTK_OutFileRoot) endif - if ((p%VTKCoord==1).or.(p%VTKCoord==3)) then - ! Global coordinate system, ALL VTK will be exported in global - call WrVTK_FVW(p, x, z, m, trim(p%VTK_OutFileBase)//'FVW_Glb', m%VTKStep, 9, bladeFrame=.FALSE.) + ! For plotting only + call PackPanelsToSegments(p, x, 1, (p%ShearModel==idShearMirror), m%nNW, m%nFW, m%Sgmt%Connct, m%Sgmt%Points, m%Sgmt%Gamma, m%Sgmt%Epsilon, nSeg, nSegP) + m%Vtot_LL = m%Vind_LL + m%Vwnd_LL - m%Vstr_LL + if (DEV_VERSION) then + call print_mean_3d(m%Vind_LL,'Mean induced vel. LL') + call print_mean_3d(m%Vtot_LL,'Mean relativevel. LL') + endif + if ( ( t - m%VTKlastTime ) >= p%DTvtk*OneMinusEpsilon ) then + m%VTKlastTime = t + if ((p%VTKCoord==2).or.(p%VTKCoord==3)) then + ! Hub reference coordinates, for export only, ALL VTK Will be exported in this coordinate system! + ! Note: hubOrientation and HubPosition are optional, but required for bladeFrame==TRUE + call WrVTK_FVW(p, x, z, m, trim(p%VTK_OutFileBase)//'FVW_Hub', m%VTKStep, 9, bladeFrame=.TRUE., & + HubOrientation=real(u%HubOrientation,ReKi),HubPosition=real(u%HubPosition,ReKi)) + endif + if ((p%VTKCoord==1).or.(p%VTKCoord==3)) then + ! Global coordinate system, ALL VTK will be exported in global + call WrVTK_FVW(p, x, z, m, trim(p%VTK_OutFileBase)//'FVW_Glb', m%VTKStep, 9, bladeFrame=.FALSE.) + endif endif endif - endif - ! --- Write VTK grids - if (p%nGridOut>0) then - if (m%FirstCall) then - call MKDIR(p%VTK_OutFileRoot) - endif - ! Distribute the Wind we requested to Inflow wind to storage Misc arrays - ! TODO ANDY: replace with direct call to inflow wind at Grid points - CALL DistributeRequestedWind_Grid(u%V_wind, p, m) - do iGrid=1,p%nGridOut - if ( ( t - m%GridOutputs(iGrid)%tLastOutput) >= m%GridOutputs(iGrid)%DTout * OneMinusEpsilon ) then - ! Compute induced velocity on grid, TODO use the same Tree for all CalcOutput - call InducedVelocitiesAll_OnGrid(m%GridOutputs(iGrid), p, x, m, ErrStat2, ErrMsg2); if (Failed()) return - - m%GridOutputs(iGrid)%tLastOutput = t - call WrVTK_FVW_Grid(p, x, z, m, iGrid, trim(p%VTK_OutFileBase)//'FVW_Grid', m%VTKStep, 9) + ! --- Write VTK grids + if (p%nGridOut>0) then + if (m%FirstCall) then + call MKDIR(p%VTK_OutFileRoot) endif - enddo - - endif - - -contains - - logical function Failed() - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'FVW_CalcOutput') - Failed = ErrStat >= AbortErrLev - end function Failed + ! Distribute the Wind we requested to Inflow wind to storage Misc arrays + ! TODO ANDY: replace with direct call to inflow wind at Grid points + CALL DistributeRequestedWind_Grid(u%V_wind, p, m) + do iGrid=1,p%nGridOut + if ( ( t - m%GridOutputs(iGrid)%tLastOutput) >= m%GridOutputs(iGrid)%DTout * OneMinusEpsilon ) then + ! Compute induced velocity on grid, TODO use the same Tree for all CalcOutput + call InducedVelocitiesAll_OnGrid(m%GridOutputs(iGrid), p, x, m, ErrStat2, ErrMsg2); + m%GridOutputs(iGrid)%tLastOutput = t + call WrVTK_FVW_Grid(p, x, z, m, iGrid, trim(p%VTK_OutFileBase)//'FVW_Grid', m%VTKStep, 9) + endif + enddo + endif + end subroutine WriteVTKOutputs end subroutine FVW_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- @@ -1414,7 +1461,7 @@ subroutine CalculateInputsAndOtherStatesForUA(InputIndex, u, p, x, xd, z, OtherS ! NOTE: this is expensive since it's an output for FVW but here we have to use it for UA ! Set m%Vind_LL m%Vind_LL=-9999.0_ReKi - call LiftingLineInducedVelocities(p, x, 1, m, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'UA_UpdateState_Wrapper'); if (ErrStat >= AbortErrLev) return + call LiftingLineInducedVelocities(m%CP_LL, p, x, 1, m, m%Vind_LL, ErrStat2, ErrMsg2); call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'UA_UpdateState_Wrapper'); if (ErrStat >= AbortErrLev) return allocate(Vind_node(3,1:p%nSpan+1)) do j = 1,p%nWings diff --git a/modules/aerodyn/src/FVW_Registry.txt b/modules/aerodyn/src/FVW_Registry.txt index 7fcf05471b..fed2fd080e 100644 --- a/modules/aerodyn/src/FVW_Registry.txt +++ b/modules/aerodyn/src/FVW_Registry.txt @@ -93,6 +93,10 @@ typedef ^ ^ ReKi # TODO UA typedef ^ ^ UA_ContinuousStateType UA - - - "states for UnsteadyAero" - +# ........ Output ............ +# FVW_OutputType +typedef FVW/FVW OutputType ReKi Vind ::: - - "TODO mesh - Induced velocity vector at AeroDyn nodes. " - + # ....... MiscVars ............ # FVW_MiscVarType @@ -178,11 +182,6 @@ typedef ^ ^ ReKi typedef ^ ^ ReKi Vwnd_LLMP {:}{:}{:} - - "Disturbed wind at LL mesh points (not CP), for UA only" - typedef ^ ^ ReKi omega_z {:}{:} - - "rotation of no-sweep-pitch-twist coordinate system around z (for CDBEMT and CUA)" "rad/s" -# ........ Output ............ -# FVW_OutputType -typedef FVW/FVW OutputType ReKi Vind ::: - - "TODO mesh - Induced velocity vector. " - -typedef ^ ^ ReKi Cl_KJ :: - - "Lift coefficient from circulation (Kutta-Joukowski)" - - #.......... DiscreteStateType ...... # FVW_DiscreteStateType diff --git a/modules/aerodyn/src/FVW_Subs.f90 b/modules/aerodyn/src/FVW_Subs.f90 index dd0a5abf86..3c98b39af1 100644 --- a/modules/aerodyn/src/FVW_Subs.f90 +++ b/modules/aerodyn/src/FVW_Subs.f90 @@ -617,12 +617,12 @@ pure integer(IntKi) function CountCPs(p, nNW, nFWEff) result(nCPs) end function CountCPs -subroutine PackPanelsToSegments(p, m, x, iDepthStart, bMirror, SegConnct, SegPoints, SegGamma, SegEpsilon, nSeg, nSegP) +subroutine PackPanelsToSegments(p, x, iDepthStart, bMirror, nNW, nFW, SegConnct, SegPoints, SegGamma, SegEpsilon, nSeg, nSegP) type(FVW_ParameterType), intent(in ) :: p !< Parameters - type(FVW_MiscVarType), intent(in ) :: m !< Initial misc/optimization variables type(FVW_ContinuousStateType), intent(in ) :: x !< States integer(IntKi), intent(in ) :: iDepthStart !< Index where we start packing for NW panels logical, intent(in ) :: bMirror !< Mirror the vorticity wrt the ground + integer(IntKi), intent(in ) :: nNW, NFW !< Number of near/far wake panels integer(IntKi),dimension(:,:), intent(inout) :: SegConnct !< Segment connectivity real(ReKi), dimension(:,:), intent(inout) :: SegPoints !< Segment Points real(ReKi), dimension(:) , intent(inout) :: SegGamma !< Segment Circulation @@ -635,11 +635,11 @@ subroutine PackPanelsToSegments(p, m, x, iDepthStart, bMirror, SegConnct, SegPoi ! If the FW contains Shed vorticity, we include the last shed vorticity form the NW, orhtwerise, we don't! ! It's important not to include it, otherwise a strong vortex will be present there with no compensating vorticity from the FW - LastNWShed = (p%FWShedVorticity ) .or. ((.not.p%FWShedVorticity) .and. (m%nNW0) then ! Nullifying for safety @@ -651,15 +651,15 @@ subroutine PackPanelsToSegments(p, m, x, iDepthStart, bMirror, SegConnct, SegPoi iHeadC=1 if (nCNW>0) then do iW=1,p%nWings - call LatticeToSegments(x%r_NW(1:3,:,1:m%nNW+1,iW), x%Gamma_NW(:,1:m%nNW,iW), x%Eps_NW(1:3,:,1:m%nNW,iW), iDepthStart, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC, .True., LastNWShed ) + call LatticeToSegments(x%r_NW(1:3,:,1:nNW+1,iW), x%Gamma_NW(:,1:nNW,iW), x%Eps_NW(1:3,:,1:nNW,iW), iDepthStart, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC, .True., LastNWShed ) enddo endif - if (m%nFW>0) then + if (nFW>0) then iHeadC_bkp = iHeadC do iW=1,p%nWings - call LatticeToSegments(x%r_FW(1:3,:,1:m%nFW+1,iW), x%Gamma_FW(:,1:m%nFW,iW), x%Eps_FW(1:3,:,1:m%nFW,iW), 1, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC , p%FWShedVorticity, p%FWShedVorticity) + call LatticeToSegments(x%r_FW(1:3,:,1:nFW+1,iW), x%Gamma_FW(:,1:nFW,iW), x%Eps_FW(1:3,:,1:nFW,iW), 1, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC , p%FWShedVorticity, p%FWShedVorticity) enddo - SegConnct(3,iHeadC_bkp:) = SegConnct(3,iHeadC_bkp:) + m%nNW ! Increasing iDepth (or age) to account for NW + SegConnct(3,iHeadC_bkp:) = SegConnct(3,iHeadC_bkp:) + nNW ! Increasing iDepth (or age) to account for NW endif if (DEV_VERSION) then ! Safety checks @@ -672,7 +672,6 @@ subroutine PackPanelsToSegments(p, m, x, iDepthStart, bMirror, SegConnct, SegPoi STOP ! Keep me. The check will be removed once the code is well established endif if (any(SegPoints(3,:)<-99._ReKi)) then - call print_x_NW_FW(p,m,x,'pack') print*,'PackPanelsToSegments: some segments are NAN' STOP ! Keep me. The check will be removed once the code is well established endif @@ -909,7 +908,7 @@ subroutine InducedVelocitiesAll_Init(p, x, m, Sgmt, Part, Tree, ErrStat, ErrMsg bMirror = p%ShearModel==idShearMirror ! Whether or not we mirror the vorticity wrt ground ! --- Packing all vortex elements into a list of segments - call PackPanelsToSegments(p, m, x, 1, bMirror, Sgmt%Connct, Sgmt%Points, Sgmt%Gamma, Sgmt%Epsilon, nSeg, nSegP) + call PackPanelsToSegments(p, x, 1, bMirror, m%nNW, m%nFW, Sgmt%Connct, Sgmt%Points, Sgmt%Gamma, Sgmt%Epsilon, nSeg, nSegP) Sgmt%RegFunction=p%RegFunction Sgmt%nAct = nSeg Sgmt%nActP = nSegP @@ -1097,11 +1096,13 @@ end subroutine WakeInducedVelocities !> Compute induced velocities from all vortex elements onto the lifting line control points !! In : x%r_NW, x%r_FW, x%Gamma_NW, x%Gamma_FW !! Out: m%Vind_LL -subroutine LiftingLineInducedVelocities(p, x, iDepthStart, m, ErrStat, ErrMsg) +subroutine LiftingLineInducedVelocities(CP_LL, p, x, iDepthStart, m, Vind_LL, ErrStat, ErrMsg) + real(ReKi), dimension(:,:,:), intent(in ) :: CP_LL !< Control points where velocity is to be evaluated type(FVW_ParameterType), intent(in ) :: p !< Parameters type(FVW_ContinuousStateType), intent(in ) :: x !< States integer(IntKi), intent(in ) :: iDepthStart !< Index where we start packing for NW panels type(FVW_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables + real(ReKi), dimension(:,:,:), intent( out) :: Vind_LL !< Control points where velocity is to be evaluated ! Local variables integer(IntKi) :: iW, nSeg, nSegP, nCPs, iHeadP real(ReKi), dimension(:,:), allocatable :: CPs !< ControlPoints @@ -1111,16 +1112,16 @@ subroutine LiftingLineInducedVelocities(p, x, iDepthStart, m, ErrStat, ErrMsg) logical :: bMirror ErrStat = ErrID_None ErrMsg = "" - m%Vind_LL = -9999._ReKi !< Safety + Vind_LL = -9999._ReKi !< Safety bMirror = p%ShearModel==idShearMirror ! Whether or not we mirror the vorticity wrt ground ! --- Packing all vortex elements into a list of segments - call PackPanelsToSegments(p, m, x, iDepthStart, bMirror, m%Sgmt%Connct, m%Sgmt%Points, m%Sgmt%Gamma, m%Sgmt%Epsilon, nSeg, nSegP) + call PackPanelsToSegments(p, x, iDepthStart, bMirror, m%nNW, m%nFW, m%Sgmt%Connct, m%Sgmt%Points, m%Sgmt%Gamma, m%Sgmt%Epsilon, nSeg, nSegP) ! --- Computing induced velocity if (nSegP==0) then nCPs=0 - m%Vind_LL = 0.0_ReKi + Vind_LL = 0.0_ReKi if (DEV_VERSION) then print'(A,I0,A,I0,A,I0,A)','Induction - nSeg:',nSeg,' - nSegP:',nSegP, ' - nCPs:',nCPs, ' -> No induction' endif @@ -1145,7 +1146,7 @@ subroutine LiftingLineInducedVelocities(p, x, iDepthStart, m, ErrStat, ErrMsg) subroutine PackLiftingLinePoints() iHeadP=1 do iW=1,p%nWings - CALL LatticeToPoints(m%CP_LL(1:3,:,iW:iW), 1, CPs, iHeadP) + CALL LatticeToPoints(CP_LL(1:3,:,iW:iW), 1, CPs, iHeadP) enddo if (DEV_VERSION) then if ((iHeadP-1)/=size(CPs,2)) then @@ -1160,7 +1161,7 @@ subroutine PackLiftingLinePoints() subroutine UnPackLiftingLineVelocities() iHeadP=1 do iW=1,p%nWings - CALL VecToLattice(Uind, 1, m%Vind_LL(1:3,:,iW:iW), iHeadP) + CALL VecToLattice(Uind, 1, Vind_LL(1:3,:,iW:iW), iHeadP) enddo if (DEV_VERSION) then if ((iHeadP-1)/=size(Uind,2)) then diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index d09ae406c2..9e538e4b61 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -122,6 +122,11 @@ MODULE FVW_Types TYPE(UA_ContinuousStateType) :: UA !< states for UnsteadyAero [-] END TYPE FVW_ContinuousStateType ! ======================= +! ========= FVW_OutputType ======= + TYPE, PUBLIC :: FVW_OutputType + REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vind !< TODO mesh - Induced velocity vector at AeroDyn nodes. [-] + END TYPE FVW_OutputType +! ======================= ! ========= FVW_MiscVarType ======= TYPE, PUBLIC :: FVW_MiscVarType LOGICAL :: FirstCall !< True if this is the first call to update state (used in CalcOutput) [-] @@ -197,12 +202,6 @@ MODULE FVW_Types REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: omega_z !< rotation of no-sweep-pitch-twist coordinate system around z (for CDBEMT and CUA) [rad/s] END TYPE FVW_InputType ! ======================= -! ========= FVW_OutputType ======= - TYPE, PUBLIC :: FVW_OutputType - REAL(ReKi) , DIMENSION(:,:,:), ALLOCATABLE :: Vind !< TODO mesh - Induced velocity vector. [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Cl_KJ !< Lift coefficient from circulation (Kutta-Joukowski) [-] - END TYPE FVW_OutputType -! ======================= ! ========= FVW_DiscreteStateType ======= TYPE, PUBLIC :: FVW_DiscreteStateType REAL(ReKi) :: NULL !< Empty to satisfy framework [-] @@ -2481,6 +2480,208 @@ SUBROUTINE FVW_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE FVW_UnPackContState + SUBROUTINE FVW_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FVW_OutputType), INTENT(IN) :: SrcOutputData + TYPE(FVW_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyOutput' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcOutputData%Vind)) THEN + i1_l = LBOUND(SrcOutputData%Vind,1) + i1_u = UBOUND(SrcOutputData%Vind,1) + i2_l = LBOUND(SrcOutputData%Vind,2) + i2_u = UBOUND(SrcOutputData%Vind,2) + i3_l = LBOUND(SrcOutputData%Vind,3) + i3_u = UBOUND(SrcOutputData%Vind,3) + IF (.NOT. ALLOCATED(DstOutputData%Vind)) THEN + ALLOCATE(DstOutputData%Vind(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vind.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputData%Vind = SrcOutputData%Vind +ENDIF + END SUBROUTINE FVW_CopyOutput + + SUBROUTINE FVW_DestroyOutput( OutputData, ErrStat, ErrMsg ) + TYPE(FVW_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyOutput' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(OutputData%Vind)) THEN + DEALLOCATE(OutputData%Vind) +ENDIF + END SUBROUTINE FVW_DestroyOutput + + SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! Vind allocated yes/no + IF ( ALLOCATED(InData%Vind) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! Vind upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Vind) ! Vind + 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%Vind) ) 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%Vind,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%Vind,3), UBOUND(InData%Vind,3) + DO i2 = LBOUND(InData%Vind,2), UBOUND(InData%Vind,2) + DO i1 = LBOUND(InData%Vind,1), UBOUND(InData%Vind,1) + ReKiBuf(Re_Xferred) = InData%Vind(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + END SUBROUTINE FVW_PackOutput + + SUBROUTINE FVW_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(FVW_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 + 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 = 'FVW_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 ! Vind 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%Vind)) DEALLOCATE(OutData%Vind) + ALLOCATE(OutData%Vind(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%Vind.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%Vind,3), UBOUND(OutData%Vind,3) + DO i2 = LBOUND(OutData%Vind,2), UBOUND(OutData%Vind,2) + DO i1 = LBOUND(OutData%Vind,1), UBOUND(OutData%Vind,1) + OutData%Vind(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + END SUBROUTINE FVW_UnPackOutput + SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(FVW_MiscVarType), INTENT(IN) :: SrcMiscData TYPE(FVW_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -6993,273 +7194,6 @@ SUBROUTINE FVW_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg END IF END SUBROUTINE FVW_UnPackInput - SUBROUTINE FVW_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FVW_OutputType), INTENT(IN) :: SrcOutputData - TYPE(FVW_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) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_CopyOutput' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputData%Vind)) THEN - i1_l = LBOUND(SrcOutputData%Vind,1) - i1_u = UBOUND(SrcOutputData%Vind,1) - i2_l = LBOUND(SrcOutputData%Vind,2) - i2_u = UBOUND(SrcOutputData%Vind,2) - i3_l = LBOUND(SrcOutputData%Vind,3) - i3_u = UBOUND(SrcOutputData%Vind,3) - IF (.NOT. ALLOCATED(DstOutputData%Vind)) THEN - ALLOCATE(DstOutputData%Vind(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Vind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Vind = SrcOutputData%Vind -ENDIF -IF (ALLOCATED(SrcOutputData%Cl_KJ)) THEN - i1_l = LBOUND(SrcOutputData%Cl_KJ,1) - i1_u = UBOUND(SrcOutputData%Cl_KJ,1) - i2_l = LBOUND(SrcOutputData%Cl_KJ,2) - i2_u = UBOUND(SrcOutputData%Cl_KJ,2) - IF (.NOT. ALLOCATED(DstOutputData%Cl_KJ)) THEN - ALLOCATE(DstOutputData%Cl_KJ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputData%Cl_KJ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputData%Cl_KJ = SrcOutputData%Cl_KJ -ENDIF - END SUBROUTINE FVW_CopyOutput - - SUBROUTINE FVW_DestroyOutput( OutputData, ErrStat, ErrMsg ) - TYPE(FVW_OutputType), INTENT(INOUT) :: OutputData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FVW_DestroyOutput' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OutputData%Vind)) THEN - DEALLOCATE(OutputData%Vind) -ENDIF -IF (ALLOCATED(OutputData%Cl_KJ)) THEN - DEALLOCATE(OutputData%Cl_KJ) -ENDIF - END SUBROUTINE FVW_DestroyOutput - - SUBROUTINE FVW_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(FVW_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 = 'FVW_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 ! Vind allocated yes/no - IF ( ALLOCATED(InData%Vind) ) THEN - Int_BufSz = Int_BufSz + 2*3 ! Vind upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vind) ! Vind - END IF - Int_BufSz = Int_BufSz + 1 ! Cl_KJ allocated yes/no - IF ( ALLOCATED(InData%Cl_KJ) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Cl_KJ upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Cl_KJ) ! Cl_KJ - 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%Vind) ) 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%Vind,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vind,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vind,3) - Int_Xferred = Int_Xferred + 2 - - DO i3 = LBOUND(InData%Vind,3), UBOUND(InData%Vind,3) - DO i2 = LBOUND(InData%Vind,2), UBOUND(InData%Vind,2) - DO i1 = LBOUND(InData%Vind,1), UBOUND(InData%Vind,1) - ReKiBuf(Re_Xferred) = InData%Vind(i1,i2,i3) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Cl_KJ) ) 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%Cl_KJ,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cl_KJ,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Cl_KJ,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cl_KJ,2) - Int_Xferred = Int_Xferred + 2 - - DO i2 = LBOUND(InData%Cl_KJ,2), UBOUND(InData%Cl_KJ,2) - DO i1 = LBOUND(InData%Cl_KJ,1), UBOUND(InData%Cl_KJ,1) - ReKiBuf(Re_Xferred) = InData%Cl_KJ(i1,i2) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FVW_PackOutput - - SUBROUTINE FVW_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(FVW_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 - 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 = 'FVW_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 ! Vind 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%Vind)) DEALLOCATE(OutData%Vind) - ALLOCATE(OutData%Vind(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%Vind.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i3 = LBOUND(OutData%Vind,3), UBOUND(OutData%Vind,3) - DO i2 = LBOUND(OutData%Vind,2), UBOUND(OutData%Vind,2) - DO i1 = LBOUND(OutData%Vind,1), UBOUND(OutData%Vind,1) - OutData%Vind(i1,i2,i3) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cl_KJ 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%Cl_KJ)) DEALLOCATE(OutData%Cl_KJ) - ALLOCATE(OutData%Cl_KJ(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cl_KJ.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Cl_KJ,2), UBOUND(OutData%Cl_KJ,2) - DO i1 = LBOUND(OutData%Cl_KJ,1), UBOUND(OutData%Cl_KJ,1) - OutData%Cl_KJ(i1,i2) = ReKiBuf(Re_Xferred) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END IF - END SUBROUTINE FVW_UnPackOutput - SUBROUTINE FVW_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(FVW_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(FVW_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -9499,14 +9433,6 @@ SUBROUTINE FVW_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg END DO END DO END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cl_KJ) .AND. ALLOCATED(y1%Cl_KJ)) THEN - DO i2 = LBOUND(y_out%Cl_KJ,2),UBOUND(y_out%Cl_KJ,2) - DO i1 = LBOUND(y_out%Cl_KJ,1),UBOUND(y_out%Cl_KJ,1) - b = -(y1%Cl_KJ(i1,i2) - y2%Cl_KJ(i1,i2)) - y_out%Cl_KJ(i1,i2) = y1%Cl_KJ(i1,i2) + b * ScaleFactor - END DO - END DO END IF ! check if allocated END SUBROUTINE FVW_Output_ExtrapInterp1 @@ -9579,15 +9505,6 @@ SUBROUTINE FVW_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er END DO END DO END DO -END IF ! check if allocated -IF (ALLOCATED(y_out%Cl_KJ) .AND. ALLOCATED(y1%Cl_KJ)) THEN - DO i2 = LBOUND(y_out%Cl_KJ,2),UBOUND(y_out%Cl_KJ,2) - DO i1 = LBOUND(y_out%Cl_KJ,1),UBOUND(y_out%Cl_KJ,1) - b = (t(3)**2*(y1%Cl_KJ(i1,i2) - y2%Cl_KJ(i1,i2)) + t(2)**2*(-y1%Cl_KJ(i1,i2) + y3%Cl_KJ(i1,i2)))* scaleFactor - c = ( (t(2)-t(3))*y1%Cl_KJ(i1,i2) + t(3)*y2%Cl_KJ(i1,i2) - t(2)*y3%Cl_KJ(i1,i2) ) * scaleFactor - y_out%Cl_KJ(i1,i2) = y1%Cl_KJ(i1,i2) + b + c * t_out - END DO - END DO END IF ! check if allocated END SUBROUTINE FVW_Output_ExtrapInterp2 diff --git a/modules/aerodyn/src/FVW_Wings.f90 b/modules/aerodyn/src/FVW_Wings.f90 index e5ace16dc1..8954b4d818 100644 --- a/modules/aerodyn/src/FVW_Wings.f90 +++ b/modules/aerodyn/src/FVW_Wings.f90 @@ -186,7 +186,6 @@ subroutine Wings_Panelling(Meshes, p, m, ErrStat, ErrMsg ) m%diag_LL(iSpan, iW) = TwoNorm(DP3) end do enddo -!FIXME: does it make sense to use the position mesh for this info? ! --- Lifting Line/ Bound Circulation panel ! For now: goes from 1/4 chord to TE ! More panelling options may be considered in the future @@ -342,7 +341,7 @@ subroutine Wings_ComputeCirculationPolarData(Gamma_LL, Gamma_LL_prev, p, x, m, A call AllocAry(Vcst, 3, p%nSpan, p%nWings, 'Vcst', ErrStat2, ErrMsg2); if(Failed()) return; ! Set m%Vind_LL Induced velocity from Known wake only (after iNWStart+1) - call LiftingLineInducedVelocities(p, x, iNWStart+1, m, ErrStat2, ErrMsg2); if(Failed()) return; + call LiftingLineInducedVelocities(m%CP_LL, p, x, iNWStart+1, m, m%Vind_LL, ErrStat2, ErrMsg2); if(Failed()) return; Vcst = m%Vind_LL + m%Vwnd_LL - m%Vstr_ll From 91db72f45d1509f7d1d2af60d76d96810d0cb0b6 Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Mon, 25 Jan 2021 15:53:53 -0700 Subject: [PATCH 12/27] OLAF: fixed issue introduced 4 commits before, input wind is no reliable at t, needs to call inflowwind within OLAF --- modules/aerodyn/src/FVW.f90 | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index 3e3744643e..7b0062fe46 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -595,6 +595,10 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m ! --- Integration between t and t+DTfvw if (m%ComputeWakeInduced) then + + ! TODO TODO: this should be in CCSD, but memory is changing between time steps, so for now we have to use u(1).. + CALL DistributeRequestedWind_NWFW(u(1)%V_wind, p, m%Vwnd_NW, m%Vwnd_FW) + if (bOverCycling) then ! Store states at t, and use this opportunity to store outputs at t call FVW_CopyContState(x, m%x1, 0, ErrStat2, ErrMsg2) ! Backup current state at t @@ -763,7 +767,9 @@ subroutine FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSt ! Distribute the Wind we requested to Inflow wind to storage Misc arrays ! TODO ANDY: replace with direct call to inflow wind at r_NW and r_FW locations - CALL DistributeRequestedWind_NWFW(u%V_wind, p, m%Vwnd_NW, m%Vwnd_FW) + ! NOTE: this has been commented out due to some information missing at some times (and memoery reindexing) + ! Call to inflow wind sould be done here at actual positions. + !CALL DistributeRequestedWind_NWFW(u%V_wind, p, m%Vwnd_NW, m%Vwnd_FW) ! Only calculate freewake after start time and if on a timestep when it should be calculated. if ((t>= p%FreeWakeStart)) then From ba85b1e32995e4a021df19d61e8801f1d73487c5 Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Mon, 25 Jan 2021 16:33:05 -0700 Subject: [PATCH 13/27] OLAF: regularization as function of span and chord --- modules/aerodyn/src/FVW.f90 | 2 +- modules/aerodyn/src/FVW_IO.f90 | 4 +- modules/aerodyn/src/FVW_Subs.f90 | 110 ++++++++++++++----------------- 3 files changed, 53 insertions(+), 63 deletions(-) diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index 7b0062fe46..882c43a242 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -848,7 +848,6 @@ subroutine FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSt if(Failed()) return endif if (p%WakeRegMethod==idRegConstant) then - !SegEpsilon=p%WakeRegParam dxdt%Eps_NW(1:3, :, :, :)=0.0_ReKi dxdt%Eps_FW(1:3, :, :, :)=0.0_ReKi @@ -863,6 +862,7 @@ subroutine FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSt ErrStat = ErrID_Fatal ErrMsg ='Regularization method not implemented' endif + dxdt%Eps_NW(1:3,:,1:iNWStart,:) = 0.0_ReKi ! LL and First NW panel epsilon does not change contains logical function Failed() diff --git a/modules/aerodyn/src/FVW_IO.f90 b/modules/aerodyn/src/FVW_IO.f90 index ee2f0ded62..06c7ff3c86 100644 --- a/modules/aerodyn/src/FVW_IO.f90 +++ b/modules/aerodyn/src/FVW_IO.f90 @@ -56,7 +56,7 @@ SUBROUTINE FVW_ReadInputFile( FileName, p, m, Inp, ErrStat, ErrMsg ) CALL ReadCom (UnIn,FileName, '--- Wake regularization header' , ErrStat2,ErrMsg2); if(Failed()) return CALL ReadVarWDefault(UnIn,FileName,Inp%DiffusionMethod ,'DiffusionMethod' ,'',idDiffusionNone , ErrStat2,ErrMsg2); if(Failed())return - CALL ReadVarWDefault(UnIn,FileName,Inp%RegDeterMethod ,'RegDeterMethod' ,'',idRegDeterManual, ErrStat2,ErrMsg2); if(Failed())return + CALL ReadVarWDefault(UnIn,FileName,Inp%RegDeterMethod ,'RegDeterMethod' ,'',idRegDeterConstant, ErrStat2,ErrMsg2); if(Failed())return CALL ReadVarWDefault(UnIn,FileName,Inp%RegFunction ,'RegFunction' ,'',idRegVatistas , ErrStat2,ErrMsg2); if(Failed())return CALL ReadVarWDefault(UnIn,FileName,Inp%WakeRegMethod ,'WakeRegMethod' ,'',idRegConstant , ErrStat2,ErrMsg2); if(Failed())return CALL ReadVar (UnIn,FileName,Inp%WakeRegParam ,'WakeRegParam' ,'' , ErrStat2,ErrMsg2); if(Failed())return @@ -219,6 +219,8 @@ subroutine ReadGridOut(sLine, GridOut) call Conv2UC( StrArray(2) ) if ( index(StrArray(2), "DEFAULT" ) == 1 ) then GridOut%DTout = p%DTfvw + else if ( index(StrArray(2), "ALL" ) == 1 ) then + GridOut%DTout = p%DTaero else if (.not. is_numeric(StrArray(2), GridOut%DTout) ) return endif diff --git a/modules/aerodyn/src/FVW_Subs.f90 b/modules/aerodyn/src/FVW_Subs.f90 index 3c98b39af1..5299f33959 100644 --- a/modules/aerodyn/src/FVW_Subs.f90 +++ b/modules/aerodyn/src/FVW_Subs.f90 @@ -31,9 +31,11 @@ module FVW_SUBS integer(IntKi), parameter :: idRegAge = 3 integer(IntKi), parameter, dimension(2) :: idRegMethodVALID = (/idRegConstant,idRegAge/) ! Regularization determination method - integer(IntKi), parameter :: idRegDeterManual = 0 + integer(IntKi), parameter :: idRegDeterConstant = 0 integer(IntKi), parameter :: idRegDeterAuto = 1 - integer(IntKi), parameter, dimension(2) :: idRegDeterVALID = (/idRegDeterManual, idRegDeterAuto /) + integer(IntKi), parameter :: idRegDeterChord = 2 + integer(IntKi), parameter :: idRegDeterSpan = 3 + integer(IntKi), parameter, dimension(4) :: idRegDeterVALID = (/idRegDeterConstant, idRegDeterAuto, idRegDeterChord, idRegDeterSpan /) ! Shear model integer(IntKi), parameter :: idShearNone = 0 integer(IntKi), parameter :: idShearMirror = 1 @@ -345,8 +347,6 @@ subroutine PropagateWake(p, m, z, x, ErrStat, ErrMsg) x%Gamma_NW(:,1:iNWStart,iW) = -999.9_ReKi ! Nullified enddo endif - x%Eps_NW(1:3,:,iNWStart,:) = p%WakeRegParam ! Second age is always WakeRegParam - x%Eps_NW(1:3,:,1:iNWStart-1,:) = p%WingRegParam ! First age is always WingRegParam (LL) ! Temporary hack for sub-cycling since straight after wkae computation, the wake size will increase ! So we do a "fake" propagation here @@ -712,12 +712,12 @@ subroutine FVW_InitRegularization(x, p, m, ErrStat, ErrMsg) integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local variables - real(ReKi) :: ds_min, ds_max, ds_mean !< min,max and mean of spanwise sections + real(ReKi) :: ds_min, ds_max, ds_mean, ds !< min,max and mean of spanwise sections real(ReKi) :: c_min, c_max, c_mean !< min,max and mean of chord real(ReKi) :: d_min, d_max, d_mean !< min,max and mean of panel diagonal real(ReKi) :: RegParam real(ReKi) :: Span !< "Blade span" - integer :: iW + integer :: iW, iSpan ErrStat = ErrID_None ErrMsg = "" ! --- Compute min max and mean spanwise section lengths @@ -733,6 +733,10 @@ subroutine FVW_InitRegularization(x, p, m, ErrStat, ErrMsg) d_mean = sum (m%diag_LL(:,iW))/(p%nSpan+1) Span = p%s_LL(p%nSpan+1,iW)-p%s_LL(1,iW) RegParam = ds_mean*2 + + ! Default init of reg param + x%Eps_NW(1:3,:,:,:) = 0.0_ReKi + x%Eps_FW(1:3,:,:,:) = 0.0_ReKi if (DEV_VERSION) then write(*,'(A)')'-----------------------------------------------------------------------------------------' write(*,'(A)')'Regularization Info' @@ -743,10 +747,19 @@ subroutine FVW_InitRegularization(x, p, m, ErrStat, ErrMsg) write(*,'(A,1F8.4)') 'RegParam (Recommended) : ',RegParam write(*,'(A,1F8.4)') 'RegParam (Input ) : ',p%WakeRegParam endif - if (p%RegDeterMethod==idRegDeterAuto) then + + if (p%RegDeterMethod==idRegDeterConstant) then + ! Set reg param on wing and first NW + ! NOTE: setting the same in all three directions for now, TODO! + x%Eps_NW(1:3,:,1,:) = p%WingRegParam ! First age is always WingRegParam (LL) + if (p%nNWMax>1) then + x%Eps_NW(1:3,:,2,:) = p%WakeRegParam ! Second age is always WakeRegParam + endif + + else if (p%RegDeterMethod==idRegDeterAuto) then ! TODO this is beta print*,'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' - print*,'!!! NOTE: using optmized wake regularization parameters is still a beta feature!' + print*,'!!! NOTE: using optimized wake regularization parameters is still a beta feature!' print*,'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' p%WakeRegMethod = idRegAge p%RegFunction = idRegVatistas @@ -758,69 +771,47 @@ subroutine FVW_InitRegularization(x, p, m, ErrStat, ErrMsg) write(*,'(A,I0)' ) 'WakeRegMethod : ', p%WakeRegMethod write(*,'(A,I0)' ) 'RegFunction : ', p%RegFunction write(*,'(A,1F8.4)') 'WakeRegParam : ', p%WakeRegParam - write(*,'(A,1F8.4)') 'WingRegParam : ', p%WingRegParam + write(*,'(A,1F8.4)') 'BladeRegParam : ', p%WingRegParam write(*,'(A,1F9.4)') 'CoreSpreadEddyVisc: ', p%CoreSpreadEddyVisc - endif - ! Default init of reg param - x%Eps_NW(1:3,:,:,:) = 0.0_ReKi - x%Eps_FW(1:3,:,:,:) = 0.0_ReKi ! Set reg param on wing and first NW ! NOTE: setting the same in all three directions for now, TODO! x%Eps_NW(1:3,:,1,:) = p%WingRegParam ! First age is always WingRegParam (LL) if (p%nNWMax>1) then x%Eps_NW(1:3,:,2,:) = p%WakeRegParam ! Second age is always WakeRegParam endif - ! KEEP: potentially perform pre-computation here - !if (p%WakeRegMethod==idRegConstant) then - !else if (p%WakeRegMethod==idRegStretching) then - !else if (p%WakeRegMethod==idRegAge) then - !else - ! ErrStat = ErrID_Fatal - ! ErrMsg ='Regularization method not implemented' - !endif -end subroutine FVW_InitRegularization - - -!> Set up regularization parameter based on diffusion method and regularization method -!! NOTE: this should preferably be done at the "panel"/vortex sheet level -subroutine WakeRegularization(p, x, m, SegConnct, SegPoints, SegGamma, SegEpsilon, ErrStat, ErrMsg) - type(FVW_ParameterType), intent(in ) :: p !< Parameters - type(FVW_ContinuousStateType), intent(in ) :: x !< States - type(FVW_MiscVarType), intent(in ) :: m !< Initial misc/optimization variables - integer(IntKi),dimension(:,:) , intent(in ) :: SegConnct !< Segment connectivity - real(ReKi), dimension(:,:) , intent(in ) :: SegPoints !< Segment Points - real(ReKi), dimension(:) , intent(in ) :: SegGamma !< Segment Circulation - real(ReKi), dimension(:) , intent( out) :: SegEpsilon !< Segment regularization parameter - integer(IntKi), intent( out) :: ErrStat !< Error status of the operation - character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - ! Local variables - integer(IntKi) :: iSeg - real(ReKi) :: time - ErrStat = ErrID_None - ErrMsg = "" - ! - if (p%WakeRegMethod==idRegConstant) then - SegEpsilon=p%WakeRegParam - - else if (p%WakeRegMethod==idRegStretching) then - ! TODO - ErrStat = ErrID_Fatal - ErrMsg ='Regularization method not implemented' - if (.false.) print*,m%nNW,x%r_NW(1,1,1,1),SegPoints(1,1),SegGamma(1) ! Needed in the future, Just to avoid unused var warning - - else if (p%WakeRegMethod==idRegAge) then - do iSeg=1,size(SegEpsilon,1) ! loop on segments - time = (SegConnct(3, iSeg)-1) * p%DTfvw ! column 3 contains "iDepth", or "iAge", from 1 to nSteps - SegEpsilon(iSeg) = sqrt( 4._ReKi * CoreSpreadAlpha * p%CoreSpreadEddyVisc * p%KinVisc* time + p%WakeRegParam**2 ) + else if (p%RegDeterMethod==idRegDeterChord) then + ! Using chord to scale the reg param + do iW=1,p%nWings + do iSpan=1,p%nSpan + x%Eps_NW(1:3, iSpan, 1, iW) = p%WingRegParam * p%chord_CP_LL(iSpan, iW) + if (p%nNWMax>1) then + x%Eps_NW(1:3, iSpan, 2, iW) = p%WakeRegParam * p%chord_CP_LL(iSpan, iW) + endif + enddo enddo - else + else if (p%RegDeterMethod==idRegDeterSpan) then + ! Using dr to scale the reg param + do iW=1,p%nWings + do iSpan=1,p%nSpan + ds = p%s_LL(iSpan+1,iW)-p%s_LL(iSpan,iW) + x%Eps_NW(1:3, iSpan, 1, iW) = p%WingRegParam * ds + if (p%nNWMax>1) then + x%Eps_NW(1:3, iSpan, 2, iW) = p%WakeRegParam * ds + endif + enddo + enddo + else ! Should never happen (caught earlier) ErrStat = ErrID_Fatal - ErrMsg ='Regularization method not implemented' + ErrMsg ='Regularization determination method not implemented' endif -end subroutine WakeRegularization + write(*,'(A,2F8.4)') ' WakeReg (min/max) : ', minval(x%Eps_NW(:,:, 1, :)), maxval(x%Eps_NW(:,:, 1, :)) + if (p%nNWMax>1) then + write(*,'(A,2F8.4)') ' BladeReg (min/max): ', minval(x%Eps_NW(:, :, 2, :)), maxval(x%Eps_NW(:, :, 2, :)) + endif +end subroutine FVW_InitRegularization !> Compute induced velocities from all vortex elements onto nPoints @@ -913,9 +904,6 @@ subroutine InducedVelocitiesAll_Init(p, x, m, Sgmt, Part, Tree, ErrStat, ErrMsg Sgmt%nAct = nSeg Sgmt%nActP = nSegP - ! --- Setting up regularization SegEpsilon - !call WakeRegularization(p, x, m, Sgmt%Connct, Sgmt%Points, Sgmt%Gamma, Sgmt%Epsilon(1:nSeg), ErrStat, ErrMsg) - ! --- Converting to particles if ((p%VelocityMethod==idVelocityTree) .or. (p%VelocityMethod==idVelocityPart)) then iHeadP=1 From ea03dffa7039a4af154090b406c10c24ad5b6d3e Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Mon, 25 Jan 2021 16:33:27 -0700 Subject: [PATCH 14/27] OLAF: update of documetation for WEIS improvements --- docs/conf.py | 5 +- .../ExampleFiles/ExampleFile--OLAF.txt | 11 ++- docs/source/user/aerodyn-olaf/InputFiles.rst | 68 +++++++++++++-- docs/source/user/aerodyn-olaf/OLAFTheory.rst | 15 +--- docs/source/user/aerodyn-olaf/OutputFiles.rst | 3 + docs/source/user/aerodyn-olaf/RunningOLAF.rst | 87 ++++++++++++++++++- 6 files changed, 165 insertions(+), 24 deletions(-) diff --git a/docs/conf.py b/docs/conf.py index 35f5cd04c5..63a5cf735c 100644 --- a/docs/conf.py +++ b/docs/conf.py @@ -245,7 +245,10 @@ def runDoxygen(sourcfile, doxyfileIn, doxyfileOut): ] def setup(app): - app.add_css_file('css/math_eq.css') + try: + app.add_css_file('css/math_eq.css') + except: + pass app.add_object_type( "confval", "confval", diff --git a/docs/source/user/aerodyn-olaf/ExampleFiles/ExampleFile--OLAF.txt b/docs/source/user/aerodyn-olaf/ExampleFiles/ExampleFile--OLAF.txt index e0d341697f..05bf188300 100644 --- a/docs/source/user/aerodyn-olaf/ExampleFiles/ExampleFile--OLAF.txt +++ b/docs/source/user/aerodyn-olaf/ExampleFiles/ExampleFile--OLAF.txt @@ -1,7 +1,7 @@ --------------------------- OLAF (cOnvecting LAgrangian Filaments) INPUT FILE ----------------- Free wake input file for the Helix test case --------------------------- GENERAL OPTIONS --------------------------------------------------- -5 IntMethod Integration method {5: Forward Euler 1st order, default: 5} (switch) +5 IntMethod Integration method {1: Runge-Kutta 4th order, 5: Forward Euler 1st order, default: 5} (switch) 0.2 DTfvw Time interval for wake propagation. {default: dtaero} (s) 5 FreeWakeStart Time when wake is free. (-) value = always free. {default: 0.0} (s) 2.0 FullCircStart Time at which full circulation is reached. {default: 0.0} (s) @@ -20,11 +20,11 @@ default FreeWakeLength Wake length that is free [integer] (number of time st False FWShedVorticity Include shed vorticity in the far wake {default: false} ------------------- WAKE REGULARIZATIONS AND DIFFUSION ----------------------------------------- 0 DiffusionMethod Diffusion method to account for viscous effects {0: None, 1: Core Spreading, "default": 0} -0 RegDeterMethod Method to determine the regularization parameters {0: Manual, 1: Optimized, default: 0 } +0 RegDeterMethod Method to determine the regularization parameters {0: Constant, 1: Optimized, 2: Chord-scaled, 3: dr-scaled, default: 0 } 2 RegFunction Viscous diffusion function {0: None, 1: Rankine, 2: LambOseen, 3: Vatistas, 4: Denominator, "default": 3} (switch) 0 WakeRegMethod Wake regularization method {1: Constant, 2: Stretching, 3: Age, default: 1} (switch) -2.0 WakeRegFactor Wake regularization factor (m) -2.0 WingRegFactor Wing regularization factor (m) +2.0 WakeRegFactor Wake regularization factor (m or -) +2.0 BladeRegFactor Blade regularization factor (m or -) 100 CoreSpreadEddyVisc Eddy viscosity in core spreading methods, typical values 1-1000 ------------------- WAKE TREATMENT OPTIONS --------------------------------------------------- False TwrShadowOnWake Include tower flow disturbance effects on wake convection {default:false} [only if TwrPotent or TwrShadow] @@ -39,4 +39,7 @@ False TwrShadowOnWake Include tower flow disturbance effects on wake convec 1 nVTKBlades Number of blades for which VTK files are exported {0: No VTK per blade, n: VTK for blade 1 to n} (-) 2 VTKCoord Coordinate system used for VTK export. {1: Global, 2: Hub, "default": 1} 1 VTK_fps Frame rate for VTK output (frames per second) {"all" for all glue code timesteps, "default" for all OLAF timesteps} [used only if WrVTK=1] +0 nGridOut Number of grid outputs +GridName DTOut XStart XEnd nX YStart YEnd nY ZStart ZEnd nZ +(-) (s) (m) (m) (-) (m) (m) (-) (m) (m) (-) ------------------------------------------------------------------------------------------------ diff --git a/docs/source/user/aerodyn-olaf/InputFiles.rst b/docs/source/user/aerodyn-olaf/InputFiles.rst index 16de76bff6..e6e6d369eb 100644 --- a/docs/source/user/aerodyn-olaf/InputFiles.rst +++ b/docs/source/user/aerodyn-olaf/InputFiles.rst @@ -30,7 +30,8 @@ General Options convect the Lagrangian markers. There are four options: 1) fourth-order Runge-Kutta *[1]*, 2) fourth-order Adams-Bashforth *[2]*, 3) fourth-order Adams-Bashforth-Moulton *[3]*, and 4) first-order forward Euler *[5]*. The -default option is *[5]*. These methods are specified in :numref:`sec:vortconv`. +default option is *[5]*. Currently only options *[1]* and *[5]* are implemented. +These methods are specified in :numref:`sec:vortconv`. **DTfvw** [sec] specifies the time interval at which the module will update the wake. The time interval must be a multiple of the time step used by @@ -111,10 +112,40 @@ for viscous diffusion. There are two options: 1) no diffusion *[0]* and 2) the core-spreading method *[1]*. The default option is *[0]*. **RegDetMethod** [switch] specifies which method is used to determine the -regularization parameters. There are two options: 1) manual *[0]* and 2) -optimized *[1]*. The manual option requires the user to specify the parameters -listed in this subsection. The optimized option determines the parameters for -the user. The default option is *[0]*. +regularization parameters. There are four options: 1) constant *[0]* and 2) +optimized *[1]*, 3) chord *[2]*, and 4) span *[3]*. +The optimized option determines all the parameters in this section for the user. +The optimized option is still work in progress and not recommended. +The constant option requires the user to specify all the parameters present in this section. +The default option is *[0]*. +When **RegDetMethod==0**, the regularization parameters is set constant: + +.. math:: + + r_{c,\text{wake}}(r) = \text{WakeRegParam} + ,\quad + r_{c,\text{blade}}(r) = \text{BladeRegParam} + +When **RegDetMethod==2**, the regularization parameters is set according to the local chord: + +.. math:: + + r_{c,\text{wake}}(r) = \text{WakeRegParam} \cdot c(r) + ,\quad + r_{c,,\text{blade}}(r) = \text{BladeRegParam} \cdot c(r) + +When **RegDetMethod==3**, the regularization parameters is set according to the spanwise discretization: + +.. math:: + + r_{c,\text{wake}}(r) = \text{WakeRegParam} \cdot \Delta r(r) + ,\quad + r_{c,,\text{blade}}(r) = \text{BladeRegParam} \cdot \Delta r(r) + +where :math:`Delta r` is the length of the spanwise station. + + + **RegFunction** [switch] specifies the regularization function used to remove the singularity of the vortex elements, as specified in @@ -128,11 +159,11 @@ radius (i.e., the regularization parameter). There are three options: 1) constant *[1]*, 2) stretching *[2]*, and 3) age *[3]*. The methods are described in :numref:`sec:corerad`. The default option is *[1]*. -**WakeRegParam** [m] specifies the wake regularization parameter, which is the +**WakeRegParam** [m, or -] specifies the wake regularization parameter, which is the regularization value used at the initialization of a vortex element. If the regularization method is “constant”, this value is used throughout the wake. -**BladeRegParam** [m] specifies the bound vorticity regularization parameter, +**BladeRegParam** [m, or -] specifies the bound vorticity regularization parameter, which is the regularization value used for the vorticity elements bound to the blades. @@ -200,6 +231,29 @@ provided value is rounded to the nearest allowable multiple of the time step. The default value is :math:`1/dt_\text{fvw}`. Specifying *VTK_fps* = *[all]*, is equivalent to using the value :math:`1/dt_\text{aero}`. + +**nGridOut** [-] specifies the number of grid outputs. The default value is 0. +The grid outputs are velocity fields that are exported on a regular Cartesian grid. +The are defined using a table that follows on the subsequent lines, with two lines of headers. +The user needs to specify a **GridName**, used for the VTK output filename, a time interval +**DTOut**, and the grid extent in each directions, e.g. **XStart**, **XEnd**, **nX**. +With these options, it is possible to export the velocity field at a point (**nX=nY=nZ=1**), +a line, a plane, or a box. When the variable **DTOut** is set to "all", the AeroDyn time step is used, when it is set to "default", the OLAF time step is used. +An example of input is given below: + +.. code:: + + 3 nGridOut Number of grid outputs + GridName DTOut XStart XEnd nX YStart YEnd nY ZStart ZEnd nZ + (-) (s) (m) (m) (-) (m) (m) (-) (m) (m) (-) + "box" all -200 1000. 5 -150. 150. 20 5. 300. 30 + "vert" default -200 1000. 100 0. 0. 1 5. 300. 30 + "hori" 2.0 -200 1000. 100 -150. 150. 20 100. 100. 1 + +In this example, the first grid, named "box", is exported at the AeroDyn time step, and consists +of a box of shape 5x20x30 and dimension 1200x300x295. The two other grids are vertical and horizontal planes. + + AeroDyn15 Input File -------------------- Input file modifications diff --git a/docs/source/user/aerodyn-olaf/OLAFTheory.rst b/docs/source/user/aerodyn-olaf/OLAFTheory.rst index 0c901f2b3a..b335d788ac 100644 --- a/docs/source/user/aerodyn-olaf/OLAFTheory.rst +++ b/docs/source/user/aerodyn-olaf/OLAFTheory.rst @@ -309,9 +309,10 @@ markers are the end points of the vortex filaments. The Lagrangian convection of the filaments stretches the filaments and thus automatically accounts for strain in the vorticity equation. -At present, a first-order forward Euler method is used to numerically solve the -left-hand side of Eq. :eq:`VortFilCart` for the vortex filament location -(**IntMethod=[5]**). This is an explicit method solved using +At present, the Runge-Kutta 4th order (**IntMethod=[1]**) or first order forward Euler +(**IntMethod=[5]**) methods are implemented to numerically solve the +left-hand side of Eq. :eq:`VortFilCart` for the vortex filament location. +In the case of the first order Euler method, the convection is then simply: Eq. :eq:`eq:Euler`. .. math:: @@ -341,14 +342,6 @@ where :math:`d\psi/dt=\Omega` and :math:`\vec{r}(\psi,\zeta)` is the position vector of a Lagrangian marker, and :math:`\vec{V}[\vec{r}(\psi,\zeta)]` is the velocity. -.. - At present, first-order forward Euler method is used to numerically solve the - left-hand side of Eq. :eq:`VortFil_expanded` for the vortex-filament location - [**IntMethod=5**]. This is an explicit method solved using Eq. :eq:`Euler`. - - .. math:: - \vec{r}(\psi+\Delta\psi_i,\zeta+\Delta\zeta) = \vec{r}(\psi,\zeta) + \vec{V}(\psi,\zeta) \Delta t - :label: Euler Induced Velocity and Velocity Field ----------------------------------- diff --git a/docs/source/user/aerodyn-olaf/OutputFiles.rst b/docs/source/user/aerodyn-olaf/OutputFiles.rst index 8068e64b21..98b5abb980 100644 --- a/docs/source/user/aerodyn-olaf/OutputFiles.rst +++ b/docs/source/user/aerodyn-olaf/OutputFiles.rst @@ -11,6 +11,9 @@ parameter is available in the OLAF input file, in which case the VTK files are written to the folder ``vtk_fvw``, or the primary ``.fst`` file, in which case the VTK files are written to the folder ``vtk``. +Velocity field outputs can be exported as VTK files. The user can control these +outputs using **nGridOut** and the subsequent table. + Results File ------------ diff --git a/docs/source/user/aerodyn-olaf/RunningOLAF.rst b/docs/source/user/aerodyn-olaf/RunningOLAF.rst index 4b91c6150c..d1b8eca429 100644 --- a/docs/source/user/aerodyn-olaf/RunningOLAF.rst +++ b/docs/source/user/aerodyn-olaf/RunningOLAF.rst @@ -1,7 +1,12 @@ + +Working with OLAF +================= + + .. _Running-OLAF: Running OLAF -============ +~~~~~~~~~~~~ As OLAF is a module of OpenFAST, the process of downloading, compiling, and running OLAF is the same as that for OpenFAST. Such instructions are @@ -10,3 +15,83 @@ available in the :ref:`installation` documentation. .. note:: To improve the speed of FVW module, the user may wish to compile with `OpenMP`. To do so, add the `-DOPENMP=ON` option with CMake. + + +Guidelines +~~~~~~~~~~ + +Most options of OLAF can be left to default. The results will depend on the time discretization, wake length, and regularization parameters. We provide guidelines for these parameters in this section, together with a simple python code to compute these parameters. +Please check this section again as we might further refine our guidelines with time. + + +**Time step and wake length** +We recommend to set OLAF's time step (**DTfvw**) such that it corresponds to :math:`\Delta \psi = 6` degrees of one rotor revolution: + +.. math:: + + \Delta t + = \frac{\Delta \psi_\text{rad}}{\times \Omega_\text{rad/s}} + = \frac{\Delta \psi_\text{deg}}{6 \times \Omega_\text{RPM}} + +If the structural solver requires a smaller time step, the time step for the glue code can be set to a different value than **DTfvw** as long as **DTfvw** is a multiple of the glue code time step. + + +We recommend to set the near wake length to the number of time steps needed to reach two rotor revolutions. For the far wake, we recommend 10 rotor revolutions. +The the far wake distance that is free, we recommend to set it to a value somewhere between 25% and 50% of the far wake length, (e.g. 3 revolutions). + +The following python script computes the parameters according to these guidelines. + +.. code:: + + def OLAFParams(omega_rpm, deltaPsiDeg=6, nNWrot=2, nFWrot=10, nFWrotFree=3, nPerAzimuth=None): + """ + Computes recommended time step and wake length based on the rotational speed in RPM + + INPUTS: + - omega_rpm: rotational speed in RPM + - deltaPsiDeg : azimuthal discretization in deg + - nNWrot : number of near wake rotations + - nFWrot : total number of far wake rotations + - nFWrotFree : number of far wake rotations that are free + + deltaPsiDeg - nPerAzimuth + 5 72 + 6 60 + 7 51.5 + 8 45 + """ + omega = omega_rpm*2*np.pi/60 + T = 2*np.pi/omega + if nPerAzimuth is not None: + dt_wanted = np.around(T/nPerAzimuth,2) + else: + dt_wanted = np.around(deltaPsiDeg/(6*omega_rpm)) + nPerAzimuth = int(2*np.pi /(deltaPsiDeg*np.pi/180)) + + nNWPanel = nNWrot*nPerAzimuth + nFWPanel = nFWrot*nPerAzimuth + nFWPanelFree = nFWrotFree*nPerAzimuth + + print(dt_wanted , ' DTfvw') + print(int (nNWPanel ), ' nNWPanel ') + print(int (nFWPanel ), ' WakeLength ') + print(int (nFWPanelFree), ' FreeWakeLength') + + return dt_wanted, nNWPanel, nFWPanel, nFWPanelFree + + +**Regularization parameters** + +One critical parameter of vortex methods is the regularization parameter, also referred to as core radius. We currently recommend to set the regularization parameter as a fraction of the spanwise discretization, that is: **RegDetMethod=3** , **WakeRegFactor=0.6**, **WingRegFactor=0.6**. +We will likely update these guidelines in the future. + + +We also recommend to have the regularization increasing with downstream distance: +**WakeRegMethod=3**. + +The factor with which the regularization parameter will increase with downstream distance can be set as +**CoreSpreadEddyVisc=1000** for modern multi-MW turbines. Further guidelines will follow on this parameter in the future. + + + + From d12cd638caf74981b030d1fb2664a6869613939c Mon Sep 17 00:00:00 2001 From: Andy Platt Date: Mon, 25 Jan 2021 17:42:53 -0700 Subject: [PATCH 15/27] Remove quotes on gfortran flag Per discussion here: https://github.com/OpenFAST/openfast/pull/595#issuecomment-767196369 The single quote on the `-fstack-reuse='none'` flag was creating issues in windows builds with gfortran. --- cmake/OpenfastFortranOptions.cmake | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cmake/OpenfastFortranOptions.cmake b/cmake/OpenfastFortranOptions.cmake index dd2ec486c2..2f7afde9ee 100644 --- a/cmake/OpenfastFortranOptions.cmake +++ b/cmake/OpenfastFortranOptions.cmake @@ -110,7 +110,7 @@ macro(set_fast_gfortran) # Disable stack reuse within routines: issues seen with gfortran 9.x, but others may also exhibit # see section 3.16 of https://gcc.gnu.org/onlinedocs/gcc-9.2.0/gcc.pdf # and https://github.com/OpenFAST/openfast/pull/595 - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fstack-reuse='none'") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fstack-reuse=none") # Deal with Double/Single precision if (DOUBLE_PRECISION) From 7e160b7a01481770d29f6bc69668faa31396d6c2 Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Mon, 25 Jan 2021 20:52:19 -0700 Subject: [PATCH 16/27] OLAF: adapt regularization for non-constant regparam --- docs/source/user/aerodyn-olaf/OLAFTheory.rst | 14 ++++++++++++++ modules/aerodyn/src/AeroDyn.f90 | 2 +- modules/aerodyn/src/FVW.f90 | 15 +++++++++------ modules/aerodyn/src/FVW_Subs.f90 | 20 +++++++++++++++----- modules/aerodyn/src/FVW_Wings.f90 | 2 +- 5 files changed, 40 insertions(+), 13 deletions(-) diff --git a/docs/source/user/aerodyn-olaf/OLAFTheory.rst b/docs/source/user/aerodyn-olaf/OLAFTheory.rst index b335d788ac..02d8f86173 100644 --- a/docs/source/user/aerodyn-olaf/OLAFTheory.rst +++ b/docs/source/user/aerodyn-olaf/OLAFTheory.rst @@ -570,6 +570,8 @@ Here, :math:`\epsilon` is the vortex-filament strain, :math:`l` is the filament length, and :math:`\Delta l` is the change of length between two time steps. The integral in Eq. :eq:`stretch` represents strain effects. +This option is not yet implemented. + Wake Age / Core-Spreading ^^^^^^^^^^^^^^^^^^^^^^^^^ @@ -592,6 +594,16 @@ vorticity itself or between the wake vorticity and the background flow. It is often referred to as the core-spreading method. Setting **DiffusionMethod=[1]** is the same as using the wake age method (**WakeRegMethod=[3]**). +The time evolution of the core radius is implemented as: + +.. math:: + + \frac{d r_c}{dt} = \frac{2\alpha\delta\nu}{r_c(t)} + +and :math:`\frac{d r_c}{dt}=0` on the blades. + + + Stretching and Wake Age ^^^^^^^^^^^^^^^^^^^^^^^ @@ -603,6 +615,8 @@ Eq. :eq:`stretchandage`. r_c(\zeta,\epsilon) = \sqrt{r_{c0}^2 + 4\alpha\delta\nu \zeta \big(1+\epsilon\big)^{-1} } :label: stretchandage +This option is not yet implemented. + .. _sec:diffusion: Diffusion diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 5fa65ad519..c66cec86c8 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -2910,7 +2910,7 @@ SUBROUTINE TwrInflArray( p, u, m, Positions, Inflow, ErrStat, ErrMsg ) call CheckTwrInfl( u, ErrStat2, ErrMsg2 ); call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ); if (ErrStat >= AbortErrLev) return !$OMP PARALLEL default(shared) - !$OMP do private(i,Pos,r_TowerBlade,theta_tower_trans,W_tower,xbar,ybar,zbar,TwrCd,TwrTI,TwrClrnc,TwrDiam,found,denom,u_TwrPotent,v_TwrPotent,u_TwrShadow,v) schedule(runtime) + !$OMP do private(i,Pos,r_TowerBlade,theta_tower_trans,W_tower,xbar,ybar,zbar,TwrCd,TwrTI,TwrClrnc,TwrDiam,found,denom,exponential,u_TwrPotent,v_TwrPotent,u_TwrShadow,v) schedule(runtime) do i = 1, size(Positions,2) Pos=Positions(1:3,i) diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index 56d1457397..575b1a95ce 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -318,8 +318,8 @@ subroutine FVW_InitStates( x, p, ErrStat, ErrMsg ) x%r_FW = 0.0_ReKi x%Gamma_NW = 0.0_ReKi ! First call of calcoutput, states might not be set x%Gamma_FW = 0.0_ReKi ! NOTE, these values might be mapped from z%Gamma_LL at init - x%Eps_NW = 0.0_ReKi - x%Eps_FW = 0.0_ReKi + x%Eps_NW = 0.001_ReKi + x%Eps_FW = 0.001_ReKi end subroutine FVW_InitStates ! ============================================================================== subroutine FVW_InitConstraint( z, p, m, ErrStat, ErrMsg ) @@ -857,14 +857,17 @@ subroutine FVW_CalcContStateDeriv( t, u, p, x, xd, z, OtherState, m, dxdt, ErrSt ! TODO else if (p%WakeRegMethod==idRegAge) then visc_fact = 2.0_ReKi * CoreSpreadAlpha * p%CoreSpreadEddyVisc * p%KinVisc - visc_fact=visc_fact/sqrt(p%WakeRegParam**2 + 2*visc_fact*p%DTaero) ! NOTE: using DTaero to be consisten with OverCycling - dxdt%Eps_NW(1:3, :, :, :) = visc_fact - dxdt%Eps_FW(1:3, :, :, :) = visc_fact + ! --- Method 1, use d(rc^2)/dt = 4 k + dxdt%Eps_NW(1:3, :, iNWStart:, :) = visc_fact/x%Eps_NW(1:3, :, iNWStart:, :) + dxdt%Eps_FW(1:3, :, :, :) = visc_fact/x%Eps_FW(1:3, :, :, :) + ! --- Method 2, use rc(tau) = 2k/sqrt(r_c^2(tau=0) + 4 k tau) + !dxdt%Eps_NW(1:3, :, :, :) = (visc_fact)/sqrt(x%Eps_NW(1:3, :, :, :)**2 + 2*visc_fact*p%DTaero) + !dxdt%Eps_FW(1:3, :, :, :) = (visc_fact)/sqrt(x%Eps_FW(1:3, :, :, :)**2 + 4*visc_fact*p%DTaero) else ErrStat = ErrID_Fatal ErrMsg ='Regularization method not implemented' endif - dxdt%Eps_NW(1:3,:,1:iNWStart,:) = 0.0_ReKi ! LL and First NW panel epsilon does not change + dxdt%Eps_NW(1:3,:,1:iNWStart,:) = 0.0_ReKi ! Important! LL and First NW panel epsilon does not change contains logical function Failed() diff --git a/modules/aerodyn/src/FVW_Subs.f90 b/modules/aerodyn/src/FVW_Subs.f90 index 5299f33959..c24a2a24ba 100644 --- a/modules/aerodyn/src/FVW_Subs.f90 +++ b/modules/aerodyn/src/FVW_Subs.f90 @@ -704,7 +704,8 @@ subroutine PackPanelsToSegments(p, x, iDepthStart, bMirror, nNW, nFW, SegConnct, end subroutine PackPanelsToSegments !> Set up regularization parameter based on diffusion method and regularization method -!! NOTE: this should preferably be done at the "panel"/vortex sheet level +!! NOTE: - reg param is now stored at panel level +!! - continuous variables are used, only the LL and NW panel needs to be set at t=0 subroutine FVW_InitRegularization(x, p, m, ErrStat, ErrMsg) type(FVW_ContinuousStateType), intent(inout) :: x !< States type(FVW_ParameterType), intent(inout) :: p !< Parameters @@ -735,8 +736,8 @@ subroutine FVW_InitRegularization(x, p, m, ErrStat, ErrMsg) RegParam = ds_mean*2 ! Default init of reg param - x%Eps_NW(1:3,:,:,:) = 0.0_ReKi - x%Eps_FW(1:3,:,:,:) = 0.0_ReKi + x%Eps_NW(1:3,:,:,:) = 0.001_ReKi + x%Eps_FW(1:3,:,:,:) = 0.001_ReKi if (DEV_VERSION) then write(*,'(A)')'-----------------------------------------------------------------------------------------' write(*,'(A)')'Regularization Info' @@ -749,6 +750,12 @@ subroutine FVW_InitRegularization(x, p, m, ErrStat, ErrMsg) endif if (p%RegDeterMethod==idRegDeterConstant) then + ! Constant reg param throughout the wake + if (p%WakeRegMethod==idRegAge) then ! NOTE: age method implies a division by rc + p%WingRegParam=max(0.01, p%WingRegParam) + p%WakeRegParam=max(0.01, p%WakeRegParam) + endif + ! Set reg param on wing and first NW ! NOTE: setting the same in all three directions for now, TODO! x%Eps_NW(1:3,:,1,:) = p%WingRegParam ! First age is always WingRegParam (LL) @@ -807,10 +814,13 @@ subroutine FVW_InitRegularization(x, p, m, ErrStat, ErrMsg) ErrMsg ='Regularization determination method not implemented' endif - write(*,'(A,2F8.4)') ' WakeReg (min/max) : ', minval(x%Eps_NW(:,:, 1, :)), maxval(x%Eps_NW(:,:, 1, :)) + call WrScr(' - Regularization parameters:') + write(*,'(A,2F8.4)') ' BladeReg (min/max): ', minval(x%Eps_NW(:, :, 1, :)), maxval(x%Eps_NW(:, :, 1, :)) if (p%nNWMax>1) then - write(*,'(A,2F8.4)') ' BladeReg (min/max): ', minval(x%Eps_NW(:, :, 2, :)), maxval(x%Eps_NW(:, :, 2, :)) + write(*,'(A,2F8.4)') ' WakeReg (min/max) : ', minval(x%Eps_NW(:,:, 2, :)), maxval(x%Eps_NW(:,:, 2, :)) endif + write(*,'(A,2F8.4)') ' k = alpha delta nu: ', CoreSpreadAlpha * p%CoreSpreadEddyVisc * p%KinVisc + end subroutine FVW_InitRegularization diff --git a/modules/aerodyn/src/FVW_Wings.f90 b/modules/aerodyn/src/FVW_Wings.f90 index 017952412a..997f984736 100644 --- a/modules/aerodyn/src/FVW_Wings.f90 +++ b/modules/aerodyn/src/FVW_Wings.f90 @@ -373,7 +373,7 @@ subroutine Wings_ComputeCirculationPolarData(Gamma_LL, Gamma_LL_prev, p, x, m, A P4=x%r_NW(1:3,iSpan ,iDepth+1,iW) Gamm=GammaLastIter(iSpan, iW) do iWCP=1,p%nWings - call ui_quad_n1(m%CP_LL(1:3,1:p%nSpan,iWCP), nCPs, P1, P2, P3, P4, Gamm, p%RegFunction, p%WingRegParam, Vvar(1:3,1:p%nSpan,iWCP)) + call ui_quad_n1(m%CP_LL(1:3,1:p%nSpan,iWCP), nCPs, P1, P2, P3, P4, Gamm, p%RegFunction, x%Eps_NW(1,iSpan,iDepth,iW), Vvar(1:3,1:p%nSpan,iWCP)) enddo enddo enddo From e338e735524b082723548b3ff0c683a72bd1d28a Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Tue, 26 Jan 2021 11:51:03 -0700 Subject: [PATCH 17/27] OLAF: small documentation fix --- docs/source/user/aerodyn-olaf/RunningOLAF.rst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/source/user/aerodyn-olaf/RunningOLAF.rst b/docs/source/user/aerodyn-olaf/RunningOLAF.rst index d1b8eca429..6dde9b023a 100644 --- a/docs/source/user/aerodyn-olaf/RunningOLAF.rst +++ b/docs/source/user/aerodyn-olaf/RunningOLAF.rst @@ -30,7 +30,7 @@ We recommend to set OLAF's time step (**DTfvw**) such that it corresponds to :ma .. math:: \Delta t - = \frac{\Delta \psi_\text{rad}}{\times \Omega_\text{rad/s}} + = \frac{\Delta \psi_\text{rad}}{\Omega_\text{rad/s}} = \frac{\Delta \psi_\text{deg}}{6 \times \Omega_\text{RPM}} If the structural solver requires a smaller time step, the time step for the glue code can be set to a different value than **DTfvw** as long as **DTfvw** is a multiple of the glue code time step. @@ -90,7 +90,7 @@ We also recommend to have the regularization increasing with downstream distance **WakeRegMethod=3**. The factor with which the regularization parameter will increase with downstream distance can be set as -**CoreSpreadEddyVisc=1000** for modern multi-MW turbines. Further guidelines will follow on this parameter in the future. +**CoreSpreadEddyVisc=1000** for modern multi-MW turbines. Further guidelines will follow for this parameter in the future. From c248ea0dfed8d19f0e705318c84f023d7e596ff3 Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Tue, 26 Jan 2021 20:46:03 -0700 Subject: [PATCH 18/27] OLAF: placement of tip and root, and different epsilon --- docs/source/user/aerodyn-olaf/RunningOLAF.rst | 6 +- modules/aerodyn/src/FVW.f90 | 2 + modules/aerodyn/src/FVW_Registry.txt | 2 + modules/aerodyn/src/FVW_Subs.f90 | 66 +++++++------- modules/aerodyn/src/FVW_Tests.f90 | 8 +- modules/aerodyn/src/FVW_Types.f90 | 14 +++ modules/aerodyn/src/FVW_VortexTools.f90 | 89 ++++++++++++++++++- modules/aerodyn/src/FVW_Wings.f90 | 3 + 8 files changed, 146 insertions(+), 44 deletions(-) diff --git a/docs/source/user/aerodyn-olaf/RunningOLAF.rst b/docs/source/user/aerodyn-olaf/RunningOLAF.rst index 6dde9b023a..4b49ade135 100644 --- a/docs/source/user/aerodyn-olaf/RunningOLAF.rst +++ b/docs/source/user/aerodyn-olaf/RunningOLAF.rst @@ -37,7 +37,7 @@ If the structural solver requires a smaller time step, the time step for the glu We recommend to set the near wake length to the number of time steps needed to reach two rotor revolutions. For the far wake, we recommend 10 rotor revolutions. -The the far wake distance that is free, we recommend to set it to a value somewhere between 25% and 50% of the far wake length, (e.g. 3 revolutions). +For the free far-wake, we recommend to set the distance to a value somewhere between 25% and 50% of the far wake length, (e.g. 3 revolutions). The following python script computes the parameters according to these guidelines. @@ -63,9 +63,9 @@ The following python script computes the parameters according to these guideline omega = omega_rpm*2*np.pi/60 T = 2*np.pi/omega if nPerAzimuth is not None: - dt_wanted = np.around(T/nPerAzimuth,2) + dt_wanted = np.around(T/nPerAzimuth,3) else: - dt_wanted = np.around(deltaPsiDeg/(6*omega_rpm)) + dt_wanted = np.around(deltaPsiDeg/(6*omega_rpm),3) nPerAzimuth = int(2*np.pi /(deltaPsiDeg*np.pi/180)) nNWPanel = nNWrot*nPerAzimuth diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index 1d62b40dc9..15248cb48b 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -188,6 +188,8 @@ subroutine FVW_InitMiscVars( p, m, ErrStat, ErrMsg ) m%VTKStep = -1 ! Counter of VTK outputs m%VTKlastTime = -HUGE(1.0_DbKi) m%tSpent = 0 + m%iTip = -1 ! Index where tip vorticity will be placed + m%iRoot = -1 ! Index where root vorticity will be placed call AllocAry( m%LE , 3 , p%nSpan+1 , p%nWings, 'Leading Edge Points', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%LE = -999999_ReKi; call AllocAry( m%TE , 3 , p%nSpan+1 , p%nWings, 'TrailingEdge Points', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%TE = -999999_ReKi; diff --git a/modules/aerodyn/src/FVW_Registry.txt b/modules/aerodyn/src/FVW_Registry.txt index f398806f3f..f759342cd1 100644 --- a/modules/aerodyn/src/FVW_Registry.txt +++ b/modules/aerodyn/src/FVW_Registry.txt @@ -125,6 +125,8 @@ typedef ^ ^ ReKi typedef ^ ^ IntKi nNW - - - "Number of active near wake panels" - typedef ^ ^ IntKi nFW - - - "Number of active far wake panels" - typedef ^ ^ IntKi iStep - - - "Current step number used for update state" - +typedef ^ ^ IntKi iTip - - - "Index where tip vorticity will be placed. TODO, per blade" - +typedef ^ ^ IntKi iRoot - - - "Index where root vorticity will be placed" - typedef ^ ^ IntKi VTKstep - - - "Current vtk output step number" - typedef ^ ^ DbKi VTKlastTime - - - "Time the last VTK file set was written out" s typedef ^ ^ ReKi r_wind :: - - "List of points where wind is requested for next time step" - diff --git a/modules/aerodyn/src/FVW_Subs.f90 b/modules/aerodyn/src/FVW_Subs.f90 index c24a2a24ba..af7c71517b 100644 --- a/modules/aerodyn/src/FVW_Subs.f90 +++ b/modules/aerodyn/src/FVW_Subs.f90 @@ -238,57 +238,53 @@ end subroutine Map_LL_NW !> Map the last NW panel with the first FW panel subroutine Map_NW_FW(p, m, z, x, ErrStat, ErrMsg) type(FVW_ParameterType), intent(in ) :: p !< Parameters - type(FVW_MiscVarType), intent(in ) :: m !< Initial misc/optimization variables + type(FVW_MiscVarType), intent(inout) :: m !< Initial misc/optimization variables type(FVW_ConstraintStateType), intent(in ) :: z !< Constraints states type(FVW_ContinuousStateType), intent(inout) :: x !< Continuous states integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None - integer(IntKi) :: iW, iRoot + integer(IntKi) :: iW, iRoot, iTip, iMax real(ReKi), dimension(p%nWings) :: FWGamma - real(ReKi), dimension(3):: FWEps + real(ReKi), dimension(p%nSpan+1) :: Gamma_t + real(ReKi), dimension(p%nSpan) :: sCoord + real(ReKi) :: FWEpsTip, FWEpsRoot + real(ReKi) :: ltip, rTip, Gamma_max integer(IntKi), parameter :: iAgeFW=1 !< we update the first FW panel ErrStat = ErrID_None ErrMsg = "" ! First Panel of Farwake has coordinates of last panel of near wake always if (p%nFWMax>0) then - FWGamma(:)=0.0_ReKi if (m%nNW==p%nNWMax) then ! First circulation of Farwake is taken as the max circulation of last NW column - ! Regularization of far wake is TODO, for now taken as max but should be ramped up + FWGamma(:)=0.0_ReKi do iW=1,p%nWings - !FWGamma = sum(x%Gamma_NW(:,p%nNWMax,iW))/p%nSpan - FWGamma(iW) = maxval(x%Gamma_NW(:,p%nNWMax,iW)) + ! NOTE: on the first pass, m%iTip and m%iRoot are computed, TODO per blade + call PlaceTipRoot(p%nSpan, x%Gamma_NW(:,m%nNW,iW), x%r_NW(1:3,:,m%nNW,iW), x%Eps_NW(1:3,:,m%nNW,iW),& ! inputs + m%iRoot, m%iTip, FWGamma(iW), FWEpsTip, FWEpsRoot) ! outputs x%Gamma_FW(1:FWnSpan,iAgeFW,iW) = FWGamma(iW) - ! Regularization TODO (should be increased to account for the concentration of vorticity to 1 panel only - FWEps(1) = maxval(x%Eps_NW(1,:,p%nNWMax,iW)) - FWEps(2) = maxval(x%Eps_NW(2,:,p%nNWMax,iW)) - FWEps(3) = maxval(x%Eps_NW(3,:,p%nNWMax,iW)) - x%Eps_FW(1,1:FWnSpan,iAgeFW,iW) = FWEps(1) - x%Eps_FW(2,1:FWnSpan,iAgeFW,iW) = FWEps(2) - x%Eps_FW(3,1:FWnSpan,iAgeFW,iW) = FWEps(3) + x%Eps_FW(3,1:FWnSpan,iAgeFW,iW) = FWEpsTip ! HACK tip put in third + x%Eps_FW(2,1:FWnSpan,iAgeFW,iW) = FWEpsRoot ! HACK root put in second + x%Eps_FW(1,1:FWnSpan,iAgeFW,iW) = FWEpsTip ! For shed vorticity.. enddo + iTip = m%iTip + iRoot = m%iRoot + else + iRoot=1 + iTip=p%nSpan+1 endif - + ! Far wake point always mapped to last near wake do iW=1,p%nWings - ! Find first point (in half span) where circulation is more than 0.1% of MaxGamma, call it the root - iRoot=1 - ! NOTE: this below won't work for a wing - ! Need to go from maxgamma location, and integrate spanwise position on both side to find location of tip and root vortex - !do while ((iRoot2)) then - ErrMsg='Error: FWnSpan>2 not implemented.' - ErrStat=ErrID_Fatal - return - endif + x%r_FW(1:3,1 ,iAgeFW,iW) = x%r_NW(1:3,iRoot,p%nNWMax+1,iW) ! Point 1 (root) + x%r_FW(1:3,FWnSpan+1,iAgeFW,iW) = x%r_NW(1:3,iTip ,p%nNWMax+1,iW) ! Point FWnSpan (tip) + !if ((FWnSpan==2)) then + ! ! in between point + ! x%r_FW(1:3,2,iAgeFW,iW) = x%r_NW(1:3,int(p%nSpan+1)/4 ,p%nNWMax+1,iW) ! Point (mid) + !else if ((FWnSpan>2)) then + ! ErrMsg='Error: FWnSpan>2 not implemented.' + ! ErrStat=ErrID_Fatal + ! return + !endif enddo endif if (.false.) print*,z%Gamma_LL(1,1) ! Just to avoid unused var warning @@ -651,13 +647,13 @@ subroutine PackPanelsToSegments(p, x, iDepthStart, bMirror, nNW, nFW, SegConnct, iHeadC=1 if (nCNW>0) then do iW=1,p%nWings - call LatticeToSegments(x%r_NW(1:3,:,1:nNW+1,iW), x%Gamma_NW(:,1:nNW,iW), x%Eps_NW(1:3,:,1:nNW,iW), iDepthStart, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC, .True., LastNWShed ) + call LatticeToSegments(x%r_NW(1:3,:,1:nNW+1,iW), x%Gamma_NW(:,1:nNW,iW), x%Eps_NW(1:3,:,1:nNW,iW), iDepthStart, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC, .True., LastNWShed, .false.) enddo endif if (nFW>0) then iHeadC_bkp = iHeadC do iW=1,p%nWings - call LatticeToSegments(x%r_FW(1:3,:,1:nFW+1,iW), x%Gamma_FW(:,1:nFW,iW), x%Eps_FW(1:3,:,1:nFW,iW), 1, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC , p%FWShedVorticity, p%FWShedVorticity) + call LatticeToSegments(x%r_FW(1:3,:,1:nFW+1,iW), x%Gamma_FW(:,1:nFW,iW), x%Eps_FW(1:3,:,1:nFW,iW), 1, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC , p%FWShedVorticity, p%FWShedVorticity, .true.) enddo SegConnct(3,iHeadC_bkp:) = SegConnct(3,iHeadC_bkp:) + nNW ! Increasing iDepth (or age) to account for NW endif diff --git a/modules/aerodyn/src/FVW_Tests.f90 b/modules/aerodyn/src/FVW_Tests.f90 index b3144910fc..450c23e9be 100644 --- a/modules/aerodyn/src/FVW_Tests.f90 +++ b/modules/aerodyn/src/FVW_Tests.f90 @@ -671,7 +671,7 @@ subroutine Test_LatticeToSegment(mvtk,iStat) iHeadP=1 iHeadC=1 - CALL LatticeToSegments(LatticePoints1, LatticeGamma1, LatticeEps1, 1, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC, .true., .true. ) + CALL LatticeToSegments(LatticePoints1, LatticeGamma1, LatticeEps1, 1, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC, .true., .true., .false. ) CALL printall() CALL WrVTK_Segments('Points1_seg.vtk', mvtk, SegPoints, SegConnct, SegGamma, SegEpsilon, bladeFrame) @@ -698,7 +698,7 @@ subroutine Test_LatticeToSegment(mvtk,iStat) allocate(SegGamma (1:nC2) ); SegGamma=-9999 iHeadP=1 iHeadC=1 - CALL LatticeToSegments(LatticePoints2, LatticeGamma2, LatticeEps2, 1, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC , .true., .true.) + CALL LatticeToSegments(LatticePoints2, LatticeGamma2, LatticeEps2, 1, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC , .true., .true., .false.) CALL printall() CALL WrVTK_Segments('Points2_seg.vtk', mvtk, SegPoints, SegConnct, SegGamma, SegEpsilon, bladeFrame) @@ -713,8 +713,8 @@ subroutine Test_LatticeToSegment(mvtk,iStat) allocate(SegConnct(1:2,1:nC)); SegConnct=-1 allocate(SegPoints(1:3,1:nP)); SegPoints=-1 allocate(SegGamma (1:nC) ); SegGamma=-9999 - CALL LatticeToSegments(LatticePoints1, LatticeGamma1, LatticeEps1, 1, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC, .true. , .true.) - CALL LatticeToSegments(LatticePoints2, LatticeGamma2, LatticeEps2, 1, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC, .true. , .true.) + CALL LatticeToSegments(LatticePoints1, LatticeGamma1, LatticeEps1, 1, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC, .true. , .true., .false.) + CALL LatticeToSegments(LatticePoints2, LatticeGamma2, LatticeEps2, 1, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC, .true. , .true., .false.) CALL printall() CALL WrVTK_Segments('PointsBoth_seg.vtk', mvtk, SegPoints, SegConnct, SegGamma, SegEpsilon, bladeFrame) diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index 34a95d4a50..f20e091edf 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -152,6 +152,8 @@ MODULE FVW_Types INTEGER(IntKi) :: nNW !< Number of active near wake panels [-] INTEGER(IntKi) :: nFW !< Number of active far wake panels [-] INTEGER(IntKi) :: iStep !< Current step number used for update state [-] + INTEGER(IntKi) :: iTip !< Index where tip vorticity will be placed. TODO, per blade [-] + INTEGER(IntKi) :: iRoot !< Index where root vorticity will be placed [-] INTEGER(IntKi) :: VTKstep !< Current vtk output step number [-] REAL(DbKi) :: VTKlastTime !< Time the last VTK file set was written out [s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: r_wind !< List of points where wind is requested for next time step [-] @@ -3011,6 +3013,8 @@ SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%nNW = SrcMiscData%nNW DstMiscData%nFW = SrcMiscData%nFW DstMiscData%iStep = SrcMiscData%iStep + DstMiscData%iTip = SrcMiscData%iTip + DstMiscData%iRoot = SrcMiscData%iRoot DstMiscData%VTKstep = SrcMiscData%VTKstep DstMiscData%VTKlastTime = SrcMiscData%VTKlastTime IF (ALLOCATED(SrcMiscData%r_wind)) THEN @@ -3666,6 +3670,8 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 1 ! nNW Int_BufSz = Int_BufSz + 1 ! nFW Int_BufSz = Int_BufSz + 1 ! iStep + Int_BufSz = Int_BufSz + 1 ! iTip + Int_BufSz = Int_BufSz + 1 ! iRoot Int_BufSz = Int_BufSz + 1 ! VTKstep Db_BufSz = Db_BufSz + 1 ! VTKlastTime Int_BufSz = Int_BufSz + 1 ! r_wind allocated yes/no @@ -4469,6 +4475,10 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%iStep Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%iTip + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%iRoot + Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%VTKstep Int_Xferred = Int_Xferred + 1 DbKiBuf(Db_Xferred) = InData%VTKlastTime @@ -5780,6 +5790,10 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Xferred = Int_Xferred + 1 OutData%iStep = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + OutData%iTip = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%iRoot = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%VTKstep = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%VTKlastTime = DbKiBuf(Db_Xferred) diff --git a/modules/aerodyn/src/FVW_VortexTools.f90 b/modules/aerodyn/src/FVW_VortexTools.f90 index 181dba4e06..62b0e5bd58 100644 --- a/modules/aerodyn/src/FVW_VortexTools.f90 +++ b/modules/aerodyn/src/FVW_VortexTools.f90 @@ -51,6 +51,86 @@ module FVW_VortexTools end interface contains + + !> Returns the discrete trailed vorticity (\Delta Gamma) based on a "bound" circulation Gamma + !! \Delta\Gamma_i = \int_{r i-1}^{r i+1} d\Gamma/dr *dr [m^2/s] + !! NOTE: this is not gamma = d\Gamma/dr \approx \Delta\Gamma /\Delta r + subroutine GammaTrailed(n, Gamma_b, Gamma_t) + integer(IntKi), intent(in) :: n !< number of points along the span + real(Reki), dimension(n), intent(in ) :: Gamma_b !< Bound circulation + real(ReKi), dimension(n+1), intent(out) :: Gamma_t !< Trailed circulation + integer(IntKi) :: i + Gamma_t(1) = Gamma_b(1) + Gamma_t(n+1) = - Gamma_b(n) + do i = 2, n + Gamma_t(i) = Gamma_b(i)-Gamma_b(i-1) + enddo + endsubroutine + + !> Curvilinear distance along a set of connected points. + subroutine CurvilinearDist(n, P, s) + integer(IntKi), intent(in) :: n !< number of points + real(Reki), dimension(3,n), intent(in) :: P !< Point cordinates + real(ReKi), dimension(n), intent(out) :: s !< Curvilinear coordinate + integer(IntKi) :: i + s(1) = 0 + do i = 2, n + s(i) = s(i-1) + sqrt((P(1,i)-P(1,i-1))**2 + (P(2,i)-P(2,i-1))**2 + (P(3,i)-P(3,i-1))**2) + enddo + endsubroutine + + !> Place Tip and Root vorticity according to Gamma distribution + !! Attempts to preserve the first moment of vorticity in the 15% region of tip and root + !! Estimtes the regularization parameters based on the length of the tip region.. + subroutine PlaceTipRoot(n, Gamma_b, xV, Eps, iRoot, iTip, Gamma_max, EpsTip, EpsRoot) + integer(IntKi), intent(in) :: n !< number of vortex points + real(ReKi), dimension(n) , intent(in) :: Gamma_b !< Wake panel circulation + real(Reki), dimension(3,n+1), intent(in) :: xV !< Vortex point nodal coordinates + real(Reki), dimension(3,n ), intent(in) :: Eps !< Vortex panels epsilon + integer(IntKi), intent(inout) :: iRoot, iTip !< Index of tip and root vortex, if <0, they are computed + real(ReKi), intent(out) :: Gamma_max + real(Reki), intent(out) :: EpsTip !< Regularization of tip + real(Reki), intent(out) :: EpsRoot !< Regularization of root + real(ReKi), dimension(n+1) :: Gamma_t + real(ReKi), dimension(n+1) :: s + real(ReKi) :: rRoot, rTip, lTip, lRoot + integer(IntKi) :: i10, i90 + + if ((n<=2)) then + iTip =n+1 + iRoot=1 + EpsTip = Eps(1,iTip) + EpsRoot = Eps(1,iRoot) + else + Gamma_max = maxval(Gamma_b,1) + call CurvilinearDist(n+1, xV, s) + if (iTip<0) then + ! Find position of tip and root + call GammaTrailed(n, Gamma_b, Gamma_t) + + i10 = minloc(abs(s(:)-0.15*s(n+1)),1) + i90 = minloc(abs(s(:)-0.85*s(n+1)),1) + + rTip = sum(Gamma_t(i90:) * (s(i90:)))/ sum(Gamma_t(i90:)) + rRoot = sum(Gamma_t(1:i10) * s(1:i10)) / sum(Gamma_t(1:i10)) + iTip = minloc(abs(rTip - s), 1) + iRoot = minloc(abs(rRoot - s), 1) + endif + rTip = s(iTip) + rRoot = s(iRoot) + + ! Mean regularization at the tip and root + EpsTip = sum(Eps(1,iTip:)) /(n-iTip+1) + EpsRoot = sum(Eps(1,1:iRoot))/(iRoot) + ! Scaling based on the "length" of the vortex, this will need further tuning + lTip = (s(n+1)-rTip )/3.14 ! Approximate radius if the tip has done half a turn + lRoot = (rRoot )/3.14 + EpsTip = 1.3*(lTip+EpsTip) ! Tuning factors + EpsRoot = 1.7*(lRoot+EpsRoot) + endif + endsubroutine PlaceTipRoot + + !> Flatten/ravel a 3D grid of vectors (each of size n) subroutine FlattenValues(GridValues, FlatValues, iHeadP) real(Reki), dimension(:,:,:,:), intent(in ) :: GridValues !< Grid values n x nx x ny x nz @@ -121,7 +201,7 @@ subroutine LatticeToPoints(LatticePoints, iDepthStart, Points, iHeadP) endsubroutine LatticeToPoints - subroutine LatticeToSegments(LatticePoints, LatticeGamma, LatticeEpsilon, iDepthStart, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC, bShedVorticity, bShedLastVorticity ) + subroutine LatticeToSegments(LatticePoints, LatticeGamma, LatticeEpsilon, iDepthStart, SegPoints, SegConnct, SegGamma, SegEpsilon, iHeadP, iHeadC, bShedVorticity, bShedLastVorticity, bHackEpsilon ) real(Reki), dimension(:,:,:), intent(in ) :: LatticePoints !< Points 3 x nSpan x nDepth real(Reki), dimension(:,:), intent(in ) :: LatticeGamma !< GammaPanl nSpan x nDepth real(Reki), dimension(:,:,:), intent(in ) :: LatticeEpsilon !< EpsPanl 3 x nSpan x nDepth (one per dimension) @@ -134,6 +214,7 @@ subroutine LatticeToSegments(LatticePoints, LatticeGamma, LatticeEpsilon, iDepth integer(IntKi), intent(inout) :: iHeadC !< Index indicating where to start in SegConnct logical , intent(in ) :: bShedVorticity !< Shed vorticity is included if true logical , intent(in ) :: bShedLastVorticity !< Shed the last vorticity segment if true + logical , intent(in ) :: bHackEpsilon !< Unfortunate fix so that tip and root vortex have different epsilon for FW ! Local integer(IntKi) :: nSpan, nDepth integer(IntKi) :: iSpan, iDepth @@ -179,7 +260,11 @@ subroutine LatticeToSegments(LatticePoints, LatticeGamma, LatticeEpsilon, iDepth endif if (iSpan==1) then Gamma41 = LatticeGamma(iSpan,iDepth) - Eps41 = LatticeEpsilon(3,iSpan,iDepth) ! Using epsilon z for seg23&41. TODO might change in the future + if (bHackEpsilon) then + Eps41 = LatticeEpsilon(2,iSpan,iDepth) ! Using epsilon y for seg41 hacked + else + Eps41 = LatticeEpsilon(3,iSpan,iDepth) ! Using epsilon z for seg23&41. TODO might change in the future + endif else Gamma41 = LatticeGamma(iSpan,iDepth)-LatticeGamma(iSpan-1,iDepth) Eps41 = (LatticeEpsilon(3,iSpan,iDepth)+LatticeEpsilon(3,iSpan-1,iDepth))/2.0_ReKi diff --git a/modules/aerodyn/src/FVW_Wings.f90 b/modules/aerodyn/src/FVW_Wings.f90 index 997f984736..a80dcf53eb 100644 --- a/modules/aerodyn/src/FVW_Wings.f90 +++ b/modules/aerodyn/src/FVW_Wings.f90 @@ -109,7 +109,10 @@ subroutine Wings_Panelling_Init(Meshes, p, m, ErrStat, ErrMsg ) !call Meshing('middle' , p%s_LL(:,iW), p%nSpan, p%s_CP_LL(:,iW)) call Meshing('fullcosineapprox' , p%s_LL(:,iW), p%nSpan, p%s_CP_LL(:,iW)) call InterpArray(p%s_LL(:,iW), p%chord_LL(:,iW), p%s_CP_LL(:,iW), p%chord_CP_LL(:,iW)) + + deallocate(s_in) enddo + end subroutine Wings_Panelling_Init !---------------------------------------------------------------------------------------------------------------------------------- !> Based on an input mesh, sets the following: From a2ae522520bf3069ee757e797d71204dcb28758f Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Tue, 26 Jan 2021 21:59:54 -0700 Subject: [PATCH 19/27] OLAF: map LL NW at t=0 --- modules/aerodyn/src/FVW.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index 15248cb48b..c519d649e5 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -587,6 +587,8 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m call FVW_CopyInput( u(2), uInterp, MESH_NEWCOPY, ErrStat2, ErrMsg2); if(Failed()) return call FVW_Input_ExtrapInterp(u(1:size(utimes)),utimes(:),uInterp,t, ErrStat2, ErrMsg2); if(Failed()) return call Wings_Panelling(uInterp%WingsMesh, p, m, ErrStat2, ErrMsg2); if(Failed()) return + call Map_LL_NW(p, m, z, x, 1.0_ReKi, ErrStat2, ErrMsg2); if(Failed()) return ! needed at t=0 if wing moved after init + call Map_NW_FW(p, m, z, x, ErrStat2, ErrMsg2); if(Failed()) return ! TODO convert quasi steady Gamma to unsteady gamma with UA states From d53edd38f118fb494da4916e39fa5e4f0739893f Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Fri, 12 Feb 2021 16:33:35 -0700 Subject: [PATCH 20/27] FVW: bug fix in determination of tip epsilon, and error handling gamma_prescr --- modules/aerodyn/src/FVW.f90 | 13 ++- modules/aerodyn/src/FVW_Subs.f90 | 123 +++++++++++++++++------- modules/aerodyn/src/FVW_VortexTools.f90 | 23 ++--- modules/aerodyn/src/FVW_Wings.f90 | 2 + 4 files changed, 112 insertions(+), 49 deletions(-) diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index c519d649e5..61a2371984 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -452,7 +452,7 @@ SUBROUTINE FVW_SetParametersFromInputFile( InputFileData, p, m, ErrStat, ErrMsg if (allocated(p%PrescribedCirculation)) deallocate(p%PrescribedCirculation) if (InputFileData%CirculationMethod==idCircPrescribed) then - call AllocAry( p%PrescribedCirculation, p%nSpan, 'Prescribed Circulation', ErrStat2, ErrMsg2 ); call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,'FVW_SetParameters' ); p%PrescribedCirculation = -999999_ReKi; + call AllocAry(p%PrescribedCirculation, p%nSpan, 'Prescribed Circulation', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,'FVW_SetParameters'); p%PrescribedCirculation = -999999_ReKi; if (.not. allocated(p%s_CP_LL)) then ErrMsg = 'Spanwise coordinate not allocated.' ErrStat = ErrID_Fatal @@ -548,7 +548,6 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m real(ReKi) :: ShedScale !< Scaling factor for shed vorticity (for sub-cycling), 1 if no subcycling logical :: bReevaluation logical :: bOverCycling - ErrStat = ErrID_None ErrMsg = "" @@ -589,7 +588,7 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m call Wings_Panelling(uInterp%WingsMesh, p, m, ErrStat2, ErrMsg2); if(Failed()) return call Map_LL_NW(p, m, z, x, 1.0_ReKi, ErrStat2, ErrMsg2); if(Failed()) return ! needed at t=0 if wing moved after init call Map_NW_FW(p, m, z, x, ErrStat2, ErrMsg2); if(Failed()) return - + ! TODO convert quasi steady Gamma to unsteady gamma with UA states ! Compute UA inputs at t @@ -619,7 +618,6 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m else call SetErrStat(ErrID_Fatal,'Invalid time integration method:'//Num2LStr(p%IntMethod),ErrStat,ErrMsg,'FVW_UpdateState') end if - ! We extend the wake length, i.e. we emit a new panel of vorticity at the TE ! NOTE: this will be rolled back if UpdateState is called at the same starting time again call PrepareNextTimeStep() @@ -659,6 +657,7 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m !call Map_NW_FW(p, m, z, m%x2, ErrStat2, ErrMsg2); if(Failed()) return endif endif + ! --- Integration between t and t+DTaero if DTaero/=DTfvw if (bOverCycling) then ! Linear interpolation of states between t and dtaero @@ -711,6 +710,12 @@ subroutine FVW_UpdateStates( t, n, u, utimes, p, x, xd, z, OtherState, AFInfo, m endif call FVW_DestroyConstrState(z_guess, ErrStat2, ErrMsg2); if(Failed()) return + if (DEV_VERSION) then + if(have_nan(p, m, x, u, 'End Update ')) then + STOP + endif + endif + contains subroutine PrepareNextTimeStep() ! --- Increase wake length if maximum not reached diff --git a/modules/aerodyn/src/FVW_Subs.f90 b/modules/aerodyn/src/FVW_Subs.f90 index af7c71517b..d0a5632f6a 100644 --- a/modules/aerodyn/src/FVW_Subs.f90 +++ b/modules/aerodyn/src/FVW_Subs.f90 @@ -117,36 +117,58 @@ subroutine ReadAndInterpGamma(CirculationFileName, s_CP_LL, L, Gamma_CP_LL, ErrS integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! Local - integer(IntKi) :: nLines - integer(IntKi) :: i - integer(IntKi) :: iStat - integer(IntKi) :: iUnit - character(len=1054) :: line + integer(IntKi) :: nLines + integer(IntKi) :: i + integer(IntKi) :: iStat + integer(IntKi) :: iUnit + character(len=1054) :: line + integer(IntKi) :: ErrStat2 ! temporary Error status + character(ErrMsgLen) :: ErrMsg2 ! temporary Error message real(ReKi), dimension(:), allocatable :: sPrescr, GammaPrescr !< Radius + real(ReKi), parameter :: ReNaN = huge(1.0_ReKi) ErrStat = ErrID_None ErrMsg = '' ! --- call GetNewUnit(iUnit) - open(unit = iUnit, file = CirculationFileName) + call OpenFInpFile(iUnit, CirculationFileName, errStat2, errMsg2); if(Failed()) return nLines=line_count(iUnit)-1 ! Read Header - read(iUnit,*, iostat=istat) line + read(iUnit,*, iostat=errStat2) line ; if(Failed()) return ! Read table: s/L [-], GammaPresc [m^2/s] - allocate(sPrescr(1:nLines), GammaPrescr(1:nLines)) + call AllocAry(sPrescr , nLines, 'sPrecr' , errStat2, errMsg2); if(Failed()) return + call AllocAry(GammaPrescr, nLines, 'GammaPrecr', errStat2, errMsg2); if(Failed()) return + sPrescr = ReNaN + GammaPrescr = ReNaN do i=1,nLines read(iUnit,*, iostat=istat) sPrescr(i), GammaPrescr(i) - sPrescr(i) = sPrescr(i) * L - GammaPrescr(i) = GammaPrescr(i) + if (istat/=0) then + errStat2=ErrID_Fatal + errMsg2='Error occured while reading line '//num2lstr(i+1)//' of circulation file: '//trim(CirculationFileName) + if(Failed()) return + endif enddo - close(iUnit) - if (istat/=0) then - ErrStat=ErrID_Fatal - ErrMsg='Error occured while reading Circulation file: '//trim(CirculationFileName) - return + if (any(GammaPrescr>=ReNaN).or.any(sPrescr>=ReNaN)) then + errStat2=ErrID_Fatal + errMsg2='Not all values were read properly (check the format) while reading the circulation file: '//trim(CirculationFileName) + if(Failed()) return endif + sPrescr = sPrescr * L ! NOTE: TODO TODO TODO THIS ROUTINE PERFORMS NASTY EXTRAPOLATION, SHOULD BE PLATEAUED - Gamma_CP_LL = interpolation_array( sPrescr, GammaPrescr, s_CP_LL, size(s_CP_LL), nLines ) + Gamma_CP_LL = interpolation_array(sPrescr, GammaPrescr, s_CP_LL, size(s_CP_LL), nLines) + + call CleanUp() contains + subroutine CleanUp() + if(allocated(sPrescr)) deallocate(sPrescr) + if(allocated(GammaPrescr)) deallocate(GammaPrescr) + if (iUnit>0) close(iUnit) + end subroutine + + logical function Failed() + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'ReadAndInterpGamma') + Failed = ErrStat >= AbortErrLev + if (Failed) call CleanUp() + end function Failed !> Counts number of lines in a file integer function line_count(iunit) @@ -367,6 +389,7 @@ subroutine PropagateWake(p, m, z, x, ErrStat, ErrMsg) end subroutine PropagateWake +!> Print the states, useful for debugging subroutine print_x_NW_FW(p, m, x, label) type(FVW_ParameterType), intent(in) :: p !< Parameters type(FVW_MiscVarType), intent(in) :: m !< Initial misc/optimization variables @@ -383,6 +406,10 @@ subroutine print_x_NW_FW(p, m, x, label) print*,trim(label)//'x', x%r_NW(1, 1, iAge,1), x%r_NW(1, p%nSpan+1, iAge,1) print*,trim(label)//'y', x%r_NW(2, 1, iAge,1), x%r_NW(2, p%nSpan+1, iAge,1) print*,trim(label)//'z', x%r_NW(3, 1, iAge,1), x%r_NW(3, p%nSpan+1, iAge,1) + if (iAge Debug function to figure out if data have nan +logical function have_nan(p, m, x, u, label) + type(FVW_ParameterType), intent(in) :: p !< Parameters + type(FVW_MiscVarType), intent(in) :: m !< Initial misc/optimization variables + type(FVW_ContinuousStateType), intent(in) :: x !< Continuous states + type(FVW_InputType), intent(in) :: u(:) !< Input states + character(len=*), intent(in) :: label !< label for print + have_nan=.False. + if (any(isnan(x%r_NW))) then + print*,trim(label),'NaN in r_NW' + have_nan=.True. + endif + if (any(isnan(x%r_FW))) then + print*,trim(label),'NaN in r_FW' + have_nan=.True. + endif + if (any(isnan(x%Gamma_NW))) then + print*,trim(label),'NaN in G_NW' + have_nan=.True. + endif + if (any(isnan(x%Gamma_FW))) then + print*,trim(label),'NaN in G_FW' + have_nan=.True. + endif + if (any(isnan(x%Eps_NW))) then + print*,trim(label),'NaN in G_FW' + have_nan=.True. + endif + if (any(isnan(x%Eps_FW))) then + print*,trim(label),'NaN in G_FW' + have_nan=.True. + endif + if (any(isnan(u(1)%V_wind))) then + print*,trim(label),'NaN in Vwind1' + have_nan=.True. + endif + if (any(isnan(u(2)%V_wind))) then + print*,trim(label),'NaN in Vwind2' + have_nan=.True. + endif +endfunction + ! -------------------------------------------------------------------------------- ! --- PACKING/UNPACKING FUNCTIONS diff --git a/modules/aerodyn/src/FVW_VortexTools.f90 b/modules/aerodyn/src/FVW_VortexTools.f90 index 62b0e5bd58..e5b65cec91 100644 --- a/modules/aerodyn/src/FVW_VortexTools.f90 +++ b/modules/aerodyn/src/FVW_VortexTools.f90 @@ -94,14 +94,9 @@ subroutine PlaceTipRoot(n, Gamma_b, xV, Eps, iRoot, iTip, Gamma_max, EpsTip, Eps real(ReKi), dimension(n+1) :: Gamma_t real(ReKi), dimension(n+1) :: s real(ReKi) :: rRoot, rTip, lTip, lRoot - integer(IntKi) :: i10, i90 + integer(IntKi) :: i10, i90, iTipPanel,iRootPanel - if ((n<=2)) then - iTip =n+1 - iRoot=1 - EpsTip = Eps(1,iTip) - EpsRoot = Eps(1,iRoot) - else + if (n>2) then Gamma_max = maxval(Gamma_b,1) call CurvilinearDist(n+1, xV, s) if (iTip<0) then @@ -113,20 +108,26 @@ subroutine PlaceTipRoot(n, Gamma_b, xV, Eps, iRoot, iTip, Gamma_max, EpsTip, Eps rTip = sum(Gamma_t(i90:) * (s(i90:)))/ sum(Gamma_t(i90:)) rRoot = sum(Gamma_t(1:i10) * s(1:i10)) / sum(Gamma_t(1:i10)) - iTip = minloc(abs(rTip - s), 1) + iTip = minloc(abs(rTip - s), 1) ! NOTE: not accurate since epsilon has one dimension less.. iRoot = minloc(abs(rRoot - s), 1) endif rTip = s(iTip) rRoot = s(iRoot) - + iTipPanel = min(iTip,n) + iRootPanel = max(iRoot,1) ! Mean regularization at the tip and root - EpsTip = sum(Eps(1,iTip:)) /(n-iTip+1) - EpsRoot = sum(Eps(1,1:iRoot))/(iRoot) + EpsTip = sum(Eps(1,iTipPanel:)) /(n-iTipPanel+1) + EpsRoot = sum(Eps(1,1:iRootPanel))/(iRootPanel) ! Scaling based on the "length" of the vortex, this will need further tuning lTip = (s(n+1)-rTip )/3.14 ! Approximate radius if the tip has done half a turn lRoot = (rRoot )/3.14 EpsTip = 1.3*(lTip+EpsTip) ! Tuning factors EpsRoot = 1.7*(lRoot+EpsRoot) + else + iTip =n+1 + iRoot=1 + EpsTip = Eps(1,iTip-1) + EpsRoot = Eps(1,iRoot) endif endsubroutine PlaceTipRoot diff --git a/modules/aerodyn/src/FVW_Wings.f90 b/modules/aerodyn/src/FVW_Wings.f90 index a80dcf53eb..4f21479d66 100644 --- a/modules/aerodyn/src/FVW_Wings.f90 +++ b/modules/aerodyn/src/FVW_Wings.f90 @@ -268,6 +268,8 @@ subroutine Wings_ComputeCirculation(t, Gamma_LL, Gamma_LL_prev, u, p, x, m, AFIn do iW = 1, p%nWings !Loop over lifting lines Gamma_LL(1:p%nSpan,iW) = p%PrescribedCirculation(1:p%nSpan) enddo + m%Vind_LL=-9999._ReKi !< Safety + m%Vtot_LL=-9999._ReKi !< Safety else if (p%CirculationMethod==idCircPolarData) then ! --- Solve for circulation using polar data From dd6ee8d1cc36fe25ec84bf5105e377eb98ce7e26 Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Mon, 15 Feb 2021 16:00:06 -0700 Subject: [PATCH 21/27] FVW: output vtk on end when WrVTK=2 --- modules/aerodyn/src/FVW.f90 | 124 +++++++++++++++++++++--------------- 1 file changed, 72 insertions(+), 52 deletions(-) diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index 61a2371984..5126fe7245 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -489,11 +489,19 @@ subroutine FVW_End( u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None integer(IntKi) :: i + real(DbKi) :: t ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" ! Place any last minute operations or calculations here: + if (p%WrVTK==2) then + call WrScr('Outputs of VTK before FVW_END') + t=-1.0_ReKi + m%VTKStep=999999999 ! not pretty, but we know we have twidth=9 + call WriteVTKOutputs(t, .true., u(1), p, x, z, y, m, ErrStat, ErrMsg) + endif + ! Close files here: ! Destroy the input data: @@ -1276,7 +1284,6 @@ subroutine FVW_CalcOutput(t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, type(FVW_ParameterType), intent(in ) :: p !< Parameters type(FVW_ContinuousStateType), intent(in ) :: x !< Continuous states at t type(FVW_DiscreteStateType), intent(in ) :: xd !< Discrete states at t -!FIXME:TODO: AD15_CalcOutput has constraint states as intent(in) only. This is forcing me to store z in the AD15 miscvars for now. type(FVW_ConstraintStateType), intent(in ) :: z !< Constraint states at t type(FVW_OtherStateType), intent(in ) :: OtherState !< Other states at t type(AFI_ParameterType), intent(in ) :: AFInfo(:) !< The airfoil parameter data @@ -1305,65 +1312,78 @@ subroutine FVW_CalcOutput(t, u, p, x, xd, z, OtherState, AFInfo, y, m, ErrStat, call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) ! Export to VTK - call WriteVTKOutputs() + if (m%VTKStep==-1) then + m%VTKStep = 0 ! Has never been called, special handling for init + else + m%VTKStep = m%iStep+1 ! We use glue code step number for outputs + endif + call WriteVTKOutputs(t, .False., u, p, x, z, y, m, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) -contains +end subroutine FVW_CalcOutput - !> Write to local VTK at fps requested - subroutine WriteVTKOutputs() - logical :: bGridOutNeeded - integer(IntKi) :: iW, iGrid - integer(IntKi) :: nSeg, nSegP - if (m%VTKStep==-1) then - m%VTKStep = 0 ! Has never been called, special handling for init - else - m%VTKStep = m%iStep+1 ! We use glue code step number for outputs +!> Write to vtk_fvw folder at fps requested +subroutine WriteVTKOutputs(t, force, u, p, x, z, y, m, ErrStat, ErrMsg) + real(DbKi), intent(in ) :: t !< Current simulation time in seconds + logical, intent(in ) :: force !< force the writing + type(FVW_InputType), intent(in ) :: u !< Inputs at Time t + type(FVW_ParameterType), intent(in ) :: p !< Parameters + type(FVW_ContinuousStateType), intent(in ) :: x !< Continuous states at t + type(FVW_ConstraintStateType), intent(in ) :: z !< Constraint states at t + type(FVW_OutputType), intent(in ) :: y !< Outputs computed at t (Input only so that mesh con- + type(FVW_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) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'FVW_CalcOutput' + integer(IntKi) :: iW, iGrid + integer(IntKi) :: nSeg, nSegP + if (p%WrVTK>0) then + if (m%FirstCall .or. force) then + call MKDIR(p%VTK_OutFileRoot) endif - if (p%WrVTK==1) then - if (m%FirstCall) then - call MKDIR(p%VTK_OutFileRoot) - endif - ! For plotting only - call PackPanelsToSegments(p, x, 1, (p%ShearModel==idShearMirror), m%nNW, m%nFW, m%Sgmt%Connct, m%Sgmt%Points, m%Sgmt%Gamma, m%Sgmt%Epsilon, nSeg, nSegP) - m%Vtot_LL = m%Vind_LL + m%Vwnd_LL - m%Vstr_LL - if (DEV_VERSION) then - call print_mean_3d(m%Vind_LL,'Mean induced vel. LL') - call print_mean_3d(m%Vtot_LL,'Mean relativevel. LL') + ! For plotting only + call PackPanelsToSegments(p, x, 1, (p%ShearModel==idShearMirror), m%nNW, m%nFW, m%Sgmt%Connct, m%Sgmt%Points, m%Sgmt%Gamma, m%Sgmt%Epsilon, nSeg, nSegP) + m%Vtot_LL = m%Vind_LL + m%Vwnd_LL - m%Vstr_LL + if (DEV_VERSION) then + call print_mean_3d(m%Vind_LL,'Mean induced vel. LL') + call print_mean_3d(m%Vtot_LL,'Mean relativevel. LL') + endif + if ( force .or. (( t - m%VTKlastTime ) >= p%DTvtk*OneMinusEpsilon )) then + m%VTKlastTime = t + if ((p%VTKCoord==2).or.(p%VTKCoord==3)) then + ! Hub reference coordinates, for export only, ALL VTK Will be exported in this coordinate system! + ! Note: hubOrientation and HubPosition are optional, but required for bladeFrame==TRUE + call WrVTK_FVW(p, x, z, m, trim(p%VTK_OutFileBase)//'FVW_Hub', m%VTKStep, 9, bladeFrame=.TRUE., & + HubOrientation=real(u%HubOrientation,ReKi),HubPosition=real(u%HubPosition,ReKi)) endif - if ( ( t - m%VTKlastTime ) >= p%DTvtk*OneMinusEpsilon ) then - m%VTKlastTime = t - if ((p%VTKCoord==2).or.(p%VTKCoord==3)) then - ! Hub reference coordinates, for export only, ALL VTK Will be exported in this coordinate system! - ! Note: hubOrientation and HubPosition are optional, but required for bladeFrame==TRUE - call WrVTK_FVW(p, x, z, m, trim(p%VTK_OutFileBase)//'FVW_Hub', m%VTKStep, 9, bladeFrame=.TRUE., & - HubOrientation=real(u%HubOrientation,ReKi),HubPosition=real(u%HubPosition,ReKi)) - endif - if ((p%VTKCoord==1).or.(p%VTKCoord==3)) then - ! Global coordinate system, ALL VTK will be exported in global - call WrVTK_FVW(p, x, z, m, trim(p%VTK_OutFileBase)//'FVW_Glb', m%VTKStep, 9, bladeFrame=.FALSE.) - endif + if ((p%VTKCoord==1).or.(p%VTKCoord==3)) then + ! Global coordinate system, ALL VTK will be exported in global + call WrVTK_FVW(p, x, z, m, trim(p%VTK_OutFileBase)//'FVW_Glb', m%VTKStep, 9, bladeFrame=.FALSE.) endif endif - ! --- Write VTK grids - if (p%nGridOut>0) then - if (m%FirstCall) then - call MKDIR(p%VTK_OutFileRoot) - endif - ! Distribute the Wind we requested to Inflow wind to storage Misc arrays - ! TODO ANDY: replace with direct call to inflow wind at Grid points - CALL DistributeRequestedWind_Grid(u%V_wind, p, m) - do iGrid=1,p%nGridOut - if ( ( t - m%GridOutputs(iGrid)%tLastOutput) >= m%GridOutputs(iGrid)%DTout * OneMinusEpsilon ) then - ! Compute induced velocity on grid, TODO use the same Tree for all CalcOutput - call InducedVelocitiesAll_OnGrid(m%GridOutputs(iGrid), p, x, m, ErrStat2, ErrMsg2); - m%GridOutputs(iGrid)%tLastOutput = t - call WrVTK_FVW_Grid(p, x, z, m, iGrid, trim(p%VTK_OutFileBase)//'FVW_Grid', m%VTKStep, 9) - endif - enddo + endif + ! --- Write VTK grids + if (p%nGridOut>0) then + if (m%FirstCall .or. force) then + call MKDIR(p%VTK_OutFileRoot) endif - end subroutine WriteVTKOutputs + ! Distribute the Wind we requested to Inflow wind to storage Misc arrays + ! TODO ANDY: replace with direct call to inflow wind at Grid points + CALL DistributeRequestedWind_Grid(u%V_wind, p, m) + do iGrid=1,p%nGridOut + if (force.or. (( t - m%GridOutputs(iGrid)%tLastOutput) >= m%GridOutputs(iGrid)%DTout * OneMinusEpsilon) ) then + ! Compute induced velocity on grid, TODO use the same Tree for all CalcOutput + call InducedVelocitiesAll_OnGrid(m%GridOutputs(iGrid), p, x, m, ErrStat2, ErrMsg2); + m%GridOutputs(iGrid)%tLastOutput = t + call WrVTK_FVW_Grid(p, x, z, m, iGrid, trim(p%VTK_OutFileBase)//'FVW_Grid', m%VTKStep, 9) + endif + enddo + endif +end subroutine WriteVTKOutputs -end subroutine FVW_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- ! --- UA related, should be merged with AeroDyn !---------------------------------------------------------------------------------------------------------------------------------- From c184f27b8b9ebcc54b84bec20c04eee474ce7009 Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Tue, 16 Feb 2021 16:19:09 -0700 Subject: [PATCH 22/27] FVW: fix tip and root when gamma is constant and FreeWakeStart>0 --- modules/aerodyn/src/FVW_Subs.f90 | 5 +++++ modules/aerodyn/src/FVW_VortexTools.f90 | 19 +++++++++++++------ 2 files changed, 18 insertions(+), 6 deletions(-) diff --git a/modules/aerodyn/src/FVW_Subs.f90 b/modules/aerodyn/src/FVW_Subs.f90 index d0a5632f6a..8153f95610 100644 --- a/modules/aerodyn/src/FVW_Subs.f90 +++ b/modules/aerodyn/src/FVW_Subs.f90 @@ -281,6 +281,11 @@ subroutine Map_NW_FW(p, m, z, x, ErrStat, ErrMsg) ! First circulation of Farwake is taken as the max circulation of last NW column FWGamma(:)=0.0_ReKi do iW=1,p%nWings + if (p%FullCirculationStart>0 .and. m%nFW<3) then + ! we might run into the issue that the circulation is 0 + m%iTip =-1 + m%iRoot=-1 + endif ! NOTE: on the first pass, m%iTip and m%iRoot are computed, TODO per blade call PlaceTipRoot(p%nSpan, x%Gamma_NW(:,m%nNW,iW), x%r_NW(1:3,:,m%nNW,iW), x%Eps_NW(1:3,:,m%nNW,iW),& ! inputs m%iRoot, m%iTip, FWGamma(iW), FWEpsTip, FWEpsRoot) ! outputs diff --git a/modules/aerodyn/src/FVW_VortexTools.f90 b/modules/aerodyn/src/FVW_VortexTools.f90 index e5b65cec91..bc1608be2c 100644 --- a/modules/aerodyn/src/FVW_VortexTools.f90 +++ b/modules/aerodyn/src/FVW_VortexTools.f90 @@ -100,16 +100,23 @@ subroutine PlaceTipRoot(n, Gamma_b, xV, Eps, iRoot, iTip, Gamma_max, EpsTip, Eps Gamma_max = maxval(Gamma_b,1) call CurvilinearDist(n+1, xV, s) if (iTip<0) then + ! Find position of tip and root call GammaTrailed(n, Gamma_b, Gamma_t) - i10 = minloc(abs(s(:)-0.15*s(n+1)),1) - i90 = minloc(abs(s(:)-0.85*s(n+1)),1) + ! If circulation is constant then use first and last + if(sum(abs(Gamma_t(:)))/(n+1)<1e-6) then + iTip =n+1 + iRoot=1 + else + i10 = minloc(abs(s(:)-0.15*s(n+1)),1) + i90 = minloc(abs(s(:)-0.85*s(n+1)),1) - rTip = sum(Gamma_t(i90:) * (s(i90:)))/ sum(Gamma_t(i90:)) - rRoot = sum(Gamma_t(1:i10) * s(1:i10)) / sum(Gamma_t(1:i10)) - iTip = minloc(abs(rTip - s), 1) ! NOTE: not accurate since epsilon has one dimension less.. - iRoot = minloc(abs(rRoot - s), 1) + rTip = sum(Gamma_t(i90:) * (s(i90:)))/ sum(Gamma_t(i90:)) + rRoot = sum(Gamma_t(1:i10) * s(1:i10)) / sum(Gamma_t(1:i10)) + iTip = minloc(abs(rTip - s), 1) ! NOTE: not accurate since epsilon has one dimension less.. + iRoot = minloc(abs(rRoot - s), 1) + endif endif rTip = s(iTip) rRoot = s(iRoot) From c6f57640e27c6eb9bfeb9696f41c341df29d6eef Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Tue, 16 Feb 2021 17:51:34 -0700 Subject: [PATCH 23/27] FVW: tip and root vorticity placement per blade --- modules/aerodyn/src/FVW.f90 | 4 +- modules/aerodyn/src/FVW_Registry.txt | 4 +- modules/aerodyn/src/FVW_Subs.f90 | 18 +++-- modules/aerodyn/src/FVW_Types.f90 | 110 +++++++++++++++++++++++++-- 4 files changed, 116 insertions(+), 20 deletions(-) diff --git a/modules/aerodyn/src/FVW.f90 b/modules/aerodyn/src/FVW.f90 index 5126fe7245..21a10443ed 100644 --- a/modules/aerodyn/src/FVW.f90 +++ b/modules/aerodyn/src/FVW.f90 @@ -188,8 +188,8 @@ subroutine FVW_InitMiscVars( p, m, ErrStat, ErrMsg ) m%VTKStep = -1 ! Counter of VTK outputs m%VTKlastTime = -HUGE(1.0_DbKi) m%tSpent = 0 - m%iTip = -1 ! Index where tip vorticity will be placed - m%iRoot = -1 ! Index where root vorticity will be placed + call AllocAry(m%iTip, p%nWings, 'iTip', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%iTip = -1;! Important init + call AllocAry(m%iRoot, p%nWings, 'iRoot', ErrStat2, ErrMsg2); call SetErrStat(ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName); m%iRoot = -1;! Important init call AllocAry( m%LE , 3 , p%nSpan+1 , p%nWings, 'Leading Edge Points', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%LE = -999999_ReKi; call AllocAry( m%TE , 3 , p%nSpan+1 , p%nWings, 'TrailingEdge Points', ErrStat2, ErrMsg2 );call SetErrStat ( ErrStat2, ErrMsg2, ErrStat,ErrMsg,RoutineName ); m%TE = -999999_ReKi; diff --git a/modules/aerodyn/src/FVW_Registry.txt b/modules/aerodyn/src/FVW_Registry.txt index f759342cd1..fa90a26f56 100644 --- a/modules/aerodyn/src/FVW_Registry.txt +++ b/modules/aerodyn/src/FVW_Registry.txt @@ -125,8 +125,8 @@ typedef ^ ^ ReKi typedef ^ ^ IntKi nNW - - - "Number of active near wake panels" - typedef ^ ^ IntKi nFW - - - "Number of active far wake panels" - typedef ^ ^ IntKi iStep - - - "Current step number used for update state" - -typedef ^ ^ IntKi iTip - - - "Index where tip vorticity will be placed. TODO, per blade" - -typedef ^ ^ IntKi iRoot - - - "Index where root vorticity will be placed" - +typedef ^ ^ IntKi iTip : - - "Index where tip vorticity will be placed. TODO, per blade" - +typedef ^ ^ IntKi iRoot : - - "Index where root vorticity will be placed" - typedef ^ ^ IntKi VTKstep - - - "Current vtk output step number" - typedef ^ ^ DbKi VTKlastTime - - - "Time the last VTK file set was written out" s typedef ^ ^ ReKi r_wind :: - - "List of points where wind is requested for next time step" - diff --git a/modules/aerodyn/src/FVW_Subs.f90 b/modules/aerodyn/src/FVW_Subs.f90 index 8153f95610..8fba1fbc1e 100644 --- a/modules/aerodyn/src/FVW_Subs.f90 +++ b/modules/aerodyn/src/FVW_Subs.f90 @@ -283,25 +283,27 @@ subroutine Map_NW_FW(p, m, z, x, ErrStat, ErrMsg) do iW=1,p%nWings if (p%FullCirculationStart>0 .and. m%nFW<3) then ! we might run into the issue that the circulation is 0 - m%iTip =-1 - m%iRoot=-1 + m%iTip(iW) =-1 + m%iRoot(iW)=-1 endif ! NOTE: on the first pass, m%iTip and m%iRoot are computed, TODO per blade call PlaceTipRoot(p%nSpan, x%Gamma_NW(:,m%nNW,iW), x%r_NW(1:3,:,m%nNW,iW), x%Eps_NW(1:3,:,m%nNW,iW),& ! inputs - m%iRoot, m%iTip, FWGamma(iW), FWEpsTip, FWEpsRoot) ! outputs + m%iRoot(iW), m%iTip(iW), FWGamma(iW), FWEpsTip, FWEpsRoot) ! outputs x%Gamma_FW(1:FWnSpan,iAgeFW,iW) = FWGamma(iW) x%Eps_FW(3,1:FWnSpan,iAgeFW,iW) = FWEpsTip ! HACK tip put in third x%Eps_FW(2,1:FWnSpan,iAgeFW,iW) = FWEpsRoot ! HACK root put in second x%Eps_FW(1,1:FWnSpan,iAgeFW,iW) = FWEpsTip ! For shed vorticity.. enddo - iTip = m%iTip - iRoot = m%iRoot - else - iRoot=1 - iTip=p%nSpan+1 endif ! Far wake point always mapped to last near wake do iW=1,p%nWings + if (m%nNW==p%nNWMax) then + iTip = m%iTip(iW) + iRoot = m%iRoot(iW) + else + iRoot = 1 + iTip = p%nSpan+1 + endif x%r_FW(1:3,1 ,iAgeFW,iW) = x%r_NW(1:3,iRoot,p%nNWMax+1,iW) ! Point 1 (root) x%r_FW(1:3,FWnSpan+1,iAgeFW,iW) = x%r_NW(1:3,iTip ,p%nNWMax+1,iW) ! Point FWnSpan (tip) !if ((FWnSpan==2)) then diff --git a/modules/aerodyn/src/FVW_Types.f90 b/modules/aerodyn/src/FVW_Types.f90 index f20e091edf..ae36dce845 100644 --- a/modules/aerodyn/src/FVW_Types.f90 +++ b/modules/aerodyn/src/FVW_Types.f90 @@ -152,8 +152,8 @@ MODULE FVW_Types INTEGER(IntKi) :: nNW !< Number of active near wake panels [-] INTEGER(IntKi) :: nFW !< Number of active far wake panels [-] INTEGER(IntKi) :: iStep !< Current step number used for update state [-] - INTEGER(IntKi) :: iTip !< Index where tip vorticity will be placed. TODO, per blade [-] - INTEGER(IntKi) :: iRoot !< Index where root vorticity will be placed [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iTip !< Index where tip vorticity will be placed. TODO, per blade [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: iRoot !< Index where root vorticity will be placed [-] INTEGER(IntKi) :: VTKstep !< Current vtk output step number [-] REAL(DbKi) :: VTKlastTime !< Time the last VTK file set was written out [s] REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: r_wind !< List of points where wind is requested for next time step [-] @@ -3013,8 +3013,30 @@ SUBROUTINE FVW_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) DstMiscData%nNW = SrcMiscData%nNW DstMiscData%nFW = SrcMiscData%nFW DstMiscData%iStep = SrcMiscData%iStep +IF (ALLOCATED(SrcMiscData%iTip)) THEN + i1_l = LBOUND(SrcMiscData%iTip,1) + i1_u = UBOUND(SrcMiscData%iTip,1) + IF (.NOT. ALLOCATED(DstMiscData%iTip)) THEN + ALLOCATE(DstMiscData%iTip(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%iTip.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF DstMiscData%iTip = SrcMiscData%iTip +ENDIF +IF (ALLOCATED(SrcMiscData%iRoot)) THEN + i1_l = LBOUND(SrcMiscData%iRoot,1) + i1_u = UBOUND(SrcMiscData%iRoot,1) + IF (.NOT. ALLOCATED(DstMiscData%iRoot)) THEN + ALLOCATE(DstMiscData%iRoot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscData%iRoot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF DstMiscData%iRoot = SrcMiscData%iRoot +ENDIF DstMiscData%VTKstep = SrcMiscData%VTKstep DstMiscData%VTKlastTime = SrcMiscData%VTKlastTime IF (ALLOCATED(SrcMiscData%r_wind)) THEN @@ -3448,6 +3470,12 @@ SUBROUTINE FVW_DestroyMisc( MiscData, ErrStat, ErrMsg ) IF (ALLOCATED(MiscData%Vind_FW)) THEN DEALLOCATE(MiscData%Vind_FW) ENDIF +IF (ALLOCATED(MiscData%iTip)) THEN + DEALLOCATE(MiscData%iTip) +ENDIF +IF (ALLOCATED(MiscData%iRoot)) THEN + DEALLOCATE(MiscData%iRoot) +ENDIF IF (ALLOCATED(MiscData%r_wind)) THEN DEALLOCATE(MiscData%r_wind) ENDIF @@ -3670,8 +3698,16 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 1 ! nNW Int_BufSz = Int_BufSz + 1 ! nFW Int_BufSz = Int_BufSz + 1 ! iStep - Int_BufSz = Int_BufSz + 1 ! iTip - Int_BufSz = Int_BufSz + 1 ! iRoot + Int_BufSz = Int_BufSz + 1 ! iTip allocated yes/no + IF ( ALLOCATED(InData%iTip) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! iTip upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%iTip) ! iTip + END IF + Int_BufSz = Int_BufSz + 1 ! iRoot allocated yes/no + IF ( ALLOCATED(InData%iRoot) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! iRoot upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%iRoot) ! iRoot + END IF Int_BufSz = Int_BufSz + 1 ! VTKstep Db_BufSz = Db_BufSz + 1 ! VTKlastTime Int_BufSz = Int_BufSz + 1 ! r_wind allocated yes/no @@ -4475,10 +4511,36 @@ SUBROUTINE FVW_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = InData%iStep Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iTip + IF ( .NOT. ALLOCATED(InData%iTip) ) 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%iTip,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%iTip,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%iTip,1), UBOUND(InData%iTip,1) + IntKiBuf(Int_Xferred) = InData%iTip(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%iRoot) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 - IntKiBuf(Int_Xferred) = InData%iRoot + ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%iRoot,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%iRoot,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%iRoot,1), UBOUND(InData%iRoot,1) + IntKiBuf(Int_Xferred) = InData%iRoot(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF IntKiBuf(Int_Xferred) = InData%VTKstep Int_Xferred = Int_Xferred + 1 DbKiBuf(Db_Xferred) = InData%VTKlastTime @@ -5790,10 +5852,42 @@ SUBROUTINE FVW_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Xferred = Int_Xferred + 1 OutData%iStep = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - OutData%iTip = IntKiBuf(Int_Xferred) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! iTip not allocated Int_Xferred = Int_Xferred + 1 - OutData%iRoot = IntKiBuf(Int_Xferred) + 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%iTip)) DEALLOCATE(OutData%iTip) + ALLOCATE(OutData%iTip(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%iTip.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%iTip,1), UBOUND(OutData%iTip,1) + OutData%iTip(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! iRoot 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%iRoot)) DEALLOCATE(OutData%iRoot) + ALLOCATE(OutData%iRoot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%iRoot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%iRoot,1), UBOUND(OutData%iRoot,1) + OutData%iRoot(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF OutData%VTKstep = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 OutData%VTKlastTime = DbKiBuf(Db_Xferred) From a13f3dd405477a0338265b070bae82611552d691 Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Tue, 16 Feb 2021 17:52:27 -0700 Subject: [PATCH 24/27] FVW: reynolds number in million for AFI --- modules/aerodyn/src/FVW_Subs.f90 | 4 ++-- modules/aerodyn/src/FVW_Wings.f90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/modules/aerodyn/src/FVW_Subs.f90 b/modules/aerodyn/src/FVW_Subs.f90 index 8fba1fbc1e..840ad21b3a 100644 --- a/modules/aerodyn/src/FVW_Subs.f90 +++ b/modules/aerodyn/src/FVW_Subs.f90 @@ -1320,7 +1320,7 @@ subroutine FVW_AeroOuts( M_sg, M_ag, PitchAndTwist, Vstr_g, Vind_g, Vwnd_g, Kin Vtot_a = matmul(M_ag, Vtot_g) alpha = atan2( Vtot_a(1), Vtot_a(2) ) Vrel_norm = sqrt(Vtot_a(1)**2 + Vtot_a(2)**2) ! NOTE: z component shoudn't be used - Re = Chord * Vrel_norm / KinVisc / 1.0E6 + Re = Chord * Vrel_norm / KinVisc ! Reynolds number (not in million) ! Section coordinates: used to define axial induction andflow angle Vstr_s = matmul(M_sg, Vstr_g) @@ -1354,7 +1354,7 @@ subroutine AlphaVrel_Generic(M_ag, Vstr_g, Vind_g, Vwnd_g, KinVisc, Chord, Vrel Vtot_a = matmul(M_ag, Vtot_g) alpha = atan2( Vtot_a(1), Vtot_a(2) ) Vrel_norm = sqrt(Vtot_a(1)**2 + Vtot_a(2)**2) ! NOTE: z component shoudn't be used - Re = Chord * Vrel_norm / KinVisc / 1.0E6 + Re = Chord * Vrel_norm / KinVisc ! Reynolds number NOTE: not in million end subroutine AlphaVrel_Generic diff --git a/modules/aerodyn/src/FVW_Wings.f90 b/modules/aerodyn/src/FVW_Wings.f90 index 4f21479d66..cd09a9cf4c 100644 --- a/modules/aerodyn/src/FVW_Wings.f90 +++ b/modules/aerodyn/src/FVW_Wings.f90 @@ -480,7 +480,7 @@ subroutine CirculationFromPolarData(Gamma_LL, p, m, AFInfo, ErrStat, ErrMsg) Vrel_norm = TwoNorm(Vrel) alpha = atan2(dot_product(Vrel,N) , dot_product(Vrel,Tc) ) ! [rad] - Re = p%Chord(icp,iW) * Vrel_norm / p%KinVisc / 1.0E6 + Re = p%Chord(icp,iW) * Vrel_norm / p%KinVisc ! Reynolds number (not in Million) !if (p%CircSolvPolar==idPolarAeroDyn) then ! compute steady Airfoil Coefs ! NOTE: UserProp set to 0.0_ReKi (no idea what it does). Also, note this assumes airfoils at nodes. From 0f2afaf478cb1350d01f28f14d8159311e65a348 Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Fri, 5 Mar 2021 19:22:31 -0700 Subject: [PATCH 25/27] FVW: improved bounding of tip/root placement --- modules/aerodyn/src/FVW_VortexTools.f90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/modules/aerodyn/src/FVW_VortexTools.f90 b/modules/aerodyn/src/FVW_VortexTools.f90 index bc1608be2c..433a786ebd 100644 --- a/modules/aerodyn/src/FVW_VortexTools.f90 +++ b/modules/aerodyn/src/FVW_VortexTools.f90 @@ -116,12 +116,14 @@ subroutine PlaceTipRoot(n, Gamma_b, xV, Eps, iRoot, iTip, Gamma_max, EpsTip, Eps rRoot = sum(Gamma_t(1:i10) * s(1:i10)) / sum(Gamma_t(1:i10)) iTip = minloc(abs(rTip - s), 1) ! NOTE: not accurate since epsilon has one dimension less.. iRoot = minloc(abs(rRoot - s), 1) + iTip = max(min(iTip,n+1), i90) + iRoot = min(max(iRoot,1) , i10) endif endif rTip = s(iTip) rRoot = s(iRoot) - iTipPanel = min(iTip,n) - iRootPanel = max(iRoot,1) + iTipPanel = max(min(iTip,n), 1) + iRootPanel = min(max(iRoot,1),n) ! Mean regularization at the tip and root EpsTip = sum(Eps(1,iTipPanel:)) /(n-iTipPanel+1) EpsRoot = sum(Eps(1,1:iRootPanel))/(iRootPanel) From 617c11d72b00d4a18a6ab77ee3c856d0db1ff7a1 Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Mon, 22 Mar 2021 15:21:46 -0600 Subject: [PATCH 26/27] Update of r-test for weis_olaf branch --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index fb2a88792e..ee3b6103bf 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit fb2a88792ea6c12ac9bb58baf9d6a0bf5995981d +Subproject commit ee3b6103bf2db31362fc20de39405b11ab26870e From 96f93814d2bce7910e64f4fec35e5114b159d12d Mon Sep 17 00:00:00 2001 From: Emmanuel Branlard Date: Mon, 22 Mar 2021 17:48:20 -0600 Subject: [PATCH 27/27] Update of r-test (hd_taperedCylinder missing) --- reg_tests/r-test | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reg_tests/r-test b/reg_tests/r-test index ee3b6103bf..89185e7341 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit ee3b6103bf2db31362fc20de39405b11ab26870e +Subproject commit 89185e7341148a103a68ad8992a3cf6c7f4b02c9