Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
C DESCRIPTION OF STRATA JUNE 22, 1966
C THIS IS A SIFTED VERSION OF BMD06D ORIGINALLY WRITTEN IN
C FORTRAN II. SOME MODIFICATIONS WERE MADE TO MAKE IT OPERABLE
C AND SLIGHTLY MORE EFFICIENT THAN THE SIFTED VERSION.
DOUBLE PRECISION A1,A2,A3,FINISH,PROBLM
DIMENSION X(400,25),SCALE(30),NCO(29),XMEAN(30),XINT(22),VAR(30),
1STD(30),SUM(30),SQ(30),STE(30),R(30,30),CD(30,30),NT(30),TD(30),
2FMT(180)
C
DATA PROBLM,FINISH,A2,A3/6HPROBLM,6HFINISH,6HSELECT,6HINTRVL/
C
NTAPE=5
CALL USAGEB('BMD06D')
EXT=10000.0*10000.0*10000.0
C
921 FORMAT (45H1BMD06D - DESCRIPTION OF STRATA - VERSION OF
118HJUNE 22, 1966 ,/
241H HEALTH SCIENCES COMPUTING FACILITY, UCLA)
C
5 READ (5,900)A1,PROB,NV,N,NVG,NJ,NS,MTAPE,KVR
IF(A1.EQ.PROBLM) GO TO 10
6 IF(A1.EQ.FINISH)GO TO 200
WRITE(6, 400) A1
7 WRITE (6,922)
GO TO 200
10 CALL TPWD(MTAPE,NTAPE)
19 WRITE (6,921)
MV=NV+NJ
WRITE (6,901)PROB,N,MV
IF(KVR.GT.0.AND.KVR.LE.10)GO TO 20
KVR=1
WRITE(6,4000)
20 KVR=KVR*18
READ (5,919)(FMT(I), I=1,KVR)
WRITE(6, 8000) (FMT(I), I=1,KVR)
8000 FORMAT(' VARIABLE FORMAT CARD(S)'/1X,18A4)
IF((N-2)*(N-701)) 205,500,500
205 IF((NV-1)*(NV-31)) 207,501,501
207 IF((MV-1)*(MV-31)) 21,502,502
500 WRITE(6, 600)
GO TO 7
501 WRITE(6, 601)
GO TO 7
502 WRITE(6, 602)
GO TO 7
21 DO 23 I=1,N
23 READ (NTAPE,FMT)(X(I,J), J=1,NV)
IF(NVG)30,30,27
27 CALL TRANZ (X,NV,N,IERROR,NVG)
NV=NV+NJ
IF(IERROR)28,30,30
28 DO 29 IJ=1,NS
READ (5,904)A1,NC,NI,NN,(NCO(I),I=1,29)
NB=NI+1
L1=2
IF(20-NI)281,282,282
281 NI=20
282 IF(11-NI)283,288,288
283 L1=13
READ (5,905)A1,(XINT(I),I=2,12)
288 READ (5,905)A1,(XINT(I),I=L1,NB)
29 CONTINUE
GO TO 5
30 DO 120 IJ=1,NS
TEST=0.0
WRITE (6,914)IJ
READ (5,904)A1,NC,NI,NN,(NCO(I),I=1,29)
IF(A1 .EQ. A2) GO TO 25
WRITE(6, 401) A1
24 WRITE (6,923)IJ
TEST=-1.0
25 NB=NI+1
L1=2
IF(20-NI)251,252,252
251 NI=20
WRITE(6, 402)
GO TO 24
252 IF(11-NI)253,258,258
253 L1=13
READ (5,905)A1,(XINT(I),I=2,12)
IF(A1 .NE. A3) GO TO 26
258 READ (5,905)A1,(XINT(I),I=L1,NB)
IF(A1 .EQ. A3) GO TO 275
WRITE(6, 403) A1
26 WRITE (6,924)IJ
GO TO 120
275 IF(TEST)120,285,285
285 ASSIGN 105 TO NNN
NA=2
ND=NI+2
XINT(1)=-EXT
XINT(ND)=EXT
31 DO 100 IK=NA,NB
IV=IK-1
ON=0.0
DO 32 I=1,NV
SUM(I)=0.0
SQ(I)=0.0
DO 32 J=1,NV
32 CD(I,J)=0.0
NNP=NN+1
DO 45 JK=1,N
IF(X(JK,NC)-XINT(IK-1)) 45, 33, 33
33 IF(X(JK,NC)-XINT(IK)) 35, 45, 45
35 STD(1)=X(JK,NC)
ON=ON+1.0
DO 37 I=1,NN
L=I+1
LL=NCO(I)
37 STD(L)=X(JK,LL)
DO 40 I=1,NNP
SUM(I)=SUM(I)+STD(I)
SQ(I)=SQ(I)+STD(I)*STD(I)
DO 40 J=1,NNP
40 CD(I,J)=CD(I,J)+STD(I)*STD(J)
45 CONTINUE
IF(ON-1.0) 60, 60, 46
46 ONN=SQRT(ON)
DO 50 I=1,NNP
XMEAN(I)=SUM(I)/ON
SCALE(I)=SQ(I)-((SUM(I)*SUM(I))/ON)
IF(SCALE(I))47,48,48
C
C SCALE(I) CANNOT BE NEGATIVE. IF IT IS IT IS JUST A ROUNDING ERROR.
C
47 SCALE(I)=0.0
48 VAR(I)=SCALE(I)/(ON-1.0)
STD(I)=SQRT(VAR(I))
50 STE(I)=STD(I)/ONN
DO 55 I=1,NNP
DO 55 J=1,NNP
R(I,J)=CD(I,J)-((SUM(I)*SUM(J))/ON)
IF(SCALE(I)*SCALE(J))1000,1000,53
1000 R(I,J)=999.99
GO TO 55
53 R(I,J)=R(I,J)/SQRT(SCALE(I)*SCALE(J))
55 CONTINUE
60 IF(IK-2) 62, 62, 70
62 WRITE (6,906)IV,XINT(2)
65 IF(ON-1.0)66,166,90
166 WRITE (6,920)
WRITE (6,911)
LL=ON
WRITE (6,913)NC,LL,SUM(1)
WRITE (6,912)
DO 170 I=1,NN
L=I+1
170 WRITE (6,913)NCO(I),LL,SUM(L)
GO TO 100
66 MM=ON
WRITE (6,907)MM
GO TO 100
70 IF(IK-ND) 75, 80, 80
75 WRITE (6,915)
WRITE (6,908)IV,XINT(IV),XINT(IK)
GO TO 65
80 WRITE (6,915)
WRITE (6,909)IV,XINT(IV)
GO TO 65
90 WRITE (6,910)
WRITE (6,911)
LL=ON
WRITE (6,913)NC,LL,XMEAN(1),VAR(1),STD(1),STE(1)
WRITE (6,912)
DO 95 I=1,NN
L=I+1
95 WRITE (6,913)NCO(I),LL,XMEAN(L),VAR(L),STD(L),STE(L)
WRITE (6,916)
WRITE (6,917)NC
WRITE (6,918)(R(1,J),J=1,NNP)
DO 97 I=2,NNP
II=I-1
WRITE (6,917)NCO(II)
97 WRITE (6,918)(R(I,J),J=1,NNP)
100 CONTINUE
GO TO NNN, (105, 110)
105 ASSIGN 110 TO NNN
NA=ND
NB=ND
GO TO 31
110 CONTINUE
120 CONTINUE
GO TO 5
C
400 FORMAT(' PROGRAM EXPECTED PROBLM OR FINISH CARD INSTEAD READ THE
1 FOLLOWING'/1X,A6)
401 FORMAT(' PROGRAM EXPECTED SELECT CARD INSTEAD READ THE FOLLOWING'/
11X,A6)
402 FORMAT(' NUMBER OF CONSTANTS USED TO DEFINE INTERVALS CANNOT EXCEE
1D 20')
403 FORMAT(' PROGRAM EXPECTED INTRVL CARD INSTEAD READ THE FOLLOWING'/
11X,A6)
600 FORMAT(' NUMBER OF CASES INCORRECTLY SPECIFIED')
601 FORMAT(' NUMBER OF VARIABLES INCORRECTLY SPECIFIED')
602 FORMAT(' NUMBER OF VARIABLES AFTER TRANSGENERATION CANNOT EXCEED 3
10')
900 FORMAT(A6,A2,I2,I3,4I2,49X,I2)
901 FORMAT(14H0PROBLEM NO. A2/12H SAMPLE SIZEI4/20H NUMBER OF VARIABL
1ESI4)
904 FORMAT(A6,32I2)
905 FORMAT(A6,11F6.0)
906 FORMAT(9H0INTERVALI3,8H (BELOWF10.2,1H))
907 FORMAT(30H0FREQUENCY IN THIS INTERVAL ISI4)
908 FORMAT(9H0INTERVALI3,24H (EQUAL OR GREATER THANF10.2,15H BUT LES
1S THANF10.2,1H))
909 FORMAT(9H0INTERVALI3,24H (EQUAL OR GREATER THANF10.2,1H))
910 FORMAT(95H0 FREQUENCY MEAN
1VARIANCE STD. DEV. STD. ERROR)
911 FORMAT(22H CONDITIONING VARIABLE)
912 FORMAT(22H CONDITIONED VARIABLES)
913 FORMAT(5X,I6,15X,I7,F17.5,3F15.5)
914 FORMAT(1H0////10H SELECTIONI4//)
915 FORMAT(1H0)
916 FORMAT(25H0CORRELATION COEFFICIENTS)
917 FORMAT(9H0VARIABLEI3)
918 FORMAT(10F12.5)
919 FORMAT(18A4)
920 FORMAT(1H027X,11HSINGLE CASE5X,5HVALUE)
922 FORMAT(22H0ERROR ON PROBLEM CARD)
923 FORMAT(24H0ERROR ON SELECTION CARDI4)
924 FORMAT(23H0ERROR ON INTERVAL CARDI4)
4000 FORMAT(1H023X71HNUMBER OF VARIABLE FORMAT CARDS INCORRECTLY SPECIF
1IED, ASSUMED TO BE 1.)
C
200 IF(NTAPE-5)202,202,201
201 REWIND NTAPE
202 STOP
END
C SUBROUTINE TPWD FOR BMD06D JUNE 22, 1966
SUBROUTINE TPWD(NT1,NT2)
IF(NT1)40,10,12
10 NT1=5
12 IF(NT1-NT2)14,19,14
14 IF(NT2.EQ.5) GO TO 18
17 REWIND NT2
19 IF(NT1-5)18,24,18
18 IF(NT1-6)22,40,22
22 REWIND NT1
24 NT2=NT1
28 RETURN
40 WRITE (6,49)
49 FORMAT(25H ERROR ON TAPE ASSIGNMENT)
STOP
END
C SUBROUTINE TRANZ FOR BMD06D JUNE 22, 1966
SUBROUTINE TRANZ (DATA,NVAR,NSAM,IERROR,NVG)
DOUBLE PRECISION A1,A2
DIMENSION DATA(400,25)
ASN(XX)=ATAN(XX/SQRT(1.0-XX**2))
DATA A2/6HTRNGEN/
MARY=0
FN=NSAM
WRITE (6,1403)
WRITE (6,1400)
IERROR=0
DO1000 J=1,NVG
READ (5,1100)A1,NEWA,LCODE,LVA,BNEW
IF(A1 .EQ. A2) GO TO 2
WRITE(6, 400) A1
1 WRITE (6,1406)J
IERROR=-999
2 IF(IERROR)1000,6,6
6 WRITE (6,1402)J,NEWA,LCODE,LVA,BNEW
IF(LCODE-11)4,5,5
5 NEWB=BNEW
4 DO 300 I=1,NSAM
D=DATA(I,LVA)
IF(LCODE*(LCODE-15)) 200,500,500
500 WRITE(6, 600)
GO TO 1
200 GOTO(10,20,30,40,50,60,70,80,90,100,110,120,130,140),LCODE
10 IF(D)99,7,8
7 D1=0.0
GO TO 3
8 D1=SQRT(D)
GO TO 3
20 IF(D)99,11,12
11 D1=1.0
GO TO 3
12 D1=SQRT(D)+SQRT(D+1.0)
GO TO 3
30 IF(-D)14,99,99
14 D1=ALOG10(D)
GO TO 3
40 D1=EXP(D)
GO TO 3
50 IF(-D)17,7,99
17 IF(D-1.0)18,19,99
18 D1=ASN(SQRT(D))
GO TO 3
19 D1=3.14159265/2.0
GO TO 3
60 A=D/(FN+1.0)
B=A+1.0/(FN+1.0)
IF(A)99,23,24
23 IF(-B)27,7,99
27 D1=ASN(SQRT(B))
GO TO 3
24 IF(B)99,28,29
28 D1=ASN(SQRT(A))
GO TO 3
29 D1=ASN(SQRT(A))+ASN(SQRT(B))
GO TO 3
70 IF(D)31,99,31
31 D1=1.0/D
GO TO 3
80 D1=D+BNEW
GO TO 3
90 D1=D*BNEW
GO TO 3
100 IF(D)33, 7,33
33 D1=D**BNEW
GO TO 3
110 D1=D+DATA(I,NEWB)
GO TO 3
120 D1=D-DATA(I,NEWB)
GO TO 3
130 D1=D*DATA(I,NEWB)
GO TO 3
140 IF(DATA(I,NEWB))34,99,34
34 D1=D/DATA(I,NEWB)
GO TO 3
99 IF(MARY)43,44,44
44 MARY=-999
IERROR=-999
WRITE (6,1404)J
43 WRITE (6,1405)I
GO TO 300
3 DATA(I,NEWA)=D1
300 CONTINUE
1000 CONTINUE
IF(IERROR)42,1111,1111
42 WRITE (6,1401)
400 FORMAT(' PROGRAM EXPECTED TRNGEN CARD INSTEAD READ THE FOLLOWING'/
11X,A6)
600 FORMAT(' ONLY CODES 01 THROUGH 14 OF THE TRANSGENERATION LIST MAY
1 BE USED')
1100 FORMAT(A6,I3,I2,I3,F6.0)
1400 FORMAT(46H0CARD NEW TRANS ORIG. ORIG. VAR(B)/45H NO.
1VARIABLE CODE VAR(A) OR CONSTANT)
1401 FORMAT(41H0PROGRAM CANNOT CONTINUE FOR THIS PROBLEM)
1402 FORMAT(2H I2,I8,2I9,4X,F10.5)
1403 FORMAT(1H06X,23HTRANS GENERATOR CARD(S))
1404 FORMAT(55H0THE INSTRUCTIONS INDICATED ON TRANS GENERATOR CARD NO.I
12,1X,3HRE-/60H SULTED IN THE VIOLATION OF A RESTRICTION FOR THIS T
2RANSFOR-/59H MATION. THE VIOLATION OCCURRED FOR THE ITEMS LISTED B
3ELOW.)
1405 FORMAT(10H ITEM NO. I5)
1406 FORMAT(34H0ERROR ON TRANSGENERATION CARD NO.I4)
1111 RETURN
END