C ******************************************************* C * * C * THIS SOFTWARE WAS DEVELOPED WITH SUPPORT * C * FROM THE NATIONAL INSTITUTES OF HEALTH: * C * NIH CA06927 * C * NIH CA22780 * C * * C * DIRECT INQUIRIES TO: * C * COMPUTER CENTER * C * THE INSTITUTE FOR CANCER RESEARCH * C * 7701 BURHOLME AVENUE * C * PHILADELPHIA, PENNSYLVANIA 19111 * C * * C * NO WARRANTY OR REPRESENTATION, EXPRESS OR * C * IMPLIED, IS MADE WITH RESPECT TO THE * C * CORRECTNESS, COMPLETENESS, OR USEFULNESS * C * OF THIS SOFTWARE, NOR THAT USE OF THIS * C * SOFTWARE MIGHT NOT INFRINGE PRIVATELY * C * OWNED RIGHTS. * C * * C * NO LIABILITY IS ASSUMED WITH RESPECT TO * C * THE USE OF, OR FOR DAMAGES RESULTING FROM * C * THE USE OF THIS SOFTWARE * C * * C ******************************************************* C * * C * THIS SOFTWARE WAS DESIGNED FOR USE ON A * C * PDP-11/70 OPERATING UNDER IAS V3.0 USING * C * THE FORTRAN-IV PLUS COMPILER. * C * * C ******************************************************* IMPLICIT INTEGER (A - Z) BYTE CMD(80) LOGICAL*1 GETCMD,EXECUT REAL CMDTAS,SECNDS,TIMSEC,SCHTAS DIMENSION DATE(3),TIME(2),IOP(4) DATA SCHTAS/6R.SCHED/,IOP/3*0,"401/ C CALL IDATE(DATE(1),DATE(2),DATE(3)) TIMSEC = SECNDS(0.0) TIME(1) = TIMSEC/3600. TIME(2) = (TIMSEC-FLOAT(TIME(1))*3600.)/60. OPEN (UNIT=1,NAME='LB:[1,1]SCHEDULE.INP',TYPE='OLD',READONLY,ERR=100) C 10 CONTINUE EXECUT = GETCMD(DATE,TIME,CMD,CMDLEN,CMDTAS) IF(.NOT.EXECUT)GOTO 20 C C SPAWN TASK ON DEVICE NL0 CALL SPWNNL(CMDTAS,IOP,CMD,CMDLEN,DSW) GOTO 10 C 20 CONTINUE CLOSE(UNIT=1) CALL SCHED(SCHTAS,,TIME(1),TIME(2),0,0) CALL EXIT C 100 CONTINUE TYPE 101 101 FORMAT(' .SCHED -- NO SCHEDULE FILE FOUND') CALL EXIT END LOGICAL FUNCTION GETCMD(DATE,TIME,CMD,CMDLEN,CMDTAS) IMPLICIT INTEGER (A - Z) BYTE CMD(80) DIMENSION DATE(3),TIME(2),CMDTAS(2) DIMENSION DAYMSK(7),CMDTIM(2) C DAY = WEEKDY(DATE(1),DATE(2),DATE(3)) C 10 CONTINUE READ(1,11,ERR=10,END=110)DAYMSK,CMDTIM,CMDLEN,CMD 11 FORMAT(7I1,1X,2(I2,1X),Q,80A1) IF(DAYMSK(DAY).EQ.0)GOTO 10 IF(CMDTIM(1)-TIME(1))10,20,100 20 CONTINUE IF(CMDTIM(2)-TIME(2))10,30,100 C 30 CONTINUE CALL IRAD50(3,'...',CMDTAS(1)) CALL IRAD50(3,CMD,CMDTAS(2)) GETCMD = .TRUE. RETURN C 100 CONTINUE TIME(1) = CMDTIM(1) TIME(2) = CMDTIM(2) 105 CONTINUE GETCMD = .FALSE. RETURN C 110 CONTINUE TIME(1) = 0 TIME(2) = 0 GOTO 105 END INTEGER FUNCTION WEEKDY(MM,DD,YY) C C THIS FUNCTION DETERMINES THE DAY OF THE WEEK FOR C VALID CALENDAR DATES (MMDDYY) WITHIN THIS CENTURY (1901-2000). C C MM - INTEGER MONTH (1-12) C DD - INTEGER DAY (1-31) C YY - INTEGER YEAR (0-99) (0 MEANS THE YEAR 2000) C C RETURNS - INTEGER DAY OF WEEK (1-7) (SUNDAY = 1, SATURDAY = 7) C INTEGER MM,DD,YY INTEGER NUM(12) DATA NUM/31,29,31,30,31,30,31,31,30,31,30,31/ C WEEKDY = 0 C C VALID INPUT? C IF(YY.LT.0.OR.YY.GT.99.OR.MM.LT.1.OR.MM.GT.12.OR.DD.LT.1) GOTO 999 IF(DD.GT.NUM(MM).OR.(MM.EQ.2.AND.MOD(YY,4).NE.0.AND.DD.GT.28)) * GOTO 999 C C ADJUST INPUT VALUES C IY = YY IF (YY .EQ. 0) IY = 100 IF (MM .GT. 2) GOTO 10 IM = MM+10 IY = IY-1 GOTO 20 10 CONTINUE IM = MM-2 20 CONTINUE C C COMPUTE DAY C WEEKDY = MOD((DD+(26*IM-2)/10+IY+IY/4+1),7)+1 C C DONE! C 999 CONTINUE RETURN END