From f6618c4d3d51d60d6c2925bd79e4876282835da0 Mon Sep 17 00:00:00 2001 From: Bonnie Jonkman Date: Tue, 1 Oct 2024 10:25:00 -0600 Subject: [PATCH] Lidar + ServoDyn - remove unnecessary lidar allocatable arrays in SrvoDyn InitInp type - remove unused URefLid from ServoDyn InitInp; the value that is passed to the controller was never initialized and doesn't make sense for a controller to use anyway. - allocate lidar arrays for controller based on number of beams and pulse gates instead of type of lidar - initialize error status in BladedInterface_End routine --- modules/openfast-library/src/FAST_Subs.f90 | 40 +--------- modules/servodyn/src/BladedInterface.f90 | 10 +-- modules/servodyn/src/BladedInterface_EX.f90 | 70 ++++++----------- modules/servodyn/src/ServoDyn.f90 | 34 ++++----- modules/servodyn/src/ServoDyn_Registry.txt | 7 -- modules/servodyn/src/ServoDyn_Types.f90 | 84 --------------------- 6 files changed, 46 insertions(+), 199 deletions(-) diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 61625c9e96..cc9498640b 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -1544,45 +1544,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, SED, BD, S END IF IF ( p_FAST%CompInflow == Module_IfW ) THEN ! assign the number of gates to ServD - if (allocated(IfW%y%lidar%LidSpeed)) then ! make sure we have the array allocated before setting it - CALL AllocAry(Init%InData_SrvD%LidSpeed, size(IfW%y%lidar%LidSpeed), 'Init%InData_SrvD%LidSpeed', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - Init%InData_SrvD%LidSpeed = IfW%y%lidar%LidSpeed - endif - if (allocated(IfW%y%lidar%MsrPositionsX)) then ! make sure we have the array allocated before setting it - CALL AllocAry(Init%InData_SrvD%MsrPositionsX, size(IfW%y%lidar%MsrPositionsX), 'Init%InData_SrvD%MsrPositionsX', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - Init%InData_SrvD%MsrPositionsX = IfW%y%lidar%MsrPositionsX - endif - if (allocated(IfW%y%lidar%MsrPositionsY)) then ! make sure we have the array allocated before setting it - CALL AllocAry(Init%InData_SrvD%MsrPositionsY, size(IfW%y%lidar%MsrPositionsY), 'Init%InData_SrvD%MsrPositionsY', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - Init%InData_SrvD%MsrPositionsY = IfW%y%lidar%MsrPositionsY - endif - if (allocated(IfW%y%lidar%MsrPositionsZ)) then ! make sure we have the array allocated before setting it - CALL AllocAry(Init%InData_SrvD%MsrPositionsZ, size(IfW%y%lidar%MsrPositionsZ), 'Init%InData_SrvD%MsrPositionsZ', errStat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ErrStat >= AbortErrLev) THEN - CALL Cleanup() - RETURN - END IF - Init%InData_SrvD%MsrPositionsZ = IfW%y%lidar%MsrPositionsZ - endif Init%InData_SrvD%SensorType = IfW%p%lidar%SensorType Init%InData_SrvD%NumBeam = IfW%p%lidar%NumBeam Init%InData_SrvD%NumPulseGate = IfW%p%lidar%NumPulseGate + else + Init%InData_SrvD%SensorType = 0 + Init%InData_SrvD%NumBeam = 0 + Init%InData_SrvD%NumPulseGate = 0 END IF diff --git a/modules/servodyn/src/BladedInterface.f90 b/modules/servodyn/src/BladedInterface.f90 index d9b7df4f9b..34837757d1 100644 --- a/modules/servodyn/src/BladedInterface.f90 +++ b/modules/servodyn/src/BladedInterface.f90 @@ -867,7 +867,10 @@ SUBROUTINE BladedInterface_End(u, p, m, xd, ErrStat, ErrMsg) INTEGER(IntKi) :: ErrStat2 ! The error status code CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred - ! call DLL final time, but skip if we've never called it + ErrStat = ErrID_None + ErrMsg = "" + + ! call DLL final time, but skip if we've never called it if (allocated(m%dll_data%avrSWAP)) then IF ( m%dll_data%SimStatus /= GH_DISCON_STATUS_INITIALISING ) THEN m%dll_data%SimStatus = GH_DISCON_STATUS_FINALISING @@ -877,10 +880,7 @@ SUBROUTINE BladedInterface_End(u, p, m, xd, ErrStat, ErrMsg) end if CALL FreeDynamicLib( p%DLL_Trgt, ErrStat2, ErrMsg2 ) ! this doesn't do anything #ifdef STATIC_DLL_LOAD because p%DLL_Trgt is 0 (NULL) - IF (ErrStat2 /= ErrID_None) THEN - ErrStat = MAX(ErrStat, ErrStat2) - ErrMsg = TRIM(ErrMsg)//NewLine//TRIM(ErrMsg2) - END IF + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'BladedInterface_End') END SUBROUTINE BladedInterface_End !================================================================================================================================== diff --git a/modules/servodyn/src/BladedInterface_EX.f90 b/modules/servodyn/src/BladedInterface_EX.f90 index 7c50a2d99e..45fde31595 100644 --- a/modules/servodyn/src/BladedInterface_EX.f90 +++ b/modules/servodyn/src/BladedInterface_EX.f90 @@ -374,66 +374,40 @@ end subroutine InitStCCtrl subroutine InitLidarMeas() integer :: I,J - if (p%NumBeam == 0) return ! Nothing to set + integer :: nPts + + nPts = p%NumBeam * p%NumPulseGate + + if (nPts == 0) return ! Nothing to set ! Allocate arrays for inputs -- these may have been set in ServoDyn already - if (allocated(InitInp%LidSpeed)) then ! make sure we have the array allocated before setting it - if (.not. allocated(u%LidSpeed)) then - CALL AllocAry(u%LidSpeed, size(InitInp%LidSpeed), 'u%LidSpeed', errStat2, ErrMsg2) - if (Failed()) return - endif - u%LidSpeed = InitInp%LidSpeed + if (.not. allocated(u%LidSpeed)) then + CALL AllocAry(u%LidSpeed, nPts, 'u%LidSpeed', errStat2, ErrMsg2); if (Failed()) return endif - if (allocated(InitInp%MsrPositionsX)) then ! make sure we have the array allocated before setting it - if (.not. allocated(u%MsrPositionsX)) then - CALL AllocAry(u%MsrPositionsX, size(InitInp%MsrPositionsX), 'u%MsrPositionsX', errStat2, ErrMsg2) - if (Failed()) return - endif - u%MsrPositionsX = InitInp%MsrPositionsX + if (.not. allocated(u%MsrPositionsX)) then + CALL AllocAry(u%MsrPositionsX, nPts, 'u%MsrPositionsX', errStat2, ErrMsg2); if (Failed()) return endif - if (allocated(InitInp%MsrPositionsY)) then ! make sure we have the array allocated before setting it - if (.not. allocated(u%MsrPositionsY)) then - CALL AllocAry(u%MsrPositionsY, size(InitInp%MsrPositionsY), 'u%MsrPositionsY', errStat2, ErrMsg2) - if (Failed()) return - endif - u%MsrPositionsY = InitInp%MsrPositionsY + if (.not. allocated(u%MsrPositionsY)) then + CALL AllocAry(u%MsrPositionsY, nPts, 'u%MsrPositionsY', errStat2, ErrMsg2); if (Failed()) return endif - if (allocated(InitInp%MsrPositionsZ)) then ! make sure we have the array allocated before setting it - if (.not. allocated(u%MsrPositionsZ)) then - CALL AllocAry(u%MsrPositionsZ, size(InitInp%MsrPositionsZ), 'u%MsrPositionsZ', errStat2, ErrMsg2) - if (Failed()) return - endif - u%MsrPositionsZ = InitInp%MsrPositionsZ + if (.not. allocated(u%MsrPositionsZ)) then + CALL AllocAry(u%MsrPositionsZ, nPts, 'u%MsrPositionsZ', errStat2, ErrMsg2) + if (Failed()) return endif ! Write summary info to summary file if (UnSum > 0) then - if (p%SensorType > 0) then ! Set these here rather than overwrite every loop step in SensorType 1 or 3 + if (p%SensorType > 0) then J=LidarMsr_StartIdx call WrSumInfoRcvd( J+0, '','Lidar input: Sensor Type') call WrSumInfoRcvd( J+1, '','Lidar input: Number of Beams') call WrSumInfoRcvd( J+2, '','Lidar input: Number of Pulse Gates') call WrSumInfoRcvd( J+3, '','Lidar input: Reference average wind speed for the lidar') - endif - if (p%SensorType == 1) THEN - do I=1,min(p%NumBeam,(LidarMsr_MaxChan-4)/4) ! Don't overstep the end for the lidar measure group - J=LidarMsr_StartIdx + 4 + (I-1) - call WrSumInfoRcvd( J+0, '','Lidar input: Measured Wind Speeds ('//trim(Num2LStr(I))//')') - call WrSumInfoRcvd( J+p%NumBeam*1, '','Lidar input: Measurement Points X ('//trim(Num2LStr(I))//')') - call WrSumInfoRcvd( J+p%NumBeam*2, '','Lidar input: Measurement Points Y ('//trim(Num2LStr(I))//')') - call WrSumInfoRcvd( J+p%NumBeam*3, '','Lidar input: Measurement Points Z ('//trim(Num2LStr(I))//')') - enddo - elseif (p%SensorType == 2) THEN - J=LidarMsr_StartIdx - call WrSumInfoRcvd( J+4, '','Lidar input: Measured Wind Speeds') - call WrSumInfoRcvd( J+5, '','Lidar input: Measurement Points X') - call WrSumInfoRcvd( J+6, '','Lidar input: Measurement Points Y') - call WrSumInfoRcvd( J+7, '','Lidar input: Measurement Points Z') - elseif (p%SensorType == 3) THEN - do I=1,min(p%NumPulseGate,(LidarMsr_MaxChan-4)/4) ! Don't overstep the end for the lidar measure group + + do I=1,min(nPts,(LidarMsr_MaxChan-4)/4) ! Don't overstep the end for the lidar measure group J=LidarMsr_StartIdx + 4 + (I-1) - call WrSumInfoRcvd( J+0, '','Lidar input: Measured Wind Speeds ('//trim(Num2LStr(I))//')') - call WrSumInfoRcvd( J+p%NumPulseGate*1, '','Lidar input: Measurement Points X ('//trim(Num2LStr(I))//')') - call WrSumInfoRcvd( J+p%NumPulseGate*2, '','Lidar input: Measurement Points Y ('//trim(Num2LStr(I))//')') - call WrSumInfoRcvd( J+p%NumPulseGate*3, '','Lidar input: Measurement Points Z ('//trim(Num2LStr(I))//')') + call WrSumInfoRcvd( J+0, '','Lidar input: Measured Wind Speeds ('//trim(Num2LStr(I))//')') + call WrSumInfoRcvd( J+nPts*1, '','Lidar input: Measurement Points X ('//trim(Num2LStr(I))//')') + call WrSumInfoRcvd( J+nPts*2, '','Lidar input: Measurement Points Y ('//trim(Num2LStr(I))//')') + call WrSumInfoRcvd( J+nPts*3, '','Lidar input: Measurement Points Z ('//trim(Num2LStr(I))//')') enddo endif endif @@ -561,7 +535,7 @@ subroutine SetEXavrSWAP_LidarSensors() dll_data%avrswap(LidarMsr_StartIdx) = real(p%SensorType,SiKi) ! Sensor Type dll_data%avrswap(LidarMsr_StartIdx+1) = real(p%NumBeam,SiKi) ! Number of Beams dll_data%avrswap(LidarMsr_StartIdx+2) = real(p%NumPulseGate,SiKi) ! Number of Pulse Gates - dll_data%avrswap(LidarMsr_StartIdx+3) = p%URefLid ! Reference average wind speed for the lidar + dll_data%avrswap(LidarMsr_StartIdx+3) = 0.0_SiKi ! Reference average wind speed for the lidar (this was never set, plus it doesn't really make sense that the controller would need it) nPts = SIZE(u%MsrPositionsX) do I=1,min(nPts,(LidarMsr_MaxChan-4)/4) ! Don't overstep the end for the lidar measure group diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index 953f2be2ec..658a4e62fc 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -134,14 +134,13 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO INTEGER(IntKi) :: i ! loop counter INTEGER(IntKi) :: j ! loop counter INTEGER(IntKi) :: K ! loop counter + INTEGER(IntKi) :: nPts ! number of linear wind-speed points INTEGER(IntKi) :: UnSum ! Summary file unit INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None character(*), parameter :: RoutineName = 'SrvD_Init' - - ! Initialize variables ErrStat = ErrID_None @@ -347,6 +346,19 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO end if END IF + nPts = InitInp%NumBeam * InitInp%NumPulseGate + if (nPts > 0 .and. p%UseBladedInterface) then + CALL AllocAry( u%LidSpeed, nPts, 'u%LidSpeed', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocAry( u%MsrPositionsX, nPts, 'u%MsrPositionsX', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocAry( u%MsrPositionsY, nPts, 'u%MsrPositionsY', ErrStat2, ErrMsg2 ); if (Failed()) return; + CALL AllocAry( u%MsrPositionsZ, nPts, 'u%MsrPositionsZ', ErrStat2, ErrMsg2 ); if (Failed()) return; + + u%LidSpeed = 0.0_SiKi + u%MsrPositionsX = 0.0_ReKi + u%MsrPositionsY = 0.0_ReKi + u%MsrPositionsZ = 0.0_ReKi + end if + u%BlPitch = p%BlPitchInit(1:p%NumBl) u%Yaw = p%YawNeut @@ -387,22 +399,7 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO u%RotPwr = 0. u%HorWindV = 0. u%YawAngle = 0. - if (allocated(InitInp%LidSpeed)) then ! Must allocate - allocate(u%LidSpeed(size(InitInp%LidSpeed))) - u%LidSpeed = 0. - endif - if (allocated(InitInp%MsrPositionsX)) then - allocate(u%MsrPositionsX(size(InitInp%MsrPositionsX))) - u%MsrPositionsX = 0. - endif - if (allocated(InitInp%MsrPositionsY)) then - allocate(u%MsrPositionsY(size(InitInp%MsrPositionsY))) - u%MsrPositionsY = 0. - endif - if (allocated(InitInp%MsrPositionsZ)) then - allocate(u%MsrPositionsZ(size(InitInp%MsrPositionsZ))) - u%MsrPositionsZ = 0. - endif + m%dll_data%ElecPwr_prev = 0. m%dll_data%GenTrq_prev = 0. @@ -504,7 +501,6 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO p%SensorType = InitInp%SensorType p%NumBeam = InitInp%NumBeam p%NumPulseGate = InitInp%NumPulseGate - p%URefLid = InitInp%URefLid !bjj: not sure why you would need to store this variable in SeroDyn or why the controller would use it CALL BladedInterface_Init(u, p, m, xd, y, InputFileData, InitInp, StC_CtrlChanInitInfo, UnSum, ErrStat2, ErrMsg2 ) if (Failed()) return; diff --git a/modules/servodyn/src/ServoDyn_Registry.txt b/modules/servodyn/src/ServoDyn_Registry.txt index dad193ca38..aa257050d7 100644 --- a/modules/servodyn/src/ServoDyn_Registry.txt +++ b/modules/servodyn/src/ServoDyn_Registry.txt @@ -57,14 +57,9 @@ typedef ^ InitInputType IntKi InterpOrder - - - "Interpolation order from glue c typedef ^ InitInputType ReKi fromSCGlob {:} - - "Initial global inputs to the controller [from the supercontroller]" - typedef ^ InitInputType ReKi fromSC {:} - - "Initial turbine specific inputs to the controller [from the supercontroller]" - #initial inputs of lidar parameters -typedef ^ InitInputType ReKi LidSpeed {:} - - "Number of Lidar measurement distances" - -typedef ^ InitInputType ReKi MsrPositionsX {:} - - "Lidar X direction measurement points" m -typedef ^ InitInputType ReKi MsrPositionsY {:} - - "Lidar Y direction measurement points" m -typedef ^ InitInputType ReKi MsrPositionsZ {:} - - "Lidar Z direction measurement points" m typedef ^ InitInputType IntKi SensorType - - - "Lidar sensor type" - typedef ^ InitInputType IntKi NumBeam - - - "Number of beams" - typedef ^ InitInputType IntKi NumPulseGate - - - "Number of pulse gates" - -typedef ^ InitInputType ReKi URefLid - - - "Reference average wind speed for the lidar" m/s # Define outputs from the initialization routine here: typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - @@ -241,7 +236,6 @@ typedef ^ BladedDLLType ReKi MsrPositionsZ {:} - - "Lidar Z direction meas typedef ^ BladedDLLType IntKi SensorType - - - "Lidar sensor type" - typedef ^ BladedDLLType IntKi NumBeam - - - "Number of beams" - typedef ^ BladedDLLType IntKi NumPulseGate - - - "Number of pulse gates" - -typedef ^ BladedDLLType IntKi URefLid - - - "Reference average wind speed for the lidar" m/s ## these are PARAMETERS sent to the DLL (THEIR VALUES SHOULD NOT CHANGE DURING SIMULATION): typedef ^ BladedDLLType DbKi DLL_DT - - - "interval for calling DLL (integer multiple number of DT)" s typedef ^ BladedDLLType CHARACTER(1024) DLL_InFile - - - "Name of input file used in DLL" - @@ -490,7 +484,6 @@ typedef ^ ParameterType Integer Jac_Idx_SStC_y {:}{:} - - "the start and typedef ^ ParameterType IntKi SensorType - - - "Lidar sensor type" - typedef ^ ParameterType IntKi NumBeam - - - "Number of beams" - typedef ^ ParameterType IntKi NumPulseGate - - - "Number of pulse gates" - -typedef ^ ParameterType ReKi URefLid - - - "Reference average wind speed for the lidar - bjj: not sure why we have this variable" m/s diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index 58c04305a0..ede96af1bd 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -74,14 +74,9 @@ MODULE ServoDyn_Types INTEGER(IntKi) :: InterpOrder = 0_IntKi !< Interpolation order from glue code -- required to set m%u_xStC sizes [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: fromSCGlob !< Initial global inputs to the controller [from the supercontroller] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: fromSC !< Initial turbine specific inputs to the controller [from the supercontroller] [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LidSpeed !< Number of Lidar measurement distances [-] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsX !< Lidar X direction measurement points [m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsY !< Lidar Y direction measurement points [m] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: MsrPositionsZ !< Lidar Z direction measurement points [m] INTEGER(IntKi) :: SensorType = 0_IntKi !< Lidar sensor type [-] INTEGER(IntKi) :: NumBeam = 0_IntKi !< Number of beams [-] INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< Number of pulse gates [-] - REAL(ReKi) :: URefLid = 0.0_ReKi !< Reference average wind speed for the lidar [m/s] END TYPE SrvD_InitInputType ! ======================= ! ========= SrvD_InitOutputType ======= @@ -254,7 +249,6 @@ MODULE ServoDyn_Types INTEGER(IntKi) :: SensorType = 0_IntKi !< Lidar sensor type [-] INTEGER(IntKi) :: NumBeam = 0_IntKi !< Number of beams [-] INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< Number of pulse gates [-] - INTEGER(IntKi) :: URefLid = 0_IntKi !< Reference average wind speed for the lidar [m/s] REAL(DbKi) :: DLL_DT = 0.0_R8Ki !< interval for calling DLL (integer multiple number of DT) [s] CHARACTER(1024) :: DLL_InFile !< Name of input file used in DLL [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] @@ -496,7 +490,6 @@ MODULE ServoDyn_Types INTEGER(IntKi) :: SensorType = 0_IntKi !< Lidar sensor type [-] INTEGER(IntKi) :: NumBeam = 0_IntKi !< Number of beams [-] INTEGER(IntKi) :: NumPulseGate = 0_IntKi !< Number of pulse gates [-] - REAL(ReKi) :: URefLid = 0.0_ReKi !< Reference average wind speed for the lidar - bjj: not sure why we have this variable [m/s] END TYPE SrvD_ParameterType ! ======================= ! ========= SrvD_InputType ======= @@ -716,58 +709,9 @@ subroutine SrvD_CopyInitInput(SrcInitInputData, DstInitInputData, CtrlCode, ErrS end if DstInitInputData%fromSC = SrcInitInputData%fromSC end if - if (allocated(SrcInitInputData%LidSpeed)) then - LB(1:1) = lbound(SrcInitInputData%LidSpeed, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%LidSpeed, kind=B8Ki) - if (.not. allocated(DstInitInputData%LidSpeed)) then - allocate(DstInitInputData%LidSpeed(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%LidSpeed.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitInputData%LidSpeed = SrcInitInputData%LidSpeed - end if - if (allocated(SrcInitInputData%MsrPositionsX)) then - LB(1:1) = lbound(SrcInitInputData%MsrPositionsX, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%MsrPositionsX, kind=B8Ki) - if (.not. allocated(DstInitInputData%MsrPositionsX)) then - allocate(DstInitInputData%MsrPositionsX(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsX.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitInputData%MsrPositionsX = SrcInitInputData%MsrPositionsX - end if - if (allocated(SrcInitInputData%MsrPositionsY)) then - LB(1:1) = lbound(SrcInitInputData%MsrPositionsY, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%MsrPositionsY, kind=B8Ki) - if (.not. allocated(DstInitInputData%MsrPositionsY)) then - allocate(DstInitInputData%MsrPositionsY(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsY.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitInputData%MsrPositionsY = SrcInitInputData%MsrPositionsY - end if - if (allocated(SrcInitInputData%MsrPositionsZ)) then - LB(1:1) = lbound(SrcInitInputData%MsrPositionsZ, kind=B8Ki) - UB(1:1) = ubound(SrcInitInputData%MsrPositionsZ, kind=B8Ki) - if (.not. allocated(DstInitInputData%MsrPositionsZ)) then - allocate(DstInitInputData%MsrPositionsZ(LB(1):UB(1)), stat=ErrStat2) - if (ErrStat2 /= 0) then - call SetErrStat(ErrID_Fatal, 'Error allocating DstInitInputData%MsrPositionsZ.', ErrStat, ErrMsg, RoutineName) - return - end if - end if - DstInitInputData%MsrPositionsZ = SrcInitInputData%MsrPositionsZ - end if DstInitInputData%SensorType = SrcInitInputData%SensorType DstInitInputData%NumBeam = SrcInitInputData%NumBeam DstInitInputData%NumPulseGate = SrcInitInputData%NumPulseGate - DstInitInputData%URefLid = SrcInitInputData%URefLid end subroutine subroutine SrvD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) @@ -805,18 +749,6 @@ subroutine SrvD_DestroyInitInput(InitInputData, ErrStat, ErrMsg) if (allocated(InitInputData%fromSC)) then deallocate(InitInputData%fromSC) end if - if (allocated(InitInputData%LidSpeed)) then - deallocate(InitInputData%LidSpeed) - end if - if (allocated(InitInputData%MsrPositionsX)) then - deallocate(InitInputData%MsrPositionsX) - end if - if (allocated(InitInputData%MsrPositionsY)) then - deallocate(InitInputData%MsrPositionsY) - end if - if (allocated(InitInputData%MsrPositionsZ)) then - deallocate(InitInputData%MsrPositionsZ) - end if end subroutine subroutine SrvD_PackInitInput(RF, Indata) @@ -862,14 +794,9 @@ subroutine SrvD_PackInitInput(RF, Indata) call RegPack(RF, InData%InterpOrder) call RegPackAlloc(RF, InData%fromSCGlob) call RegPackAlloc(RF, InData%fromSC) - call RegPackAlloc(RF, InData%LidSpeed) - call RegPackAlloc(RF, InData%MsrPositionsX) - call RegPackAlloc(RF, InData%MsrPositionsY) - call RegPackAlloc(RF, InData%MsrPositionsZ) call RegPack(RF, InData%SensorType) call RegPack(RF, InData%NumBeam) call RegPack(RF, InData%NumPulseGate) - call RegPack(RF, InData%URefLid) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -919,14 +846,9 @@ subroutine SrvD_UnPackInitInput(RF, OutData) call RegUnpack(RF, OutData%InterpOrder); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%fromSCGlob); if (RegCheckErr(RF, RoutineName)) return call RegUnpackAlloc(RF, OutData%fromSC); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%LidSpeed); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%MsrPositionsX); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%MsrPositionsY); if (RegCheckErr(RF, RoutineName)) return - call RegUnpackAlloc(RF, OutData%MsrPositionsZ); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NumBeam); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NumPulseGate); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%URefLid); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SrvD_CopyInitOutput(SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg) @@ -1730,7 +1652,6 @@ subroutine SrvD_CopyBladedDLLType(SrcBladedDLLTypeData, DstBladedDLLTypeData, Ct DstBladedDLLTypeData%SensorType = SrcBladedDLLTypeData%SensorType DstBladedDLLTypeData%NumBeam = SrcBladedDLLTypeData%NumBeam DstBladedDLLTypeData%NumPulseGate = SrcBladedDLLTypeData%NumPulseGate - DstBladedDLLTypeData%URefLid = SrcBladedDLLTypeData%URefLid DstBladedDLLTypeData%DLL_DT = SrcBladedDLLTypeData%DLL_DT DstBladedDLLTypeData%DLL_InFile = SrcBladedDLLTypeData%DLL_InFile DstBladedDLLTypeData%RootName = SrcBladedDLLTypeData%RootName @@ -2111,7 +2032,6 @@ subroutine SrvD_PackBladedDLLType(RF, Indata) call RegPack(RF, InData%SensorType) call RegPack(RF, InData%NumBeam) call RegPack(RF, InData%NumPulseGate) - call RegPack(RF, InData%URefLid) call RegPack(RF, InData%DLL_DT) call RegPack(RF, InData%DLL_InFile) call RegPack(RF, InData%RootName) @@ -2229,7 +2149,6 @@ subroutine SrvD_UnPackBladedDLLType(RF, OutData) call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NumBeam); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NumPulseGate); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%URefLid); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DLL_DT); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%DLL_InFile); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%RootName); if (RegCheckErr(RF, RoutineName)) return @@ -4923,7 +4842,6 @@ subroutine SrvD_CopyParam(SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg) DstParamData%SensorType = SrcParamData%SensorType DstParamData%NumBeam = SrcParamData%NumBeam DstParamData%NumPulseGate = SrcParamData%NumPulseGate - DstParamData%URefLid = SrcParamData%URefLid end subroutine subroutine SrvD_DestroyParam(ParamData, ErrStat, ErrMsg) @@ -5221,7 +5139,6 @@ subroutine SrvD_PackParam(RF, Indata) call RegPack(RF, InData%SensorType) call RegPack(RF, InData%NumBeam) call RegPack(RF, InData%NumPulseGate) - call RegPack(RF, InData%URefLid) if (RegCheckErr(RF, RoutineName)) return end subroutine @@ -5416,7 +5333,6 @@ subroutine SrvD_UnPackParam(RF, OutData) call RegUnpack(RF, OutData%SensorType); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NumBeam); if (RegCheckErr(RF, RoutineName)) return call RegUnpack(RF, OutData%NumPulseGate); if (RegCheckErr(RF, RoutineName)) return - call RegUnpack(RF, OutData%URefLid); if (RegCheckErr(RF, RoutineName)) return end subroutine subroutine SrvD_CopyInput(SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg)