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