Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50437/replib.for
There are no other files named replib.for in the archive.
SUBROUTINE SKONTM(TIME,UNIT)
C
C --SKIP LINE EVERY FOUR HOURS
C
INTEGER TIME,UNIT
IF ((TIME .EQ. 4) .OR. (TIME .EQ. 8) .OR. (TIME .EQ. 12)
1.OR. (TIME .EQ. 16) .OR. (TIME .EQ. 20)) GOTO 10
RETURN
10 WRITE(UNIT,20)
RETURN
20 FORMAT(1X)
END
INTEGER FUNCTION MAKSEC(A,B)
INTEGER A,B
C
C --RETURN NUMBER OF SECONDS BETWEEN A AND B
C
I = A-B
IF (I .LT. 0) I = -I
MAKSEC = I*60
RETURN
END
SUBROUTINE GETFNM(FNAME)
IMPLICIT INTEGER(A-Z)
COMMON/FILE/ XXX
DOUBLE PRECISION FNAME,CDAT,XXX
10 FORMAT(' BOSS REPORT GENERATOR',/' DATE(IN CODED FORMAT
1): ',$)
WRITE(5,10)
20 FORMAT(A6)
30 FORMAT(O6,'.BOS')
60 FORMAT(A6,'.BOS')
READ(5,20) CDAT
IF (CDAT .EQ. 'YDAY') GOTO 70
IF (CDAT .EQ. 'TDAY') GOTO 70
ENCODE(10,60,FNAME) CDAT
GOTO 80
70 X = GETTAB("53,"11)
X = LSH(X,-18)
IF (CDAT .EQ. 'YDAY') X = X-1
ENCODE(10,30,FNAME) X
40 FORMAT(' MAKE PLOT REPORTS? ',$)
50 FORMAT(A3)
80 WRITE(5,40)
READ(5,50) YES
I7 = 0
IF (YES .EQ. 'YES') I7 = 1
CALL PLTINI(I7)
XXX = FNAME
RETURN
END
SUBROUTINE OUTDAT(UNIT)
INCLUDE 'SYSREP.PRM'
C
C OUTPUT DATE AND SYSTEM NAME ON SPECIFIED UNIT
C
DOUBLE PRECISION WKDAY
DIMENSION MNTH(12),NAME(4)
DATA MNTH/'Jan','Feb','Mar','Apr','May','Jun','Jul'
1,'Aug','Sep','Oct','Nov','Dec'/
DAY = REC000(8,1)
MONTH = MNTH(REC000(7,1))
YEAR = REC000(6,1)-1900
CALL DAYID(WKDAY)
DO 10 I = 1,4
10 NAME(I) = REC000(I+1,1)
NL = REC000(12,1)
20 FORMAT(18X,A10,I2,'-',A3,'-',I2,3X,4A5,A5,/)
WRITE(UNIT,20) WKDAY,DAY,MONTH,YEAR,NAME,NL
RETURN
END
SUBROUTINE DTOUT(A,B,C)
INCLUDE 'SYSREP.PRM'
X = REC000(10,C)
A = 0 ; B = 0
IF (X.EQ. 0) RETURN
A = X/10
B = X-(A*10)
RETURN
END
Subroutine DAYID(wkday)
Include 'Sysrep.Prm'
Double Precision Dayx(7),wkday
Data Dayx/'Monday','Tuesday','Wendesday','Thursday',
1'Friday','Saturday','Sunday'/
C
C --Get date information
C
IYR = Rec000(6,1) !Year
IMN = Rec000(7,1) !Month
IDY = Rec000(8,1) !Day
C
C --Get day of week
C
Call Calday(IYR,IMN,IDY,I)
IF (I .EQ. 0) I = 7
wkday = Dayx(I)
Return
End