SUBROUTINE SUSPEND (HOURS,MINUTES,SECONDS,TENTHS) INTEGER*4 HOURS, MINUTES, SECONDS, TENTHS C********************************************************************* C*** C*** THIS ROUTINE WILL SUSPEND THE PROGRAM FOR THE SPECIFIED TIME C*** C*** HOURS IS LIMITED FROM 0 TO 23 C*** MINUTES IS LIMITED FROM 0 TO 59 C*** SECONDS IS LIMITED FROM 0 TO 59 C*** TENTHS IS LIMITED FROM 0 TO 9 C*** C*** IF ALL PARAMETERS ARE 0, THEN THE ROUTINE WILL RETURN C*** IMMEDIATELY C*** C*** PARAMETERS : C*** C*** HOURS (I*4) NUMBER OF HOURS TO WAIT C*** C*** MINUTES (I*4) NUMBER OF MINUTES TO WAIT C*** C*** SECONDS (I*4) NUMBER OF SECONDS TO WAIT C*** C*** TENTHS (I*4) NUMBER OF TENTHS OF SECONDS TO WAIT C*** C******************************************************************** C*MCT INTEGER*4 H, M, S, T CHARACTER*16 ASCII_TIME INTEGER*4 BINARY_TIME(2) C INTEGER*4 SYS$BINTIM, SYS$SETIMR, SYS$WAITFR INTEGER*4 LIB$GET_EF INTEGER*4 FLAG C C*** LIMIT VALUES H = LIMIT (HOURS,0,23) M = LIMIT (MINUTES,0,59) S = LIMIT (SECONDS,0,59) T = LIMIT (TENTHS,0,9) C I = H + M + S + T IF (I .EQ. 0) RETURN C C*** ENCODE THE ASCII TIME ENCODE (16,10,ASCII_TIME) H, M, S, T 10 FORMAT ('0000 ',I2.2,':',I2.2,':',I2.2,'.',I1,'0') C C*** CONVERT TO SYSTEM BINARY TIME ISTAT = SYS$BINTIM (ASCII_TIME,BINARY_TIME) IF (.NOT. ISTAT) CALL SYS_SIGNAL (ISTAT) C C*** FIND OURSELF AN EVENT FLAG WE CAN USE CALL LIB$GET_EF (FLAG) IF (FLAG .EQ. -1) THEN C C*** NO EVENT FLAGS AVAILABLE, RETURN WITH NO DELAY RETURN ELSE ENDIF C C*** NOW SET THE TIMER ISTAT = SYS$SETIMR (%VAL(FLAG),BINARY_TIME,,) IF (.NOT. ISTAT) CALL SYS_SIGNAL (ISTAT) C C*** NOW SUSPEND OURSELF, AND WAIT FOR EVENT FLAG TO RAISE ISTAT = SYS$WAITFR (%VAL(FLAG)) IF (.NOT. ISTAT) CALL SYS_SIGNAL (ISTAT) C C*** FREE THE EVENT FLAG CALL LIB$FREE_EF (FLAG) C RETURN END