diff --git a/modules/aerodyn/src/UA_Dvr_Subs.f90 b/modules/aerodyn/src/UA_Dvr_Subs.f90 index be9f61eabe..aff43dcae6 100644 --- a/modules/aerodyn/src/UA_Dvr_Subs.f90 +++ b/modules/aerodyn/src/UA_Dvr_Subs.f90 @@ -5,10 +5,17 @@ module UA_Dvr_Subs use AirfoilInfo_Types use UnsteadyAero_Types use UnsteadyAero + use LinDyn implicit none - integer, parameter :: NumAFfiles = 1 + integer, parameter :: NumAFfiles = 1 + integer(IntKi), parameter :: NumInp = 2 ! Number of inputs sent to UA_UpdateStates (must be at least 2) + real(ReKi), parameter :: myNaN = -99.9_ReKi + integer(IntKi), parameter :: idFmtAscii = 1 + integer(IntKi), parameter :: idFmtBinary = 2 + integer(IntKi), parameter :: idFmtBoth = 3 + integer(IntKi), parameter, dimension(3) :: idFmtVALID = (/idFmtAscii, idFmtBinary, idFmtBoth/) type UA_Dvr_InitInput logical :: Echo @@ -41,7 +48,50 @@ module UA_Dvr_Subs real(ReKi) :: initPos(3) real(ReKi) :: initVel(3) end type UA_Dvr_InitInput - + + + type :: Dvr_Outputs + integer(intki) :: unOutFile = -1 !< unit number for writing output file + !integer(intki) :: actualchanlen !< actual length of channels written to text file (less than or equal to chanlen) [-] + integer(intki) :: nDvrOutputs=0 !< number of outputs for the driver (without ad and iw) [-] + !character(20) :: fmt_t !< format specifier for time channel [-] + !character(25) :: fmt_a !< format specifier for each column (including delimiter) [-] + !character(1) :: delim !< column delimiter [-] + !character(20) :: outfmt !< format specifier [-] + integer(intki) :: fileFmt = idFmtBinary !< output format 1=text, 2=binary, 3=both [-] + character(1024) :: root = '' !< output file rootname [-] + character(chanlen) , dimension(:), allocatable :: writeoutputhdr !< channel headers [-] + character(chanlen) , dimension(:), allocatable :: writeoutputunt !< channel units [-] + real(ReKi) , dimension(:,:), allocatable :: storage !< nchannel x ntime [-] + real(ReKi) , dimension(:), allocatable :: outline !< output line to be written to disk [-] + !real(dbki) :: dt_outs !< output time resolution [s] + !integer(intki) :: n_dt_out !< number of time steps between writing a line in the time-marching output files [-] + end type Dvr_Outputs + + type Dvr_Data + real(ReKi) :: dt + type(Dvr_Outputs) :: out + type(UA_InitInputType) , pointer :: UA_InitInData ! Input data for initialization + type(UA_InitOutputType) , pointer :: UA_InitOutData ! Output data from initialization + type(UA_ContinuousStateType), pointer :: UA_x ! Continuous states + type(UA_DiscreteStateType) , pointer :: UA_xd ! Discrete states + type(UA_OtherStateType) , pointer :: UA_OtherState ! Other/optimization states + type(UA_MiscVarType) , pointer :: UA_m ! Misc/optimization variables + type(UA_ParameterType) , pointer :: UA_p ! Parameters + type(UA_InputType) , pointer :: UA_u(:) ! System inputs + type(UA_OutputType) , pointer :: UA_y ! System outputs + type(LD_InitInputType) , pointer :: LD_InitInData ! Input data for initialization + type(LD_InitOutputType) , pointer :: LD_InitOutData ! Output data from initialization + type(LD_ContinuousStateType), pointer :: LD_x ! Continuous states + type(LD_DiscreteStateType) , pointer :: LD_xd ! Discrete states + type(LD_OtherStateType) , pointer :: LD_OtherState ! Other/optimization states + type(LD_ConstraintStateType), pointer :: LD_z ! Constraint states + type(LD_MiscVarType) , pointer :: LD_m ! Misc/optimization variables + type(LD_ParameterType) , pointer :: LD_p ! Parameters + type(LD_InputType) , pointer :: LD_u(:) ! System inputs + type(LD_OutputType) , pointer :: LD_y ! System outputs + end type Dvr_Data + contains !-------------------------------------------------------------------------------------------------------------- @@ -355,8 +405,302 @@ subroutine Cleanup() call AFI_DestroyInitInput(AFI_InitInputs, errStat2, errMsg2) end subroutine Cleanup end subroutine Init_AFI + + +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine Dvr_EndSim(dvr, errStat, errMsg) + type(Dvr_Data), target, intent(inout) :: dvr ! driver data + integer(IntKi) , intent(out) :: errStat ! Status of error message + character(*) , intent(out) :: errMsg ! Error message if errStat /= ErrID_None + character(ErrMsgLen) :: errMsg2 ! temporary Error message if errStat /= ErrID_None + integer(IntKi) :: errStat2 ! temporary Error status of the operation + character(*), parameter :: RoutineName = 'Dvr_EndSim' + type(Dvr_Outputs), pointer :: out ! driver output, data + out => dvr%out + errStat = ErrID_None + errMsg = '' + ! Close the output file + if (out%fileFmt==idFmtBoth .or. out%fileFmt == idFmtAscii) then + if (out%unOutFile > 0) close(out%unOutFile) + endif + if (out%fileFmt==idFmtBoth .or. out%fileFmt == idFmtBinary) then + print*,'>>>> OUTPUT',trim(out%Root)//'.outb' + call WrBinFAST(trim(out%Root)//'.outb', FileFmtID_ChanLen_In, 'AeroDynDriver', out%WriteOutputHdr, out%WriteOutputUnt, (/0.0_DbKi, dvr%dt/), out%storage(:,:), errStat2, errMsg2) + call SetErrStat(errStat2, errMsg2, errStat, errMsg, RoutineName) + endif +end subroutine Dvr_EndSim + +! -------------------------------------------------------------------------------- +! --- IO +! -------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------------------------------------------------------- +!> Concatenate new output channels info to the extisting ones in the driver +!! TODO COPY PASTED FROM AeroDyn_Inflow. Should be placed in NWTC_Lib +subroutine concatOutputHeaders(WriteOutputHdr0, WriteOutputUnt0, WriteOutputHdr, WriteOutputUnt, errStat, errMsg) + character(ChanLen), dimension(:), allocatable, intent(inout) :: WriteOutputHdr0 !< Channel headers + character(ChanLen), dimension(:), allocatable, intent(inout) :: WriteOutputUnt0 !< Channel units + character(ChanLen), dimension(:), allocatable, intent(inout) :: WriteOutputHdr !< Channel headers + character(ChanLen), dimension(:), allocatable, intent(inout) :: WriteOutputUnt !< Channel units + integer(IntKi) , intent( out) :: errStat !< Status of error message + character(*) , intent( out) :: errMsg !< Error message if errStat /= ErrID_None + ! Locals + character(ChanLen), allocatable :: TmpHdr(:) + character(ChanLen), allocatable :: TmpUnt(:) + integer :: nOld, nAdd + errStat = ErrID_None + errMsg = '' + !print*,'>>> Concat',allocated(WriteOutputHdr0), allocated(WriteOutputUnt0), allocated(WriteOutputHdr), allocated(WriteOutputUnt) + if (.not.allocated(WriteOutputHdr)) return + if (.not.allocated(WriteOutputHdr0)) then + call move_alloc(WriteOutputHdr, WriteOutputHdr0) + call move_alloc(WriteOutputUnt, WriteOutputUnt0) + else + nOld = size(WriteOutputHdr0) + nAdd = size(WriteOutputHdr) + + call move_alloc(WriteOutputHdr0, TmpHdr) + call move_alloc(WriteOutputUnt0, TmpUnt) + + allocate(WriteOutputHdr0(nOld+nAdd)) + allocate(WriteOutputUnt0(nOld+nAdd)) + WriteOutputHdr0(1:nOld) = TmpHdr + WriteOutputUnt0(1:nOld) = TmpUnt + WriteOutputHdr0(nOld+1:nOld+nAdd) = WriteOutputHdr + WriteOutputUnt0(nOld+1:nOld+nAdd) = WriteOutputUnt + deallocate(TmpHdr) + deallocate(TmpUnt) + endif +end subroutine concatOutputHeaders +!---------------------------------------------------------------------------------------------------------------------------------- +!> Initialize outputs to file for driver +subroutine Dvr_InitializeOutputs(out, numSteps, errStat, errMsg) + type(Dvr_Outputs), intent(inout) :: out + integer(IntKi) , intent(in ) :: numSteps ! Number of time steps + integer(IntKi) , intent( out) :: errStat ! Status of error message + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None + ! locals + integer(IntKi) :: numOuts +! integer(IntKi) :: i +! integer(IntKi) :: numSpaces +! integer(IntKi) :: iWT +! character(ChanLen) :: colTxt +! character(ChanLen) :: caseTxt +! + numOuts = size(out%WriteOutputHdr) + + call AllocAry(out%outLine, numOuts-1, 'outLine', errStat, errMsg); ! NOTE: time not stored + out%outLine=0.0_ReKi +! +! ! --- Ascii +! if (out%fileFmt==idFmtBoth .or. out%fileFmt == idFmtAscii) then +! +! ! compute the width of the column output +! numSpaces = out%ActualChanLen ! the size of column produced by OutFmt +! out%ActualChanLen = max( out%ActualChanLen, MinChanLen ) ! set this to at least MinChanLen , or the size of the column produced by OutFmt +! do i=1,numOuts +! out%ActualChanLen = max(out%ActualChanLen, LEN_TRIM(out%WriteOutputHdr(i))) +! out%ActualChanLen = max(out%ActualChanLen, LEN_TRIM(out%WriteOutputUnt(i))) +! end do +! +! ! create format statements for time and the array outputs: +! out%Fmt_t = '(F'//trim(num2lstr(out%ActualChanLen))//'.4)' +! out%Fmt_a = '"'//out%delim//'"'//trim(out%outFmt) ! format for array elements from individual modules +! numSpaces = out%ActualChanLen - numSpaces ! the difference between the size of the headers and what is produced by OutFmt +! if (numSpaces > 0) then +! out%Fmt_a = trim(out%Fmt_a)//','//trim(num2lstr(numSpaces))//'x' +! end if +! +! ! --- Start writing to ascii input file +! do iWT=1,nWT +! if (nWT>1) then +! sWT = '.T'//trim(num2lstr(iWT)) +! else +! sWT = '' +! endif +! call GetNewUnit(out%unOutFile(iWT), errStat, errMsg) +! if ( errStat >= AbortErrLev ) then +! out%unOutFile(iWT) = -1 +! return +! end if +! call OpenFOutFile ( out%unOutFile(iWT), trim(out%Root)//trim(sWT)//'.out', errStat, errMsg ) +! if ( errStat >= AbortErrLev ) return +! write (out%unOutFile(iWT),'(/,A)') 'Predictions were generated on '//CurDate()//' at '//CurTime()//' using '//trim( version%Name ) +! write (out%unOutFile(iWT),'(1X,A)') trim(GetNVD(out%AD_ver)) +! write (out%unOutFile(iWT),'()' ) !print a blank line +! write (out%unOutFile(iWT),'()' ) !print a blank line +! write (out%unOutFile(iWT),'()' ) !print a blank line +! +! ! Write the names of the output parameters on one line: +! do i=1,numOuts +! call WrFileNR ( out%unOutFile(iWT), out%delim//out%WriteOutputHdr(i)(1:out%ActualChanLen) ) +! end do ! i +! write (out%unOutFile(iWT),'()') +! +! ! Write the units of the output parameters on one line: +! do i=1,numOuts +! call WrFileNR ( out%unOutFile(iWT), out%delim//out%WriteOutputUnt(i)(1:out%ActualChanLen) ) +! end do ! i +! write (out%unOutFile(iWT),'()') +! enddo +! endif +! + ! --- Binary + if (out%fileFmt==idFmtBoth .or. out%fileFmt == idFmtBinary) then + call AllocAry(out%storage, numOuts-1, numSteps, 'storage', errStat, errMsg) + out%storage= myNaN !0.0_ReKi ! Alternative: myNaN + endif +end subroutine Dvr_InitializeOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +!> Initialize driver (not module-level) output channels +subroutine Dvr_InitializeDriverOutputs(dvr, out, errStat, errMsg) + type(Dvr_Data), intent(inout) :: dvr ! driver data + type(Dvr_Outputs), intent(inout) :: out ! driver output data + integer(IntKi) , intent( out) :: errStat ! Status of error message + character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None + integer(IntKi) :: errStat2 ! Status of error message + character(ErrMsgLen) :: errMsg2 ! Error message + integer :: j + errStat = ErrID_None + errMsg = '' + + ! --- Allocate driver-level outputs + out%nDvrOutputs = 6 ! temporary hack + + call AllocAry(out%WriteOutputHdr, 1+out%nDvrOutputs, 'WriteOutputHdr', errStat2, errMsg2); if(Failed()) return + call AllocAry(out%WriteOutputUnt, 1+out%nDvrOutputs, 'WriteOutputUnt', errStat2, errMsg2); if(Failed()) return + + j=1 + out%WriteOutputHdr(j) = 'Time' ; out%WriteOutputUnt(j) = '(s)' ; j=j+1 + ! HACK + out%WriteOutputHdr(j) = 'x' ; out%WriteOutputUnt(j) = '(m)' ; j=j+1 + out%WriteOutputHdr(j) = 'y' ; out%WriteOutputUnt(j) = '(m)' ; j=j+1 + out%WriteOutputHdr(j) = 'th' ; out%WriteOutputUnt(j) = '(rad)' ; j=j+1 + out%WriteOutputHdr(j) = 'dx' ; out%WriteOutputUnt(j) = '(m/s)' ; j=j+1 + out%WriteOutputHdr(j) = 'dy' ; out%WriteOutputUnt(j) = '(m/s)' ; j=j+1 + out%WriteOutputHdr(j) = 'dth' ; out%WriteOutputUnt(j) = '(rad/s)' ; j=j+1 +contains + logical function Failed() + CALL SetErrStat(errStat2, errMsg2, errStat, errMsg, 'Dvr_InitializeDriverOutputs' ) + Failed = errStat >= AbortErrLev + end function Failed +end subroutine Dvr_InitializeDriverOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +! !> Store driver data +! subroutine Dvr_CalcOutputDriver(dvr, y_ADI, FED, errStat, errMsg) +! type(Dvr_SimData), target, intent(inout) :: dvr ! driver data +! type(FED_Data), target, intent(in ) :: FED !< Elastic wind turbine data (Fake ElastoDyn) +! type(ADI_OutputType), intent(in ) :: y_ADI ! ADI output data +! integer(IntKi) , intent( out) :: errStat ! Status of error message +! character(*) , intent( out) :: errMsg ! Error message if errStat /= ErrID_None +! integer :: maxNumBlades, k, j, iWT +! real(ReKi) :: rotations(3) +! integer(IntKi) :: errStat2 ! Status of error message +! character(ErrMsgLen) :: errMsg2 ! Error message +! real(ReKi), pointer :: arr(:) +! type(WTData), pointer :: wt ! Alias to shorten notation +! type(RotFED), pointer :: y_ED ! Alias to shorten notation +! +! errStat = ErrID_None +! errMsg = '' +! +! maxNumBlades = 0 +! do iWT=1,size(dvr%WT) +! maxNumBlades= max(maxNumBlades, dvr%WT(iWT)%numBlades) +! end do +! +! ! Determine if a swap array is present +! +! do iWT = 1, dvr%numTurbines +! wt => dvr%wt(iWT) +! y_ED => FED%wt(iWT) +! if (dvr%wt(iWT)%numBlades >0 ) then ! TODO, export for tower only +! arr => dvr%wt(iWT)%WriteOutput +! k=1 +! ! NOTE: to do this properly we would need to store at the previous time step and perform a rotation +! arr(k) = dvr%iCase ; k=k+1 +! ! Environment +! arr(k) = y_ADI%HHVel(1, iWT) ; k=k+1 ! NOTE: stored at beginning of array +! arr(k) = y_ADI%HHVel(2, iWT) ; k=k+1 +! arr(k) = y_ADI%HHVel(3, iWT) ; k=k+1 +! arr(k) = y_ADI%PLExp ; k=k+1 ! shear exp, not set if CompInflow=1 +! +! ! 6 base DOF +! rotations = EulerExtract(y_ED%PlatformPtMesh%Orientation(:,:,1)); +! arr(k) = y_ED%PlatformPtMesh%TranslationDisp(1,1); k=k+1 ! surge +! arr(k) = y_ED%PlatformPtMesh%TranslationDisp(2,1); k=k+1 ! sway +! arr(k) = y_ED%PlatformPtMesh%TranslationDisp(3,1); k=k+1 ! heave +! arr(k) = rotations(1) * R2D ; k=k+1 ! roll +! arr(k) = rotations(2) * R2D ; k=k+1 ! pitch +! arr(k) = rotations(3) * R2D ; k=k+1 ! yaw +! ! RNA motion +! arr(k) = wt%nac%yaw*R2D ; k=k+1 ! yaw [deg] +! arr(k) = modulo(real(wt%hub%azimuth+(dvr%dt * wt%hub%rotSpeed)*R2D, ReKi), 360.0_ReKi); k=k+1 ! azimuth [deg], stored at nt-1 +! arr(k) = wt%hub%rotSpeed*RPS2RPM; k=k+1 ! rotspeed [rpm] +! do j=1,maxNumBlades +! if (j<= wt%numBlades) then +! arr(k) = wt%bld(j)%pitch*R2D ! pitch [deg] +! else +! arr(k) = 0.0_ReKi ! myNaN +! endif +! k=k+1; +! enddo +! ! Swap array +! if (wt%hub%motionType == idHubMotionUserFunction) then +! do j=1,size(wt%userSwapArray) +! arr(k) = wt%userSwapArray(j); k=k+1; +! enddo +! endif +! +! endif +! enddo +! +! end subroutine Dvr_CalcOutputDriver +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine Dvr_WriteOutputs(nt, t, dvr, out, errStat, errMsg) + integer(IntKi) , intent(in ) :: nt ! simulation time step + real(DbKi) , intent(in ) :: t ! simulation time (s) + type(Dvr_Data), intent(inout) :: dvr ! driver data + type(Dvr_Outputs) , intent(inout) :: out ! driver uotput options + integer(IntKi) , intent(inout) :: errStat ! Status of error message + character(*) , intent(inout) :: errMsg ! Error message if errStat /= ErrID_None +! ! Local variables. +! character(ChanLen) :: tmpStr ! temporary string to print the time output as text + integer :: nDV , nUA, nLD + errStat = ErrID_None + errMsg = '' + out%outLine = myNaN ! Safety +! +! ! Packing all outputs excpet time into one array + !nUA = size(yADI%AD%rotors(1)%WriteOutput) + !nLD = size(yADI%IW_WriteOutput) + nLD = 6 ! HACK + nDV = out%nDvrOutputs + !out%outLine(1:nDV) = dvr%LD_x%q(1:nDV) ! Driver Write Outputs + out%outLine(1:nLD) = dvr%LD_x%q(1:nDV) ! Driver Write Outputs + + + !out%outLine(nDV+1:nDV+nAD) = yADI%AD%rotors%WriteOutput ! AeroDyn WriteOutputs + !out%outLine(nDV+nAD+1:) = yADI%IW_WriteOutput ! InflowWind WriteOutputs + !if (out%fileFmt==idFmtBoth .or. out%fileFmt == idFmtAscii) then + ! ! ASCII + ! ! time + ! write( tmpStr, out%Fmt_t ) t ! '(F15.4)' + ! call WrFileNR( out%unOutFile, tmpStr(1:out%ActualChanLen) ) + ! call WrNumAryFileNR(out%unOutFile, out%outLine, out%Fmt_a, errStat, errMsg) + ! ! write a new line (advance to the next line) + ! write(out%unOutFile,'()') + !endif + if (out%fileFmt==idFmtBoth .or. out%fileFmt == idFmtBinary) then + ! Store for binary + out%storage(:, nt) = out%outLine(:) + !out%storage(1:nDV+nAD+nIW, nt) = out%outLine(1:nDV+nAD+nIW) + endif +end subroutine Dvr_WriteOutputs +! + + subroutine WriteAFITables(AFI_Params, OutRootName, UseCm, UA_f_cn) type(AFI_ParameterType), intent(in), target :: AFI_Params diff --git a/modules/aerodyn/src/UnsteadyAero_Driver.f90 b/modules/aerodyn/src/UnsteadyAero_Driver.f90 index 36312bc4b3..8369a8632a 100644 --- a/modules/aerodyn/src/UnsteadyAero_Driver.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Driver.f90 @@ -33,33 +33,34 @@ program UnsteadyAero_Driver implicit none ! Variables - integer(IntKi), parameter :: NumInp = 2 ! Number of inputs sent to UA_UpdateStates (must be at least 2) - real(DbKi) :: dt, t, uTimes(NumInp) + real(DbKi) :: t, uTimes(NumInp) integer :: i, j, n, iu - ! --- UA - type(UA_InitInputType) :: UA_InitInData ! Input data for initialization - type(UA_InitOutputType) :: InitOutData ! Output data from initialization - type(UA_ContinuousStateType) :: x ! Continuous states - type(UA_DiscreteStateType) :: xd ! Discrete states - type(UA_OtherStateType) :: OtherState ! Other/optimization states - type(UA_MiscVarType) :: m ! Misc/optimization variables - type(UA_ParameterType) :: p ! Parameters - type(UA_InputType) :: u(NumInp) ! System inputs - type(UA_OutputType) :: y ! System outputs - ! --- LinDyn - type(LD_InitInputType) :: LD_InitInData ! Input data for initialization - type(LD_InitOutputType) :: LD_InitOutData ! Output data from initialization - type(LD_ContinuousStateType) :: LD_x ! Continuous states - type(LD_DiscreteStateType) :: LD_xd ! Discrete states - type(LD_OtherStateType) :: LD_OtherState ! Other/optimization states - type(LD_ConstraintStateType) :: LD_z ! Constraint states - type(LD_MiscVarType) :: LD_m ! Misc/optimization variables - type(LD_ParameterType) :: LD_p ! Parameters - type(LD_InputType) :: LD_u(NumInp) ! System inputs - type(LD_OutputType) :: LD_y ! System outputs - + ! --- All Data + type(Dvr_Data) :: dvr + + ! --- UA + type(UA_InitInputType) , target :: UA_InitInData ! Input data for initialization + type(UA_InitOutputType) , target :: InitOutData ! Output data from initialization + type(UA_ContinuousStateType) , target :: x ! Continuous states + type(UA_DiscreteStateType) , target :: xd ! Discrete states + type(UA_OtherStateType) , target :: OtherState ! Other/optimization states + type(UA_MiscVarType) , target :: m ! Misc/optimization variables + type(UA_ParameterType) , target :: p ! Parameters + type(UA_InputType) , target :: u(NumInp) ! System inputs + type(UA_OutputType) , target :: y ! System outputs + ! --- LinDyn + type(LD_InitInputType) , target :: LD_InitInData ! Input data for initialization + type(LD_InitOutputType) , target :: LD_InitOutData ! Output data from initialization + type(LD_ContinuousStateType) , target :: LD_x ! Continuous states + type(LD_DiscreteStateType) , target :: LD_xd ! Discrete states + type(LD_OtherStateType) , target :: LD_OtherState ! Other/optimization states + type(LD_ConstraintStateType) , target :: LD_z ! Constraint states + type(LD_MiscVarType) , target :: LD_m ! Misc/optimization variables + type(LD_ParameterType) , target :: LD_p ! Parameters + type(LD_InputType) , target :: LD_u(NumInp) ! System inputs + type(LD_OutputType) , target :: LD_y ! System outputs integer(IntKi) :: ErrStat ! Status of error message character(ErrMsgLen) :: ErrMsg ! Error message if ErrStat /= ErrID_None @@ -69,7 +70,7 @@ program UnsteadyAero_Driver CHARACTER(1024) :: dvrFilename ! Filename and path for the driver input file. This is passed in as a command line argument when running the Driver exe. TYPE(UA_Dvr_InitInput) :: dvrInitInp ! Initialization data for the driver program real(DbKi) :: simTime - integer :: nSimSteps + integer :: numSteps character(*), parameter :: RoutineName = 'UnsteadyAero_Driver' real(DbKi), allocatable :: timeArr(:) real(ReKi), allocatable :: AOAarr(:) @@ -101,29 +102,49 @@ program UnsteadyAero_Driver call get_command_argument(1, dvrFilename) call ReadDriverInputFile( dvrFilename, dvrInitInp, errStat, errMsg ); call checkError() + ! --- Driver Data TODO TODO + dvr%out%Root = dvrInitInp%OutRootName + dvr%UA_InitInData => UA_InitInData + dvr%UA_InitOutData => InitOutData + dvr%UA_x => x + dvr%UA_xd => xd + dvr%UA_OtherState => OtherState + dvr%UA_m => m + dvr%UA_p => p + dvr%UA_u => u + dvr%UA_y => y + dvr%LD_InitInData => LD_InitInData + dvr%LD_InitOutData => LD_InitOutData + dvr%LD_x => LD_x + dvr%LD_xd => LD_xd + dvr%LD_OtherState => LD_OtherState + dvr%LD_z => LD_z + dvr%LD_m => LD_m + dvr%LD_p => LD_p + dvr%LD_u => LD_u + dvr%LD_y => LD_y ! --- Time simulation control if ( dvrInitInp%SimMod == 1 ) then ! Using the frequency and NCycles, determine how long the simulation needs to run simTime = dvrInitInp%NCycles/dvrInitInp%Frequency - nSimSteps = dvrInitInp%StepsPerCycle*dvrInitInp%NCycles ! we could add 1 here to make this a complete cycle - dt = simTime / nSimSteps + numSteps = dvrInitInp%StepsPerCycle*dvrInitInp%NCycles ! we could add 1 here to make this a complete cycle + dvr%dt = simTime / numSteps else if ( dvrInitInp%SimMod == 2 ) then ! Read time-series data file with columns:( time, Angle-of-attack, Vrel, omega ) - call ReadTimeSeriesData( dvrInitInp%InputsFile, nSimSteps, timeArr, AOAarr, Uarr, OmegaArr, errStat, errMsg ); call checkError() - dt = (timeArr(nSimSteps) - timeArr(1)) / (nSimSteps-1) - nSimSteps = nSimSteps-NumInp + 1 + call ReadTimeSeriesData( dvrInitInp%InputsFile, numSteps, timeArr, AOAarr, Uarr, OmegaArr, errStat, errMsg ); call checkError() + dvr%dt = (timeArr(numSteps) - timeArr(1)) / (numSteps-1) + numSteps = numSteps-NumInp + 1 elseif ( dvrInitInp%SimMod == 3 ) then simTime = dvrInitInp%TMax - dt = dvrInitInp%dt - nSimSteps = int(simTime/dt) ! TODO - print*,'nSimSteps',nSimSteps, simTime, dt + dvr%dt = dvrInitInp%dt + numSteps = int(simTime/dvr%dt) ! TODO ! --- Initialize Elastic Section call LD_InitInputData(3, LD_InitInData, errStat, errMsg); call checkError() - LD_InitInData%dt = dt + LD_InitInData%dt = dvr%dt LD_InitInData%IntMethod = 1 ! TODO LD_InitInData%prefix = '' ! TODO for output channel names LD_InitInData%MM = dvrInitInp%MM @@ -134,18 +155,7 @@ program UnsteadyAero_Driver LD_InitInData%activeDOFs = dvrInitInp%activeDOFs call LD_Init(LD_InitInData, LD_u(1), LD_p, LD_x, LD_xd, LD_z, LD_OtherState, LD_y, LD_m, LD_InitOutData, errStat, errMsg); call checkError() - ! set inputs: - !u(1) = time at n=1 (t= 0) - !u(2) = time at n=0 (t= -dt) - !u(3) = time at n=-1 (t= -2dt) if NumInp > 2 - ! t = (n-1)*dt - do iu = 1, NumInp !u(NumInp) is overwritten in time-sim loop, so no need to init here - uTimes(iu) = (2-iu-1)*dt - enddo - ! Allocs - do iu = 2,NumInp - call AllocAry(LD_u(iu)%Fext, LD_p%nx, 'Fext', errStat, errMsg); call checkError() - enddo + call Dvr_InitializeDriverOutputs(dvr, dvr%out, errStat, errMsg); call checkError() end if @@ -153,7 +163,7 @@ program UnsteadyAero_Driver call driverInputsToUAInitData(dvrInitInp, UA_InitInData, AFI_Params, AFIndx, errStat, errMsg); call checkError() ! --- Initialize UnsteadyAero (need AFI) - call UA_Init( UA_InitInData, u(1), p, x, xd, OtherState, y, m, dt, AFI_Params, AFIndx, InitOutData, errStat, errMsg ); call checkError() + call UA_Init( UA_InitInData, u(1), p, x, xd, OtherState, y, m, dvr%dt, AFI_Params, AFIndx, InitOutData, errStat, errMsg ); call checkError() if (p%NumOuts <= 0) then ErrStat = ErrID_Fatal ErrMsg = "No outputs have been selected. Rebuild the executable with -DUA_OUTS" @@ -161,76 +171,126 @@ program UnsteadyAero_Driver end if + ! --- Initialize Inputs + !u(1) = time at n=1 (t= 0) + !u(2) = time at n=0 (t= -dt) + !u(3) = time at n=-1 (t= -2dt) if NumInp > 2 + if ( dvrInitInp%SimMod == 3 ) then + ! General inputs + do iu = 1, NumInp !u(NumInp) is overwritten in time-sim loop, so no need to init here + uTimes(iu) = (2-iu-1)*dvr%dt + enddo + ! LD Inputs - Allocs + do iu = 2,NumInp + call AllocAry(LD_u(iu)%Fext, LD_p%nx, 'Fext', errStat, errMsg); call checkError() + enddo + ! UA inputs: + do iu = 1, NumInp-1 !u(NumInp) is overwritten in time-sim loop, so no need to init here + ! TODO TODO TODO + u(iu)%UserProp = 0 + u(iu)%Re = dvrInitInp%Re + u(iu)%omega = 0.0_ReKi + u(iu)%v_ac(1) = 0.0_ReKi + u(iu)%v_ac(2) = 0.0_ReKi + u(iu)%alpha = 0.0_ReKi + u(iu)%U = 0.0_ReKi + enddo + else + ! UA inputs: + do iu = 1, NumInp-1 !u(NumInp) is overwritten in time-sim loop, so no need to init here + call setUAinputs(2-iu, u(iu), uTimes(iu), dvr%dt, dvrInitInp, timeArr, AOAarr, Uarr, OmegaArr, errStat, errMsg); call checkError() + end do + endif + + i = 1 ! nodes per blade + j = 1 ! number of blades + ! --- Time marching loop + if ( dvrInitInp%SimMod == 3 ) then + call Dvr_InitializeOutputs(dvr%out, numSteps, errStat, errMsg) + LD_u(1)%Fext=0.0_ReKi ! TODO TODO LD_u(2)%Fext=0.0_ReKi ! TODO TODO ! --- time marching loop - do n = 1, nSimSteps + print*,'>>> Time simulation', uTimes(1), numSteps*dvr%dt + do n = 1, numSteps ! set inputs: - DO iu = NumInp-1, 1, -1 - LD_u( iu+1) = LD_u( iu) + do iu = NumInp-1, 1, -1 + dvr%UA_u( iu+1) = dvr%UA_u( iu) + dvr%LD_u( iu+1) = dvr%LD_u( iu) uTimes(iu+1) = uTimes(iu) - END DO -! ! first value of uTimes/u contain inputs at t+dt -! call setUAinputs(n+1, u(1), uTimes(1), dt, dvrInitInp, timeArr, AOAarr, Uarr, OmegaArr, errStat, errMsg); call checkError() - uTimes(1) = (n+1-1)*dt + end do + ! ! first value of uTimes/u contain inputs at t+dt + + ! Basic inputs + uTimes(1) = (n+1-1)*dvr%dt + ! UA-LD Inputs Solve TODO TODO TODO + ! call setUAinputs(n+1, u(1), uTimes(1), dt, dvrInitInp, timeArr, AOAarr, Uarr, OmegaArr, errStat, errMsg); call checkError() + u(1)%UserProp = 0 + u(1)%Re = dvrInitInp%Re + u(1)%omega = LD_x%q(6) + u(1)%v_ac(1) = dvrInitInp%Mean -LD_x%q(4) + u(1)%v_ac(2) = -LD_x%q(5) + u(1)%alpha = 0.0_ReKi + u(1)%U = sqrt( u(1)%v_ac(1)**2 + u(1)%v_ac(2)**2) t = uTimes(2) ! Use existing states to compute the outputs call LD_CalcOutput(t, LD_u(2), LD_p, LD_x, LD_xd, LD_z, LD_OtherState, LD_y, LD_m, errStat, errMsg); call checkError() !! Use existing states to compute the outputs - !call UA_CalcOutput(i, j, t, u(2), p, x, xd, OtherState, AFI_Params(AFIndx(i,j)), y, m, errStat, errMsg ); call checkError() - print*,'t',t, LD_x%q -! ! Generate file outputs -! call UA_WriteOutputToFile(t, p, y) - ! Prepare states for next time step - call LD_UpdateStates(t, n, LD_u, uTimes, LD_p, LD_x, LD_xd, LD_z, LD_OtherState, LD_m, errStat, errMsg); call checkError() -! ! Prepare states for next time step -! call UA_UpdateStates(i, j, t, n, u, uTimes, p, x, xd, OtherState, AFI_Params(AFIndx(i,j)), m, errStat, errMsg ); call checkError() - end do + call UA_CalcOutput(i, j, t, u(2), p, x, xd, OtherState, AFI_Params(AFIndx(i,j)), y, m, errStat, errMsg ); call checkError() - print*,'STOPPING FOR NOW' - call cleanUp() - call NormStop() - endif + LD_u(1)%Fext(1) = 0.5_ReKi * dvrInitInp%Chord * u(1)%U**2 * y%Cl /100 ! TODO TODO + LD_u(1)%Fext(2) = 0.5_ReKi * dvrInitInp%Chord * u(1)%U**2 * y%Cd /100 ! TODO TODO + !y%Cn + !y%Cc + !y%Cm + !y%Cl + !y%Cd - ! set inputs: - !u(1) = time at n=1 (t= 0) - !u(2) = time at n=0 (t= -dt) - !u(3) = time at n=-1 (t= -2dt) if NumInp > 2 - DO iu = 1, NumInp-1 !u(NumInp) is overwritten in time-sim loop, so no need to init here - call setUAinputs(2-iu, u(iu), uTimes(iu), dt, dvrInitInp, timeArr, AOAarr, Uarr, OmegaArr, errStat, errMsg); call checkError() - END DO - ! --- time marching loop - i = 1 ! nodes per blade - j = 1 ! number of blades - do n = 1, nSimSteps - - ! set inputs: - DO iu = NumInp-1, 1, -1 - u( iu+1) = u( iu) - uTimes(iu+1) = uTimes(iu) - END DO - - ! first value of uTimes/u contain inputs at t+dt - call setUAinputs(n+1, u(1), uTimes(1), dt, dvrInitInp, timeArr, AOAarr, Uarr, OmegaArr, errStat, errMsg); call checkError() + ! Generate file outputs + call UA_WriteOutputToFile(t, p, y) + ! Write outputs for all turbines at nt-1 + call Dvr_WriteOutputs(n, t, dvr, dvr%out, errStat, errMsg); call checkError() + + + ! Prepare states for next time step + call LD_UpdateStates(t, n, LD_u, uTimes, LD_p, LD_x, LD_xd, LD_z, LD_OtherState, LD_m, errStat, errMsg); call checkError() + ! Prepare states for next time step + call UA_UpdateStates(i, j, t, n, u, uTimes, p, x, xd, OtherState, AFI_Params(AFIndx(i,j)), m, errStat, errMsg ); call checkError() + end do + + call Dvr_EndSim(dvr, errStat, errMsg) + else + ! --- time marching loop + do n = 1, numSteps - t = uTimes(2) + ! set inputs: + DO iu = NumInp-1, 1, -1 + u( iu+1) = u( iu) + uTimes(iu+1) = uTimes(iu) + END DO + + ! first value of uTimes/u contain inputs at t+dt + call setUAinputs(n+1, u(1), uTimes(1), dvr%dt, dvrInitInp, timeArr, AOAarr, Uarr, OmegaArr, errStat, errMsg); call checkError() + + t = uTimes(2) - ! Use existing states to compute the outputs - call UA_CalcOutput(i, j, t, u(2), p, x, xd, OtherState, AFI_Params(AFIndx(i,j)), y, m, errStat, errMsg ); call checkError() - - ! Generate file outputs - call UA_WriteOutputToFile(t, p, y) - - ! Prepare states for next time step - call UA_UpdateStates(i, j, t, n, u, uTimes, p, x, xd, OtherState, AFI_Params(AFIndx(i,j)), m, errStat, errMsg ); call checkError() - - end do + ! Use existing states to compute the outputs + call UA_CalcOutput(i, j, t, u(2), p, x, xd, OtherState, AFI_Params(AFIndx(i,j)), y, m, errStat, errMsg ); call checkError() + + ! Generate file outputs + call UA_WriteOutputToFile(t, p, y) + + ! Prepare states for next time step + call UA_UpdateStates(i, j, t, n, u, uTimes, p, x, xd, OtherState, AFI_Params(AFIndx(i,j)), m, errStat, errMsg ); call checkError() + + end do + endif ! --- Exit call Cleanup()