From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- math/slalib/wait.f__vms | 60 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) create mode 100644 math/slalib/wait.f__vms (limited to 'math/slalib/wait.f__vms') diff --git a/math/slalib/wait.f__vms b/math/slalib/wait.f__vms new file mode 100644 index 00000000..5897e7e6 --- /dev/null +++ b/math/slalib/wait.f__vms @@ -0,0 +1,60 @@ + SUBROUTINE sla_WAIT (DELAY) +*+ +* - - - - - +* W A I T +* - - - - - +* +* Interval wait +* +* !!! VAX/VMS specific !!! +* +* Given: +* DELAY real delay in seconds +* +* A delay 100ns < DELAY < 200s is requested. +* +* P.T.Wallace Starlink 14 October 1991 +* +* License: +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; either version 2 of the License, or +* (at your option) any later version. +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program (see SLA_CONDITIONS); if not, write to the +* Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +* Boston, MA 02110-1301 USA +* +*- + + IMPLICIT NONE + + REAL DELAY + + INTEGER JSTAT + INTEGER SYS$SCHDWK,SYS$HIBER + + INTEGER IDT(2) + DATA IDT(2)/-1/ + + + +* Encode delta time + IDT(1)=-NINT(MAX(1.0,1E7*MIN(200.0,DELAY))) + + +* Schedule a wakeup + JSTAT=SYS$SCHDWK(,,IDT,) + IF (.NOT.JSTAT) CALL LIB$STOP(%VAL(JSTAT)) + +* Hibernate + JSTAT=SYS$HIBER() + IF (.NOT.JSTAT) CALL LIB$STOP(%VAL(JSTAT)) + + END -- cgit