From 60f24a8f42ae319111fb26f4920275253f5a879f Mon Sep 17 00:00:00 2001 From: Derek Slaughter Date: Sat, 10 Jun 2023 14:37:29 +0000 Subject: [PATCH] Use pointers to couple InflowWind and FAST.Farm This commit is the initial attempt to use pointers to couple the wind velocities generated by AWAE in FAST.Farm to the InflowWind FlowField which is used by AeroDyn to calculate the wind velocities. The Vdist_High data in AWAE has been changed to a pointer and FlowField%Grid4D%Vel is associated with this data to alleviate the need to copy the data between the modules. --- glue-codes/fast-farm/src/FASTWrapper.f90 | 13 +- .../fast-farm/src/FASTWrapper_Registry.txt | 2 +- .../fast-farm/src/FASTWrapper_Types.f90 | 122 +------ glue-codes/fast-farm/src/FAST_Farm_Subs.f90 | 20 +- modules/awae/src/AWAE.f90 | 7 + modules/awae/src/AWAE_Registry.txt | 4 +- modules/awae/src/AWAE_Types.f90 | 300 +++++++++++++++++- modules/inflowwind/src/IfW_FlowField.f90 | 4 +- modules/inflowwind/src/IfW_FlowField.txt | 2 +- .../inflowwind/src/IfW_FlowField_Types.f90 | 106 +------ modules/inflowwind/src/InflowWind_IO.f90 | 12 +- modules/inflowwind/src/InflowWind_IO.txt | 1 + .../inflowwind/src/InflowWind_IO_Types.f90 | 12 + .../openfast-library/src/FAST_Registry.txt | 1 + modules/openfast-library/src/FAST_Subs.f90 | 1 + modules/openfast-library/src/FAST_Types.f90 | 12 + 16 files changed, 359 insertions(+), 260 deletions(-) diff --git a/glue-codes/fast-farm/src/FASTWrapper.f90 b/glue-codes/fast-farm/src/FASTWrapper.f90 index 903666cb48..e7a4cd176d 100644 --- a/glue-codes/fast-farm/src/FASTWrapper.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper.f90 @@ -158,6 +158,7 @@ SUBROUTINE FWrap_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ExternInitData%windGrid_delta(4) = InitInp%dt_high ExternInitData%windGrid_pZero = InitInp%p_ref_high - InitInp%p_ref_Turbine + ExternInitData%windGrid_data => InitInp%Vdist_High CALL FAST_InitializeAll_T( t_initial, InitInp%TurbNum, m%Turbine, ErrStat2, ErrMsg2, InitInp%FASTInFile, ExternInitData ) @@ -183,10 +184,7 @@ SUBROUTINE FWrap_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init call cleanup() return end if - - call move_alloc(m%Turbine%IfW%p%FlowField%Grid4D%Vel, u%Vdist_High) - - + !................. ! Define parameters here: !................. @@ -555,10 +553,6 @@ SUBROUTINE FWrap_CalcOutput(p, u, y, m, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = '' - ! put this back! - call move_alloc(m%Turbine%IfW%p%FlowField%Grid4D%Vel, u%Vdist_High) - - ! Turbine-dependent commands to the super controller: if (m%Turbine%p_FAST%UseSC) then y%toSC = m%Turbine%SC_DX%u%toSC @@ -712,8 +706,7 @@ SUBROUTINE FWrap_SetInputs(u, m, t) REAL(DbKi), INTENT(IN ) :: t !< current simulation time ! set the 4d-wind-inflow input array (a bit of a hack [simplification] so that we don't have large amounts of data copied in multiple data structures): - call move_alloc(u%Vdist_High, m%Turbine%IfW%p%FlowField%Grid4D%Vel) - m%Turbine%IfW%p%FlowField%Grid4D%TimeStart = t + m%Turbine%IfW%p%FlowField%Grid4D%TimeStart = t ! do something with the inputs from the super-controller: if ( m%Turbine%p_FAST%UseSC ) then diff --git a/glue-codes/fast-farm/src/FASTWrapper_Registry.txt b/glue-codes/fast-farm/src/FASTWrapper_Registry.txt index 5dedfed49a..d5822b91f8 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Registry.txt +++ b/glue-codes/fast-farm/src/FASTWrapper_Registry.txt @@ -40,6 +40,7 @@ typedef ^ InitInputType IntKi NumCtrl2SC typedef ^ InitInputType Logical UseSC - - - "Use the SuperController? (flag)" - typedef ^ InitInputType SiKi fromSCGlob {:} - - "Global outputs from SuperController" - typedef ^ InitInputType SiKi fromSC {:} - - "Turbine-specific outputs from SuperController" - +typedef ^ InitInputType SiKi *Vdist_High {:}{:}{:}{:}{:} - - "Pointer to UVW components of disturbed wind [nx^high, ny^high, nz^high, n^high/low] (ambient + deficits) across the high-resolution domain around the turbine for each high-resolution time step within a low-resolution time step" "(m/s)" # Define outputs from the initialization routine here: #typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - @@ -85,7 +86,6 @@ typedef ^ ParameterType ReKi p_ref_Turbine # Define inputs that are contained on the mesh here: typedef ^ InputType SiKi fromSCglob {:} - - "Global (turbine-independent) commands from the super controller" "(various units)" typedef ^ InputType SiKi fromSC {:} - - "Turbine-dependent commands from the super controller from the super controller" "(various units)" -typedef ^ InputType SiKi Vdist_High {:}{:}{:}{:}{:} - - "UVW components of disturbed wind [nx^high, ny^high, nz^high, n^high/low] (ambient + deficits) across the high-resolution domain around the turbine for each high-resolution time step within a low-resolution time step" "(m/s)" # ..... Outputs ................................................................................................................... # Define outputs that are contained on the mesh here: diff --git a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 index 94b8cbcc0e..837c4048f9 100644 --- a/glue-codes/fast-farm/src/FASTWrapper_Types.f90 +++ b/glue-codes/fast-farm/src/FASTWrapper_Types.f90 @@ -59,6 +59,7 @@ MODULE FASTWrapper_Types LOGICAL :: UseSC !< Use the SuperController? (flag) [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: fromSCGlob !< Global outputs from SuperController [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: fromSC !< Turbine-specific outputs from SuperController [-] + REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: Vdist_High => NULL() !< Pointer to UVW components of disturbed wind [nx^high, ny^high, nz^high, n^high/low] (ambient + deficits) across the high-resolution domain around the turbine for each high-resolution time step within a low-resolution time step [(m/s)] END TYPE FWrap_InitInputType ! ======================= ! ========= FWrap_InitOutputType ======= @@ -108,7 +109,6 @@ MODULE FASTWrapper_Types TYPE, PUBLIC :: FWrap_InputType REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: fromSCglob !< Global (turbine-independent) commands from the super controller [(various units)] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: fromSC !< Turbine-dependent commands from the super controller from the super controller [(various units)] - REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: Vdist_High !< UVW components of disturbed wind [nx^high, ny^high, nz^high, n^high/low] (ambient + deficits) across the high-resolution domain around the turbine for each high-resolution time step within a low-resolution time step [(m/s)] END TYPE FWrap_InputType ! ======================= ! ========= FWrap_OutputType ======= @@ -135,6 +135,10 @@ SUBROUTINE FWrap_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er ! 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_CopyInitInput' @@ -186,6 +190,7 @@ SUBROUTINE FWrap_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Er END IF DstInitInputData%fromSC = SrcInitInputData%fromSC ENDIF + DstInitInputData%Vdist_High => SrcInitInputData%Vdist_High END SUBROUTINE FWrap_CopyInitInput SUBROUTINE FWrap_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) @@ -207,6 +212,7 @@ SUBROUTINE FWrap_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) IF (ALLOCATED(InitInputData%fromSC)) THEN DEALLOCATE(InitInputData%fromSC) ENDIF +NULLIFY(InitInputData%Vdist_High) END SUBROUTINE FWrap_DestroyInitInput SUBROUTINE FWrap_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -398,6 +404,10 @@ SUBROUTINE FWrap_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_UnPackInitInput' @@ -501,6 +511,7 @@ SUBROUTINE FWrap_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = Re_Xferred + 1 END DO END IF + NULLIFY(OutData%Vdist_High) END SUBROUTINE FWrap_UnPackInitInput SUBROUTINE FWrap_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -2246,10 +2257,6 @@ SUBROUTINE FWrap_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs ! 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_CopyInput' @@ -2279,26 +2286,6 @@ SUBROUTINE FWrap_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMs END IF END IF DstInputData%fromSC = SrcInputData%fromSC -ENDIF -IF (ALLOCATED(SrcInputData%Vdist_High)) THEN - i1_l = LBOUND(SrcInputData%Vdist_High,1) - i1_u = UBOUND(SrcInputData%Vdist_High,1) - i2_l = LBOUND(SrcInputData%Vdist_High,2) - i2_u = UBOUND(SrcInputData%Vdist_High,2) - i3_l = LBOUND(SrcInputData%Vdist_High,3) - i3_u = UBOUND(SrcInputData%Vdist_High,3) - i4_l = LBOUND(SrcInputData%Vdist_High,4) - i4_u = UBOUND(SrcInputData%Vdist_High,4) - i5_l = LBOUND(SrcInputData%Vdist_High,5) - i5_u = UBOUND(SrcInputData%Vdist_High,5) - IF (.NOT. ALLOCATED(DstInputData%Vdist_High)) THEN - ALLOCATE(DstInputData%Vdist_High(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputData%Vdist_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstInputData%Vdist_High = SrcInputData%Vdist_High ENDIF END SUBROUTINE FWrap_CopyInput @@ -2320,9 +2307,6 @@ SUBROUTINE FWrap_DestroyInput( InputData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(InputData%fromSC)) THEN DEALLOCATE(InputData%fromSC) -ENDIF -IF (ALLOCATED(InputData%Vdist_High)) THEN - DEALLOCATE(InputData%Vdist_High) ENDIF END SUBROUTINE FWrap_DestroyInput @@ -2371,11 +2355,6 @@ SUBROUTINE FWrap_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 2*1 ! fromSC upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%fromSC) ! fromSC END IF - Int_BufSz = Int_BufSz + 1 ! Vdist_High allocated yes/no - IF ( ALLOCATED(InData%Vdist_High) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! Vdist_High upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vdist_High) ! Vdist_High - END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -2433,41 +2412,6 @@ SUBROUTINE FWrap_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( .NOT. ALLOCATED(InData%Vdist_High) ) 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%Vdist_High,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_High,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_High,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_High,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_High,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_High,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_High,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_High,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vdist_High,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_High,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%Vdist_High,5), UBOUND(InData%Vdist_High,5) - DO i4 = LBOUND(InData%Vdist_High,4), UBOUND(InData%Vdist_High,4) - DO i3 = LBOUND(InData%Vdist_High,3), UBOUND(InData%Vdist_High,3) - DO i2 = LBOUND(InData%Vdist_High,2), UBOUND(InData%Vdist_High,2) - DO i1 = LBOUND(InData%Vdist_High,1), UBOUND(InData%Vdist_High,1) - ReKiBuf(Re_Xferred) = InData%Vdist_High(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF END SUBROUTINE FWrap_PackInput SUBROUTINE FWrap_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2484,10 +2428,6 @@ SUBROUTINE FWrap_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FWrap_UnPackInput' @@ -2537,44 +2477,6 @@ SUBROUTINE FWrap_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = Re_Xferred + 1 END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vdist_High 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 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vdist_High)) DEALLOCATE(OutData%Vdist_High) - ALLOCATE(OutData%Vdist_High(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%Vdist_High,5), UBOUND(OutData%Vdist_High,5) - DO i4 = LBOUND(OutData%Vdist_High,4), UBOUND(OutData%Vdist_High,4) - DO i3 = LBOUND(OutData%Vdist_High,3), UBOUND(OutData%Vdist_High,3) - DO i2 = LBOUND(OutData%Vdist_High,2), UBOUND(OutData%Vdist_High,2) - DO i1 = LBOUND(OutData%Vdist_High,1), UBOUND(OutData%Vdist_High,1) - OutData%Vdist_High(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF END SUBROUTINE FWrap_UnPackInput SUBROUTINE FWrap_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) diff --git a/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 b/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 index 7b33fe2831..6eaf96b93f 100644 --- a/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 +++ b/glue-codes/fast-farm/src/FAST_Farm_Subs.f90 @@ -1736,6 +1736,9 @@ SUBROUTINE Farm_InitFAST( farm, WD_InitInp, AWAE_InitOutput, SC_InitOutput, SC_y FWrap_InitInp%dX_high = AWAE_InitOutput%dX_high(nt) FWrap_InitInp%dY_high = AWAE_InitOutput%dY_high(nt) FWrap_InitInp%dZ_high = AWAE_InitOutput%dZ_high(nt) + + FWrap_InitInp%Vdist_High => AWAE_InitOutput%Vdist_High(nt)%data + if (SC_InitOutput%NumSC2Ctrl>0) then FWrap_InitInp%fromSC = SC_y%fromSC((nt-1)*SC_InitOutput%NumSC2Ctrl+1:nt*SC_InitOutput%NumSC2Ctrl) end if @@ -2063,7 +2066,6 @@ subroutine FARM_InitialCO(farm, ErrStat, ErrMsg) !-------------------- ! 1c. transfer y_AWAE to u_F and u_WD - call Transfer_AWAE_to_FAST(farm) call Transfer_AWAE_to_WD(farm) if (farm%p%UseSC) then @@ -2155,8 +2157,7 @@ subroutine FARM_InitialCO(farm, ErrStat, ErrMsg) !....................................................................................... ! Transfer y_AWAE to u_F and u_WD !....................................................................................... - - call Transfer_AWAE_to_FAST(farm) + call Transfer_AWAE_to_WD(farm) !....................................................................................... @@ -2732,7 +2733,6 @@ subroutine FARM_CalcOutput(t, farm, ErrStat, ErrMsg) !-------------------- ! 2. Transfer y_AWAE to u_F and u_WD - call Transfer_AWAE_to_FAST(farm) call Transfer_AWAE_to_WD(farm) @@ -2879,18 +2879,6 @@ SUBROUTINE Transfer_AWAE_to_WD(farm) END SUBROUTINE Transfer_AWAE_to_WD !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Transfer_AWAE_to_FAST(farm) - type(All_FastFarm_Data), INTENT(INOUT) :: farm !< FAST.Farm data - - integer(intKi) :: nt - - DO nt = 1,farm%p%NumTurbines - ! allocated in FAST's IfW initialization as 3,x,y,z,t - farm%FWrap(nt)%u%Vdist_High = farm%AWAE%y%Vdist_High(nt)%data - END DO - -END SUBROUTINE Transfer_AWAE_to_FAST -!---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE Transfer_WD_to_AWAE(farm) type(All_FastFarm_Data), INTENT(INOUT) :: farm !< FAST.Farm data diff --git a/modules/awae/src/AWAE.f90 b/modules/awae/src/AWAE.f90 index b640d50397..9c5634d690 100644 --- a/modules/awae/src/AWAE.f90 +++ b/modules/awae/src/AWAE.f90 @@ -1176,6 +1176,13 @@ subroutine AWAE_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for y%TI_amb.', errStat, errMsg, RoutineName ) if (errStat >= AbortErrLev) return + ! Set pointers to high resolution wind in InitOutput + allocate(InitOut%Vdist_High(1:p%NumTurbines), STAT=ErrStat2 ) + if (errStat2 /= 0) call SetErrStat ( ErrID_Fatal, 'Could not allocate memory for y%Vdist_High.', errStat, errMsg, RoutineName ) + do i = 1, p%NumTurbines + InitOut%Vdist_High(i)%data => y%Vdist_High(i)%data + end do + ! This next step is not strictly necessary y%V_plane = 0.0_Reki y%Vx_wind_disk = 0.0_Reki diff --git a/modules/awae/src/AWAE_Registry.txt b/modules/awae/src/AWAE_Registry.txt index a5680f0dc5..95e4054e73 100644 --- a/modules/awae/src/AWAE_Registry.txt +++ b/modules/awae/src/AWAE_Registry.txt @@ -23,7 +23,8 @@ param ^ - INTEGER MeanderMod_TruncJinc param ^ - INTEGER MeanderMod_WndwdJinc - 3 - "Spatial filter model for wake meandering: windowed jinc" - # ..... Wind 3D Data ....................................................................................................... -typedef AWAE/AWAE AWAE_HighWindGrid SiKi data {:}{:}{:}{:}{:} - - "UVW components of wind data across the high-res regularly-spaced grid" m/s +typedef AWAE/AWAE AWAE_HighWindGrid SiKi &data {:}{:}{:}{:}{:} - - "UVW components of wind data across the high-res regularly-spaced grid" m/s +typedef AWAE/AWAE AWAE_HighWindGridPtr SiKi *data {:}{:}{:}{:}{:} - - "Pointer to UVW components of wind data across the high-res regularly-spaced grid" m/s # ..... InputFile Data ....................................................................................................... typedef AWAE/AWAE AWAE_InputFileType ReKi dr - - - "Radial increment of radial finite-difference grid [>0.0]" m typedef ^ ^ DbKi dt_low - - - "Low-resolution (FAST.Farm driver/glue code) time step" s @@ -99,6 +100,7 @@ typedef ^ InitOutputType IntKi nZ_low - - - "Number typedef ^ InitOutputType ReKi X0_low - - - "X-component of the origin of the low-resolution spatial domain" m typedef ^ InitOutputType ReKi Y0_low - - - "Y-component of the origin of the low-resolution spatial domain" m typedef ^ InitOutputType ReKi Z0_low - - - "Z-component of the origin of the low-resolution spatial domain" m +typedef ^ InitOutputType AWAE_HighWindGridPtr Vdist_High {:} - - "Pointers to Wind velocity of disturbed wind (ambient + wakes) across each high-resolution domain around a turbine for each high-resolution step within a low-resolution step" m/s # ..... States .................................................................................................................... # Define continuous (differentiable) states here: diff --git a/modules/awae/src/AWAE_Types.f90 b/modules/awae/src/AWAE_Types.f90 index 541f8e297c..4ca953b3b8 100644 --- a/modules/awae/src/AWAE_Types.f90 +++ b/modules/awae/src/AWAE_Types.f90 @@ -42,9 +42,14 @@ MODULE AWAE_Types INTEGER(IntKi), PUBLIC, PARAMETER :: MeanderMod_WndwdJinc = 3 ! Spatial filter model for wake meandering: windowed jinc [-] ! ========= AWAE_HighWindGrid ======= TYPE, PUBLIC :: AWAE_HighWindGrid - REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: data !< UVW components of wind data across the high-res regularly-spaced grid [m/s] + REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: data => NULL() !< UVW components of wind data across the high-res regularly-spaced grid [m/s] END TYPE AWAE_HighWindGrid ! ======================= +! ========= AWAE_HighWindGridPtr ======= + TYPE, PUBLIC :: AWAE_HighWindGridPtr + REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: data => NULL() !< Pointer to UVW components of wind data across the high-res regularly-spaced grid [m/s] + END TYPE AWAE_HighWindGridPtr +! ======================= ! ========= AWAE_InputFileType ======= TYPE, PUBLIC :: AWAE_InputFileType REAL(ReKi) :: dr !< Radial increment of radial finite-difference grid [>0.0] [m] @@ -118,6 +123,7 @@ MODULE AWAE_Types REAL(ReKi) :: X0_low !< X-component of the origin of the low-resolution spatial domain [m] REAL(ReKi) :: Y0_low !< Y-component of the origin of the low-resolution spatial domain [m] REAL(ReKi) :: Z0_low !< Z-component of the origin of the low-resolution spatial domain [m] + TYPE(AWAE_HighWindGridPtr) , DIMENSION(:), ALLOCATABLE :: Vdist_High !< Pointers to Wind velocity of disturbed wind (ambient + wakes) across each high-resolution domain around a turbine for each high-resolution step within a low-resolution step [m/s] END TYPE AWAE_InitOutputType ! ======================= ! ========= AWAE_ContinuousStateType ======= @@ -259,7 +265,7 @@ SUBROUTINE AWAE_CopyHighWindGrid( SrcHighWindGridData, DstHighWindGridData, Ctrl ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(SrcHighWindGridData%data)) THEN +IF (ASSOCIATED(SrcHighWindGridData%data)) THEN i1_l = LBOUND(SrcHighWindGridData%data,1) i1_u = UBOUND(SrcHighWindGridData%data,1) i2_l = LBOUND(SrcHighWindGridData%data,2) @@ -270,7 +276,7 @@ SUBROUTINE AWAE_CopyHighWindGrid( SrcHighWindGridData, DstHighWindGridData, Ctrl i4_u = UBOUND(SrcHighWindGridData%data,4) i5_l = LBOUND(SrcHighWindGridData%data,5) i5_u = UBOUND(SrcHighWindGridData%data,5) - IF (.NOT. ALLOCATED(DstHighWindGridData%data)) THEN + IF (.NOT. ASSOCIATED(DstHighWindGridData%data)) THEN ALLOCATE(DstHighWindGridData%data(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHighWindGridData%data.', ErrStat, ErrMsg,RoutineName) @@ -294,8 +300,9 @@ SUBROUTINE AWAE_DestroyHighWindGrid( HighWindGridData, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(HighWindGridData%data)) THEN +IF (ASSOCIATED(HighWindGridData%data)) THEN DEALLOCATE(HighWindGridData%data) + HighWindGridData%data => NULL() ENDIF END SUBROUTINE AWAE_DestroyHighWindGrid @@ -335,7 +342,7 @@ SUBROUTINE AWAE_PackHighWindGrid( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_BufSz = 0 Int_BufSz = 0 Int_BufSz = Int_BufSz + 1 ! data allocated yes/no - IF ( ALLOCATED(InData%data) ) THEN + IF ( ASSOCIATED(InData%data) ) THEN Int_BufSz = Int_BufSz + 2*5 ! data upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%data) ! data END IF @@ -366,7 +373,7 @@ SUBROUTINE AWAE_PackHighWindGrid( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IF ( .NOT. ALLOCATED(InData%data) ) THEN + IF ( .NOT. ASSOCIATED(InData%data) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE @@ -453,7 +460,7 @@ SUBROUTINE AWAE_UnPackHighWindGrid( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat i5_l = IntKiBuf( Int_Xferred ) i5_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%data)) DEALLOCATE(OutData%data) + IF (ASSOCIATED(OutData%data)) DEALLOCATE(OutData%data) ALLOCATE(OutData%data(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%data.', ErrStat, ErrMsg,RoutineName) @@ -474,6 +481,142 @@ SUBROUTINE AWAE_UnPackHighWindGrid( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END IF END SUBROUTINE AWAE_UnPackHighWindGrid + SUBROUTINE AWAE_CopyHighWindGridPtr( SrcHighWindGridPtrData, DstHighWindGridPtrData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AWAE_HighWindGridPtr), INTENT(IN) :: SrcHighWindGridPtrData + TYPE(AWAE_HighWindGridPtr), INTENT(INOUT) :: DstHighWindGridPtrData + 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_CopyHighWindGridPtr' +! + ErrStat = ErrID_None + ErrMsg = "" + DstHighWindGridPtrData%data => SrcHighWindGridPtrData%data + END SUBROUTINE AWAE_CopyHighWindGridPtr + + SUBROUTINE AWAE_DestroyHighWindGridPtr( HighWindGridPtrData, ErrStat, ErrMsg ) + TYPE(AWAE_HighWindGridPtr), INTENT(INOUT) :: HighWindGridPtrData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_DestroyHighWindGridPtr' + + ErrStat = ErrID_None + ErrMsg = "" + +NULLIFY(HighWindGridPtrData%data) + END SUBROUTINE AWAE_DestroyHighWindGridPtr + + SUBROUTINE AWAE_PackHighWindGridPtr( 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(AWAE_HighWindGridPtr), 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 = 'AWAE_PackHighWindGridPtr' + ! 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 + 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 + + END SUBROUTINE AWAE_PackHighWindGridPtr + + SUBROUTINE AWAE_UnPackHighWindGridPtr( 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(AWAE_HighWindGridPtr), 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'AWAE_UnPackHighWindGridPtr' + ! 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 + NULLIFY(OutData%data) + END SUBROUTINE AWAE_UnPackHighWindGridPtr + SUBROUTINE AWAE_CopyInputFileType( SrcInputFileTypeData, DstInputFileTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(AWAE_InputFileType), INTENT(IN) :: SrcInputFileTypeData TYPE(AWAE_InputFileType), INTENT(INOUT) :: DstInputFileTypeData @@ -1669,6 +1812,22 @@ SUBROUTINE AWAE_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, DstInitOutputData%X0_low = SrcInitOutputData%X0_low DstInitOutputData%Y0_low = SrcInitOutputData%Y0_low DstInitOutputData%Z0_low = SrcInitOutputData%Z0_low +IF (ALLOCATED(SrcInitOutputData%Vdist_High)) THEN + i1_l = LBOUND(SrcInitOutputData%Vdist_High,1) + i1_u = UBOUND(SrcInitOutputData%Vdist_High,1) + IF (.NOT. ALLOCATED(DstInitOutputData%Vdist_High)) THEN + ALLOCATE(DstInitOutputData%Vdist_High(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitOutputData%Vdist_High.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcInitOutputData%Vdist_High,1), UBOUND(SrcInitOutputData%Vdist_High,1) + CALL AWAE_Copyhighwindgridptr( SrcInitOutputData%Vdist_High(i1), DstInitOutputData%Vdist_High(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF END SUBROUTINE AWAE_CopyInitOutput SUBROUTINE AWAE_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) @@ -1703,6 +1862,13 @@ SUBROUTINE AWAE_DestroyInitOutput( InitOutputData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(InitOutputData%dZ_high)) THEN DEALLOCATE(InitOutputData%dZ_high) +ENDIF +IF (ALLOCATED(InitOutputData%Vdist_High)) THEN +DO i1 = LBOUND(InitOutputData%Vdist_High,1), UBOUND(InitOutputData%Vdist_High,1) + CALL AWAE_DestroyHighWindGridPtr( InitOutputData%Vdist_High(i1), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) +ENDDO + DEALLOCATE(InitOutputData%Vdist_High) ENDIF END SUBROUTINE AWAE_DestroyInitOutput @@ -1801,6 +1967,29 @@ SUBROUTINE AWAE_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Re_BufSz = Re_BufSz + 1 ! X0_low Re_BufSz = Re_BufSz + 1 ! Y0_low Re_BufSz = Re_BufSz + 1 ! Z0_low + Int_BufSz = Int_BufSz + 1 ! Vdist_High allocated yes/no + IF ( ALLOCATED(InData%Vdist_High) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Vdist_High upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Vdist_High,1), UBOUND(InData%Vdist_High,1) + Int_BufSz = Int_BufSz + 3 ! Vdist_High: size of buffers for each call to pack subtype + CALL AWAE_PackHighWindGridPtr( Re_Buf, Db_Buf, Int_Buf, InData%Vdist_High(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Vdist_High + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Vdist_High + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Vdist_High + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Vdist_High + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -1970,6 +2159,47 @@ SUBROUTINE AWAE_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%Z0_low Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%Vdist_High) ) 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%Vdist_High,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vdist_High,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Vdist_High,1), UBOUND(InData%Vdist_High,1) + CALL AWAE_PackHighWindGridPtr( Re_Buf, Db_Buf, Int_Buf, InData%Vdist_High(i1), ErrStat2, ErrMsg2, OnlySize ) ! Vdist_High + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF END SUBROUTINE AWAE_PackInitOutput SUBROUTINE AWAE_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2171,6 +2401,62 @@ SUBROUTINE AWAE_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = Re_Xferred + 1 OutData%Z0_low = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vdist_High 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%Vdist_High)) DEALLOCATE(OutData%Vdist_High) + ALLOCATE(OutData%Vdist_High(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vdist_High.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Vdist_High,1), UBOUND(OutData%Vdist_High,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 AWAE_UnpackHighWindGridPtr( Re_Buf, Db_Buf, Int_Buf, OutData%Vdist_High(i1), ErrStat2, ErrMsg2 ) ! Vdist_High + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF END SUBROUTINE AWAE_UnPackInitOutput SUBROUTINE AWAE_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) diff --git a/modules/inflowwind/src/IfW_FlowField.f90 b/modules/inflowwind/src/IfW_FlowField.f90 index 65be6083b8..e74b7a14f4 100644 --- a/modules/inflowwind/src/IfW_FlowField.f90 +++ b/modules/inflowwind/src/IfW_FlowField.f90 @@ -251,7 +251,7 @@ subroutine IfW_FlowField_GetVelAcc(FF, IStart, Time, PositionXYZ, VelocityUVW, A !------------------------------------------------------------------------- ! If field is not allocated, return error - if (.not. allocated(FF%Grid4D%Vel)) then + if (.not. associated(FF%Grid4D%Vel)) then call SetErrStat(ErrID_Fatal, "Grid4D Field not allocated", ErrStat, ErrMsg, RoutineName) return end if @@ -1629,6 +1629,8 @@ subroutine Grid4DField_GetVel(G4D, Time, Position, Velocity, ErrStat, ErrMsg) end if Indx_Hi(i) = min(Indx_Lo(i) + 1, G4D%n(i)) ! make sure it's a valid index end do + Indx_Lo = Indx_Lo-1 + Indx_Hi = Indx_Hi-1 !---------------------------------------------------------------------------- ! Clamp isopc to [-1, 1] so we don't extrapolate (effectively nearest neighbor) diff --git a/modules/inflowwind/src/IfW_FlowField.txt b/modules/inflowwind/src/IfW_FlowField.txt index cb890684f4..a8bde89c8c 100644 --- a/modules/inflowwind/src/IfW_FlowField.txt +++ b/modules/inflowwind/src/IfW_FlowField.txt @@ -97,7 +97,7 @@ typedef ^ ^ LOGICAL BoxExceedWarn typedef ^ Grid4DFieldType IntKi n 4 - - "number of evenly-spaced grid points in the x, y, z, and t directions" - typedef ^ ^ ReKi delta 4 - - "size between 2 consecutive grid points in each grid direction" "m,m,m,s" typedef ^ ^ ReKi pZero 3 - - "fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" -typedef ^ ^ SiKi Vel ::::: - - "this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]" - +typedef ^ ^ SiKi *Vel ::::: - - "this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt]" - typedef ^ ^ ReKi TimeStart - - - "this is the time where the first time grid in m%V starts (i.e, the time associated with m%V(:,:,:,:,1))" s typedef ^ ^ ReKi RefHeight - - - "reference height; used to center the wind" meters diff --git a/modules/inflowwind/src/IfW_FlowField_Types.f90 b/modules/inflowwind/src/IfW_FlowField_Types.f90 index 11d0acc220..f37bbc73cd 100644 --- a/modules/inflowwind/src/IfW_FlowField_Types.f90 +++ b/modules/inflowwind/src/IfW_FlowField_Types.f90 @@ -132,7 +132,7 @@ MODULE IfW_FlowField_Types INTEGER(IntKi) , DIMENSION(1:4) :: n !< number of evenly-spaced grid points in the x, y, z, and t directions [-] REAL(ReKi) , DIMENSION(1:4) :: delta !< size between 2 consecutive grid points in each grid direction [m,m,m,s] REAL(ReKi) , DIMENSION(1:3) :: pZero !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] - REAL(SiKi) , DIMENSION(:,:,:,:,:), ALLOCATABLE :: Vel !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt] [-] + REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: Vel => NULL() !< this is the 4-d velocity field for each wind component [{uvw},nx,ny,nz,nt] [-] REAL(ReKi) :: TimeStart !< this is the time where the first time grid in m%V starts (i.e, the time associated with m%V(:,:,:,:,1)) [s] REAL(ReKi) :: RefHeight !< reference height; used to center the wind [meters] END TYPE Grid4DFieldType @@ -2272,26 +2272,7 @@ SUBROUTINE IfW_FlowField_CopyGrid4DFieldType( SrcGrid4DFieldTypeData, DstGrid4DF DstGrid4DFieldTypeData%n = SrcGrid4DFieldTypeData%n DstGrid4DFieldTypeData%delta = SrcGrid4DFieldTypeData%delta DstGrid4DFieldTypeData%pZero = SrcGrid4DFieldTypeData%pZero -IF (ALLOCATED(SrcGrid4DFieldTypeData%Vel)) THEN - i1_l = LBOUND(SrcGrid4DFieldTypeData%Vel,1) - i1_u = UBOUND(SrcGrid4DFieldTypeData%Vel,1) - i2_l = LBOUND(SrcGrid4DFieldTypeData%Vel,2) - i2_u = UBOUND(SrcGrid4DFieldTypeData%Vel,2) - i3_l = LBOUND(SrcGrid4DFieldTypeData%Vel,3) - i3_u = UBOUND(SrcGrid4DFieldTypeData%Vel,3) - i4_l = LBOUND(SrcGrid4DFieldTypeData%Vel,4) - i4_u = UBOUND(SrcGrid4DFieldTypeData%Vel,4) - i5_l = LBOUND(SrcGrid4DFieldTypeData%Vel,5) - i5_u = UBOUND(SrcGrid4DFieldTypeData%Vel,5) - IF (.NOT. ALLOCATED(DstGrid4DFieldTypeData%Vel)) THEN - ALLOCATE(DstGrid4DFieldTypeData%Vel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstGrid4DFieldTypeData%Vel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstGrid4DFieldTypeData%Vel = SrcGrid4DFieldTypeData%Vel -ENDIF + DstGrid4DFieldTypeData%Vel => SrcGrid4DFieldTypeData%Vel DstGrid4DFieldTypeData%TimeStart = SrcGrid4DFieldTypeData%TimeStart DstGrid4DFieldTypeData%RefHeight = SrcGrid4DFieldTypeData%RefHeight END SUBROUTINE IfW_FlowField_CopyGrid4DFieldType @@ -2309,9 +2290,7 @@ SUBROUTINE IfW_FlowField_DestroyGrid4DFieldType( Grid4DFieldTypeData, ErrStat, E ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(Grid4DFieldTypeData%Vel)) THEN - DEALLOCATE(Grid4DFieldTypeData%Vel) -ENDIF +NULLIFY(Grid4DFieldTypeData%Vel) END SUBROUTINE IfW_FlowField_DestroyGrid4DFieldType SUBROUTINE IfW_FlowField_PackGrid4DFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -2352,11 +2331,6 @@ SUBROUTINE IfW_FlowField_PackGrid4DFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata Int_BufSz = Int_BufSz + SIZE(InData%n) ! n Re_BufSz = Re_BufSz + SIZE(InData%delta) ! delta Re_BufSz = Re_BufSz + SIZE(InData%pZero) ! pZero - Int_BufSz = Int_BufSz + 1 ! Vel allocated yes/no - IF ( ALLOCATED(InData%Vel) ) THEN - Int_BufSz = Int_BufSz + 2*5 ! Vel upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Vel) ! Vel - END IF Re_BufSz = Re_BufSz + 1 ! TimeStart Re_BufSz = Re_BufSz + 1 ! RefHeight IF ( Re_BufSz .GT. 0 ) THEN @@ -2398,41 +2372,6 @@ SUBROUTINE IfW_FlowField_PackGrid4DFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Indata ReKiBuf(Re_Xferred) = InData%pZero(i1) Re_Xferred = Re_Xferred + 1 END DO - IF ( .NOT. ALLOCATED(InData%Vel) ) 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%Vel,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,2) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,3) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,3) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,4) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,4) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Vel,5) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vel,5) - Int_Xferred = Int_Xferred + 2 - - DO i5 = LBOUND(InData%Vel,5), UBOUND(InData%Vel,5) - DO i4 = LBOUND(InData%Vel,4), UBOUND(InData%Vel,4) - DO i3 = LBOUND(InData%Vel,3), UBOUND(InData%Vel,3) - DO i2 = LBOUND(InData%Vel,2), UBOUND(InData%Vel,2) - DO i1 = LBOUND(InData%Vel,1), UBOUND(InData%Vel,1) - ReKiBuf(Re_Xferred) = InData%Vel(i1,i2,i3,i4,i5) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF ReKiBuf(Re_Xferred) = InData%TimeStart Re_Xferred = Re_Xferred + 1 ReKiBuf(Re_Xferred) = InData%RefHeight @@ -2488,44 +2427,7 @@ SUBROUTINE IfW_FlowField_UnPackGrid4DFieldType( ReKiBuf, DbKiBuf, IntKiBuf, Outd OutData%pZero(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vel 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 - i5_l = IntKiBuf( Int_Xferred ) - i5_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Vel)) DEALLOCATE(OutData%Vel) - ALLOCATE(OutData%Vel(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vel.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i5 = LBOUND(OutData%Vel,5), UBOUND(OutData%Vel,5) - DO i4 = LBOUND(OutData%Vel,4), UBOUND(OutData%Vel,4) - DO i3 = LBOUND(OutData%Vel,3), UBOUND(OutData%Vel,3) - DO i2 = LBOUND(OutData%Vel,2), UBOUND(OutData%Vel,2) - DO i1 = LBOUND(OutData%Vel,1), UBOUND(OutData%Vel,1) - OutData%Vel(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) - Re_Xferred = Re_Xferred + 1 - END DO - END DO - END DO - END DO - END DO - END IF + NULLIFY(OutData%Vel) OutData%TimeStart = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 OutData%RefHeight = ReKiBuf(Re_Xferred) diff --git a/modules/inflowwind/src/InflowWind_IO.f90 b/modules/inflowwind/src/InflowWind_IO.f90 index 5863024344..96c2d7e21c 100644 --- a/modules/inflowwind/src/InflowWind_IO.f90 +++ b/modules/inflowwind/src/InflowWind_IO.f90 @@ -1023,8 +1023,6 @@ subroutine IfW_Grid4D_Init(InitInp, G4D, ErrStat, ErrMsg) character(*), intent(out) :: ErrMsg character(*), parameter :: RoutineName = "IfW_Grid4D_Init" - integer(IntKi) :: TmpErrStat - character(ErrMsgLen) :: TmpErrMsg ErrStat = ErrID_None ErrMsg = "" @@ -1035,15 +1033,7 @@ subroutine IfW_Grid4D_Init(InitInp, G4D, ErrStat, ErrMsg) G4D%pZero = InitInp%pZero G4D%TimeStart = 0.0_ReKi G4D%RefHeight = InitInp%pZero(3) + (InitInp%n(3)/2) * InitInp%delta(3) - - ! uvw velocity components at x,y,z,t coordinates - call AllocAry(G4D%Vel, 3, G4D%n(1), G4D%n(2), G4D%n(3), G4D%n(4), & - 'External Grid Velocity', TmpErrStat, TmpErrMsg) - call SetErrStat(ErrStat, ErrMsg, TmpErrStat, TmpErrMsg, RoutineName) - if (ErrStat >= AbortErrLev) return - - ! Initialize velocities to zero - G4D%Vel = 0.0_SiKi + G4D%Vel => InitInp%Vel end subroutine diff --git a/modules/inflowwind/src/InflowWind_IO.txt b/modules/inflowwind/src/InflowWind_IO.txt index 5d6c60e59b..60ad32b108 100644 --- a/modules/inflowwind/src/InflowWind_IO.txt +++ b/modules/inflowwind/src/InflowWind_IO.txt @@ -87,6 +87,7 @@ typedef ^ User_InitInputType SiKi Dummy typedef ^ Grid4D_InitInputType IntKi n 4 - - "number of grid points in the x, y, z, and t directions" - typedef ^ ^ ReKi delta 4 - - "size between 2 consecutive grid points in each grid direction" "m,m,m,s" typedef ^ ^ ReKi pZero 3 - - "fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:))" "m" +typedef ^ ^ SiKi *Vel ::::: - - "pointer to 4D grid velocity data" "m/s" #---------------------------------------------------------------------------------------------------------------------------------- typedef ^ Points_InitInputType IntKi NumWindPoints - - - "Number of points where wind components will be provided" - diff --git a/modules/inflowwind/src/InflowWind_IO_Types.f90 b/modules/inflowwind/src/InflowWind_IO_Types.f90 index eb74581ab5..1d4342bf6b 100644 --- a/modules/inflowwind/src/InflowWind_IO_Types.f90 +++ b/modules/inflowwind/src/InflowWind_IO_Types.f90 @@ -132,6 +132,7 @@ MODULE InflowWind_IO_Types INTEGER(IntKi) , DIMENSION(1:4) :: n !< number of grid points in the x, y, z, and t directions [-] REAL(ReKi) , DIMENSION(1:4) :: delta !< size between 2 consecutive grid points in each grid direction [m,m,m,s] REAL(ReKi) , DIMENSION(1:3) :: pZero !< fixed position of the XYZ grid (i.e., XYZ coordinates of m%V(:,1,1,1,:)) [m] + REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: Vel => NULL() !< pointer to 4D grid velocity data [m/s] END TYPE Grid4D_InitInputType ! ======================= ! ========= Points_InitInputType ======= @@ -1836,6 +1837,10 @@ SUBROUTINE InflowWind_IO_CopyGrid4D_InitInputType( SrcGrid4D_InitInputTypeData, ! 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_CopyGrid4D_InitInputType' @@ -1845,6 +1850,7 @@ SUBROUTINE InflowWind_IO_CopyGrid4D_InitInputType( SrcGrid4D_InitInputTypeData, DstGrid4D_InitInputTypeData%n = SrcGrid4D_InitInputTypeData%n DstGrid4D_InitInputTypeData%delta = SrcGrid4D_InitInputTypeData%delta DstGrid4D_InitInputTypeData%pZero = SrcGrid4D_InitInputTypeData%pZero + DstGrid4D_InitInputTypeData%Vel => SrcGrid4D_InitInputTypeData%Vel END SUBROUTINE InflowWind_IO_CopyGrid4D_InitInputType SUBROUTINE InflowWind_IO_DestroyGrid4D_InitInputType( Grid4D_InitInputTypeData, ErrStat, ErrMsg ) @@ -1860,6 +1866,7 @@ SUBROUTINE InflowWind_IO_DestroyGrid4D_InitInputType( Grid4D_InitInputTypeData, ErrStat = ErrID_None ErrMsg = "" +NULLIFY(Grid4D_InitInputTypeData%Vel) END SUBROUTINE InflowWind_IO_DestroyGrid4D_InitInputType SUBROUTINE InflowWind_IO_PackGrid4D_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1955,6 +1962,10 @@ SUBROUTINE InflowWind_IO_UnPackGrid4D_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_IO_UnPackGrid4D_InitInputType' @@ -1986,6 +1997,7 @@ SUBROUTINE InflowWind_IO_UnPackGrid4D_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, OutData%pZero(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO + NULLIFY(OutData%Vel) END SUBROUTINE InflowWind_IO_UnPackGrid4D_InitInputType SUBROUTINE InflowWind_IO_CopyPoints_InitInputType( SrcPoints_InitInputTypeData, DstPoints_InitInputTypeData, CtrlCode, ErrStat, ErrMsg ) diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index f69948e8e8..649b1528e5 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -752,6 +752,7 @@ typedef ^ FAST_ExternInitType logical FarmIntegration - .false. - "whether this typedef ^ FAST_ExternInitType IntKi windGrid_n 4 - - "number of grid points in the x, y, z, and t directions for IfW" - typedef ^ FAST_ExternInitType ReKi windGrid_delta 4 - - "size between 2 consecutive grid points in each grid direction for IfW" "m,m,m,s" typedef ^ FAST_ExternInitType ReKi windGrid_pZero 3 - - "fixed position of the XYZ grid (i.e., XYZ coordinates of IfW m%V(:,1,1,1,:))" m +typedef ^ FAST_ExternInitType SiKi *windGrid_data ::::: - - "Pointers to Wind velocity of disturbed wind (ambient + wakes) across each high-resolution domain around a turbine for each high-resolution step within a low-resolution step" m/s typedef ^ FAST_ExternInitType CHARACTER(1024) RootName - - - "Root name of FAST output files (overrides normal operation)" - typedef ^ FAST_ExternInitType IntKi NumActForcePtsBlade - - - "number of actuator line force points in blade" - typedef ^ FAST_ExternInitType IntKi NumActForcePtsTower - - - "number of actuator line force points in tower" - diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 659aebd2e8..c795815058 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -603,6 +603,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, Init%InData_IfW%FDext%n = ExternInitData%windGrid_n Init%InData_IfW%FDext%delta = ExternInitData%windGrid_delta Init%InData_IfW%FDext%pZero = ExternInitData%windGrid_pZero + Init%InData_IfW%FDext%Vel => ExternInitData%windGrid_data end if ELSE Init%InData_IfW%Use4Dext = .false. diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 1c8b10120e..893900335c 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -772,6 +772,7 @@ MODULE FAST_Types INTEGER(IntKi) , DIMENSION(1:4) :: windGrid_n !< number of grid points in the x, y, z, and t directions for IfW [-] REAL(ReKi) , DIMENSION(1:4) :: windGrid_delta !< size between 2 consecutive grid points in each grid direction for IfW [m,m,m,s] REAL(ReKi) , DIMENSION(1:3) :: windGrid_pZero !< fixed position of the XYZ grid (i.e., XYZ coordinates of IfW m%V(:,1,1,1,:)) [m] + REAL(SiKi) , DIMENSION(:,:,:,:,:), POINTER :: windGrid_data => NULL() !< Pointers to Wind velocity of disturbed wind (ambient + wakes) across each high-resolution domain around a turbine for each high-resolution step within a low-resolution step [m/s] CHARACTER(1024) :: RootName !< Root name of FAST output files (overrides normal operation) [-] INTEGER(IntKi) :: NumActForcePtsBlade !< number of actuator line force points in blade [-] INTEGER(IntKi) :: NumActForcePtsTower !< number of actuator line force points in tower [-] @@ -48375,6 +48376,10 @@ SUBROUTINE FAST_CopyExternInitType( SrcExternInitTypeData, DstExternInitTypeData ! 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExternInitType' @@ -48418,6 +48423,7 @@ SUBROUTINE FAST_CopyExternInitType( SrcExternInitTypeData, DstExternInitTypeData DstExternInitTypeData%windGrid_n = SrcExternInitTypeData%windGrid_n DstExternInitTypeData%windGrid_delta = SrcExternInitTypeData%windGrid_delta DstExternInitTypeData%windGrid_pZero = SrcExternInitTypeData%windGrid_pZero + DstExternInitTypeData%windGrid_data => SrcExternInitTypeData%windGrid_data DstExternInitTypeData%RootName = SrcExternInitTypeData%RootName DstExternInitTypeData%NumActForcePtsBlade = SrcExternInitTypeData%NumActForcePtsBlade DstExternInitTypeData%NumActForcePtsTower = SrcExternInitTypeData%NumActForcePtsTower @@ -48443,6 +48449,7 @@ SUBROUTINE FAST_DestroyExternInitType( ExternInitTypeData, ErrStat, ErrMsg ) IF (ALLOCATED(ExternInitTypeData%fromSC)) THEN DEALLOCATE(ExternInitTypeData%fromSC) ENDIF +NULLIFY(ExternInitTypeData%windGrid_data) END SUBROUTINE FAST_DestroyExternInitType SUBROUTINE FAST_PackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -48624,6 +48631,10 @@ SUBROUTINE FAST_UnPackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt 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) :: i5, i5_l, i5_u ! bounds (upper/lower) for an array dimension 5 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackExternInitType' @@ -48715,6 +48726,7 @@ SUBROUTINE FAST_UnPackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt OutData%windGrid_pZero(i1) = ReKiBuf(Re_Xferred) Re_Xferred = Re_Xferred + 1 END DO + NULLIFY(OutData%windGrid_data) DO I = 1, LEN(OutData%RootName) OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) Int_Xferred = Int_Xferred + 1