diff --git a/modules/inflowwind/src/IfW_HAWCWind.f90 b/modules/inflowwind/src/IfW_HAWCWind.f90 index 6861a1705..66e8748e9 100644 --- a/modules/inflowwind/src/IfW_HAWCWind.f90 +++ b/modules/inflowwind/src/IfW_HAWCWind.f90 @@ -42,6 +42,7 @@ MODULE IfW_HAWCWind PUBLIC :: IfW_HAWCWind_CalcOutput INTEGER(IntKi), PARAMETER :: nc = 3 !< number of wind components + INTEGER(IntKi), PARAMETER :: WindProfileType_None = -1 !< don't add wind profile; already included in input data INTEGER(IntKi), PARAMETER :: WindProfileType_Constant = 0 !< constant wind INTEGER(IntKi), PARAMETER :: WindProfileType_Log = 1 !< logarithmic INTEGER(IntKi), PARAMETER :: WindProfileType_PL = 2 !< power law @@ -95,8 +96,9 @@ SUBROUTINE IfW_HAWCWind_Init(InitInp, p, MiscVars, Interval, InitOut, ErrStat, E p%nz = InitInp%nz p%RefHt = InitInp%RefHt p%URef = InitInp%URef - p%InitPosition = 0.0_ReKi ! bjj: someday we may want to let the users give an offset time/position - p%InitPosition(1) = InitInp%dx + p%InitPosition = InitInp%InitPosition + if (EqualRealNos(InitInp%InitPosition(1), 0.0_ReKi)) p%InitPosition(1) = InitInp%dx ! This is the old behaviour + p%deltaXInv = 1.0 / InitInp%dx p%deltaYInv = 1.0 / InitInp%dy @@ -145,7 +147,7 @@ SUBROUTINE IfW_HAWCWind_Init(InitInp, p, MiscVars, Interval, InitOut, ErrStat, E WRITE(InitInp%SumFileUnit,'(A)', IOSTAT=TmpErrStat) 'HAWC wind type. Read by InflowWind sub-module '//TRIM(GetNVD(IfW_HAWCWind_Ver)) WRITE(InitInp%SumFileUnit,'(A34,G12.4)',IOSTAT=TmpErrStat) ' Reference height (m): ',p%RefHt - WRITE(InitInp%SumFileUnit,'(A34,G12.4)',IOSTAT=TmpErrStat) ' Timestep (s): ',p%deltaXInv / p%URef + WRITE(InitInp%SumFileUnit,'(A34,G12.4)',IOSTAT=TmpErrStat) ' Timestep (s): ',1.0_ReKi / (p%deltaXInv * p%URef) WRITE(InitInp%SumFileUnit,'(A34,I12)', IOSTAT=TmpErrStat) ' Number of timesteps: ',p%nx WRITE(InitInp%SumFileUnit,'(A34,G12.4)',IOSTAT=TmpErrStat) ' Mean windspeed (m/s): ',p%URef WRITE(InitInp%SumFileUnit,'(A)', IOSTAT=TmpErrStat) ' Time range (s): [ '// & @@ -213,7 +215,7 @@ SUBROUTINE ValidateInput(InitInp, ErrStat, ErrMsg) if (InitInp%WindProfileType == WindProfileType_Log) then if ( InitInp%z0 < 0.0_ReKi .or. EqualRealNos( InitInp%z0, 0.0_ReKi ) ) & call SetErrStat( ErrID_Fatal, 'The surface roughness length, Z0, must be greater than zero', ErrStat, ErrMsg, RoutineName ) - elseif ( InitInp%WindProfileType < WindProfileType_Constant .or. InitInp%WindProfileType > WindProfileType_PL) then + elseif ( InitInp%WindProfileType < WindProfileType_None .or. InitInp%WindProfileType > WindProfileType_PL) then call SetErrStat( ErrID_Fatal, 'The WindProfile type must be 0 (constant), 1 (logarithmic) or 2 (power law).', ErrStat, ErrMsg, RoutineName ) end if diff --git a/modules/inflowwind/src/IfW_HAWCWind.txt b/modules/inflowwind/src/IfW_HAWCWind.txt index 278d9be3f..4d38bd567 100644 --- a/modules/inflowwind/src/IfW_HAWCWind.txt +++ b/modules/inflowwind/src/IfW_HAWCWind.txt @@ -31,6 +31,7 @@ typedef ^ ^ ReKi RefHt typedef ^ ^ ReKi URef - 0 - "Mean u-component wind speed at the reference height" meters typedef ^ ^ ReKi PLExp - 0 - "Power law exponent (used for PL wind profile type only)" - typedef ^ ^ ReKi Z0 - 0 - "Surface roughness length (used for LOG wind profile type only)" - +typedef ^ ^ ReKi InitPosition 3 0 - "the initial position of grid (distance in FF is offset)" meters # Init Output diff --git a/modules/inflowwind/src/IfW_HAWCWind_Types.f90 b/modules/inflowwind/src/IfW_HAWCWind_Types.f90 index 18a96ae64..47bb45034 100644 --- a/modules/inflowwind/src/IfW_HAWCWind_Types.f90 +++ b/modules/inflowwind/src/IfW_HAWCWind_Types.f90 @@ -51,6 +51,7 @@ MODULE IfW_HAWCWind_Types REAL(ReKi) :: URef = 0 !< Mean u-component wind speed at the reference height [meters] REAL(ReKi) :: PLExp = 0 !< Power law exponent (used for PL wind profile type only) [-] REAL(ReKi) :: Z0 = 0 !< Surface roughness length (used for LOG wind profile type only) [-] + REAL(ReKi) , DIMENSION(1:3) :: InitPosition !< the initial position of grid (distance in FF is offset) [meters] END TYPE IfW_HAWCWind_InitInputType ! ======================= ! ========= IfW_HAWCWind_InitOutputType ======= @@ -141,6 +142,7 @@ SUBROUTINE IfW_HAWCWind_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlC DstInitInputData%URef = SrcInitInputData%URef DstInitInputData%PLExp = SrcInitInputData%PLExp DstInitInputData%Z0 = SrcInitInputData%Z0 + DstInitInputData%InitPosition = SrcInitInputData%InitPosition END SUBROUTINE IfW_HAWCWind_CopyInitInput SUBROUTINE IfW_HAWCWind_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) @@ -205,6 +207,7 @@ SUBROUTINE IfW_HAWCWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Re_BufSz = Re_BufSz + 1 ! URef Re_BufSz = Re_BufSz + 1 ! PLExp Re_BufSz = Re_BufSz + 1 ! Z0 + Re_BufSz = Re_BufSz + SIZE(InData%InitPosition) ! InitPosition IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -268,6 +271,8 @@ SUBROUTINE IfW_HAWCWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Re_Xferred = Re_Xferred + 1 ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Z0 Re_Xferred = Re_Xferred + 1 + ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InitPosition))-1 ) = PACK(InData%InitPosition,.TRUE.) + Re_Xferred = Re_Xferred + SIZE(InData%InitPosition) END SUBROUTINE IfW_HAWCWind_PackInitInput SUBROUTINE IfW_HAWCWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -369,6 +374,17 @@ SUBROUTINE IfW_HAWCWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = Re_Xferred + 1 OutData%Z0 = ReKiBuf( Re_Xferred ) Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%InitPosition,1) + i1_u = UBOUND(OutData%InitPosition,1) + ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + mask1 = .TRUE. + OutData%InitPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InitPosition))-1 ), mask1, 0.0_ReKi ) + Re_Xferred = Re_Xferred + SIZE(OutData%InitPosition) + DEALLOCATE(mask1) END SUBROUTINE IfW_HAWCWind_UnPackInitInput SUBROUTINE IfW_HAWCWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) diff --git a/modules/inflowwind/src/InflowWind.f90 b/modules/inflowwind/src/InflowWind.f90 index fe870be70..6c12d390f 100644 --- a/modules/inflowwind/src/InflowWind.f90 +++ b/modules/inflowwind/src/InflowWind.f90 @@ -557,6 +557,7 @@ SUBROUTINE InflowWind_Init( InitInp, InputGuess, p, ContStates, DiscStates, HAWC_InitData%URef = InputFileData%HAWC_URef HAWC_InitData%PLExp = InputFileData%HAWC_PLExp HAWC_InitData%Z0 = InputFileData%HAWC_Z0 + HAWC_InitData%InitPosition = InputFileData%HAWC_InitPosition ! Initialize the HAWCWind module diff --git a/modules/inflowwind/src/InflowWind.txt b/modules/inflowwind/src/InflowWind.txt index 0923fbce2..3c41229fa 100644 --- a/modules/inflowwind/src/InflowWind.txt +++ b/modules/inflowwind/src/InflowWind.txt @@ -99,6 +99,7 @@ typedef ^ ^ ReKi HAWC_URef typedef ^ ^ IntKi HAWC_ProfileType - - - "HAWC -- Wind profile type (0=constant;1=logarithmic;2=power law)" - typedef ^ ^ ReKi HAWC_PLExp - - - "HAWC -- Power law exponent (used for PL wind profile type only)" - typedef ^ ^ ReKi HAWC_Z0 - - - "HAWC -- Surface roughness length (used for LOG wind profile type only)" - +typedef ^ ^ ReKi HAWC_InitPosition 3 - - "HAWC -- initial position (offset for wind file box)" meters typedef ^ ^ LOGICAL SumPrint - - - "Write summary info to a file .IfW.Sum" - typedef ^ ^ IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - typedef ^ ^ CHARACTER(10) OutList : - - "List of user-requested output channels" - diff --git a/modules/inflowwind/src/InflowWind_Subs.f90 b/modules/inflowwind/src/InflowWind_Subs.f90 index bd39768c7..cf18b5f75 100644 --- a/modules/inflowwind/src/InflowWind_Subs.f90 +++ b/modules/inflowwind/src/InflowWind_Subs.f90 @@ -789,14 +789,24 @@ SUBROUTINE InflowWind_ReadInput( InputFileName, EchoFileName, InputFileData, Err RETURN END IF - - !---------------------- OUTPUT -------------------------------------------------- - CALL ReadCom( UnitInput, InputFileName, 'Section Header: Output', TmpErrStat, TmpErrMsg, UnitEcho ) - CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF + ! Read HAWC_InitPosition (Shift of wind box) NOTE: This an optional input!!!! + InputFileData%HAWC_InitPosition(2:3) = 0.0_ReKi ! We are only using X, so only read in one. The data can handle 3 coords + CALL ReadVar( UnitInput, InputFileName, InputFileData%HAWC_InitPosition(1), 'HAWC_Position', & + 'Initial position of the HAWC wind file (shift along X usually)', TmpErrStat, TmpErrMsg, UnitEcho ) + if (TmpErrStat == ErrID_None) then + !---------------------- OUTPUT -------------------------------------------------- + CALL ReadCom( UnitInput, InputFileName, 'Section Header: Output', TmpErrStat, TmpErrMsg, UnitEcho ) + CALL SetErrStat( TmpErrStat, TmpErrMsg, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + else + InputFileData%HAWC_InitPosition = 0.0_ReKi + TmpErrStat = ErrID_None ! reset + TmpErrMsg = "" + ! NOTE: since we read in a line that wasn't a number, what we actually read was the header. + endif ! SumPrint - Print summary data to .IfW.sum (flag): CALL ReadVar( UnitInput, InputFileName, InputFileData%SumPrint, "SumPrint", "Print summary data to .IfW.sum (flag)", TmpErrStat, TmpErrMsg, UnitEcho) diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index 1596d07cd..f2e468ed8 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -115,6 +115,7 @@ MODULE InflowWind_Types INTEGER(IntKi) :: HAWC_ProfileType !< HAWC -- Wind profile type (0=constant;1=logarithmic;2=power law) [-] REAL(ReKi) :: HAWC_PLExp !< HAWC -- Power law exponent (used for PL wind profile type only) [-] REAL(ReKi) :: HAWC_Z0 !< HAWC -- Surface roughness length (used for LOG wind profile type only) [-] + REAL(ReKi) , DIMENSION(1:3) :: HAWC_InitPosition !< HAWC -- initial position (offset for wind file box) [meters] LOGICAL :: SumPrint !< Write summary info to a file .IfW.Sum [-] INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] @@ -590,6 +591,7 @@ SUBROUTINE InflowWind_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCod DstInputFileData%HAWC_ProfileType = SrcInputFileData%HAWC_ProfileType DstInputFileData%HAWC_PLExp = SrcInputFileData%HAWC_PLExp DstInputFileData%HAWC_Z0 = SrcInputFileData%HAWC_Z0 + DstInputFileData%HAWC_InitPosition = SrcInputFileData%HAWC_InitPosition DstInputFileData%SumPrint = SrcInputFileData%SumPrint DstInputFileData%NumOuts = SrcInputFileData%NumOuts IF (ALLOCATED(SrcInputFileData%OutList)) THEN @@ -722,6 +724,7 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Int_BufSz = Int_BufSz + 1 ! HAWC_ProfileType Re_BufSz = Re_BufSz + 1 ! HAWC_PLExp Re_BufSz = Re_BufSz + 1 ! HAWC_Z0 + Re_BufSz = Re_BufSz + SIZE(InData%HAWC_InitPosition) ! HAWC_InitPosition Int_BufSz = Int_BufSz + 1 ! SumPrint Int_BufSz = Int_BufSz + 1 ! NumOuts Int_BufSz = Int_BufSz + 1 ! OutList allocated yes/no @@ -893,6 +896,8 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Re_Xferred = Re_Xferred + 1 ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_Z0 Re_Xferred = Re_Xferred + 1 + ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HAWC_InitPosition))-1 ) = PACK(InData%HAWC_InitPosition,.TRUE.) + Re_Xferred = Re_Xferred + SIZE(InData%HAWC_InitPosition) IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) Int_Xferred = Int_Xferred + 1 IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts @@ -1120,6 +1125,17 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = Re_Xferred + 1 OutData%HAWC_Z0 = ReKiBuf( Re_Xferred ) Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%HAWC_InitPosition,1) + i1_u = UBOUND(OutData%HAWC_InitPosition,1) + ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + mask1 = .TRUE. + OutData%HAWC_InitPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HAWC_InitPosition))-1 ), mask1, 0.0_ReKi ) + Re_Xferred = Re_Xferred + SIZE(OutData%HAWC_InitPosition) + DEALLOCATE(mask1) OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) Int_Xferred = Int_Xferred + 1 OutData%NumOuts = IntKiBuf( Int_Xferred ) diff --git a/reg_tests/r-test b/reg_tests/r-test index 283707d5f..9fff694eb 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 283707d5f3a9d8e23acd08c9521fba81d275530a +Subproject commit 9fff694eb70f267a1cc1f3e7783ae08e3514d5ce