      INTEGER FUNCTION FILL_MONIT_POOL ( DATA_OPTION )
C----------------------------------------------------------------------
C-
C-   Purpose and Methods : Shell around FILL_MONIT_POOL to implement
C-                         recovery on send or receive failure.
C-
C-   Returned value  :
C-   Inputs  : see TRY_FILL_MONIT_POOL
C-   Outputs :
C-   Controls:
C-
C-   Created   3-SEP-1993   Philippe Laurens - MSU L1 Trigger
C-
C----------------------------------------------------------------------
      IMPLICIT NONE
      INTEGER        DATA_OPTION
C
      INTEGER        RETRY
      PARAMETER      STATUS_NORMAL   = 0
      PARAMETER      MAX_RETRIES     = 5  ! Number of connection retries
      CHARACTER*1    ESC
C
C ****  external function
C
      INTEGER        TRY_FILL_MONIT_POOL 
C
C
C ****  Change timeout default (1 mn)
      CALL WAIT_SET_TIMEOUT ( '0 00:00:30' )
C
      DO RETRY = 1, MAX_RETRIES
        FILL_MONIT_POOL = TRY_FILL_MONIT_POOL ( DATA_OPTION )
        IF ( FILL_MONIT_POOL .EQ. STATUS_NORMAL ) GOTO 999
        ESC = CHAR(27)
        PRINT *, ESC, '[23;1H' 
        PRINT *, 'Problem getting data from TCC, Retrying... '
        CALL WAITIT(1.)
      END DO
C
C----------------------------------------------------------------------
  999 RETURN
      END
C
      INTEGER FUNCTION TRY_FILL_MONIT_POOL ( DATA_OPTION )
C----------------------------------------------------------------------
C-
C-   Purpose and Methods : read Monitoring Information from D0TCC/TRICS and
C-                              fill Monitoring Pool area
C-
C-   Inputs  : DATA_OPTION specify information transferred (declared parameter)
C-                          see LV1_MPOOL.PARAMS
C-             REF_TYP specify ref set type (only when necessary)
C-             REF_NUM specify ref set number (only when necessary)
C-             Logical D0TCC_NODE (Implicit)
C-             Logical MPOOL_CHANNEL (Implicit)
C-   Outputs : RETURN 0 when successful
C-             Write variables in common areas 'LV1_MPOOL_RAW.INC'
C-   Controls:
C-
C-   Created   5-FEB-1991 MICHIGAN STATE UNIVERSITY, TRIGGER CONTROL SOFTWARE
C-   Modified 18-APR-1991 Return single ITC message, and unpack general section
C-                        Check for data length and complain/abort when mismatch
C-   Updated  24-OCT-1991   Philippe Laurens: send user name and process name
C-   Updated   2-APR-1992   Philippe Laurens, Steven Klocek
C-                        Timeout on receive after 5s, retry 3 times,
C-                          close channel if 3 retrys fail.
C-                        Handle new MPOOL messages.
C-   Updated   3-SEP-1993   Philippe Laurens - MSU L1 Trigger  
C-                        Rework the error recovery features wait timeout and
C-                        disconnect/retry. Add the subroutine calling layer 
C-                        FILL_MONIT_POOL -> TRY_FILL_MONIT_POOL
C-   Updated   8-SEP-1993   Philippe Laurens - MSU L1 Trigger   
C-                        Add reception of Large Tile Reference Set.
C-   Updated  27-APR-1995   Philippe Laurens - MSU L1 Trigger   
C-                        Fix bug that prevented sending TCC the process name
C-
C----------------------------------------------------------------------
C
      IMPLICIT       NONE
C
C *** Include paramaters predeclared in SYS$LIBRARY:FORSYSDEF.TLB
C
      INCLUDE       '($JPIDEF)'
C
C *** Include user parameters and common blocks
C
      INCLUDE       'LV1_MPOOL.PARAMS/LIST'
      INCLUDE       'LV1_MPOOL_RAW.INC/LIST'
C
C *** Explicit Subroutine Arguments
C
      INTEGER        DATA_OPTION
C
C ***  Non-temporary variables
C
      LOGICAL        FIRST              ! first call flag
      LOGICAL        DISCONNECTED       ! Flag ITC Channel needs to be opened
      INTEGER        NET_CHAN           ! IO channel allocated
      INTEGER        RECEIVED           ! ITC Event for meesage received
      DATA           FIRST /.TRUE./
C      DATA           DISCONNECTED /.FALSE./
      DATA           DISCONNECTED /.TRUE./
      DATA           RECEIVED /-1/
      SAVE           FIRST, DISCONNECTED
      SAVE           NET_CHAN, RECEIVED
C
C *** Local Variables
C
      CHARACTER*8    NODE               ! receive implicit logical
      CHARACTER*10   OBJECT             ! receive implicit logical
      INTEGER        STATUS             ! Function Return status
      INTEGER        MSGLEN             ! ITC message length
      INTEGER        REF_TYP, REF_NUM   ! loop variables
      INTEGER        INT_REQUEST        ! \ used to send data option as
      CHARACTER*48   CHR_REQUEST        ! / a character string
      EQUIVALENCE  ( INT_REQUEST, CHR_REQUEST )
      CHARACTER*16   TEMPSTR
      INTEGER        TEMPINT
C
C *** Constants
C
      PARAMETER      STATUS_NORMAL   = 0        ! successful return code
      PARAMETER      STATUS_TIMEOUT  = -2       ! timeout return code
      PARAMETER      START_USER_NAME = 17       !define substring in chr_request
      PARAMETER      STOP_USER_NAME  = 32       ! for user name (16 char)
      PARAMETER      START_PROC_NAME = 33       !define substring in chr_request
      PARAMETER      STOP_PROC_NAME  = 48       ! for process name (16 char)
C
C *** Declaration of External Functions
C
      INTEGER        SYS$CLREF, LIB$SYS_TRNLOG
      INTEGER        LIB$GETJPI
      INTEGER        ITC_CONNECT, ITC_DISCONNECT
      INTEGER        ITC_DECLARE_RECEIVE_EVENT
      INTEGER        ITC_WRITE, ITC_READ
      INTEGER        WAIT_WITH_TIMEOUT 
C
C ********************************************************************
C *** Executable starts here
C
C *** Check Availibility of all implicit parameters,
C *** and initialize ITC, variables.
C
      STATUS = STATUS_NORMAL
      IF ( FIRST .EQ. .TRUE. ) THEN
C
        STATUS = LIB$SYS_TRNLOG( 'D0TCC_NODE', , NODE, , , )
        CALL CHECK_STATUS( STATUS, 'Translate Logical D0TCC_NODE' )
C
        STATUS = LIB$SYS_TRNLOG( 'MPOOL_CHANNEL', , OBJECT, , , )
        CALL CHECK_STATUS( STATUS, 'Translate Logical MPOOL_CHANNEL' )
C
        CALL ITC_INIT ( MAX_CHANNEL, MAX_ACTIVITY, MAX_BLOCK_SIZE )
C
        STATUS = ITC_DECLARE_RECEIVE_EVENT (RECEIVED)
        CALL CHECK_STATUS( STATUS, 'ITC Declare Receive Event' )
C
        STATUS = LIB$GETJPI ( JPI$_USERNAME,! item
     &                        ,           ! pid
     &                        ,           ! process name
     &                        ,           ! out value
     &                        TEMPSTR,    ! out string
     &                        TEMPINT )   ! out len
        CHR_REQUEST(START_USER_NAME:STOP_USER_NAME)= TEMPSTR(1:TEMPINT)
C
        STATUS = LIB$GETJPI ( JPI$_PRCNAM,! item
     &                        ,           ! pid
     &                        ,           ! process name
     &                        ,           ! out value
     &                        TEMPSTR,    ! out string
     &                        TEMPINT )   ! out len
        CHR_REQUEST(START_PROC_NAME:STOP_PROC_NAME)= TEMPSTR(1:TEMPINT)
C
        FIRST = .FALSE.
C
      END IF
C
C *** Connect to DECnet Network Object on ELN Node
      IF ( DISCONNECTED .EQ. .TRUE. ) THEN
C
        CHR_REQUEST(START_PROC_NAME:STOP_PROC_NAME)= ' (ReConnecting) '
        STATUS = ITC_CONNECT ( NET_CHAN, OBJECT, NODE )
        CALL CHECK_STATUS( STATUS, 'ITC Connect to ' // NODE )
        IF (.NOT. STATUS) GOTO 500
C
        DISCONNECTED = .FALSE.
C
      END IF
C
C *** Check explicit parameters
C
      IF ( ( DATA_OPTION .LT. MP_FIRST )
     &  .OR.( DATA_OPTION .GT. MP_LAST ) ) THEN
        STATUS = -2
        PRINT *, 'FILL_MONIT_POOL: Argument out of Range = ',
     &                        DATA_OPTION
        GOTO 500
      END IF
C
C ****  Clear receive event flag
C
      STATUS = SYS$CLREF ( %VAL( RECEIVED ) )
      CALL CHECK_STATUS( STATUS, 'Clear Receive Event' )
C
C *** Send data option specifying information requested
C
      INT_REQUEST = DATA_OPTION !transfer to character string, cf.declaration
C
      STATUS = ITC_WRITE ( NET_CHAN, CHR_REQUEST )
      CALL CHECK_STATUS( STATUS, 'ITC Write = Data Option' )
      IF ( .NOT. STATUS ) GOTO 500
C
C *** Receive Data Set over the Opened Link
C
      STATUS = WAIT_WITH_TIMEOUT ( RECEIVED )
      IF ( STATUS .NE. STATUS_NORMAL ) GOTO 500
C
  200 CONTINUE
C
      IF      ( DATA_OPTION .EQ. MP_SPTRG_GSECT ) THEN
C
        STATUS = ITC_READ ( NET_CHAN, BLOCK_SPTRG_GEOSECT, MSGLEN )
        CALL CHECK_STATUS ( STATUS, 'ITC Read = Section SpTrg+GeoSect' )
        CALL CHECK_LENGTH ( MSGLEN, SIZE_SPTRG_GEOSECT,
     &                     'ITC Read = Section SpTrg+GeoSect' )
        BLOCK_GENERAL = BLOCK_GENERAL_SPTRG_GEOSECT
C
      ELSE IF ( DATA_OPTION .EQ. MP_DATABLOCK ) THEN
C
        STATUS = ITC_READ ( NET_CHAN, BLOCK_DB_SPY, MSGLEN )
        CALL CHECK_STATUS ( STATUS, 'ITC Read = Section DataBlock' )
        CALL CHECK_LENGTH ( MSGLEN, SIZE_DB_SPY,
     &                     'ITC Read = Section DataBlock' )
        BLOCK_GENERAL = BLOCK_GENERAL_DB_SPY
C
      ELSE IF ( DATA_OPTION .EQ. MP_TRGTWR ) THEN
C
        STATUS = ITC_READ ( NET_CHAN, BLOCK_TRGTWR, MSGLEN )
        CALL CHECK_STATUS ( STATUS, 'ITC Read = Section TrgTwr' )
        CALL CHECK_LENGTH ( MSGLEN, SIZE_TRGTWR,
     &                     'ITC Read = Section TrgTwr' )
        BLOCK_GENERAL = BLOCK_GENERAL_TRGTWR
C
      ELSE IF ( DATA_OPTION .EQ. MP_REFSET ) THEN
C
        STATUS = ITC_READ ( NET_CHAN, BLOCK_REFSET_STATUS, MSGLEN )
        CALL CHECK_STATUS ( STATUS, 'ITC Read = Section RefSet/Sta' )
        CALL CHECK_LENGTH ( MSGLEN, SIZE_REFSET_STATUS,
     &                     'ITC Read = Section RefSet/Sta' )
        BLOCK_GENERAL = BLOCK_GENERAL_REFSET
C
        DO REF_TYP = 0 , 2
          DO REF_NUM = 0 , 3
C
            STATUS = WAIT_WITH_TIMEOUT ( RECEIVED )
            IF ( STATUS .NE. STATUS_NORMAL ) GOTO 500
C
            STATUS = ITC_READ ( NET_CHAN,
     &                          BLOCK_TT_REFSET_DATA( REF_NUM, REF_TYP),
     &                          MSGLEN )
            CALL CHECK_STATUS ( STATUS,
     &                         'ITC Read = Section TT RefSet/Dat' )
            CALL CHECK_LENGTH ( MSGLEN, SIZE_TT_REFSET_DATA,
     &                         'ITC Read = Section TT RefSet/Dat' )
C
          ENDDO
        ENDDO
C
        STATUS = WAIT_WITH_TIMEOUT ( RECEIVED )
        IF ( STATUS .NE. STATUS_NORMAL ) GOTO 500
C
        STATUS = ITC_READ ( NET_CHAN, BLOCK_LT_REFSET_DATA, MSGLEN )
        CALL CHECK_STATUS ( STATUS, 'ITC Read = Section LT RefSet/Dat' )
        CALL CHECK_LENGTH ( MSGLEN, SIZE_LT_REFSET_DATA,
     &                     'ITC Read = Section LT RefSet/Dat' )
C
      ELSE IF ( DATA_OPTION .EQ. MP_GL_THRSH ) THEN
C
        STATUS = ITC_READ ( NET_CHAN, BLOCK_GLOBAL_THRESH, MSGLEN )
        CALL CHECK_STATUS ( STATUS, 'ITC Read = Section GloThresh' )
        CALL CHECK_LENGTH ( MSGLEN, SIZE_GLOBAL_THRESH,
     &                     'ITC Read = Section GloThresh' )
        BLOCK_GENERAL = BLOCK_GENERAL_GLOBAL_THRESH
C
      ELSE IF (( DATA_OPTION .EQ. MP_PER_BUNCH )) THEN
C
        STATUS = ITC_READ ( NET_CHAN, BLOCK_PER_BUNCH, MSGLEN )
        CALL CHECK_STATUS ( STATUS, 'ITC Read = Section Per Bunch' )
        CALL CHECK_LENGTH ( MSGLEN, SIZE_PER_BUNCH,
     &                     'ITC Read = Section Per Bunch' )
        BLOCK_GENERAL = BLOCK_GENERAL_PER_BUNCH
C
      ELSE IF ( DATA_OPTION .EQ. MP_FOREIGN_SCALERS ) THEN
C
        STATUS = ITC_READ ( NET_CHAN, BLOCK_FOREIGN_SCALER, MSGLEN )
        CALL CHECK_STATUS ( STATUS, 'ITC Read = Section Foreign Scal' )
        CALL CHECK_LENGTH ( MSGLEN, SIZE_FOREIGN_SCALER,
     &                     'ITC Read = Section Foreign Scal' )
        BLOCK_GENERAL = BLOCK_GENERAL_FOREIGN_SCALER
C
      ELSE IF ( DATA_OPTION .EQ. MP_36X36_SCALERS ) THEN
C
        STATUS = ITC_READ ( NET_CHAN, BLOCK_36X36_SCALER, MSGLEN )
        CALL CHECK_STATUS ( STATUS, 'ITC Read = Section 36X36 Scal' )
        CALL CHECK_LENGTH ( MSGLEN, SIZE_36X36_SCALER,
     &                     'ITC Read = Section 36X36 Scal' )
        BLOCK_GENERAL = BLOCK_GENERAL_36X36_SCALER
C
      END IF
C
C *** Assign Function Return Value
C
      STATUS = STATUS_NORMAL
  500 CONTINUE
      IF (( .NOT. STATUS ) .AND. (STATUS .NE. STATUS_NORMAL) ) THEN
        STATUS = ITC_DISCONNECT( NET_CHAN )
        CALL CHECK_STATUS( STATUS, 'ITC Disconnect' )
        DISCONNECTED = .TRUE.
      ENDIF
      TRY_FILL_MONIT_POOL = STATUS
  999 RETURN
C----------------------------------------------------------------------
      END
C
C#######################################################################
      INTEGER FUNCTION WAIT_WITH_TIMEOUT ( EVENT_FLAG )
C----------------------------------------------------------------------
C-
C-   Purpose and Methods : WAIT for the specified event, with a timeout
C-   specified in entry point WAIT_SET_TIMEOUT (default is 1 mn)
C-
C-   Inputs  : EVENT_FLAG VMS event flag
C-
C-   Created   3-SEP-1993   Philippe Laurens - MSU L1 Trigger
C-
C----------------------------------------------------------------------
      IMPLICIT NONE
      INTEGER        EVENT_FLAG
      INTEGER        WAIT_SET_TIMEOUT  ! ENTRY Point
      CHARACTER*10   TIME_STRING       ! ENTRY Point Argument
C
      INTEGER STATUS
      PARAMETER      STATUS_NORMAL   = 0        ! successful return code
      PARAMETER      STATUS_TIMEOUT  = -2       ! timeout return code
      PARAMETER      REQUEST_NUM     = 578      !ID for timer request
      INTEGER        WHICH_EVENT
C
      LOGICAL        FIRST              ! first call flag
      LOGICAL        TIMEOUT_SET        ! Flag Timeout has been defined
      INTEGER        TIMEOUT_EVENT      ! Event flag for communication timeout
      CHARACTER*8    TIMEOUT_PERIOD     ! 8 bytes to store the system
C                                       ! format time
      DATA           FIRST /.TRUE./
      DATA           TIMEOUT_SET /.FALSE./, TIMEOUT_EVENT /-1/
      SAVE           FIRST
      SAVE           TIMEOUT_SET, TIMEOUT_EVENT, TIMEOUT_PERIOD
C
      CHARACTER*10   ONE_MINUTE 
      PARAMETER    ( ONE_MINUTE = '0 00:01:00' )
C
C *** Declaration of External Functions
C
      INTEGER        SYS$BINTIM, SYS$SETIMR, SYS$CANTIM
      INTEGER        LIB$GET_EF, SYS$CLREF
      INTEGER        ITC_WAIT_ANY
C
C ****  Executable 
C
      IF ( FIRST .EQ. .TRUE. ) THEN
C
        STATUS = LIB$GET_EF( TIMEOUT_EVENT )
        CALL CHECK_STATUS( STATUS, 'Allocate Timeout Event' )
C
        IF ( TIMEOUT_SET .NE. .TRUE. ) THEN
          STATUS = SYS$BINTIM( ONE_MINUTE, %REF( TIMEOUT_PERIOD ) )
          CALL CHECK_STATUS( STATUS, 'Translate Delta Time' )
          TIMEOUT_SET = .TRUE.
        END IF
C
        FIRST = .FALSE.
C
      END IF
C
C *** Set Receive Timeout Timer
C
      STATUS = SYS$CLREF ( %VAL( TIMEOUT_EVENT ) )
      CALL CHECK_STATUS( STATUS, 'Clear Event = Timeout Event' )
C
      STATUS = SYS$SETIMR( %VAL( TIMEOUT_EVENT ),        ! Event Flag
     &                     %REF( TIMEOUT_PERIOD ), ,     ! Timeout Period
     &                     %VAL( REQUEST_NUM ) )         ! Request ID
      CALL CHECK_STATUS( STATUS, 'Timer Request' )
C
      WHICH_EVENT = 0
      STATUS = ITC_WAIT_ANY ( WHICH_EVENT, EVENT_FLAG, TIMEOUT_EVENT )
      CALL CHECK_STATUS( STATUS, 'ITC Wait Any' )
C
      IF ( WHICH_EVENT .EQ. 1 ) THEN
        STATUS = SYS$CLREF ( %VAL( EVENT_FLAG ) )
        CALL CHECK_STATUS( STATUS, 'Clear Event = Receive Section' ) 
        STATUS = SYS$CANTIM( %VAL( REQUEST_NUM ),  )
        CALL CHECK_STATUS( STATUS, 'Cancel Timer' )
        STATUS = STATUS_NORMAL
      ELSE IF ( WHICH_EVENT .EQ. 2 ) THEN
        STATUS = STATUS_TIMEOUT
      ENDIF
C
C *** Assign Function Return Value
C
      WAIT_WITH_TIMEOUT = STATUS
C
  999 RETURN
C#######################################################################
      ENTRY WAIT_SET_TIMEOUT ( TIME_STRING )
C----------------------------------------------------------------------
C-
C-   Purpose and Methods : Set timeout value for WAIT_WITH_TIMEOUT
C-
C-   Input: TIME_STRING, Time in VMS time string format
C-
C-   Created   3-SEP-1993   Philippe Laurens - MSU L1 Trigger
C-
C----------------------------------------------------------------------
      WAIT_SET_TIMEOUT = SYS$BINTIM( TIME_STRING, %REF(TIMEOUT_PERIOD) )
      CALL CHECK_STATUS( WAIT_SET_TIMEOUT, 'Translate Delta Time' )
      IF ( WAIT_SET_TIMEOUT ) TIMEOUT_SET = .TRUE.
      RETURN
C----------------------------------------------------------------------
      END
C
C#######################################################################
      SUBROUTINE CHECK_STATUS ( STATUS, ACTION_BEING_CHECKED )
C----------------------------------------------------------------------
C-
C-   Purpose and Methods : Check on STATUS returned by a system call and
C-                              display error message if necessary
C-
C-   Inputs  : STATUS integer status code being checked
C-             ACTION_BEING_CHECKED string description of caller action
C-
C-   Outputs : screen message (PRINT *) if STATUS is Even
C-
C-   Controls:
C-
C-   Created   28-MAR-1991 MICHIGAN STATE UNIVERSITY, TRIGGER CONTROL SOFTWARE
C-
C----------------------------------------------------------------------
C
      IMPLICIT       NONE
C
C *** Explicit Subroutine Arguments
C
      INTEGER        STATUS
      CHARACTER*(*)  ACTION_BEING_CHECKED
C
C *** Local Variables
C
      INTEGER        ISTAT
      CHARACTER*256  ERRMSG             ! receives VMS error message
      INTEGER        LENGTH
C
C *** Constants
C
      PARAMETER      ALL = 1+2+4+8      ! request for full message from GETMSG
C
C *** Declaration of External Functions
C
      INTEGER        SYS$GETMSG
C
C ********************************************************************
C *** Executable starts here
C
      IF ( .NOT. STATUS ) THEN
C
        ISTAT = SYS$GETMSG( %VAL(STATUS), LENGTH, ERRMSG, %VAL(ALL),)
        PRINT *, 'Error detected During > ', ACTION_BEING_CHECKED
        PRINT *, ERRMSG(1:LENGTH)
C
      END IF
C
C----------------------------------------------------------------------
      RETURN
      END

      SUBROUTINE CHECK_LENGTH ( RECEIVED_LENGTH, EXPECTED_LENGTH,
     &                          ACTION_BEING_CHECKED )
C----------------------------------------------------------------------
C-
C-   Purpose and Methods : compare observed received message length
C-                         and expected data section size
C-
C-   Inputs  : RECEIVED_LENGTH ITC message length reported by ITC
C-             EXPECTED_LENGTH defined section length
C-             ACTION_BEING_CHECKED string description of caller action
C-
C-   Outputs : screen message (PRINT *) if length mismatch
C-
C-   Controls:
C-
C-   Created   18-APR-1991 MICHIGAN STATE UNIVERSITY, TRIGGER CONTROL SOFTWARE
C-
C----------------------------------------------------------------------
C
      IMPLICIT       NONE
C
C *** Explicit Subroutine Arguments
C
      INTEGER        RECEIVED_LENGTH
      INTEGER        EXPECTED_LENGTH
      CHARACTER*(*)  ACTION_BEING_CHECKED
C
C *** Local Variables
C
      CHARACTER*1    ESC
C
C ********************************************************************
C *** Executable starts here
C
      IF ( RECEIVED_LENGTH .NE. EXPECTED_LENGTH ) THEN
C
        ESC = CHAR(27)
C
        PRINT *, ESC, '[1;1H', ESC, '[2J'
        PRINT *, 'ITC Received',      RECEIVED_LENGTH,
     &           ' Bytes instead of', EXPECTED_LENGTH
        PRINT *, 'During > ', ACTION_BEING_CHECKED
        PRINT *, 'This is an internal Level 1 error'
        PRINT *, 'Run TRGMON again.'
        PRINT *, 'If this problem persists, '
     &         //'send MAIL to MSUHEP::TRIGGER or call (517)355-8525'
C
        CALL WAITIT ( 5.0 )
        STOP
      END IF
C
C----------------------------------------------------------------------
      RETURN
      END
