diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 3fe4204562..7d27b984d1 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -226,6 +226,22 @@ typedef ^ FAST_ParameterType ReKi WS_TSR {:} - - "List of WindSpeed or TSRs (dep typedef ^ FAST_ParameterType ReKi Pitch {:} - - "List of pitch angles for aeromap generation" "(rad)" typedef ^ FAST_ParameterType IntKi GearBox_index - - - "Index to gearbox rotation in state array (for steady-state calculations)" - +# ................................................... ZMQ PROTOCOL ........................................................... +typedef ^ FAST_ParameterType LOGICAL ZmqOn - .false. - "zmq activation flag" - +typedef ^ FAST_ParameterType CHARACTER(1024) ZmqInAddress - - - "address for ZMQ REQ-REP protocol" - +typedef ^ FAST_ParameterType IntKi ZmqInNbr - - - "number of ZMQ REQ-REP channels" - +typedef ^ FAST_ParameterType CHARACTER(ChanLen) ZmqInChannels {:} - - "address for ZMQ REQ-REP protocol" - + +typedef ^ FAST_ParameterType CHARACTER(1024) ZmqOutAddress - - - "address for ZMQ PUB-SUB protocol" - +typedef ^ FAST_ParameterType IntKi ZmqOutNbr - - - "number of ZMQ PUB-SUB channels" - + +typedef ^ FAST_ParameterType CHARACTER(ChanLen) ZmqOutChannels {:} - - "variables to pass ZMQ PUB-SUB protocol" - +typedef ^ FAST_ParameterType IntKi ZmqOutChnlsIdx {:} - - "indexes of channels to be broadcasted" - + +typedef ^ FAST_ParameterType CHARACTER(ChanLen) ZmqOutChannelsNames {:} - - "names for ZMQ PUB-SUB protocol" - +typedef ^ FAST_ParameterType ReKi ZmqOutChannelsAry {:} - - "array to pass ZMQ PUB-SUB protocol" - +# ............................................................................................................................ + # SAVED OPERATING POINT DATA FOR VTKLIN (visualization of mode shapes from linearization analysis) # ..... IceDyn OP data ....................................................................................................... diff --git a/modules/openfast-library/src/FAST_SS_Subs.f90 b/modules/openfast-library/src/FAST_SS_Subs.f90 index f391591f60..b3dc47f82a 100644 --- a/modules/openfast-library/src/FAST_SS_Subs.f90 +++ b/modules/openfast-library/src/FAST_SS_Subs.f90 @@ -115,12 +115,13 @@ SUBROUTINE FAST_SteadyState_T( Turbine, ErrStat, ErrMsg ) CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None CALL FAST_SteadyState( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%AD, Turbine%MeshMapData, ErrStat, ErrMsg ) + Turbine%ED, Turbine%BD, Turbine%AD, Turbine%MeshMapData, & + Turbine%TurbID, ErrStat, ErrMsg ) END SUBROUTINE FAST_SteadyState_T !---------------------------------------------------------------------------------------------------------------------------------- !> This routine takes data from n_t_global and gets values at n_t_global + 1 -SUBROUTINE FAST_SteadyState(p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE FAST_SteadyState(p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, TurbID, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code @@ -149,6 +150,7 @@ SUBROUTINE FAST_SteadyState(p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, Err CHARACTER(MaxWrScrLen), PARAMETER :: BlankLine = " " CHARACTER(*), PARAMETER :: RoutineName = 'FAST_SteadyState' + INTEGER(IntKi) :: TurbID !< Turbine ID for consistent zmq comms. ErrStat = ErrID_None ErrMsg = "" @@ -219,7 +221,8 @@ SUBROUTINE FAST_SteadyState(p_FAST, y_FAST, m_FAST, ED, BD, AD, MeshMapData, Err CALL WrOutputLine( n_global, p_FAST, y_FAST, UnusedAry, UnusedAry, ED%y%WriteOutput, & AD%y, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, UnusedAry, & - UnusedAry, UnusedAry, UnusedAry, UnusedAry, y_IceD, BD%y, ErrStat2, ErrMsg2 ) + UnusedAry, UnusedAry, UnusedAry, UnusedAry, y_IceD, BD%y, & + p_FAST%ZmqOutChannelsAry, TurbID, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) then diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index a17b91db9e..1ebdb896a2 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -19,6 +19,197 @@ ! See the License for the specific language governing permissions and ! limitations under the License. !********************************************************************************************************************************** +! Define here subroutine to get zmq value +module zmq_client_module + use iso_c_binding + implicit none + + interface + function zmq_req_rep(socket_address, request) result(out) bind(C, name='zmq_req_rep') + use, intrinsic :: iso_c_binding + character(kind=c_char), dimension(*), intent(in) :: socket_address(*) + character(kind=c_char), dimension(*), intent(in) :: request(*) + type(c_ptr) :: out + end function zmq_req_rep + end interface + ! interface + ! FUNCTION zmq_req_rep(socket_address, request) BIND(C, NAME="zmq_req_rep") + ! IMPORT :: C_PTR, C_CHAR + ! CHARACTER(KIND=C_CHAR), INTENT(IN) :: socket_address, request + ! TYPE(C_PTR) :: zmq_req_rep ! Return a C pointer + ! END FUNCTION zmq_req_rep + ! end interface + ! interface + ! function zmq_broadcast(message) result(out) bind(C, name='zmq_broadcast') + ! use, intrinsic :: iso_c_binding + ! character(kind=c_char), dimension(*), intent(in) :: message + ! type(c_ptr) :: out + ! end function zmq_broadcast + ! end interface + + interface + function zmq_broadcast(arr, names) result(zmq_broadcast_out) bind(C, name='zmq_broadcast') + use, intrinsic :: iso_c_binding + + ! real(c_double), intent(in) :: arr(:) + character(kind=c_char), dimension(*), intent(in) :: arr(*) + character(kind=c_char), dimension(*), intent(in) :: names(*) + integer(c_int) :: zmq_broadcast_out + end function zmq_broadcast + end interface + + interface + function zmq_init_pub(req_address) result(out_pub) bind(C, name='zmq_init_pub') + use, intrinsic :: iso_c_binding + character(kind=c_char), dimension(*), intent(in) :: req_address + integer(c_int) :: out_pub + end function zmq_init_pub + end interface + + interface + function zmq_init_req(reqrep_address) result(out_req) bind(C, name='zmq_init_req_rep') + use, intrinsic :: iso_c_binding + character(kind=c_char), dimension(*), intent(in) :: reqrep_address + integer(c_int) :: out_req + end function zmq_init_req + end interface + +end module zmq_client_module +!---------------------------------------------------------------------------------------------------------------------------------- +function strcat(input_strings, num_strings) result(output_string) + character(len=*), dimension(:) :: input_strings + character(len=1000) :: output_string + integer :: num_strings, i + + output_string = '' + + do i = 1, num_strings + if (i /= 1) then + output_string = trim(adjustl(output_string)) // ';' + end if + output_string = output_string // trim(adjustl(input_strings(i))) + end do + +end function strcat +! ----- ZMQ Requester ---------------------------------------------------------------------------------------------------------------------------------- +subroutine zmq_req(socket_address, request, request_size, values_array) +use iso_c_binding +use zmq_client_module, only: zmq_req_rep +implicit none + +character(len=300) :: socket_address +integer, intent(in) :: request_size +character(len=*), dimension(request_size) :: request ! array of strings with requests +real, dimension(request_size) :: values_array ! empty (or not) array to be overwritten +! -------------------------------------------------------------- +real(c_double), dimension(:), pointer :: received_values +type(c_ptr) :: response_ptr +integer :: num_values, i, str_len +integer, parameter :: max_string_length = 1024 +real(kind=c_float), dimension(:), pointer :: float_array +! -------------------------------------------------------------- + +character(len=300) :: concatreq = '' +do i = 1, request_size + concatreq = trim(adjustl(concatreq)) // trim(adjustl(request(i))) // ";" +end do + +concatreq = trim(concatreq) // c_null_char +socket_address = trim(socket_address) // c_null_char ! to be moved in initialization + +response_ptr = zmq_req_rep(socket_address, concatreq) + +call c_f_pointer(response_ptr, float_array, [request_size]) + +! Print the received C string (for debugging purposes) +print *, "Received measurements: ", float_array + +do i= 1, request_size + values_array(i) = float_array(i) +end do + + ! received_float = tmp_float + ! Set as ErrStat // ErrMsg for consistency with openfast ""ErrId_Severe, Fatal, None"" + ! - FATAL -> if missing requested data + ! - SEVERE -> In broadcasting because simulation keeps running + +end subroutine zmq_req +! ------------------------------------------------------------------------------------------------------------------------------- +! subroutine zmq_pub(message) +! use iso_c_binding +! use zmq_client_module, only: zmq_broadcast +! implicit none + +! character(*) :: message +! type(c_ptr) :: response_ptr_pub +! real(c_float), pointer :: tmp_float_pub +! real(c_float) :: received_float_pub + +! response_ptr_pub = zmq_broadcast(message) + +! end subroutine zmq_pub +! --------------------------------------------- +subroutine zmq_pub(array, names, ZmqOutNbr) + use iso_c_binding + use zmq_client_module, only: zmq_broadcast + implicit none + ! Fixed-size buffer for concatenated names + character(len=2048) :: concatenated_names = "" + integer :: totalLength, totalLength_ary, i, offset, ZmqOutNbr + integer(c_int) :: response_ptr_pub + ! real(c_double), dimension(ZmqOutNbr + 2), intent(out) :: array + character(len=*), dimension(ZmqOutNbr + 2), intent(in) :: names + + real(kind=C_DOUBLE), dimension(ZmqOutNbr + 2) :: array + character(len=1), parameter :: delimiter = ";" + character(len=1000) :: concatenatedString = "" + ! ----------------------------------------------------- + totalLength = 0 + totalLength_ary = 0 + + do i = 1, ZmqOutNbr + 2 + concatenated_names(totalLength + 1 : totalLength + len_trim(names(i)) + 1) = trim(names(i)) // ";" + totalLength = totalLength + len_trim(names(i)) + 2 + + write(concatenatedString(totalLength_ary+1:), '(f0.6,a)') array(i), delimiter + totalLength_ary = len_trim(trim(concatenatedString)) + end do + + concatenated_names = trim(concatenated_names) // c_null_char + concatenatedString = trim(concatenatedString) // c_null_char + + response_ptr_pub = zmq_broadcast(concatenatedString, concatenated_names) + +end subroutine zmq_pub +! --------------------------------------------- +subroutine zmq_pub_init(req_address) + use iso_c_binding + use zmq_client_module, only: zmq_init_pub + implicit none + + character(*) :: req_address + integer(c_int) :: response_ptr_pub_init + + print *, "Atempting connection from Fortran at ", req_address + + response_ptr_pub_init = zmq_init_pub(trim(req_address)) + +end subroutine zmq_pub_init +! ---------------------------------------------- +subroutine zmq_req_init(reqrep_address) + use iso_c_binding + use zmq_client_module, only: zmq_init_req + implicit none + + character(*) :: reqrep_address + integer(c_int) :: response_ptr_req_init + + print *, "Atempting connection from Fortran at ", reqrep_address + + response_ptr_req_init = zmq_init_req(trim(reqrep_address)) + +end subroutine zmq_req_init +! ---------------------------------------------- MODULE FAST_Subs USE FAST_Solver @@ -1613,8 +1804,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Set up output for glue code (must be done after all modules are initialized so we have their WriteOutput information) ! ........................ - CALL FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + CALL FAST_InitOutput( p_FAST, y_FAST, Init, p_FAST%ZmqOutChnlsIdx, p_FAST%ZmqOutChannelsNames, p_FAST%ZmqOutChannelsAry, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! zmq integration ok ! ------------------------------------------------------------------------- @@ -2078,6 +2269,16 @@ SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, call ValidateInputData(p, m_FAST, ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (p%ZmqOn) then + ! 1. We open the Broadcast socket (or, if already open, we connect to it) + call zmq_pub_init(p%ZmqOutAddress) + call zmq_req_init(p%ZmqInAddress) + ! 1. We open the REQ-REP socket (or, if already open, we connect to it) + ! call zmq_pub_init(Turbine%p_FAST%ZmqInAddress) + ! p%ZmqOutChannelsAry(1) = TurbID + + end if + IF ( ErrStat >= AbortErrLev ) RETURN @@ -2286,31 +2487,69 @@ SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) END IF END IF - if (p%CompAeroMaps) then + ! if (p%CompAeroMaps) then - if (p%NumSSCases < 0) then - CALL SetErrStat( ErrID_Fatal, 'NumSSCases must be at least 1 to compute steady-state solve.', ErrStat, ErrMsg, RoutineName ) - else - do i=1,p%NumSSCases - if (p%RotSpeed(i) < 0.0_ReKi) then - CALL SetErrStat( ErrID_Fatal, 'RotSpeed must be positive for the steady-state solver.', ErrStat, ErrMsg, RoutineName ) - end if - end do + ! if (p%NumSSCases < 0) then + ! CALL SetErrStat( ErrID_Fatal, 'NumSSCases must be at least 1 to compute steady-state solve.', ErrStat, ErrMsg, RoutineName ) + ! else + ! do i=1,p%NumSSCases + ! if (p%RotSpeed(i) < 0.0_ReKi) then + ! CALL SetErrStat( ErrID_Fatal, 'RotSpeed must be positive for the steady-state solver.', ErrStat, ErrMsg, RoutineName ) + ! end if + ! end do - do i=1,p%NumSSCases - if (p%WS_TSR(i) < EPSILON(p%WS_TSR(1))) then - CALL SetErrStat( ErrID_Fatal, 'WindSpeed and TSR must be positive numbers for the steady-state solver.', ErrStat, ErrMsg, RoutineName ) ! at least, they can't be zero! - end if - end do + ! do i=1,p%NumSSCases + ! if (p%WS_TSR(i) < EPSILON(p%WS_TSR(1))) then + ! CALL SetErrStat( ErrID_Fatal, 'WindSpeed and TSR must be positive numbers for the steady-state solver.', ErrStat, ErrMsg, RoutineName ) ! at least, they can't be zero! + ! end if + ! end do - end if + ! end if - end if + ! end if + + ! ! Query of ZMQ broadcast channels idx + + ! if (p_FAST%ZmqOn) then + ! CALL AllocAry( ZmqOutChnlsIdx, p_FAST%ZmqOutNbr, 'ZmqOutChnlsIdx', ErrStat, ErrMsg ) + ! CALL AllocAry( ZmqOutChannelsNames, p_FAST%ZmqOutNbr + 2, 'ZmqOutChannelNames', ErrStat, ErrMsg ) + + ! ZmqOutChnlsIdx = 0_IntKi + + ! do i = 1, SIZE(ZmqOutChnlsIdx) + ! tmp_string = p_FAST%ZmqOutChannels(i) + ! call Conv2UC(tmp_string) + + ! do j = 1, SIZE(y_FAST%ChannelNames) + ! tmp_string2 = y_FAST%ChannelNames(j) + ! call Conv2UC(tmp_string2) + + ! if (trim(tmp_string) == trim(tmp_string2)) then + ! ZmqOutChnlsIdx(i) = j + ! exit + ! end if + + ! end do + ! end do + + ! if (minval(ZmqOutChnlsIdx) == 0) then + ! call WrScr('Warning: one channel requested from ZMQ was not identified') ! CU = unit number for the output + ! end if + + ! ! Augmenting ZMQ output to handle wind turbine id and current time stamp + ! ZmqOutChannelsNames(1) = 'TurbId' + ! ZmqOutChannelsNames(2) = 'Time' + + ! do i = 1,p_FAST%ZmqOutNbr + ! ZmqOutChannelsNames(2 + i) = trim(y_FAST%ChannelNames(ZmqOutChnlsIdx(i))) ! Up to here everything OK! + ! end do + + ! end if END SUBROUTINE ValidateInputData !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes the output for the glue code, including writing the header for the primary output file. -SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) +SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ZmqOutChnlsIdx, ZmqOutChannelsNames, ZmqOutChannelsAry, ErrStat, ErrMsg ) IMPLICIT NONE @@ -2319,6 +2558,11 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) TYPE(FAST_OutputFileType), INTENT(INOUT) :: y_FAST !< Glue-code simulation outputs TYPE(FAST_InitData), INTENT(IN) :: Init !< Initialization data for all modules + INTEGER(IntKi), allocatable, intent(inout) :: ZmqOutChnlsIdx(:) + CHARACTER(*), allocatable, intent(inout) :: ZmqOutChannelsNames(:) + REAL(DbKi), allocatable, intent(inout) :: ZmqOutChannelsAry(:) + + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message corresponding to ErrStat @@ -2330,7 +2574,8 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) INTEGER(IntKi) :: NumOuts ! number of channels to be written to the output file(s) - + CHARACTER(ChanLen) :: tmp_string ! zmq auxiliarry string + CHARACTER(ChanLen) :: tmp_string2 ! zmq auxiliarry string !...................................................... ! Set the description lines to be printed in the output file !...................................................... @@ -2600,6 +2845,45 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) END IF + ! Query of ZMQ broadcast channels idx + + if (p_FAST%ZmqOn) then + CALL AllocAry( ZmqOutChnlsIdx, p_FAST%ZmqOutNbr, 'ZmqOutChnlsIdx', ErrStat, ErrMsg ) + CALL AllocAry( ZmqOutChannelsNames, p_FAST%ZmqOutNbr + 2, 'ZmqOutChannelNames', ErrStat, ErrMsg ) + + ZmqOutChnlsIdx = 0_IntKi + + do i = 1, SIZE(ZmqOutChnlsIdx) + tmp_string = p_FAST%ZmqOutChannels(i) + call Conv2UC(tmp_string) + + do j = 1, SIZE(y_FAST%ChannelNames) + tmp_string2 = y_FAST%ChannelNames(j) + call Conv2UC(tmp_string2) + + if (trim(tmp_string) == trim(tmp_string2)) then + ZmqOutChnlsIdx(i) = j + exit + end if + + end do + end do + + if (minval(ZmqOutChnlsIdx) == 0) then + call WrScr('Warning: one channel requested from ZMQ was not identified') ! CU = unit number for the output + end if + + ! Augmenting ZMQ output to handle wind turbine id and current time stamp + ZmqOutChannelsNames(1) = 'TurbId' + ZmqOutChannelsNames(2) = 'Time' + + do i = 1,p_FAST%ZmqOutNbr + ZmqOutChannelsNames(2 + i) = trim(y_FAST%ChannelNames(ZmqOutChnlsIdx(i))) ! Up to here everything OK! + end do + + end if + + !...................................................... ! Open the text output file and print the headers !...................................................... @@ -3654,6 +3938,109 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrS call cleanup() RETURN + ! --------------------- ZMQ Communication ------------------------ ! + CALL ReadCom( UnIn, InputFile, 'Section Header: ZMQ Communication', ErrStat2, ErrMsg2, UnEc ) + + if ( ErrStat2 >= AbortErrLev ) then + CALL SetErrStat( ErrId_Warn, "ZMQ section not found, turning off ZMQ communication", ErrStat, ErrMsg, RoutineName) + call cleanup() + RETURN + end if + + CALL ReadVar( UnIn, InputFile, p%ZmqOn, "ZmqOn", "ZMQ communication (flag)", ErrStat2, ErrMsg2, UnEc) + if ( ErrStat2 >= AbortErrLev ) then + CALL SetErrStat( ErrId_Warn, "ZMQ section not found, turning off ZMQ communication", ErrStat, ErrMsg, RoutineName) + call cleanup() + RETURN + end if + + CALL ReadVar( UnIn, InputFile, p%ZmqInAddress, "ZmqInAddress", "REQ-REP localhost address", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + p%ZmqInAddress = trim(p%ZmqInAddress) // c_null_char + + ! check valid address to be put here + + CALL ReadVar( UnIn, InputFile, p%ZmqInNbr, "ZmqInNbr", "Number of parameters to be requested ", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + CALL AllocAry(p%ZmqInChannels, p%ZmqInNbr, "ZmqInChannels", Errstat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + CALL ReadAry( UnIn, InputFile, p%ZmqInChannels, p%ZmqInNbr, "ZmqInChannels", "Channels to be requested at communication time", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + + ! ------------------------------------------- Broadcasting settings ---------------------------------------------------- + CALL ReadVar( UnIn, InputFile, p%ZmqOutAddress, "ZmqOutAddress", "PUB-SUB localhost address ", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + p%ZmqOutAddress = trim(p%ZmqOutAddress) // c_null_char + + ! check valid address + + CALL ReadVar( UnIn, InputFile, p%ZmqOutNbr, "ZmqOutNbr", "Number of channels to be broadcasted", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + ! Read channel names to be broadcasted + + CALL AllocAry(p%ZmqOutChannels, p%ZmqOutNbr, "ZmqOutChannels", Errstat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + CALL ReadAry( UnIn, InputFile, p%ZmqOutChannels, p%ZmqOutNbr, "ZmqOutChannels", "Channels to be broadcasterd at communication time", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + ! Create broadcasting array and name tag, actually used by the Message Passing Interface. We add 2 slots, for wind turbine ID and time, to be always broadcasted + + CALL AllocAry(p%ZmqOutChannelsNames, p%ZmqOutNbr + 2, "ZmqOutChannelsNames", Errstat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + CALL AllocAry(p%ZmqOutChannelsAry, p%ZmqOutNbr + 2, "ZmqOutChannelsAry" , Errstat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + +call cleanup() +RETURN + + CONTAINS !............................................................................................................................... subroutine cleanup() @@ -5048,13 +5435,13 @@ SUBROUTINE FAST_Solution0_T(Turbine, ErrStat, ErrMsg) CALL FAST_Solution0(Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX,& Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, Turbine%TurbID, ErrStat, ErrMsg ) END SUBROUTINE FAST_Solution0_T !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that calls CalcOutput for the first time of the simulation (at t=0). After the initial solve, data arrays are initialized. SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, TurbID, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code @@ -5093,7 +5480,7 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution0' - + INTEGER(IntKi) :: TurbID !< grab turbine ID for ZMQ communication !NOTE: m_FAST%t_global is t_initial in this routine @@ -5134,7 +5521,9 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, ! Check to see if we should output data this time step: !---------------------------------------------------------------------------------------- - CALL WriteOutputToFile(n_t_global_next, t_initial, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) + CALL WriteOutputToFile(n_t_global_next, t_initial, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, & + ExtInfw, SeaSt, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, & + TurbID, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! turn off VTK output when @@ -7397,15 +7786,17 @@ SUBROUTINE FAST_Solution_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) CALL FAST_Solution(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, Turbine%p_FAST%ZmqOutChannelsAry, Turbine%TurbID, ErrStat, ErrMsg ) END SUBROUTINE FAST_Solution_T !---------------------------------------------------------------------------------------------------------------------------------- !> This routine takes data from n_t_global and gets values at n_t_global + 1 SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, SeaSt, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ZmqOutChannelsAry, TurbID, ErrStat, ErrMsg ) - REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + + use iso_c_binding + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code @@ -7445,7 +7836,8 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, INTEGER(IntKi), parameter :: MaxCorrections = 20 ! maximum number of corrections allowed LOGICAL :: WriteThisStep ! Whether WriteOutput values will be printed - INTEGER(IntKi) :: I, k ! generic loop counters + INTEGER(IntKi) :: I, k, idx ! generic loop counters + INTEGER(IntKi) :: TurbID !< Grab Turbine ID for messages-tagging purposes (ZMQ) !REAL(ReKi) :: ControlInputGuess ! value of controller inputs @@ -7453,6 +7845,11 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Solution' + ! ----------------------------------------------------------------------------- + REAL(DbKi), allocatable, intent(inout) :: ZmqOutChannelsAry(:) + REAL(DbKi) :: ZmqInChannelsAry(p_FAST%ZmqInNbr) + character(len=1024) :: tmp_str + ! ----------------------------------------------------------------------------- ErrStat = ErrID_None @@ -7485,7 +7882,8 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ call FAST_AdvanceToNextTimeStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData,& + ZmqOutChannelsAry, TurbID, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -7493,7 +7891,8 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !! Write outputs !---------------------------------------------------------------------------------------- call FAST_WriteOutput(t_initial, n_t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, & + TurbID, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END SUBROUTINE FAST_Solution @@ -7770,13 +8169,14 @@ SUBROUTINE FAST_AdvanceToNextTimeStep_T(t_initial, n_t_global, Turbine, ErrStat, CALL FAST_AdvanceToNextTimeStep(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, Turbine%p_FAST%ZmqOutChannelsAry, & + Turbine%TurbID, ErrStat, ErrMsg ) END SUBROUTINE FAST_AdvanceToNextTimeStep_T !---------------------------------------------------------------------------------------------------------------------------------- !> This routine advances the time step from n_t_global to n_t_global + 1 and does all the relvant copying of data SUBROUTINE FAST_AdvanceToNextTimeStep(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ZmqOutChannelsAry, TurbID, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter @@ -7816,12 +8216,17 @@ SUBROUTINE FAST_AdvanceToNextTimeStep(t_initial, n_t_global, p_FAST, y_FAST, m_F INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step INTEGER(IntKi) :: I, k ! generic loop counters - + INTEGER(IntKi) :: TurbID !< Grab Turbine ID for messages-tagging purposes (ZMQ) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_AdvanceToNextTimeStep' + ! ----------------------------------------------------------------------------- + REAL(DbKi), allocatable, intent(inout) :: ZmqOutChannelsAry(:) + REAL(DbKi) :: ZmqInChannelsAry(p_FAST%ZmqInNbr) + character(len=1024) :: tmp_str + ! ----------------------------------------------------------------------------- ErrStat = ErrID_None ErrMsg = "" @@ -8016,6 +8421,47 @@ SUBROUTINE FAST_AdvanceToNextTimeStep(t_initial, n_t_global, p_FAST, y_FAST, m_F !! update the global time m_FAST%t_global = t_global_next + if (p_FAST%ZmqOn) then + + ZmqInChannelsAry = 0.0_DbKi + + call zmq_req(p_FAST%ZmqInAddress, p_FAST%ZmqInChannels, p_FAST%ZmqInNbr, ZmqInChannelsAry) + + If (ZmqInChannelsAry(1) == TurbID) then + + do i = 1, p_FAST%ZmqInNbr + tmp_str = trim(p_FAST%ZmqInChannels(i)) + + select case (tmp_str) ! Be careful with dependencies + case('VelH') + IfW%p%FlowField%Uniform%VelH = ZmqInChannelsAry(i) + case('VelV') + IfW%p%FlowField%Uniform%VelV = ZmqInChannelsAry(i) + case('VelGust') + IfW%p%FlowField%Uniform%VelGust = ZmqInChannelsAry(i) + case('AngleV') + IfW%p%FlowField%Uniform%AngleV = ZmqInChannelsAry(i) + case('AngleH') + IfW%p%FlowField%Uniform%AngleH = ZmqInChannelsAry(i) + case('BldPitchCom1') + SrvD%y%BlPitchCom(1) = ZmqInChannelsAry(i) + case('BldPitchCom2') + SrvD%y%BlPitchCom(2) = ZmqInChannelsAry(i) + case('BldPitchCom3') + SrvD%y%BlPitchCom(3) = ZmqInChannelsAry(i) + case('YawMom') + SrvD%y%YawMom = ZmqInChannelsAry(i) + case('GenTrq') + SrvD%y%GenTrq = ZmqInChannelsAry(i) + case('HSSBrFrac') + SrvD%y%hssbrtrqc = ZmqInChannelsAry(i) + end select + + end do + + end if + + end if END SUBROUTINE FAST_AdvanceToNextTimeStep !---------------------------------------------------------------------------------------------------------------------------------- @@ -8032,13 +8478,13 @@ SUBROUTINE FAST_WriteOutput_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg ) CALL FAST_WriteOutput(t_initial, n_t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%ExtLd, Turbine%IfW, Turbine%ExtInfw, Turbine%SC_DX, & Turbine%SeaSt, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat, ErrMsg ) + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, Turbine%TurbID, ErrStat, ErrMsg ) END SUBROUTINE FAST_WriteOutput_T !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes the outputs at this timestep SUBROUTINE FAST_WriteOutput(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, ExtLd, IfW, ExtInfw, SC_DX, & - SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) + SeaSt, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, TurbID, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial time INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter @@ -8075,6 +8521,7 @@ SUBROUTINE FAST_WriteOutput(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, B ! local variables INTEGER(IntKi) :: I, k ! generic loop counters REAL(DbKi) :: t_global ! this simulation time (m_FAST%t_global + p_FAST%dt) + INTEGER(IntKi) :: TurbID !< Grab Turbine ID for messages-tagging purposes (ZMQ) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_WriteOutput' @@ -8089,7 +8536,7 @@ SUBROUTINE FAST_WriteOutput(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, B !! Check to see if we should output data this time step: !---------------------------------------------------------------------------------------- CALL WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & - SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) + SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, TurbID, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !---------------------------------------------------------------------------------------- @@ -8126,7 +8573,7 @@ END FUNCTION NeedWriteOutput !! calls the routine to write to the files with the output data. It should be called after all the output solves for a given time !! have been completed, and assumes y_FAST\%WriteThisStep has been set. SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, ExtInfw, SeaSt, HD, SD, ExtPtfm, & - SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg) + SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, TurbID, ErrStat, ErrMsg) !............................................................................................................................... INTEGER(IntKi), INTENT(IN ) :: n_t_global !< Current global time step REAL(DbKi), INTENT(IN ) :: t_global !< Current global time @@ -8157,6 +8604,7 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, CHARACTER(*), PARAMETER :: RoutineName = 'WriteOutputToFile' + INTEGER(IntKi), INTENT(INOUT) :: TurbID !< Added TurbID for ZMQ communication ErrStat = ErrID_None ErrMsg = "" @@ -8169,7 +8617,8 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, ! Generate glue-code output file CALL WrOutputLine( t_global, p_FAST, y_FAST, IfW%y%WriteOutput, ExtInfw%y%WriteOutput, ED%y%WriteOutput, & AD%y, SrvD%y%WriteOutput, SeaSt%y%WriteOutput, HD%y%WriteOutput, SD%y%WriteOutput, ExtPtfm%y%WriteOutput, MAPp%y%WriteOutput, & - FEAM%y%WriteOutput, MD%y%WriteOutput, Orca%y%WriteOutput, IceF%y%WriteOutput, IceD%y, BD%y, ErrStat, ErrMsg ) + FEAM%y%WriteOutput, MD%y%WriteOutput, Orca%y%WriteOutput, IceF%y%WriteOutput, IceD%y, BD%y,& + p_FAST%ZmqOutChannelsAry, TurbID, ErrStat, ErrMsg ) ENDIF @@ -8185,7 +8634,7 @@ END SUBROUTINE WriteOutputToFile !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes the module output to the primary output file(s). SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, y_AD, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput,& - MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, ErrStat, ErrMsg) + MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, ZmqOutChannelsAry, TurbID, ErrStat, ErrMsg) IMPLICIT NONE @@ -8221,13 +8670,41 @@ SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, CHARACTER(p_FAST%TChanLen) :: TmpStr ! temporary string to print the time output as text REAL(ReKi) :: OutputAry(SIZE(y_FAST%ChannelNames)-1) + INTEGER(IntKi) :: i + INTEGER(IntKi) :: TurbID + + ! ---- ZMQ Definitions ----- + REAL(ReKi), ALLOCATABLE :: ZmqOutChannelsAry(:) + ! Initialize the error status ErrStat = ErrID_None ErrMsg = '' + CALL FillOutputAry(p_FAST, y_FAST, IfWOutput, ExtInfwOutput, EDOutput, y_AD, SrvDOutput, SeaStOutput, HDOutput, SDOutput, ExtPtfmOutput, & MAPOutput, FEAMOutput, MDOutput, OrcaOutput, IceFOutput, y_IceD, y_BD, OutputAry) + + ! ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + ! ! End of simulation time step. Broadcast results to ZMQ (assuming that we broadcast at every time step, to be modified later) + ! ! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + if (p_FAST%ZmqOn) then + + CALL AllocAry( ZmqOutChannelsAry, p_FAST%ZmqOutNbr + 2, 'ZmqOutChannelsAry', ErrStat, ErrMsg ) + + ZmqOutChannelsAry = 0.0_ReKi !< Reset to zero all values prior to allocation and broadcasting + + ZmqOutChannelsAry(1) = TurbID + ZmqOutChannelsAry(2) = t + + do i = 1, p_FAST%ZmqOutNbr + ZmqOutChannelsAry(2 + i) = OutputAry(p_FAST%ZmqOutChnlsIdx(i) - 1) + end do + + call zmq_pub(ZmqOutChannelsAry, p_FAST%ZmqOutChannelsNames, p_FAST%ZmqOutNbr) + + end if + IF (p_FAST%WrTxtOutFile) THEN ! Write one line of tabular output: diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 42035af7e1..7f298046c2 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -232,6 +232,16 @@ MODULE FAST_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: WS_TSR !< List of WindSpeed or TSRs (depending on WindSpeedOrTSR setting) for aeromap generation [(m/s or -)] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: Pitch !< List of pitch angles for aeromap generation [(rad)] INTEGER(IntKi) :: GearBox_index !< Index to gearbox rotation in state array (for steady-state calculations) [-] + LOGICAL :: ZmqOn = .false. !< zmq activation flag [-] + CHARACTER(1024) :: ZmqInAddress !< address for ZMQ REQ-REP protocol [-] + INTEGER(IntKi) :: ZmqInNbr !< number of ZMQ REQ-REP channels [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ZmqInChannels !< address for ZMQ REQ-REP protocol [-] + CHARACTER(1024) :: ZmqOutAddress !< address for ZMQ PUB-SUB protocol [-] + INTEGER(IntKi) :: ZmqOutNbr !< number of ZMQ PUB-SUB channels [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ZmqOutChannels !< variables to pass ZMQ PUB-SUB protocol [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: ZmqOutChnlsIdx !< indexes of channels to be broadcasted [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ZmqOutChannelsNames !< names for ZMQ PUB-SUB protocol [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: ZmqOutChannelsAry !< array to pass ZMQ PUB-SUB protocol [-] END TYPE FAST_ParameterType ! ======================= ! ========= FAST_LinStateSave ======= @@ -2541,6 +2551,71 @@ SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%Pitch = SrcParamData%Pitch ENDIF DstParamData%GearBox_index = SrcParamData%GearBox_index + DstParamData%ZmqOn = SrcParamData%ZmqOn + DstParamData%ZmqInAddress = SrcParamData%ZmqInAddress + DstParamData%ZmqInNbr = SrcParamData%ZmqInNbr +IF (ALLOCATED(SrcParamData%ZmqInChannels)) THEN + i1_l = LBOUND(SrcParamData%ZmqInChannels,1) + i1_u = UBOUND(SrcParamData%ZmqInChannels,1) + IF (.NOT. ALLOCATED(DstParamData%ZmqInChannels)) THEN + ALLOCATE(DstParamData%ZmqInChannels(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ZmqInChannels.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%ZmqInChannels = SrcParamData%ZmqInChannels +ENDIF + DstParamData%ZmqOutAddress = SrcParamData%ZmqOutAddress + DstParamData%ZmqOutNbr = SrcParamData%ZmqOutNbr +IF (ALLOCATED(SrcParamData%ZmqOutChannels)) THEN + i1_l = LBOUND(SrcParamData%ZmqOutChannels,1) + i1_u = UBOUND(SrcParamData%ZmqOutChannels,1) + IF (.NOT. ALLOCATED(DstParamData%ZmqOutChannels)) THEN + ALLOCATE(DstParamData%ZmqOutChannels(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ZmqOutChannels.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%ZmqOutChannels = SrcParamData%ZmqOutChannels +ENDIF +IF (ALLOCATED(SrcParamData%ZmqOutChnlsIdx)) THEN + i1_l = LBOUND(SrcParamData%ZmqOutChnlsIdx,1) + i1_u = UBOUND(SrcParamData%ZmqOutChnlsIdx,1) + IF (.NOT. ALLOCATED(DstParamData%ZmqOutChnlsIdx)) THEN + ALLOCATE(DstParamData%ZmqOutChnlsIdx(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ZmqOutChnlsIdx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%ZmqOutChnlsIdx = SrcParamData%ZmqOutChnlsIdx +ENDIF +IF (ALLOCATED(SrcParamData%ZmqOutChannelsNames)) THEN + i1_l = LBOUND(SrcParamData%ZmqOutChannelsNames,1) + i1_u = UBOUND(SrcParamData%ZmqOutChannelsNames,1) + IF (.NOT. ALLOCATED(DstParamData%ZmqOutChannelsNames)) THEN + ALLOCATE(DstParamData%ZmqOutChannelsNames(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ZmqOutChannelsNames.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%ZmqOutChannelsNames = SrcParamData%ZmqOutChannelsNames +ENDIF +IF (ALLOCATED(SrcParamData%ZmqOutChannelsAry)) THEN + i1_l = LBOUND(SrcParamData%ZmqOutChannelsAry,1) + i1_u = UBOUND(SrcParamData%ZmqOutChannelsAry,1) + IF (.NOT. ALLOCATED(DstParamData%ZmqOutChannelsAry)) THEN + ALLOCATE(DstParamData%ZmqOutChannelsAry(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%ZmqOutChannelsAry.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%ZmqOutChannelsAry = SrcParamData%ZmqOutChannelsAry +ENDIF END SUBROUTINE FAST_CopyParam SUBROUTINE FAST_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) @@ -2576,6 +2651,21 @@ SUBROUTINE FAST_DestroyParam( ParamData, ErrStat, ErrMsg, DEALLOCATEpointers ) ENDIF IF (ALLOCATED(ParamData%Pitch)) THEN DEALLOCATE(ParamData%Pitch) +ENDIF +IF (ALLOCATED(ParamData%ZmqInChannels)) THEN + DEALLOCATE(ParamData%ZmqInChannels) +ENDIF +IF (ALLOCATED(ParamData%ZmqOutChannels)) THEN + DEALLOCATE(ParamData%ZmqOutChannels) +ENDIF +IF (ALLOCATED(ParamData%ZmqOutChnlsIdx)) THEN + DEALLOCATE(ParamData%ZmqOutChnlsIdx) +ENDIF +IF (ALLOCATED(ParamData%ZmqOutChannelsNames)) THEN + DEALLOCATE(ParamData%ZmqOutChannelsNames) +ENDIF +IF (ALLOCATED(ParamData%ZmqOutChannelsAry)) THEN + DEALLOCATE(ParamData%ZmqOutChannelsAry) ENDIF END SUBROUTINE FAST_DestroyParam @@ -2763,6 +2853,36 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Re_BufSz = Re_BufSz + SIZE(InData%Pitch) ! Pitch END IF Int_BufSz = Int_BufSz + 1 ! GearBox_index + Int_BufSz = Int_BufSz + 1 ! ZmqOn + Int_BufSz = Int_BufSz + 1*LEN(InData%ZmqInAddress) ! ZmqInAddress + Int_BufSz = Int_BufSz + 1 ! ZmqInNbr + Int_BufSz = Int_BufSz + 1 ! ZmqInChannels allocated yes/no + IF ( ALLOCATED(InData%ZmqInChannels) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ZmqInChannels upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ZmqInChannels)*LEN(InData%ZmqInChannels) ! ZmqInChannels + END IF + Int_BufSz = Int_BufSz + 1*LEN(InData%ZmqOutAddress) ! ZmqOutAddress + Int_BufSz = Int_BufSz + 1 ! ZmqOutNbr + Int_BufSz = Int_BufSz + 1 ! ZmqOutChannels allocated yes/no + IF ( ALLOCATED(InData%ZmqOutChannels) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ZmqOutChannels upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ZmqOutChannels)*LEN(InData%ZmqOutChannels) ! ZmqOutChannels + END IF + Int_BufSz = Int_BufSz + 1 ! ZmqOutChnlsIdx allocated yes/no + IF ( ALLOCATED(InData%ZmqOutChnlsIdx) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ZmqOutChnlsIdx upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ZmqOutChnlsIdx) ! ZmqOutChnlsIdx + END IF + Int_BufSz = Int_BufSz + 1 ! ZmqOutChannelsNames allocated yes/no + IF ( ALLOCATED(InData%ZmqOutChannelsNames) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ZmqOutChannelsNames upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ZmqOutChannelsNames)*LEN(InData%ZmqOutChannelsNames) ! ZmqOutChannelsNames + END IF + Int_BufSz = Int_BufSz + 1 ! ZmqOutChannelsAry allocated yes/no + IF ( ALLOCATED(InData%ZmqOutChannelsAry) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ZmqOutChannelsAry upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%ZmqOutChannelsAry) ! ZmqOutChannelsAry + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -3137,6 +3257,101 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, END IF IntKiBuf(Int_Xferred) = InData%GearBox_index Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%ZmqOn, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%ZmqInAddress) + IntKiBuf(Int_Xferred) = ICHAR(InData%ZmqInAddress(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%ZmqInNbr + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%ZmqInChannels) ) 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%ZmqInChannels,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ZmqInChannels,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ZmqInChannels,1), UBOUND(InData%ZmqInChannels,1) + DO I = 1, LEN(InData%ZmqInChannels) + IntKiBuf(Int_Xferred) = ICHAR(InData%ZmqInChannels(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + DO I = 1, LEN(InData%ZmqOutAddress) + IntKiBuf(Int_Xferred) = ICHAR(InData%ZmqOutAddress(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%ZmqOutNbr + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%ZmqOutChannels) ) 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%ZmqOutChannels,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ZmqOutChannels,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ZmqOutChannels,1), UBOUND(InData%ZmqOutChannels,1) + DO I = 1, LEN(InData%ZmqOutChannels) + IntKiBuf(Int_Xferred) = ICHAR(InData%ZmqOutChannels(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ZmqOutChnlsIdx) ) 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%ZmqOutChnlsIdx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ZmqOutChnlsIdx,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ZmqOutChnlsIdx,1), UBOUND(InData%ZmqOutChnlsIdx,1) + IntKiBuf(Int_Xferred) = InData%ZmqOutChnlsIdx(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ZmqOutChannelsNames) ) 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%ZmqOutChannelsNames,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ZmqOutChannelsNames,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ZmqOutChannelsNames,1), UBOUND(InData%ZmqOutChannelsNames,1) + DO I = 1, LEN(InData%ZmqOutChannelsNames) + IntKiBuf(Int_Xferred) = ICHAR(InData%ZmqOutChannelsNames(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ZmqOutChannelsAry) ) 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%ZmqOutChannelsAry,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ZmqOutChannelsAry,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ZmqOutChannelsAry,1), UBOUND(InData%ZmqOutChannelsAry,1) + ReKiBuf(Re_Xferred) = InData%ZmqOutChannelsAry(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF END SUBROUTINE FAST_PackParam SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3560,6 +3775,116 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs END IF OutData%GearBox_index = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 + OutData%ZmqOn = TRANSFER(IntKiBuf(Int_Xferred), OutData%ZmqOn) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%ZmqInAddress) + OutData%ZmqInAddress(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%ZmqInNbr = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ZmqInChannels 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%ZmqInChannels)) DEALLOCATE(OutData%ZmqInChannels) + ALLOCATE(OutData%ZmqInChannels(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ZmqInChannels.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ZmqInChannels,1), UBOUND(OutData%ZmqInChannels,1) + DO I = 1, LEN(OutData%ZmqInChannels) + OutData%ZmqInChannels(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + DO I = 1, LEN(OutData%ZmqOutAddress) + OutData%ZmqOutAddress(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%ZmqOutNbr = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ZmqOutChannels 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%ZmqOutChannels)) DEALLOCATE(OutData%ZmqOutChannels) + ALLOCATE(OutData%ZmqOutChannels(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ZmqOutChannels.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ZmqOutChannels,1), UBOUND(OutData%ZmqOutChannels,1) + DO I = 1, LEN(OutData%ZmqOutChannels) + OutData%ZmqOutChannels(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ZmqOutChnlsIdx 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%ZmqOutChnlsIdx)) DEALLOCATE(OutData%ZmqOutChnlsIdx) + ALLOCATE(OutData%ZmqOutChnlsIdx(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ZmqOutChnlsIdx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ZmqOutChnlsIdx,1), UBOUND(OutData%ZmqOutChnlsIdx,1) + OutData%ZmqOutChnlsIdx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ZmqOutChannelsNames 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%ZmqOutChannelsNames)) DEALLOCATE(OutData%ZmqOutChannelsNames) + ALLOCATE(OutData%ZmqOutChannelsNames(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ZmqOutChannelsNames.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ZmqOutChannelsNames,1), UBOUND(OutData%ZmqOutChannelsNames,1) + DO I = 1, LEN(OutData%ZmqOutChannelsNames) + OutData%ZmqOutChannelsNames(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ZmqOutChannelsAry 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%ZmqOutChannelsAry)) DEALLOCATE(OutData%ZmqOutChannelsAry) + ALLOCATE(OutData%ZmqOutChannelsAry(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ZmqOutChannelsAry.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ZmqOutChannelsAry,1), UBOUND(OutData%ZmqOutChannelsAry,1) + OutData%ZmqOutChannelsAry(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF END SUBROUTINE FAST_UnPackParam SUBROUTINE FAST_CopyLinStateSave( SrcLinStateSaveData, DstLinStateSaveData, CtrlCode, ErrStat, ErrMsg ) diff --git a/modules/openfast-library/src/zmq_client.c b/modules/openfast-library/src/zmq_client.c new file mode 100644 index 0000000000..886d2bcdee --- /dev/null +++ b/modules/openfast-library/src/zmq_client.c @@ -0,0 +1,482 @@ +// || ----- ZeroMQ Client (re-adapted from ROSCO) ------ || +// || Real-time interactor for FAST || +// || --------------------------------------------------- || + + +#include +#include +#include +#include +#include +#include + +// Initializing publisher and requester as global variables + +void *publisher = NULL; +void *requester = NULL; + +void printString(const char *str) { + printf("String: "); + + // Print each character of the string including the null terminator + for (int i = 0; str[i] != '\0'; ++i) { + printf("%c", str[i]); + } + printf("\\0"); +} + + +// float *zmq_req_rep(const char *socket_address, const char *request) { +// // add null-termination from Fortran strings inputs + +// // printf("received request from fortran in C: %s \n\n", request); + +// size_t socket_len = strlen(socket_address); +// size_t request_len = strlen(request); + +// int send_status_req; +// int send_status_data; +// // Allocate memory for null-terminated strings +// // char *socket_copy = malloc(socket_len + 1); +// // char *request_copy = malloc(request_len + 1); + +// // // Copy received strings and null-terminate them +// // strncpy(socket_copy, socket_address, socket_len); +// // socket_copy[socket_len +1] = '\0'; + +// // strncpy(request_copy, request, request_len); +// // request_copy[request_len +1] = '\0'; + +// void *context = zmq_ctx_new(); + +// if (context == NULL) { +// perror("Error in opening ZMQ comm"); +// return NULL; // Return NULL to indicate failure +// } + +// void *requester = zmq_socket(context, ZMQ_REQ); +// if (requester == NULL) { +// perror("Error in opening ZMQ comm"); +// zmq_ctx_destroy(context); +// return NULL; // Return NULL to indicate failure +// } +// // printf("Connecting..."); + +// int rc = zmq_connect(requester, socket_address); + +// if (rc != 0) { +// perror("Error in connecting to specified address"); +// fprintf(stderr, "Address: %s\n", socket_address); +// zmq_close(requester); +// zmq_ctx_destroy(context); +// return NULL; // Return NULL to indicate failure +// } + +// // printf("C: Sending request %s to socket... \n", request); +// send_status_req = zmq_send(requester, request, strlen(request), 0); + +// if (send_status_req >= 0) { +// printf("C: Request sent successfully.\n"); +// } else { +// printf("C: Error sending request: %s\n", zmq_strerror(errno)); +// } + +// float *received_value = (float *)malloc(sizeof(float)); + +// int recv_size = zmq_recv(requester, (char *)received_value, sizeof(float), 0); +// if (recv_size == sizeof(float)) { +// printf("C: Received float value: %f\n", *received_value); +// return received_value; // Return pointer to received float data + +// } else { +// free(received_value); // Free the allocated memory in case of failure +// printf("C: Error receiving float value\n"); +// zmq_close(requester); +// zmq_ctx_destroy(context); + +// return NULL; +// } + +// zmq_close(requester); +// zmq_ctx_destroy(context); +// free(socket_address); +// free(request); + +// return NULL; // Return NULL to indicate failure +// } +// String manipulation before passing to ZMQ + + +char **split(const char *str, char delimiter, int *count) { + int token_count = 0; + int str_len = strlen(str); + + // Count the number of tokens + for (int i = 0; i < str_len; i++) { + if (str[i] == delimiter) { + token_count++; + } + } + token_count++; // Add one for the last token + + char **tokens = malloc(token_count * sizeof(char *)); + if (tokens == NULL) { + *count = 0; + return NULL; + } + + int token_index = 0; + int token_start = 0; + for (int i = 0; i <= str_len; i++) { + if (str[i] == delimiter || str[i] == '\0') { + int token_length = i - token_start; + tokens[token_index] = malloc((token_length + 1) * sizeof(char)); + if (tokens[token_index] == NULL) { + *count = token_index; + for (int j = 0; j < token_index; j++) { + free(tokens[j]); + } + free(tokens); + return NULL; + } + strncpy(tokens[token_index], str + token_start, token_length); + tokens[token_index][token_length] = '\0'; + token_index++; + token_start = i + 1; + } + } + + *count = token_count; + return tokens; +} + +char *createJSONString(const char *data, const char *names) { + cJSON *root = cJSON_CreateObject(); + + int data_count, names_count; + char **data_tokens = split(data, ';', &data_count); + char **names_tokens = split(names, ';', &names_count); + + if (root && data_tokens && names_tokens && data_count == names_count) { + for (int i = 0; i < data_count; i++) { + // Check for empty string in names before adding to JSON + if (strcmp(names_tokens[i], "") != 0) { + cJSON_AddItemToObject(root, names_tokens[i], cJSON_CreateNumber(atof(data_tokens[i]))); + } + free(data_tokens[i]); + free(names_tokens[i]); + } + free(data_tokens); + free(names_tokens); + + char *jsonString = cJSON_Print(root); + cJSON_Delete(root); + return jsonString; + } else { + cJSON_Delete(root); + if (data_tokens) { + for (int i = 0; i < data_count; i++) { + free(data_tokens[i]); + } + free(data_tokens); + } + if (names_tokens) { + for (int i = 0; i < names_count; i++) { + free(names_tokens[i]); + } + free(names_tokens); + } + return NULL; + } +} + +char *cJSON_keys_to_string(cJSON *json, const char *delimiter) { + char *result = NULL; + cJSON *child = json->child; + size_t total_len = 0; + + // Calculate the total length needed for the keys string + while (child != NULL) { + total_len += strlen(child->string) + strlen(delimiter) + 1; // +1 for delimiter + + child = child->next; + } + + // Allocate memory for the keys string + result = (char *)malloc(total_len + 1); // +1 for null terminator + if (result == NULL) { + return NULL; + } + + // Build the keys string separated by the delimiter + child = json->child; + result[0] = '\0'; // Initialize the string + while (child != NULL) { + strcat(result, child->string); + if (child->next != NULL) { + strcat(result, delimiter); + } + child = child->next; + } + + return result; +} + +char *cJSON_values_to_string(cJSON *json, const char *delimiter) { + char *result = NULL; + cJSON *child = json->child; + size_t total_len = 0; + + // Calculate the total length needed for the values string + while (child != NULL) { + total_len += strlen(cJSON_Print(child)) + strlen(delimiter) + 1; // +1 for delimiter + + child = child->next; + } + + // Allocate memory for the values string + result = (char *)malloc(total_len + 1); // +1 for null terminator + if (result == NULL) { + return NULL; + } + + // Build the values string separated by the delimiter + child = json->child; + result[0] = '\0'; // Initialize the string + while (child != NULL) { + strcat(result, cJSON_Print(child)); + if (child->next != NULL) { + strcat(result, delimiter); + } + child = child->next; + } + + return result; +} + +float *process_received_data(const char *received_data) { + // Parse received JSON data + cJSON *root = cJSON_Parse(received_data); + if (!root) { + fprintf(stderr, "Error parsing JSON\n"); + return NULL; // Handle the error appropriately + } + + // Extract values from JSON and create an array of floats + cJSON *array = cJSON_GetObjectItem(root, "array_key"); // Replace "array_key" with your JSON key + if (!array || !cJSON_IsArray(array)) { + fprintf(stderr, "JSON array not found or invalid\n"); + cJSON_Delete(root); + return NULL; // Handle the error appropriately + } + + int num_elements = cJSON_GetArraySize(array); + float *float_array = (float *)malloc(num_elements * sizeof(float)); + + for (int i = 0; i < num_elements; ++i) { + cJSON *item = cJSON_GetArrayItem(array, i); + if (cJSON_IsNumber(item)) { + float_array[i] = (float)item->valuedouble; + } else { + fprintf(stderr, "Non-numeric value found in JSON array\n"); + free(float_array); + cJSON_Delete(root); + return NULL; // Handle the error appropriately + } + } + + cJSON_Delete(root); + return float_array; +} + + +// ------------------------------- Key ZMQ Helpers ------------------------- // +int zmq_init_pub(const char *req_address) { + void *context = zmq_ctx_new(); + publisher = zmq_socket(context, ZMQ_PUB); + + int rc = zmq_connect(publisher, req_address); + + if (rc != 0) { + printf("Error binding at %s : %s\n", req_address, zmq_strerror(errno)); + zmq_close(publisher); + zmq_ctx_destroy(context); + return -1; // Return error code if binding fails + } + + printf("Established PUB - SUB connection at address %s \n", req_address); + return 0; // Return success +} + + +int zmq_init_req_rep(const char *req_address) { + void *context = zmq_ctx_new(); + requester = zmq_socket(context, ZMQ_REQ); + + int rc = zmq_connect(requester, req_address); + + if (rc != 0) { + printf("Error binding at %s : %s\n", req_address, zmq_strerror(errno)); + zmq_close(requester); + zmq_ctx_destroy(context); + return -1; // Return error code if binding fails + } + + printf("Established REQ - REP connection at address %s \n", req_address); + return 0; // Return success +} + +int zmq_broadcast(const char *data, const char *names) { + if (publisher == NULL) { + printf("Socket not initialized. Call zmq_initialize_publisher first.\n"); + return -1; // Return error if socket is not initialized + } + // printf("inside C broadcasting routine.... \n"); + + size_t size = 0; + + // printf("Received names: %s\n", names); + // printf("Received string: %s\n", data); + + char *jsonString = createJSONString(data, names); + + if (jsonString) { + // printf("JSON String ready to be published: %s\n", jsonString); + zmq_send(publisher, jsonString, strlen(jsonString), 0); + free(jsonString); + } else { + printf("Failed to create JSON string\n"); + } + + return 0; // Success +} + +int count_semicolons(const char *request) { + int semicolon_count = 0; + for (int i = 0; request[i] != '\0'; i++) { + if (request[i] == ';') { + semicolon_count++; + } + } + return semicolon_count; +} + + +float *zmq_req_rep(const char *socket_address, const char *request) { + + if (requester == NULL) { + printf("Socket not initialized. Call zmq_initialize_requester first.\n"); + return -1; // Return error if socket is not initialized + } + + int req_count, send_status_req; + int max_floats = count_semicolons(request); + + // char **reqtoken = split(request, ';', &req_count); + + // printf("C: Sending request %s to socket... \n", request); + send_status_req = zmq_send(requester, request, strlen(request), 0); + + // char received_data[max_floats * sizeof(float)]; + + // Receive data via ZeroMQ + char buffer[1024]; + zmq_recv(requester, buffer, sizeof(buffer), 0); + + // Process received string + int count = 0; + const char delim[] = ";"; + char* token; + float* float_array; + + // Count the number of floats + char* copy = strdup(buffer); + token = strtok(copy, delim); + while (token != NULL) { + count++; + token = strtok(NULL, delim); + } + free(copy); + + // Allocate memory for the float array + float_array = (float*)malloc(count * sizeof(float)); + + // Convert string tokens to floats + token = strtok(buffer, delim); + for (int i = 0; i < count; ++i) { + float_array[i] = strtof(token, NULL); + token = strtok(NULL, delim); + } + + printf("Received float array:"); + for (int i = 0; i < count; ++i) { + printf(" %.4f", float_array[i]); + } + printf("\n"); + + return float_array; +} + + + + + + + + + + + + + + + + + + + + + // const int max_data_size = 1024; + + // Receive data via ZeroMQ + // char* received_data = (char*)malloc(max_data_size * sizeof(char)); + + // Receive data via ZeroMQ + // int recv_size = zmq_recv(requester, received_data, max_data_size - 1, 0); + + // if (recv_size > 0) { + // received_data[recv_size] = '\0'; // Null-terminate at the correct position + // printf("Received data: %s\n", received_data); + + // return received_data; + // } else { + // fprintf(stderr, "Error receiving data\n"); + // free(received_data); + // return NULL; + // } + // } + + + + +// float *received_value = (float *)malloc(sizeof(float)); + +// // int recv_size = zmq_recv(requester, (char *)received_value, max_floats * sizeof(float), 0); +// int recv_size = zmq_recv(requester, (char *)&received_value, sizeof(float *), 0); + +// if (recv_size > 0 && recv_size == sizeof(float *)) { +// printf("Received pointer to array\n"); +// return received_value; // Return pointer to the received float array +// } +// else +// { +// printf("C: Error receiving float array\n"); +// return NULL; +// } +// } + +// free(socket_address); +// free(request); + +// return NULL; // Return NULL to indicate failure +// } diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index a5e683526f..2589f9de1d 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -62,7 +62,8 @@ MODULE ServoDyn INTEGER(IntKi), PARAMETER :: ControlMode_USER = 3 !< The (ServoDyn-universal) control code for obtaining the control values from a user-defined routine INTEGER(IntKi), PARAMETER :: ControlMode_EXTERN = 4 !< The (ServoDyn-universal) control code for obtaining the control values from Simulink or Labivew INTEGER(IntKi), PARAMETER :: ControlMode_DLL = 5 !< The (ServoDyn-universal) control code for obtaining the control values from a Bladed-Style dynamic-link library - + INTEGER(IntKi), PARAMETER :: ZmqIn = 9 !< The (ServoDyn-universal) control code for obtaining the control values from a Zmq socket + INTEGER(IntKi), PARAMETER, PUBLIC :: TrimCase_none = 0 INTEGER(IntKi), PARAMETER, PUBLIC :: TrimCase_yaw = 1 INTEGER(IntKi), PARAMETER, PUBLIC :: TrimCase_torque = 2 @@ -4586,13 +4587,12 @@ SUBROUTINE Pitch_ValidateData( ) END IF - - IF ( InputFileData%PCMode /= ControlMode_NONE .and. InputFileData%PCMode /= ControlMode_USER ) THEN + + IF ( InputFileData%PCMode /= ControlMode_NONE .and. InputFileData%PCMode /= ControlMode_USER .and. InputFileData%PCMode /= ZmqIn ) THEN IF ( InputFileData%PCMode /= ControlMode_EXTERN .and. InputFileData%PCMode /= ControlMode_DLL ) & CALL SetErrStat( ErrID_Fatal, 'PCMode must be 0, 3, 4, or 5.', ErrStat, ErrMsg, RoutineName ) ENDIF - ! Time that pitch control is enabled: IF ( InputFileData%TPCOn < 0.0_DbKi ) THEN @@ -4627,7 +4627,7 @@ SUBROUTINE Yaw_ValidateData( ) !............................................................................................................................... ! checks for yaw control mode: - IF ( InputFileData%YCMode /= ControlMode_NONE .and. InputFileData%YCMode /= ControlMode_USER ) THEN + IF ( InputFileData%YCMode /= ControlMode_NONE .and. InputFileData%YCMode /= ControlMode_USER .and. InputFileData%YCMode /= ZmqIn) THEN IF ( InputFileData%YCMode /= ControlMode_DLL .and. InputFileData%YCMode /= ControlMode_EXTERN ) & CALL SetErrStat( ErrID_Fatal, 'YCMode must be 0, 3, 4 or 5.', ErrStat, ErrMsg, RoutineName ) ENDIF @@ -4695,16 +4695,15 @@ SUBROUTINE Torque_ValidateData( ) IF ( InputFileData%VSContrl == ControlMode_EXTERN ) THEN CALL SetErrStat( ErrID_Fatal, 'VSContrl can equal '//TRIM(Num2LStr(ControlMode_EXTERN))//' only when ServoDyn is interfaced with Simulink or LabVIEW.'// & - ' Set VSContrl to 0, 1, 3, or 5 or interface ServoDyn with Simulink or LabVIEW.', ErrStat, ErrMsg, RoutineName ) + ' Set VSContrl to 0, 1, 3, 5 for interface ServoDyn with Simulink or LabVIEW or 9 for ZMQ.', ErrStat, ErrMsg, RoutineName ) END IF END IF - ! checks for generator and torque control: IF ( InputFileData%VSContrl /= ControlMode_NONE .and. & - InputFileData%VSContrl /= ControlMode_SIMPLE .AND. InputFileData%VSContrl /= ControlMode_USER ) THEN + InputFileData%VSContrl /= ControlMode_SIMPLE .AND. InputFileData%VSContrl /= ControlMode_USER .AND. InputFileData%VSContrl /= ZmqIn ) THEN IF ( InputFileData%VSContrl /= ControlMode_DLL .AND. InputFileData%VSContrl /=ControlMode_EXTERN ) & - CALL SetErrStat( ErrID_Fatal, 'VSContrl must be either 0, 1, 3, 4, or 5.', ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrID_Fatal, 'VSContrl must be either 0, 1, 3, 4, 5 or 9.', ErrStat, ErrMsg, RoutineName ) ENDIF IF ( InputFileData%SpdGenOn < 0.0_ReKi ) CALL SetErrStat( ErrID_Fatal, 'SpdGenOn must not be negative.', ErrStat, ErrMsg, RoutineName ) @@ -4854,7 +4853,7 @@ SUBROUTINE SrvD_SetParameters( InputFileData, p, UnSum, ErrStat, ErrMsg ) if (UnSum >0) then write(UnSum, '(A)') ' Unless specified, units are consistent with Input units, [SI] system is advised.' write(UnSum, '(A)') SectionDivide - write(UnSum, '(A)') ' Pitch control mode {0: none, 3: user-defined from routine PitchCntrl, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} (switch)' + write(UnSum, '(A)') ' Pitch control mode {0: none, 3: user-defined from routine PitchCntrl, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL, 9: ZmqIn} (switch)' write(UnSum, '(A43,I2)') ' PCMode -- Pitch control mode: ',p%PCMode write(UnSum, '(A43,ES20.12e3)') ' TPCOn -- pitch control start time: ',p%TPCOn write(UnSum, '(A)') ' -------------------' @@ -5028,7 +5027,7 @@ SUBROUTINE SrvD_SetParameters( InputFileData, p, UnSum, ErrStat, ErrMsg ) if (UnSum >0) then write(UnSum, '(A)') '' write(UnSum, '(A)') SectionDivide - write(UnSum, '(A)') ' Yaw control mode {0: none, 3: user-defined from routine UserYawCont, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL} (switch)' + write(UnSum, '(A)') ' Yaw control mode {0: none, 3: user-defined from routine UserYawCont, 4: user-defined from Simulink/Labview, 5: user-defined from Bladed-style DLL, 9: ZmqIn} (switch)' write(UnSum, '(A32,I2)') ' YCMode -- yaw control mode ',p%YCMode if (p%YCMode > 0) & write(UnSum, '(A55,ES12.5e2)') ' TYCOn -- Time to enable active yaw control (s) ',p%TYCOn @@ -5180,6 +5179,8 @@ SUBROUTINE Yaw_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg y%YawMom = m%dll_data%YawTorqueDemand return + + end if end if @@ -5259,6 +5260,10 @@ SUBROUTINE CalculateStandardYaw(t, u, p, m, YawPosCom, YawRateCom, YawPosComInt, return end if + CASE ( ZmqIn ) + + continue ! pass through, it is going to be overwritten in FAST_Subs + END SELECT @@ -5405,13 +5410,17 @@ SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, BlPitchCom, ElecPwr, BlPitchCom = p%BlAlpha * m%xd_BlPitchFilter + (1.0_ReKi - p%BlAlpha) * BlPitchCom + CASE ( ZmqIn ) + + continue ! pass through, it is going to be overwritten in FAST_Subs + END SELECT ELSE ! Do not control pitch yet, maintain initial pitch angles. ! Use the initial blade pitch angles: - BlPitchCom = p%BlPitchInit + BlPitchCom = p%BlPitchInit ! todo: add check that blpitch is one of the channels inputs of ZMQ ENDIF @@ -5749,6 +5758,10 @@ SUBROUTINE Torque_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM HSSBrFrac = u%ExternalHSSBrFrac + CASE ( ZmqIn ) + + continue ! pass through, it is going to be overwritten in FAST_Subs + ENDSELECT HSSBrFrac = MAX( MIN( HSSBrFrac, 1.0_ReKi ), 0.0_ReKi ) ! make sure we didn't get outside the acceptable range: 0 (off) <= HSSBrFrac <= 1 (full) @@ -5997,6 +6010,10 @@ SUBROUTINE CalculateTorque( t, u, p, m, GenTrq, ElecPwr, ErrStat, ErrMsg ) GenTrq = u%ExternalGenTrq ElecPwr = u%ExternalElecPwr + CASE ( ZmqIn ) + + continue ! pass through, it is going to be overwritten in FAST_Subs + END SELECT @@ -6209,6 +6226,13 @@ SUBROUTINE CalculateTorqueJacobian( t, u, p, m, GenTrq_du, ElecPwr_du, ErrStat, GenTrq_du = 0.0_R8Ki ElecPwr_du = 0.0_R8Ki + CASE ( ZmqIn ) ! User-defined generator model. + + ! we should not get here (initialization should have caught this issue) + + GenTrq_du = 0.0_R8Ki + ElecPwr_du = 0.0_R8Ki + END SELECT