Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0137/cross/cross.for
There are 3 other files named cross.for in the archive. Click here to see a list.
C WESTERN MICHIGAN UNIVERSITY
C CROSS.F4 (FILE NAME ON LIBRARY DECTAPE)
C CROSS, 1.1.6 (CALLING NAME, SUBLST NO.)
C CROSS TABULATION WITH CHI-SQUARE
C THIS PROGRAM WAS TAKEN FROM THE BOOK "DATA PROCESSING"
C BY K. JANDA. SEVERAL MODIFICATIONS WERE MADE TO MAKE
C IT COMPATIBLE AND SOME ADDITIONAL FEATURES WERE ADDED BY
C SAM ANEMA.
C LIBRARY DECTAPE PROGS. USED: USAGE.MAC
C FORWMU PROGS. USED: TTYPTY, EXISTS, PRINTS, DEVCHG
C APLIB PROGS. USED: IO, GETFOR
C INTERNAL SUBR. USED: COEFT
C ABOVE COMMENTS AND RIGHT ADJUSTED COMMENTS PUT IN BY WG
C
DIMENSION LAD(200,40), MAX(40), KIND(40),KONST(40),MBRAK(16)
DIMENSION FMT(48), NTAB(101,21), NRTOT(101), NCLT(21),LOB(16)
DIMENSIONTAB(101,21),RTOT(101), CLT(21), PCENT(21)
DIMENSION NDEEP(72), NDIM(4,72), MXTEMP(4)
DIMENSION STORE(40,12)
DIMENSION CKK(16)
C
C
EQUIVALENCE (NTAB,TAB)
NOUTD=-1
IND=-4
INP=2
IOUT=3
C---------------TTYPTY RETURNS 0 - TTY JOB, MINUS ONE - BATCH JOB
CALL TTYPTY(ICODE)
WRITE(NOUTD,8745)
8745 FORMAT(20X,'PDP-10 VERSION OF NUCROS')
7 FORMAT(40I2)
C CALL USAGE('CROSS')
C
C READ AND PRINTTITLES
C---------------NDV1, NDV2 ARE RETURNED. OTHER ARGS. ARE INPUT.
C--------------- 1 MEANS OUTPUT? PRINTS, 0 - INPUT? PRINTS
CALL IO(IOUT,NDV1,NOUTD,IND,1,ICODE)
500 CALL IO(INP,NDV2,NOUTD,IND,0,ICODE)
C---------------FMT, ISTD ARE RETURNED. OTHER ARGS. ARE INPUT.
C--------------- 48=NO. OF OBJ. TIME FORMAT WORDS (3 LINES).
C--------------- 1 MEANS I TYPE FORMAT ONLY.
CALL GETFOR(NOUTD,IND,FMT,ISTD,48,1)
REWIND 20
REWIND 21
REWIND 22
800 FORMAT(1H1)
WRITE(NOUTD,1002)
1002 FORMAT(' ENTER IDENTIFICATION'/)
READ(IND,10)(CKK(I),I=1,16)
WRITE(IOUT,5)(CKK(I),I=1,16)
5 FORMAT(1X,16A5)
C
C READ CONTROL CARDS 4-8
230 WRITE(NOUTD,1003)
1003 FORMAT(' ENTER PROBLEM CONTROL PARAMETERS'/)
READ(IND,1001)NOBS,NVAR,NTABLE,IDVAR,NCODE,NCHI,NPCT,
1NTAU
1001 FORMAT(10I)
IF(NVAR.LT.2.OR.NVAR.GT.40)GO TO 217
IF(NTABLE .LT.1.OR.NTABLE.GT.72)GO TO 218
GO TO 219
217 WRITE(NOUTD,220)
220 FORMAT(' ILLEGAL NUMBER OF VARIABLES SPECIFIED.'/)
IF(ICODE.EQ.-1)CALL EXIT
GO TO 230
218 WRITE(NOUTD,221)
221 FORMAT(' ILLEGAL NUMBER OF TABLES SPECIFIED'/)
IF(ICODE.EQ.-1)CALL EXIT
GO TO 230
219 LCHI=0
IF(NCHI.GT.0.OR.NTAU.GT.0)LCHI=1
10 FORMAT(16A5)
IF(NDV1.NE.'TTY')WRITE(IOUT,690)(FMT(I),I=1,48)
690 FORMAT(' FORMAT OF DATA'/(' ',16A5))
LPCT = MIN0(NPCT,1)
WRITE (IOUT,185) NOBS
WRITE(NOUTD,1006)
1006 FORMAT(//' ENTER MAXIMUM VALUES'/)
READ (IND,1012) (MAX(J),J=1,NVAR)
WRITE (IOUT,9)(J,J=1,NVAR)
WRITE(IOUT,423) (MAX(J),J=1,NVAR)
6 FORMAT(I4,9I2)
185 FORMAT(/20H TOTAL CASES USED = I4)
780 FORMAT (1H0)
423 FORMAT(11H MAX.VALUE ,40I3)
9 FORMAT(//11H VARIABLE , 40I3)
C
C READ + PRINT CONTOL CDS 9,10,11,12.. DETERMINE ALL TABLE DEPTHS
WRITE(NOUTD,1007)
1007 FORMAT(//' ENTER TABLE CONTROL PARAMETERS'/)
1012 FORMAT(30I2)
DO 1000 I=1,4
1000 READ (IND,1012) (NDIM(I,K),K=1,NTABLE)
DO472 K=1,NTABLE
NDEEP(K) =2
DO 472 I=3,4
IF (NDIM(I,K))472,472,470
470 NDEEP(K)=I
472 CONTINUE
WRITE (IOUT,424)
IF(NTABLE-36)9001,9001,9002
9001 WRITE(IOUT,781)
GO TO 9003
9002 WRITE (IOUT,426)
9003 CONTINUE
LTABLE = MIN0(NTABLE,36)
DO 4 L=1,LTABLE
K=L
NDEPTH = NDEEP(K)
WRITE (IOUT,8) K,(NDIM(I,K),I=1,NDEPTH)
DO 550 I = 1,NDEPTH
J = NDIM(I,K)
550 MXTEMP(I) = MAX(J)
WRITE(IOUT,425) (MXTEMP(I),I=1,NDEPTH)
K=L+36
IF (K .GT. NTABLE) GO TO 427
NDEPTH = NDEEP(K)
WRITE (IOUT,428) K,(NDIM(I,K),I=1,NDEPTH)
DO 429I=1,NDEPTH
J=NDIM(I,K)
429 MXTEMP(I) = MAX(J)
WRITE (IOUT,430) (MXTEMP(I),I=1,NDEPTH)
GO TO 4
427 CONTINUE
4 CONTINUE
8 FORMAT (1X,9XI6,7X,4I4)
424 FORMAT (//1H+,9X9HTABLE NO.,6X9HVARIABLES,7X14HMAXIMUM VALUES)
425 FORMAT (1H+,38X,4I4)
426 FORMAT ('+'75X9HTABLE NO.,6X9HVARIABLES,7X14HMAXIMUM VALUES)
428 FORMAT (1H+,74X,I6,7X,4I4)
430 FORMAT ('+'104X,4I4)
781 FORMAT (' ')
C
C READ AND PRINT RECODE-CONTROL-CARDS, IF RECODING OPTED
IF (NCODE) 20,20,19
19 WRITE(NOUTD,1014)
1014 FORMAT(' ENTER TWO RECODING LINES'/)
READ (IND,1012) (KIND(J),J=1,NVAR)
READ (IND,1012) (KONST(J),J=1,NVAR)
DO 400 J=1,NVAR
NOPER = KIND(J)
IF (NOPER-3) 400,400,403
403 WRITE(NOUTD,1015)
1015 FORMAT(' ENTER GROUP BOUNDARIES'/)
READ(IND,1019) MBRAK
1019 FORMAT(16I)
IF(NOPER.EQ.8)GO TO 650
DO 651 I=0,15
651 LOB(I+1)=I
GO TO 652
650 WRITE(NOUTD,653)
653 FORMAT(' ENTER CATEGORIZATION'/)
READ(IND,1019)LOB
652 WRITE (21) MBRAK,LOB
400 CONTINUE
WRITE(IOUT,186)
REWIND 21
DO 2200 J=1,NVAR
NOPER=KIND(J)
IF(NOPER)2200,2200,2202
2202 IF(NOPER-3)2201,2201,2203
2201 WRITE(IOUT,188)J,NOPER,KONST(J)
GO TO 2200
2203 READ(21)MBRAK,LOB
IF(NOPER.EQ.4)WRITE(IOUT,187)J,NOPER,MBRAK
IF(NOPER.GT.4.AND.NOPER.LT.8)WRITE(IOUT,9004)J,NOPER,KONST(J),MBRA
1K
IF(NOPER.EQ.8)WRITE(IOUT,660)J,NOPER,MBRAK,LOB
2200 CONTINUE
186 FORMAT (27H1RECODING OPTION CALLED FOR // 4X,67H VAR.NO. CODE
X CONSTANT RECODED CATEGORIES (UPPER LIMITS) )
188 FORMAT (8XI2,5XI1,4XI3,10X4HNONE)
187 FORMAT ( 8XI2,5XI1,4X4HNONE,16I3)
9004 FORMAT(8XI2,5XI1,4XI3,1X,16I3)
660 FORMAT(8X,I2,5X,I1,4X,'NONE',16I3/24X,16I3)
REWIND 21
C
C READ AND PRINT VAR NAMES IF OPTED
20 IF (IDVAR) 480,480,495
495 WRITE(NOUTD,1008)
1008 FORMAT(' ENTER VARIABLE NAMES'/)
DO 490 I=1,NVAR
490 READ(IND,82)(STORE(I,J),J=1,12)
WRITE(IOUT,83)
DO 1009 I=1,NVAR
1009 WRITE(IOUT,57)I,(STORE(I,J),J=1,12)
83 FORMAT (8H1VAR.NO.//)
82 FORMAT(12A5)
57 FORMAT(I5,2X,12A5)
C
C INITIALIZE FOR FIRST BATCH
480 NBATCH = MIN0 (NOBS,200)
NOBS = NOBS- NBATCH
IBATCH = 1
IF(NDV2.EQ.'TTY')GO TO 214
WRITE(NOUTD,3576)
GO TO 215
214 IF(ISTD.EQ.1)WRITE(NOUTD,216)
216 FORMAT(/' ENTER DATA (AT MOST 10 PER LINE)'/)
IF(ISTD.EQ.0)WRITE(NOUTD,3577)
3576 FORMAT(/' YOUR DATA IS BEING READ. PLEASE WAIT.'/)
3577 FORMAT(/' ENTER DATA'/)
215 IOSW = 24
LINE = 60
C
C
C READ A BATCH OF DATA CARDS
299 DO 3817 N=1,NBATCH
3817 READ(INP,FMT)(LAD(N,J),J=1,NVAR)
C
C RECODE VARIABLES IF OPTED
302 IF (NCODE) 485,485,483
483 DO 32 J = 1,NVAR
NOPER = KIND(J)
IF(NOPER) 32,32,176
176 GO TO (23,24,25,52,52,52,52,52 ), NOPER
C
C DO TYPE 1,2,OR 3 RECODING
23 DO 1201 I=1,NBATCH
1201 LAD(I,J) = LAD(I,J)+KONST (J)
GO TO 32
24 DO1203 I = 1,NBATCH
1203 LAD(I,J) = MAX0(LAD(I,J)-KONST(J),0)
GO TO 32
25 DO1202 I= 1,NBATCH
1202 LAD(I,J)= LAD(I,J) /KONST(J)
GO TO 32
C
C DO TYPE 4 REC DING
52 READ (21) MBRAK,LOB
DO 29 I = 1,NBATCH
DO 28 K = 1,16
IF(LAD(I,J)-MBRAK(K)) 27,27,28
28 CONTINUE
LAD(I,J) = 20
GO TO 29
27 LAD(I,J) =LOB(K)
29 CONTINUE
IF(NOPER.EQ.8)GO TO 32
IF(NOPER-4) 32,32,7638
7638 NOPER= NOPER-4
GO TO 176
32 CONTINUE
REWIND 21
C
C DEFINE TABLE DEPTH,MAX VAL, VARS TO BE USED...FOR EACH TABLE
485 DO 115 KT=1,NTABLE
NDEPTH = NDEEP(KT)
J1 = NDIM(1,KT)
J2 = NDIM(2,KT)
MAXA = MAX(J1) +1
MAXB = MAX(J2) +1
MAXC = 0
MAXD = 0
LREQ = 10 + MAXB + 2*LCHI
LREQPC = LPCT * (MAXB-1+6)
GO TO (36,36,33,34),NDEPTH
34 J4 = NDIM(4,KT)
MAXD = MAX(J4)
33 J3 = NDIM(3,KT)
MAXC = MAX(J3)
LREQ = LREQ +2
C
36 DO 115 L3 = 0,MAXC
DO 115 L4 = 0,MAXD
IF (IBATCH-1) 41,41,42
C ZERO OUT TABLE AREA IF FIRST BATCH
41 DO 43 I=1,MAXB
DO 43 J=1,MAXA
43 NTAB(I,J) = 0
GO TO 44
C OTHERWISE READ INTO TABLE-AREA STORED-RESULTS FROM PREVIOUS BATCH(ES)
42 IF (IOSW-24) 46,46,47
46 READ (20) ((NTAB(I,J),J=1,MAXA),I=1,MAXB)
GO TO 44
47 READ (22) ((NTAB(I,J),J=1,MAXA),I=1,MAXB)
C
C DO A TABLE. TEST 3RD AND 4TH-DIMENSION VARIABLES FOR APPROP VALUE
C BEFORE COUNTING THE OBSERVATION (WHERE 3RD OR 4TH DIM IS USED)
44 DO 45 N=1,NBATCH
IF (NDEPTH-3) 40,35,39
39 IF (LAD(N,J4) -L4) 45,35,45
35 IF (LAD(N,J3) - L3) 45,40,45
40 L1 = LAD(N,J1) +1
L2 = LAD(N,J2) +1
IF (L1 .LT. 1 .OR. L2 .LT. 1) GO TO 45
IF (L1.GT.MAXA .OR. L2.GT.MAXB) GO TO 45
NTAB(L2,L1) = NTAB(L2,L1) +1
45 CONTINUE
C
C IF MORE OBSERVATIONS REMAIN, STORE THIS TABLE (RESULTS TO DATE)
IF (NOBS) 75,75,48
48 IF (IOSW-24) 50,50,60
50 WRITE (22) ((NTAB(I,J),J=1,MAXA),I=1,MAXB)
GO TO 115
60 WRITE (20) ((NTAB(I,J),J=1,MAXA),I=1,MAXB)
GO TO 115
C
C
C IF NO MORE OBSERVATIONS WRITE OUT THIS TABLE
75 LINE= LINE + LREQ
IF(LINE+2*LREQPC-58)431,431,811
431 WRITE(IOUT,780)
GO TO 76
811 WRITE (IOUT,800)
LINE=LREQ-1
76 GO TO (822,822,823,824),NDEPTH
C TWO-DIMENSION TITLE
822 IF(IDVAR)522,522,523
523 WRITE(IOUT,524)KT,J1,(STORE(J1,J),J=1,12),J2,(STORE(J2,J),J=1,12)
1 ,MAXA,MAXB
524 FORMAT(7X,11H TABLE NO. ,I3,10X,13HVARIABLE NO. ,I2,2X, 12A5,/
1 25X,6HVRS. ,13HVARIABLE NO. ,I2,2X,12A5, / 7X,13HTABLE SIZE =
2 I3,5H BY ,I3)
GO TO 86
522 WRITE (IOUT,80) KT,J1,J2,MAXA,MAXB
80 FORMAT ( 10X,11H TABLE NO. I3,5X,13HVARIABLE NO. I2,3X,
1 9HVRS. NO. , I2//13X,13HTABLE SIZE = I3,5H BY I3)
GO TO 86
C THREE DIMENSIOANL TITLE
823 IF (IDVAR)525, 525,526
526 WRITE(IOUT,527) KT,J1,(STORE (J1,J),J=1,12),J2,(STORE(J2,J),J=1,12
1),J3,(STORE(J3,J),J=1,12), MAXA,MAXB,L3
527 FORMAT(7X,11H TABLE NO. , I3,10X,13HVARIABLE NO. I2,2X,12A5,
1 2(/25X,6HVRS ,13HVARIABLE NO. I2,2X,12A5) //7X,
213HTABLE SIZE = I3,5H BY I3,10X,16H 3RD DIMENSION = I3)
GO TO 86
525 WRITE (IOUT,77) KT,J1,J2,J3, MAXA,MAXB,L3
77 FORMAT(10X,11HTABLE NO. I3,5X,13HVARIABLE NO I2,3X,9HVRS NO.
1I2,3X,9HVRS. NO. I2,///13X,13HTABLE SIZE = I3,5H BY I3//13X,
216H3RD DIMENSION = I3)
GO TO 86
C FOUR DIMENSION TITLE
824 IF(IDVAR)528,528,529
529 WRITE(IOUT,530)KT,J1,(STORE(J1,J),J=1,12),J2,(STORE(J2,J),J=1,12),
1J3,(STORE(J3,J),J=1,12),J4,(STORE(J4,J),J=1,12),MAXA,MAXB,L3,L4
530 FORMAT(7X,11H TABLE NO. I3,10X,13HVARIABLE NO. I2,2X, 12A5,
13(/25X,6HVRS. ,13HVARIABLE NO. I2,2X, 12A5) //7X,
213HTABLE SIZE = I3,5H BY I3,10X,16H3RD DIMENSION = I3,5X,
316H4TH DIMENSION = I3)
GO TO 86
528 WRITE(IOUT,72) KT,J1,J2,J3,J4,MAXA,MAXB,L3,L4
72 FORMAT (10X,11H TABLE NO. I3,5X,13HVARIABLE NO. I2,3X,9HVRS.
1NO. I2,3X,9HVRS NO. I2,3X,9HVRS NO. I2//13X,13HTABLE SIZE =
2I3,5H BY I3//13X,16H3RD DIMENSION = I3,5X,16H4TH DIMENSION = I3)
86 CONTINUE
C
C
C PRINT BODY OF MAP,COMPUTE AND PRINT COLUMN AND ROW TOTALS
84 MSUB = MAXA-1
WRITE (IOUT,91) (IH,IH=0,MSUB)
WRITE (IOUT,781)
NGRTO=0
DO 85 J=1,MAXA
85 NCLT(J)=0
DO 100 I=1,MAXB
ISUB = I-1
NRTOT(I)=0
DO 90 J=1,MAXA
NRTOT(I)= NRTOT(I) + NTAB(I,J)
90 NCLT(J)= NCLT(J)+NTAB (I,J)
WRITE(IOUT,105) ISUB,NRTOT(I),(NTAB(I,J),J=1,MAXA)
100 NGRTO = NGRTO+NRTOT(I)
WRITE (IOUT,106) NGRTO,(NCLT(J),J=1,MAXA)
91 FORMAT (/17X,3HTOT,3X,21I5)
105 FORMAT(9X,I3,I8,3X,21I5)
106 FORMAT (/9X5HTOTAL,I6,3X,21I5)
C
C
C DO CHISQARES +/OR PERCENTS +/OR COEFFICIENTS IF OPTED
C GET FLOATING _PT EQUIVALENTS..DEDUCT ZEROROW,COLUMN FROM TOTALS
IF(NCHI +NPCT + NTAU) 115,115,404
404 DO 407 I=1,MAXB
RTOT(I)=NRTOT(I)
DO 407 J=1,MAXA
407 TAB(I,J) = NTAB (I,J)
DO 405 I=1,MAXA
405 CLT(I)=NCLT(I)
GRTO=NGRTO
C
IF(NCHI+NTAU) 410,410,605
605 IF (NCHI) 606,606,408
606 WRITE (IOUT,781)
GO TO 304
408 CHISQ = 0.0
IF(NGRTO.NE.0)GO TO 1071
CHISQ=0.
CRXC=0.
GO TO 1070
1071 DO 409 I=1,MAXB
DO409 J=1,MAXA
A= (CLT(J)*RTOT(I)) /GRTO
B= (TAB(I,J)-A )**2
IF(A.NE.0.)GO TO 409
A=1.
B=0.
409 CHISQ = CHISQ + B/A
CRXC=( CHISQ/(CHISQ+GRTO)) **.5
1070 WRITE(IOUT,608) CHISQ,CRXC
608 FORMAT(/1H+,6X,12HCHI SQUARE = ,F8.3,3X,4HC = ,F5.3)
IF(MAXB.NE.2.OR.MAXA.NE.2)GO TO 631
A=TAB(1,1)
B=TAB(1,2)
C=TAB(2,1)
D=TAB(2,2)
C22=GRTO*(ABS(A*D-B*C)-GRTO/2)**2/((A+B)*(C+D)*(A+C)*(B+D))
WRITE(IOUT,632)C22
632 FORMAT(4X,'2X2 CORRECTED CHI-SQUARE = ',F8.3)
631 IF(NTAU) 604,604,304
604 WRITE(IOUT,781)
GO TO 410
C
C
C DO ALL CORRELATION COEFFICIENTS
C NTAU IS NOT USED BY THE SUBROUTINE BUT MAY BE USED TO
C EXERCISE OPTIONS IN ALTERNATE SUBROUTINES
304 CALL COEFT (TAB,MAXB,MAXA,NTAU)
C
C
C DO COLUMN PERCENTAGES
410 IF (NPCT) 115,115,411
411 LINE = LINE +LREQPC
IF (LINE-58) 412,412,413
412 WRITE (IOUT,108)
GO TO 414
413 WRITE (IOUT,800)
WRITE (IOUT,108)
WRITE (IOUT,113) (IH,IH=0,MSUB)
WRITE (IOUT,781)
LINE = LREQPC + 3
108 FORMAT(//7X,40HPERCENTS BY COLUMN FROM THE ABOVE MATRIX //)
113 FORMAT (17X,3HTOT,8X,20I5 )
C
414 DO 416 I = 1,MAXB
ISUB = I-1
DO 415 J = 1,MAXA
IF(CLT(J).NE.0.)GO TO 1080
PCENT(J)=0.
GO TO 415
1080 PCENT(J) = TAB(I,J) / CLT(J)
415 CONTINUE
416 WRITE(IOUT,109) ISUB,NRTOT(I), (PCENT(J),J = 1,MAXA)
WRITE (IOUT,111) NGRTO,(NCLT(J), J=1,MAXA )
109 FORMAT (9X,I3,I8,9X,2P20F5.1)
111 FORMAT(/9X,5HTOTAL, I6,8X,20I5 )
C
C DO ROW PERCENTS
LINE = LINE+ LREQPC
IF(LINE-58) 417,417,418
417 WRITE( IOUT,114)
GO TO 419
418 WRITE( IOUT,800)
WRITE (IOUT,114)
WRITE (IOUT,113) (IH,IH=0,MSUB)
WRITE (IOUT,781)
LINE = LREQPC + 3
114 FORMAT(//7X,38HPERCENTS BY ROW FROM THE ABOVE MATRIX //)
C
419 DO 421 I= 1,MAXB
ISUB = I-1
DO 420 J= 1,MAXA
IF(RTOT(I).NE.0.)GO TO 1081
PCENT(J)=0.
GO TO 420
1081 PCENT(J) = TAB (I,J) / RTOT(I)
420 CONTINUE
421 WRITE (IOUT,109) ISUB,NRTOT(I),(PCENT(J),J=1,MAXA)
WRITE (IOUT,111) NGRTO, (NCLT(J),J=1,MAXA)
115 CONTINUE
C
C
C PREPARE PROCESS NEXT BATCH IF ANY
IF (NOBS) 500,500,130
130 NBATCH = MIN0 (NOBS,200)
NOBS = NOBS-NBATCH
IBATCH = IBATCH + 1
IF(IOSW-24) 12,12,13
12 IOSW = 42
GO TO 15
13 IOSW = 24
15 REWIND 20
REWIND 22
GO TO 299
END
C---------------NTAU APPARENTLY NOT USED. OTHER ARGS. ARE INPUT.
SUBROUTINE COEFT(A,II,JJ,NTAU)
DIMENSION A(101,21), TI(101), TJ(21)
IOUT=3
SUM = 0.
DO 2 I = 1,II
DO 2 J = 1,JJ
2 SUM=SUM+A(I,J)
P=0.
IX = II-1
JX = JJ-1
DO 10 I=1,IX
DO 10 J=1,JX
IY=I+1
JY=J+1
DO 10 K=IY,II
DO 10 L=JY,JJ
10 P=P+A(I,J)*A(K,L)
Q=0.
DO 11 I=1,IX
DO 11J=2,JJ
IN=I+1
JY=J-1
DO 11 K=IN,II
DO 11 L=1,JY
11 Q = Q+A(I,J)*A(K,L)
S=P-Q
GAMMA=(P-Q)/(P+Q)
100 DO 21 I=1,II
TI(I)=0.
DO21 J=1,JJ
21 TI(I)=TI(I)+A( I,J)
DO 22 J=1,JJ
TJ(J)=0.
DO22 I=1,II
22 TJ(J)=TJ(J)+A(I,J)
I1=0
DO 105 I=1,II
105 IF(TI(I).NE.0.0)I1=I1+1
J1=0
DO 106 J=1,JJ
106 IF(TJ(J).NE.0.0)J1=J1+1
82 IF (I1-J1) 86,85,86
85 IPT = 2
GO TO 84
86 IPT = 3
84 CONTINUE
XU=0.
DO55 J=1,JJ
55 XU=XU + TJ(J)**2
XU=.5*(SUM**2-XU)
YU=0.
DO56 I=1,II
56 YU=YU+TI(I)**2
YU=.5*(SUM**2-YU)
DYX = S/XU
DXY=S/YU
IF(IPT-2) 57,57,102
57 CONTINUE
T=0.
DO 23 I=1,II
23 T=T+.5*TI(I)*(TI(I)-1.)
U=0.
DO24 J=1,JJ
24 U=U+.5*TJ(J)*(TJ(J)-1.)
BI=(SUM*(SUM-1.) *.5-T)**(.5)
BJ=(SUM*(SUM-1.) *.5-U)**(.5)
TAUB=S/(BI*BJ)
104 WRITE (IOUT,301) TAUB,GAMMA,DXY,DYX
RETURN
102 IF(I1-J1) 5,5,6
5 AM=I1
GO TO 12
6 AM=J1
12 TAUC=S/((.5*SUM**2*(AM-1.)/AM))
WRITE(IOUT,302) TAUC,GAMMA,DXY,DYX
RETURN
301 FORMAT(1H+,41X,8HTAU-B = ,F6.3,3X,8HGAMMA = ,F6.3,3X,6HDXY = ,
1F6.3,3X, 6HDYX = ,F6.3)
302 FORMAT(1H+,41X,8HTAU-C = ,F6.3,3X,8HGAMMA = ,F6.3,3X,6HDXY = ,
1F6.3,3X, 6HDYX = ,F6.3)
END