SUBROUTINE INV2(A,N,M,N1,N2,D,M1) IMPLICIT DOUBLE PRECISION (A-H,O-Z) DIMENSION A(M1,M1) SCALE=10000.0 DO 101 I=1,N DO 101 J=1,N 101 A(I,J)=A(I,J)/SCALE L=N+M D=1.0D0 DO 1 I=N1,N2 D=D*A(I,I) A(I,I)=1.0D0/A(I,I) DO 2 J=1,L IF(J-I) 3,2,3 3 A(I,J)=A(I,J)*A(I,I) 2 CONTINUE DO 1 J=1,N IF (J-I) 4,1,4 4 DO 6 K=1,L IF (K-I) 5,6,5 5 A(J,K)=A(J,K)-A(J,I)*A(I,K) 6 CONTINUE A(J,I)=-A(J,I)*A(I,I) 1 CONTINUE DO 102 I=1,N DO 102 J=1,N 102 A(I,J)=A(I,J)/SCALE 1000 RETURN END SUBROUTINE STAR(ASTAR,N,K,SS) DIMENSION A(20,20,3),ASTAR(20,20) INTEGER SS COMMON A DO 1 I=1,K DO 1 J=1,SS 1 ASTAR(I,J)=0 DO 2 I=1,K DO 2 J=I,SS DO 2 L=1,I 2 ASTAR(I,J)=ASTAR(I,J)+A(L,J,N) RETURN END SUBROUTINE SORT(A,M,N,K) DIMENSION A(K),M(K) DO 1 I=1,N 1 M(I)=I NN=N-1 DO 2 I=1,NN J=I 3 M1=M(J) M2=M(J+1) IF(A(M1).LE.A(M2))GO TO 2 SAVE=M(J) M(J)=M(J+1) M(J+1)=SAVE J=J-1 IF(J.GT.0)GO TO 3 2 CONTINUE RETURN END SUBROUTINE ROWCOL(N) C COMPUTES RROW,RCOL,QROW,ETC - WORKS WITH THE LARGER MATRIX THAT C ENCOMPASSES THE THREE SMALLER ONES DIMENSION A(20,20,3),B(20,3),C(20,3) COMMON A,B,C,K,KK DO 1 L=1,N DO 2 I=1,K DO 2 J=1,KK B(I,L)=0 2 C(J,L)=0 DO 1 I=1,K DO 1 J=1,KK B(I,L)=B(I,L)+A(I,J,L) C(J,L)=C(J,L)+A(I,J,L) 1 CONTINUE RETURN END SUBROUTINE ADJUST(A,BROW,BCOL,N) C COMPUTES T,U,V DIMENSION A(21),BROW(20),BCOL(20) DO 1 I=1,N IF(I.EQ.1) GO TO 2 IF(I.EQ.N) GO TO 3 A(I)=BROW(I)+A(I-1)-BCOL(I-1) GO TO 1 2 A(I)=BROW(I) GO TO 1 3 A(I)=A(I-1)-BCOL(I-1) 1 CONTINUE RETURN END SUBROUTINE ADJ2(A,BCOL,N,M,L) C ADJUSTS T,U,V FOR S>0 DIMENSION A(21),BCOL(20) DO 1 I=L,M K=N+I A(K)=0 DO 1 J=1,M A(K)=A(K)+BCOL(N+J) 1 CONTINUE RETURN END C PRINTS INPUT MATRICES SUBROUTINE PRTIN(NAME,CASE,K,SS,NML,YR,SEX) DIMENSION A(20,20,3),NML(20,3),YR(20) CHARACTER NAME(3,3,2)*4, FORMT*30 COMMON A INTEGER SS,CASE,YR,SEX REAL NML DO 2 L=1,CASE WRITE(6,1)(NAME(I,L,SEX),I=1,3) 1 FORMAT('0',3A4,' INPUT MATRIX') WRITE(6,1) DO 2 I=1,K II=(I-1)*6+1 WRITE(FORMT,101) II 2 WRITE(6,FORMT) YR(I),NML(I,L),(A(I,J,L),J=I,SS) RETURN 101 FORMAT('(I5,F7.0,',I2,'X,20F6.0)') END SUBROUTINE BLOCKD C PARAMETER INITIALIZATION COMMON /D/ JPARM1,JPARM2,JPARM3,JPARM4,LEY COMMON /DCHAR/ ESNEME,MNEME COMMON /FFCHAR/ CNEME1,CNEME2,CNEME3,CNEME4,CNEME5,CNEME6 COMMON /FF/ JP1,JP2,JP3,JP4,JP5,JP6 COMMON/OO/ JPA1,JPA2 COMMON /OOCHAR/ DONTAB,DONTB2,DONTB3 COMMON/PP/BDDSUM,BKEY CHARACTER*8 CONTAB(41),CONTB2(21),CONTB3(6) CHARACTER*8 DONTAB(41),DONTB2(21),DONTB3(6) CHARACTER*8 CNAME1(3,18),CNAME2(3,18), *CNAME3(3,18),CNAME4(3,18),CNAME5(3,12),CNAME6(3,6) CHARACTER*8 CNEME1(3,18),CNEME2(3,18), *CNEME3(3,18),CNEME4(3,18),CNEME5(3,12),CNEME6(3,6) DIMENSION IPA1(3),IPA2(3),AKEY(5) DIMENSION JPA1(3),JPA2(3),BKEY(5) DIMENSION IP1(5),IP2(18,5),IP3(18,5),IP4(18,5),IP5(18,5),IP6(18,5) DIMENSION JP1(5),JP2(18,5),JP3(18,5),JP4(18,5),JP5(18,5),JP6(18,5) DIMENSION IPARM1(5),IPARM2(12,5),IPARM3(12,5),IPARM4(12,5) DIMENSION JPARM1(5),JPARM2(12,5),JPARM3(12,5),JPARM4(12,5) DOUBLE PRECISION ADDSUM(5) DOUBLE PRECISION BDDSUM(5) CHARACTER*8 ESNAME(2,19),MNAME(8) CHARACTER*8 ESNEME(2,19),MNEME(8) DATA AKEY/2.,8.,4.,4.,4./ DATA ESNAME/'F(I)',' ','S(I)',' ','F''(I)',' ','S''(I)',' ', *'F''''(I)',' ','S''''(I)',' ','F''''''(I)',' ','F''''''''(I)', *' ','SK...SK+','I-1FK+I','S''K...SK','+I-1FK+I','SK FK+1',' ', *'S''K+1 FK','+1','S''''K FK+','1','SK/S''K',' ',' ',' ', *'SK-1 FK',' ','S''K-1 FK',' ','S''''K-1 F','''''''K','S''''K-1 F', *'''''''K'/ DATA MNAME/'F','S','F''','S''','F''''','S''''','F''''''', *'F'''''''''/ DATA IPARM1/4,6,9,10,11/, * IPARM2/1,2,3,4,9,14,15,15,15,15,15,15, * 1,2,3,4,7,9,10,15,15,15,15,15, * 1,2,3,4,5,6,11,12,13,15,15,15, * 1,2,3,4,5,6,7,11,12,13,15,15, * 1,2,3,4,5,6,7,8,13,14,15,15/ DATA IPARM3/1,1,1,1,1,1,0,0,0,0,0,0, * 2,1,1,1,1,1,1,0,0,0,0,0, * 1,1,1,1,1,1,1,1,1,0,0,0, * 1,1,1,1,1,1,2,1,1,1,0,0, * 2,1,1,1,1,1,2,1,1,1,1,1/ DATA CNAME1/'F(I),S(I','))',' ','S(I),S(I','+1))',' ','F(I+1),S', *'(I))',' ','F''(I),S''','(I))',' ','S''(I),S(','I))',' ','S''(I),S *(' ,'I+1))',' ','S''(I),F(','I+1))',' ',33*' '/ DATA CNAME2/'F''''''(I),','F(I))',' ','F''''''(I),','S(I))',' ','F *''''''(I+1' * ,'),S(I))',' ','F''''''(I+1','),S''(I))',' ','F(I),S(I',') *)' ,' ','S(I),F(I','+1))',' ','F(I+1),S','''(I))',' ','S(I),S(I', *'+1))',' ','S(I),S''(','I))',' ','S(I+1),S','''(I))',' ','F''(I),S *''','(I))',' ',' ',' ', *' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',' ', * ' ',' ',' '/ DATA CNAME3/'F(I),S(I','))',' ','F(I+1),S','(I))',' ','F(I+1),S', *'''(I))',' ','S(I),S(I','+1))',' ','S(I),S''(','I))',' ','S(I+1),S *' ,'''(I))',' ','F''(I),S''','(I))',' ','F''(I+1),','S''''(I))', *' ','S''(I+1),','S''''(I)),',' ','F''''(I),S','''''(I))',' ', * 24*' '/ DATA CNAME4/'F(I),S(I','))',' ','F(I+1),S','(I))',' ','F(I+1),S', *'''(I))',' ','S(I),S(I','+1))',' ','S(I+1),S','''(I))',' ','S(I),S *''(' ,'I))',' ','F''(I),S''','(I))',' ','F''(I+1),','S''''(I))',' * ','F''(I),F''','''''(I))',' ','S''(I+1),','S''''(I))',' ','S''(I) *,F''','''''(I))',' ','F''''(I),S','''''(I))',' ','S''''(I),F','''' *'''(I+1)',' ',15*' '/ DATA CNAME5/'F(I),S(I','))',' ','F(I+1),S','(I))',' ','F(I+1),S', * '''( *I))',' ','S(I),S(I','+1))',' ','S(I),S''(','I))',' ','S(I+1),S', *'''(I))',' ','F''(I),S''','(I))',' ','F''(I+1),','S''''(I))',' ' *,'F''(I),F''','''''(I))',' ','S''(I+1),','S''''(I))',' ','S''(I),F *''','''''(I))',' ','F''''(I),S','''''(I))',' '/ DATA CNAME6/'S''''(I),F','''''''(I+1)',')','F''''''''(I)',',F(I))' * ,' ','F''''''''(I)',',S(I))',' ','F''''''''(I+','1),S(I))',' ','F *''''''''(I+','1),S''(1)',')',' ',' ',' '/ DATA IP1/7,11,10,13,17/ C THIS ARRAY WAS SET UP FOR THE ORIGNAL DIMENSION OF 10 FOR INPUT MATRIC C IT IS USED ONLY IN COVCOR WHERE THERE IS AN ADJUSTMENT FOR CHANGES IN C DIMENSION DATA IP2/10,20,11,30,40,40,40,0,0,0,0,0,0,0,0,0,0,0, * 70,70,71,71,10,11,11,20,20,21,30,0,0,0,0,0,0,0, * 10,11,11,20,20,21,30,31,41,50,0,0,0,0,0,0,0,0, * 10,11,11,20,21,20,30,31,30,41,40,50,60,0,0,0,0,0, * 10,11,11,20,20,21,30,31,30,41,40,50,60,80,80,81,81,0/ DATA IP3/20,21,20,40,20,21,11,0,0,0,0,0,0,0,0,0,0,0, * 10,20,20,40,20,20,40,21,40,40,40,0,0,0,0,0,0,0, * 20,20,40,21,40,40,40,60,60,60,0,0,0,0,0,0,0,0, * 20,20,40,21,40,40,40,60,70,60,70,60,71,0,0,0,0,0, * 20,20,40,21,40,40,40,60,70,60,70,60,71,10,20,20,40,0/ DATA IP4/1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0, * 2,1,1,1,2,1,1,1,1,1,1,0,0,0,0,0,0,0, * 1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0, * 1,1,1,1,1,1,1,1,2,1,2,1,1,0,0,0,0,0, * 2,1,1,1,1,1,1,1,2,1,2,1,1,2,1,1,1,0/ DATA IP6/1,2,2,3,9,2,2,0,0,0,0,0,0,0,0,0,0,0, * 4,4,5,5,6,7,7,7,8,7,3,0,0,0,0,0,0,0, * 17,2,2,2,9,2,10,12,12,3,0,0,0,0,0,0,0,0, * 17,2,2,2,2,9,11,13,11,14,15,3,14,0,0,0,0,0, * 6,7,7,7,16,7,11,13,11,14,15,3,14,4,4,18,18,0/ DATA IPA1/1,7,15/ DATA IPA2/3,3,13/ DATA CONTAB/'R(I.)','N(I)-R(I','.)','Q(I.)','M(I)-Q(I','.)','R(I,I *)','R(I.)-R(','I,I)','W(I)-R(I',',I)','Z(I+1)-R','(.I)+R(I',',I)', *'Q(I,I+1)',' ',' ','R(1,2)',' ',' ! R*(','I,I+1)+Q','*(I-1,I+', *'1)',')! R(.K+','1)+Q(.K+','1)-Q(K,K','+1)','Q(I.)-Q(','I,I)-Q(I', *',I+1)','R(1.)-R(','1,1)-R(1',',2)! Z(I','+1)-R*(I',',I+1)-Q*','(I *-1,I+1',')! T(K+1',')+U(K+1)','-Q(K.)+Q','(K,K)-R(','.K+1)-Q('/ DATA CONTB2/'.K+1)+Q(','K,K+1)','R(.I)',' ','T(I)-R(.','I)','Q(.I) *-Q(','I,I)','U(I)-Q(2','.)-Q(.I)','+Q(I,I)','R(.I)-R(','I,I)','T(I *)-R(I','.)-R(.I)','+R(I,I)','Q(.I)-Q(','I,I)','U(I)-Q(I','.)-Q(.I) *','+Q(2,I)'/ DATA CONTB3/'W(I)','Z(I+1)',' ','Q(I,I)','Q(I.)-Q(','I,I)'/ DO 1 I=1,41 1 DONTAB(I)=CONTAB(I) DO 2 I=1,21 2 DONTB2(I)=CONTB2(I) DO 3 I=1,6 3 DONTB3(I)=CONTB3(I) DO 4 I=1,3 JPA1(I)=IPA1(I) JPA2(I)=IPA2(I) DO 5 J=1,18 CNEME1(I,J)=CNAME1(I,J) CNEME2(I,J)=CNAME2(I,J) CNEME3(I,J)=CNAME3(I,J) 5 CNEME4(I,J)=CNAME4(I,J) DO 6 J=1,12 6 CNEME5(I,J)=CNAME5(I,J) DO 7 J=1,6 7 CNEME6(I,J)=CNAME6(I,J) 4 CONTINUE DO 8 I=1,5 BKEY(I)=AKEY(I) JP1(I)=IP1(I) JPARM1(I)=IPARM1(I) BDDSUM(I)=ADDSUM(I) DO 9 J=1,18 JP2(J,I)=IP2(J,I) JP3(J,I)=IP3(J,I) JP4(J,I)=IP4(J,I) JP5(J,I)=IP5(J,I) 9 JP6(J,I)=IP6(J,I) DO 10 J=1,12 JPARM2(J,I)=IPARM2(J,I) JPARM3(J,I)=IPARM3(J,I) 10 JPARM4(J,I)=IPARM4(J,I) 8 CONTINUE DO 11 I=1,2 DO 11 J=1,19 11 ESNEME(I,J)=ESNAME(I,J) DO 12 I=1,8 12 MNEME(I)=MNAME(I) RETURN END SUBROUTINE FILNDX (HAT,SD,K) CPRELIMINARY TO PRINT ROUTINE;PULLS OUT CORRECT INDICES FOR HAT,SD C FROM IPARM VECTORS CHARACTER*8 ESNAME(2,19),NAME(2,2) CHARACTER*8 MNAME(8),MAME(2) DOUBLE PRECISION ADD(2),ADDSUM(5) DIMENSION HAT(204),SD(204),N(2,20),KEND(2), *IPARM1(5),IPARM2(12,5),IPARM3(12,5),IPARM4(12,5) DIMENSION SE(2),STERR(8) INTEGER YR(20) COMMON /TT/YR,STERR CHARACTER TITLE*80 COMMON /TTCHAR/ TITLE COMMON /D/ IPARM1,IPARM2,IPARM3,IPARM4,KEY COMMON /DCHAR/ ESNAME,MNAME DIMENSION AKEY(5) COMMON/PP/ADDSUM,AKEY KK=K IF(K.GT.2)KK=KK+1 WRITE(6,10)TITLE IF(K.LT.3)CALL TEXT(K) WRITE(6,11)KK 10 FORMAT('1',A80) 11 FORMAT('0ESTIMATES UNDER H',I1/' ------------------'/'0') C SETS OUTSIDE PARAMETER TO NUMBER OF ESTIMATES FOR K TH HYPOTHESIS N1=IPARM1(K) DO 1 I=1,N1,2 C INITIALIZES CONTROL PARAMETERS PASSED TO PRINT ROUTINE DO 4 J=1,2 KEND(J)=0 ADD(J)=0 DO 4 JJ=1,20 4 N(J,JJ)=0 C PULLING OFF TWO ESTIMATE VECTORS AT A TIME, ISAVE IS THE INDEX OF THE C CURRENT ESTIMATE DO 3 II=1,2 ISAVE=I+II-1 IF((ISAVE).GT.N1)GO TO 5 C M IS THE INDEX IN THE LONG VECTOR OVERLAYING THE ESTIMATE VECTORS. IT C CORRESPONDS TO ISAVE. KK=IPARM2(ISAVE,K) IF(KK.LE.10)M=(KK-1)*20 IF(KK.GT.10)M=200+KK-11 C M1 AND M2 ARE TWO POINTS IN THE LONG VECTOR CORRESPONDING TO THE C BEGINNING AND END POINTS IN THE CURRENT ESTIMATE (SUCH AS 2,...,K-1) JJ=IPARM3(ISAVE,K) M1=M+JJ M2=M+IPARM4(ISAVE,K) DO 2 J=M1,M2 N(II,JJ)=J JJ=JJ+1 2 CONTINUE 5 ISA=IPARM2(ISAVE,K) IF(KEY.EQ.1.AND.K.EQ.5.AND.ISA.GT.10.AND.ISA.LT.15)ISA=ISA+5 IF(KEY.EQ.1.AND.K.EQ.4.AND.ISA.EQ.13)ISA=19 IF(KEY.EQ.1.AND.K.EQ.2.AND.ISA.GT.8)ISA=ISA+7 NAME(1,II)=ESNAME(1,ISA) NAME(2,II)=ESNAME(2,ISA) MAME(II)=MNAME(ISA) C ADDSUM IS THE SUMMATION OF COV(SHAT(I),SHAT(I+1)) OF EACH HYPOTHESIS C THAT IS ADDED, IN THE CASE OF SHAT, TO THE SUMMATION OF THE VARIANCES C TO FIND THE MEAN STANDARD ERROR IF(KK.EQ.2)ADD(II)=ADDSUM(K) 3 KEND(II)=IPARM4(ISAVE,K) CALL PRINT(NAME,MAME,ADD,HAT,SD,N,KEND,SE,YR) IF(K.NE.1)GO TO 1 STERR(I)=SE(1) STERR(I+1)=SE(2) 1 CONTINUE RETURN END SUBROUTINE PRINT(NAME,MAME,ADD,HAT,SD,N,KEND,SE,YR) DIMENSION HAT(204),SD(204),N(2,20),KEND(2),CI(2,2),H(2),S(2) DOUBLE PRECISION ADD(2) CHARACTER*8 NAME(2,2),MAME(2) REAL MEAN(2),MNVAR(2),MCI(2,2) DIMENSION MN(2),SE(2) INTEGER YR(20) CHARACTER UNDERL*8,BLANK*1 DATA BLANK/' '/ DATA UNDERL/'________'/ WRITE(6,100)NAME,(UNDERL,I=1,14) 100 FORMAT('0',26X,2A8,45X,2A8,/11X,6A8,A2,10X,6A8,A2/2X,'I', * 3X,'YR',3X,'ESTIMATE',9X,'STANDARD',11X,'95% CONFIDENCE',10X, *'ESTIMATE',9X,'STANDARD',11X,'95% CONFIDENCE'/29X,'ERROR', * 15X,'INTERVAL',32X,'ERROR',15X,'INTERVAL' 1 /'+',9X,'________',9X,'_________',11X,'______________', 1 10X,'________',9X,'_________',11X,'______________') C OUTPUTS TWO ESTIMATE TABLES SIDE BY SIDE C HAT IS THE ARRAY CONTAINING ALL THE ESTIMATES FUSED INTO A SINGLE C VECTOR C SD SIMILARLY CONTAINS ALL THE STANDARD DEVIATIONS C N HOLDS THE INDICES IN THE ABOVE ARRAYS OF THE TWO SUBGROUPS OF C OF ESTIMATES C KEND HOLDS THE COUNT OF EACH L=MAX0(KEND(1),KEND(2)) DO 15 I=1,2 MN(I)=0 MNVAR(I)=0 15 MEAN(I)=0 LL=0 KK=2 IF(KEND(2).EQ.0)KK=1 DO 3 J=1,L JYR=YR(J) C LOOKS AT ESTIMATES TWO AT A TIME,ONE FOR EACH TABLE,LINE BY LINE DO 1 I=1,2 C K IS EQUAL TO ZERO IF THERE WAS NO ESTIMATE CALCULATED FOR THIS VALUE K=N(I,J) IF(I.EQ.1.AND.K.GT.160)JYR=9999 IF(K.EQ.0.AND.I.EQ.2)GO TO 4 IF(K.NE.0.OR.I.NE.1)GO TO 10 LL=1 GO TO 1 C PULLS OUT CURRENT ESTIMATE AND VARIANCE,FINDS STANDARD DEVIATION AND C C CONFIDENCE LEVELS 10 H(I)=HAT(K) IF(H(I).EQ.0)GO TO 5 C USED TO CALCULATE MEAN ESTIMATES IF(K.GT.160) GO TO 11 MN(I)=MN(I)+1 MEAN(I)=MEAN(I)+H(I) MNVAR(I)=MNVAR(I)+SD(K) GO TO 16 11 IF(I.EQ.1.AND.KK.NE.0)KK=0 IF(I.EQ.2.AND.KK.EQ.2) KK=1 C 16 S(I)=SQRT(SD(K)) CI(I,1)=H(I)-(1.96*S(I)) CI(I,2)=H(I)+(1.96*S(I)) GO TO 1 C AN ESTIMATE THAT IS ZERO IS SET TO THIS VALUE WHICH WILL PRINT OUT AS 5 H(I)=9999 S(I)=9999 CI(I,1)=9999 CI(I,2)=9999 1 CONTINUE C PRINTS STATEMENTS LEAVE BLANKS FOR J'S WHERE NO ESTIMATE WAS CALCULATE IF(LL.EQ.1)GO TO 6 2 WRITE(6,101)J,JYR,(H(I),S(I),(CI(I,K),K=1,2),I=1,2) GO TO 3 4 IF(LL.EQ.1)GO TO 8 WRITE(6,101)J,JYR,H(1),S(1),(CI(1,K),K=1,2) GO TO 3 6 WRITE(6,102)J,JYR,H(2),S(2),(CI(2,K),K=1,2) GO TO 9 8 WRITE(6,101)J,JYR 9 LL=0 3 CONTINUE 101 FORMAT('0',I2,2X,I4,1X,F7.4,10X,F8.4,8X,F8.4,1X,'-',F8.4,10X, *F7.4,10X,F8.4,8X,F8.4,1X,'-',F8.4) 102 FORMAT('0',I2,2X,I4,62X,F7.4,10X,F8.4,8X,F8.4,1X,'-',F8.4) C PRINTS MEAN ESTIMATES IF(KK.EQ.0) GO TO 12 WRITE(6,105) (BLANK,J=1,KK) WRITE(6,106) (BLANK,J=1,KK) WRITE(6,107) ((UNDERL,I=1,4),J=1,KK) 105 FORMAT('0',8X,A1,'AVERAGE',10X,'STANDARD',11X,'95% CONFIDENCE',1X 1,8X,A1,'AVERAGE',10X,'STANDARD',11X,'95% CONFIDENCE') 106 FORMAT(9X,A1,'ESTIMATE',9X,'ERROR',17X,'INTERVAL',4X, 18X,A1,'ESTIMATE',9X,'ERROR',17X,'INTERVAL') 107 FORMAT('+',9X,A8,9X,A8,11X,A8,A6,1X, 19X,A8,9X,A8,11X,A8,A6,1X) DO 13 I=1,KK IF(MN(I).EQ.0)GO TO 20 MEAN(I)=MEAN(I)/MN(I) MNVAR(I)=(MNVAR(I)+2*ADD(I))/(MN(I)**2) MNVAR(I)=SQRT(MNVAR(I)) MCI(I,1)=MEAN(I)-(1.96*MNVAR(I)) MCI(I,2)=MEAN(I)+(1.96*MNVAR(I)) GO TO 21 20 MEAN(I)=9999 MNVAR(I)=9999 MCI(I,1)=9999 MCI(I,2)=9999 21 SE(I)=MNVAR(I) 13 CONTINUE WRITE(6,109) (UNDERL,I=1,KK) 109 FORMAT(4X,A1,60X,A1) WRITE(6,108) (MAME(I),MEAN(I),MNVAR(I),(MCI(I,J),J=1,2),I=1,KK) 108 FORMAT(' ',3X,A5,'=',F7.4,10X,F8.4,8X,F8.4,1X,'-',F8.4,1X, 13X,A5,'=',F7.4,10X,F8.4,8X,F8.4,1X,'-',F8.4) WRITE(6,108) 12 RETURN END SUBROUTINE COVCOR(KURRNT,K) C CALCULATES AND PRINTS OUT COVARIANCES AND CORRELATIONS DOUBLE PRECISION CVS(2),CRS(2) DOUBLE PRECISION COVAR(2,20),CORR(2,20),SDD CHARACTER*8 CONAME(3,18,5) DIMENSION STERR(8) DIMENSION SUBCOV(20,18) INTEGER YR(20) DIMENSION IP1(5),IP2(18,5),IP3(18,5),IP4(18,5),IP5(18,5),IP6(18,5) DIMENSION HAT(204),SD(204) COMMON /TT/YR,STERR CHARACTER TITLE*80 COMMON /TTCHAR/ TITLE COMMON/GG/SUBCOV COMMON/FF/ IP1,IP2,IP3,IP4,IP5,IP6 COMMON /FFCHAR/ CONAME COMMON/AA/HAT COMMON/BB/SD CHARACTER BL*1 DATA BL/' '/ ISP=1 CVS(1)=0 CVS(2)=0 KK=KURRNT IF(KK.GT.2)KK=KK+1 WRITE(6,100)TITLE,KK C JJ=# OF COVAR VECTORS CALCULATED FOR CURRENT HYPOTHESIS JJ=IP1(KURRNT) DO 1 J=1,JJ,2 DO 2 I=1,K DO 2 II=1,2 2 COVAR(II,I)=0 C PULL OUT FROM INITIALIZED ARRAYS IP1 - IP6 THE PARAMETERS TO SELECT C OUT THE CORRECT ESTIMATES TO COMPUTE COVARIANCE AND CORRELATIONS DO 3 JJJ=1,2 IJ=J-1+JJJ IF(IJ.GT.JJ)GO TO 3 II=IP4(IJ,KURRNT) III=IP5(IJ,KURRNT) C ROUTINE FOR ADJUSTING PARAMETERS TO NEW DIMENSIONS. NN HOLDS VALUE C OF NEW DIMENSION NN=20 I1=IP2(IJ,KURRNT)-10 I3=I1/10 I5=I1-I3*10 I1=I3*NN+I5 I2=IP3(IJ,KURRNT)-10 I4=I2/10 I6=I2-I4*10 I2=I4*NN+I6 KK=IP6(IJ,KURRNT) IF (IJ.EQ.4)ISP =2 DO 10 I=II,III COVAR(JJJ,I)=(HAT(I1+I)*HAT(I2+I))*SUBCOV(I,KK) IF(KURRNT.EQ.1.AND.(IJ.EQ.1.OR.IJ.EQ.3.OR.IJ.EQ.4).AND.I.LT.K) *CVS(ISP)=CVS(ISP)+COVAR(JJJ,I) IF(COVAR(JJJ,I).EQ.0)GO TO 10 SDD=SD(I1+I)*SD(I2+I) CORR(JJJ,I)=COVAR(JJJ,I)/DSQRT(SDD) 10 CONTINUE 3 CONTINUE C PRINT TABLES JJJ=J+1 IF(JJJ.GT.JJ)JJJ=JJ 100 FORMAT('1',A80/'0ESTIMATED NON-ZERO COVARIANCES AND CORRELATIONS *UNDER H',I1) WRITE(6,101)(BL,(CONAME(I,KK,KURRNT),I=1,3),(CONAME(I,KK,KURRNT), *I=1,3),KK=J,JJJ) 101 FORMAT('0'/'0 I',6X,'YR',1X,2(A1,'COVAR(',3A8,'CORR(',3A8)) DO 4 I=1,K KEY=2 C WHERE COVAR IS EQUAL TO ZERO THERE WAS NO COVARIANCE CALCULATED FOR TH IF(COVAR(1,I).EQ.0)KEY=3 IF(COVAR(2,I).NE.0)GO TO 8 IF(KEY.EQ.3)GO TO 4 KEY=1 C PRINT STATEMENTS PUT BLANKS WHERE NO COVAR WAS CALCULATED 8 GO TO (5,5,6),KEY 5 WRITE(6,102)I,YR(I),(COVAR(KK,I),CORR(KK,I),KK=1,KEY) GO TO 4 102 FORMAT(I3,I8,2X,2(4X,F13.9,17X,F13.9,12X)) 6 WRITE(6,103)I,YR(I),COVAR(2,I),CORR(2,I) 103 FORMAT(I3,I8,65X,F13.9,17X,F13.9) 4 CONTINUE 1 CONTINUE WRITE(6,104) 104 FORMAT('0'/'0',7X,'THE ABOVE ARE ESTIMATES OF THE SAMPLING COVARIA *NCES AND CORRELATIONS BETWEEN THE PARAMETER ESTIMATORS.') C SPECIAL CORVAR AND CORR FOR HYPOTHESIS 1 USING STANDARD ERROR FROM H1 C ESTIMATES IF(KURRNT.NE.1)GO TO 20 DO 11 I=1,2 IF(CVS(I).EQ.0)GO TO 15 CVS(I)=CVS(I)/(K*(K-1)) J1=2*(I-1)+1 J2=2*I CRS(I)=CVS(I)/(STERR(J1)*STERR(J2)) GO TO 11 15 CVS(I)=9999 CRS(I)=9999 11 CONTINUE WRITE(6,106) WRITE(6,105)CVS(1),CRS(1) 105 FORMAT(13X,'COVAR(S,F) =',F13.9,34X,'CORR(S,F) =',F13.9) 106 FORMAT('0'/' ',18X,'_ _',56X,'_ _') WRITE(6,108) WRITE(6,109)CVS(2),CRS(2) 109 FORMAT(13X,'COVAR(S'',F'')=',F13.9,34X,'CORR(S'',F'')=',F13.9) 108 FORMAT('0'/' ',18X,'_ _',55X,'_ _') 20 RETURN END SUBROUTINE SUM(SHAT,RROW,N,K) DOUBLE PRECISION ADDSUM(5),A,B CHARACTER*8 CONAME(3,18,5) DIMENSION SHAT(20),RROW(20),N(20),IP1(5),IP2(18,5),IP3(18,5),IP4( *18,5),IP5(18,5),IP6(18,5) DIMENSION SUBCOV(20,18) DIMENSION AKEY(5) REAL N COMMON /PP/ADDSUM,AKEY COMMON /FF/ IP1,IP2,IP3,IP4,IP5,IP6 COMMON /FFCHAR/ CONAME COMMON/GG/SUBCOV I=AKEY(K) ADDSUM(K)=0 I1=IP4(I,K) I2=IP5(I,K) I3=IP6(I,K) DO 1 I=I1,I2 A=SHAT(I)*SHAT(I+1) B=SUBCOV(I,I3) ADDSUM(K)=ADDSUM(K)+A*B 1 CONTINUE RETURN END SUBROUTINE CMBINE DIMENSION ALPHA(4,20),C(20),R(4),INDEX(20),IN2(4),SUMCS(7),ISMDF *(7),CSUM(4,20),CSTAR(20),DUMMY1(20),DUMMY2(20) COMMON/CC/ALPHA,C,R,JC,JR,SUMCS,ISMDF,KEY INTEGER CASE COMMON/EE/CASE,IE,II,IERR C SORT COLUMN TOTALS AND FIND THEIR SUM CALL SORT(C,INDEX,JC,20) CTOTAL=0 DO 7001 I=1,JC 7001 CTOTAL=CTOTAL+C(I) C FIND SMALLEST ROW TOTAL CALL SORT(R,IN2,JR,4) J=IN2(1) SRT=R(J) IF(SRT.GT.0)GO TO 11 WRITE(6,104) 104 FORMAT('0'/'0',44X,'SMALLEST ROW TOTAL EQUALS ZERO'/45X,'NO CHI SQ *UARE COMPUTED') RETURN C COMBINE ROW TOTALS UNTIL THE MIN I IS FOUND SUCH THAT THE TOTAL IS GE C TO 2*CTOTAL/SRT 11 K=0 L=1 CSTAR(L)=0 DO 8 M=1,JR 8 CSUM(M,L)=0 DO 2 I=1,JC J=INDEX(I) IF(K.EQ.1)GO TO 4 CSTAR(L)=CSTAR(L)+C(J) 5 IF(CSTAR(L).GE.(2*CTOTAL/SRT))K=1 DO 3 M=1,JR 3 CSUM(M,L)=CSUM(M,L)+ALPHA(M,J) GO TO 2 4 L=L+1 CSTAR(L)=C(J) K=0 DO 9 M=1,JR 9 CSUM(M,L)=0 GO TO 5 2 CONTINUE C FIND CHISQ FROM COLUMN TOTAL MATRIX CALL CHSQ(CSUM,JR,L,CS,IDF,IERR,DUMMY1,DUMMY2,30) SUMCS(4)=SUMCS(4)+CS IF(IERR.GT.0)CALL ERROR ISMDF(4)=ISMDF(4)+IDF WRITE(6,100)II DO 10 I=1,JR 10 WRITE(6,101) (CSUM(I,J),J=1,L) IF(CS.NE.0) *WRITE(6,102) CS,IDF IF(CS.EQ.0)WRITE(6,103) 103 FORMAT('+',81X,'NO CHI SQUARE COMPUTED') 100 FORMAT('0',10X,'I=',I2) 101 FORMAT(20X,15F4.0) 102 FORMAT('+',81X,F6.2,' WITH',I3,' D.F.') C REINITIALIZE FOR NEXT MATRIX DO 6 I=1,10 6 C(I)=0 DO 7 I=1,4 7 R(I)=0 RETURN END SUBROUTINE ERROR INTEGER CASE COMMON/EE/CASE,IE,I,IERR WRITE(6,100) 100 FORMAT('0 *** ERROR ***') GO TO (1,2),IERR 1 WRITE(6,3) I GO TO 12 2 WRITE(6,7)I 12 GO TO (21,5,6),CASE 21 WRITE(6,22) 22 FORMAT('+',78X,'TEST FOR SEX DIFFERENCES') GO TO 20 5 IF(IE.EQ.4)GO TO 10 K=IE-1 WRITE(6,8) K,IE GO TO 20 10 K=IE-1 WRITE(6,9)K GO TO 20 6 IF(IE.EQ.4)GO TO 11 IE=IE+3 K=IE+1 WRITE(6,8)IE,K GO TO 20 11 K=IE+2 WRITE(6,9)K 20 RETURN 3 FORMAT('+EXPECTED VALUE LESS THAN 1.0 FOR I= ',I2, 1 ' CONTINGENCY TABLE IN ') 7 FORMAT('+ROW OR COLUMN TOTAL LESS THAN OR EQUAL TO ZERO FOR I= ', *I2,' CONTINGENCY TABLE IN ') 8 FORMAT('+',78X,'TEST OF H',I1,' VERSUS H',I1) 9 FORMAT('+',78X,'GOODNESS OF FIT TEST FOR H',I1) END SUBROUTINE CHSQ(A,N,M,CS,NDF,IERR,TR,TC,L) DIMENSION A(4,20),TR(20),TC(20) NM=N*M IERR=0 CS=0.0 NDF=(N-1)*(M-1) IF(NDF) 5,5,10 5 IERR=3 NDF=0 RETURN 10 DO 90 I=1,N TR(I)=0.0 DO 91 J=1,M 91 TR(I)=TR(I)+A(I,J) IF(TR(I).LE.0)GO TO 150 90 CONTINUE DO 100 J=1,M TC(J)=0.0 DO 95 I=1,N 95 TC(J)=TC(J)+A(I,J) IF(TC(J).LE.0)GO TO 150 100 CONTINUE GT=0.0 DO 110 I=1,N 110 GT=GT+TR(I) IF(NM-4) 130,120,130 120 CS=GT*(ABS(A(1,1)*A(2,2)-A(2,1)*A(1,2)))**2 /(TC(1)*TC(2)*TR(1) 1*TR(2)) RETURN 130 IJ=0 DO 140 J=1,M DO 140 I=1,N E=TR(I)*TC(J)/GT IF(E-1.0) 135, 140, 140 135 IERR=1 140 CS=CS+(A(I,J)-E)*(A(I,J)-E)/E GO TO 160 150 IERR=2 NDF=0 160 RETURN END SUBROUTINE CHIPRT(N,KK,K,L) DIMENSION A(20,2,2,2),B(4,20),C(2) DIMENSION ALPHA(4,20),ROW(4),R(20),DUMMY1(20),SUMCS(7),ISMDF(7) DIMENSION IPA1(3),IPA2(3),DUMMY2(20) CHARACTER*8 CONTAB(62),CONTB2(6) DOUBLE PRECISION Z,PP INTEGER A CHARACTER TITLE*80 COMMON /TTCHAR/ TITLE COMMON/CC/ALPHA,R,ROW,JC,JR,SUMCS,ISMDF,KEY INTEGER CASE COMMON/EE/CASE,IE,I,IERR COMMON /HH/A COMMON /OO/ IPA1,IPA2 COMMON /OOCHAR/ CONTAB,CONTB2 CHARACTER LINE*8,BLANK*1 DATA LINE/'--------'/ DATA BLANK/' '/ NN=N-1 IF(N.EQ.10)GO TO 111 IF(N.EQ.9)NN=2 IF(N.EQ.8)NN=1 IF(N.EQ.8)N=9 WRITE(6,100)TITLE,NN,N,(LINE,I=1,4) 100 FORMAT('1',A80/'0CHI-SQUARE TEST OF H',I1,' VS H',I1/1X,3A8,A3) 111 WRITE(6,101) (BLANK,I=1,L) 101 FORMAT('0'/'0',2(3X,A1,'2 X 2 CONTINGENCY TABLE',3X,'CORRESPONDING * CHI-SQUARE STATISTIC',1X)) WRITE(6,102) (BLANK,I=1,L) 102 FORMAT(2(30X,A1,'WITH 1 DEGREE OF FREEDOM',10X)) WRITE(6,103) ((LINE,J=1,3),(LINE,J=1,5),I=1,L) 103 FORMAT(2(5X,2A8,A7,3X,4A8,A2)) IF(L.NE.2)GO TO 110 ICT1=IPA1(N) ICT2=IPA2(N)+ICT1-1 WRITE(6,108)(CONTAB(I),I=ICT1,ICT2) WRITE(6,109) (CONTB2(I),I=ICT1,ICT2) ICT1=ICT2+1 ICT2=ICT1+IPA2(N)-1 WRITE(6,108)(CONTAB(I),I=ICT1,ICT2) WRITE(6,109) (CONTB2(I),I=ICT1,ICT2) 109 FORMAT('+',69X,3A8) 108 FORMAT('0',4X,16A8) 110 IF(N.GT.8)N=4 IF(N.GT.4)N=N-4 DO 4 II=KK,K IF(N.EQ.1.AND.II.EQ.K.AND.KEY.EQ.1)L=1 DO 6 I=1,L DO 5 J=1,2 DO 5 JJ=1,2 5 B(JJ,J)=A(II,JJ,J,I) CALL CHSQ(B,2,2,CS,IDF,IERR,DUMMY1,DUMMY2,4) SUMCS(N)=SUMCS(N)+CS C(I)=CS IE=N IF(IERR.GT.0)CALL ERROR 6 CONTINUE 9 WRITE(6,105)II,((A(II,1,J,I),J=1,2),I=1,L) 105 FORMAT('0','I=',I2,4X,I5,2X,I5,49X,4X,I5,2X,I5) WRITE(6,106)((A(II,2,J,I),J=1,2),C(I),I=1,L) 106 FORMAT(2(9X,I5,2X,I5,23X,F8.3,13X)) 4 CONTINUE IF(N.EQ.4)GO TO 112 WRITE(6,104)(LINE,J=1,7) WRITE(6,107)ISMDF(N),SUMCS(N) 107 FORMAT(' !TOTAL CHI-SQUARE WITH',I3,' DEGREES OF FREEDOM =',F8.3, *'!') WRITE(6,104)(LINE,J=1,7) 104 FORMAT(1X,'!',6A8,A5,'!') Z=SUMCS(N) IDF=ISMDF(N) CALL CHI(IDF,Z,PP,IDUMMY) 112 RETURN END SUBROUTINE EXPECT(M,E,Z,N,K,S,H,II) DIMENSION M(20,20),E(20,20),Z(20,20),N(20) REAL N,M INTEGER S,SS,H,II CHARACTER TITLE*80, FORMT*20 COMMON /TTCHAR/ TITLE CHARACTER UNDERL*4,NAME(2)*6 INTEGER IS DATA UNDERL/'----'/ DATA NAME/'ADULTS','YOUNG'/ C MATRIX OF STANDARD NORMAL DEVIATES SS=S+K KK=K IF (II.EQ.2.AND.S.EQ.0.AND.H.LE.9) KK=K-1 DO 10 I=1,KK JJ=I IF (II.EQ.2.AND.H.LE.9) JJ=I+1 11 DO 10 J=JJ,SS IF(E(I,J).EQ.0) GO TO 10 Z(I,J)=(M(I,J)-E(I,J))/SQRT(E(I,J)*(N(I)-E(I,J))/N(I)) 10 CONTINUE C PRINT HEADINGS AND 3 MATRICES WRITE(6,104)TITLE IF (H.LE.9) WRITE(6,100) H,NAME(II),(UNDERL,I=1,11) IF (H.GT.9) WRITE(6,105) NAME(II),(UNDERL,I=1,11) DO 20 I=1,K IS=(I-1)*7+1 WRITE(FORMT,101) IS 20 WRITE(6,FORMT)I,(M(I,J),J=I,SS) WRITE(6,102)NAME(II),(UNDERL,I=1,11) DO 21 I=1,K IS=(I-1)*7+1 WRITE(FORMT,101) IS 21 WRITE(6,FORMT)I,(E(I,J),J=I,SS) WRITE(6,103)NAME(II),(UNDERL,I=1,11) DO 22 I=1,K IS=(I-1)*7+1 WRITE(FORMT,101) IS 22 WRITE(6,FORMT)I,(Z(I,J),J=I,SS) 100 FORMAT('0H',I1/'0'/'0MATRIX OF DATA VALUES -- ',A6/' ',11A4) 101 FORMAT('(7X,I2,',I2,'X,20F7.2)') 102 FORMAT('0'/'0MATRIX OF EXPECTED VALUES -- ',A6/' ',11A4) 103 FORMAT('0'/'0MATRIX OF STANDARD NORMAL DEVIATES -- ',A6/' ',11A4) 104 FORMAT('1',A80) 105 FORMAT('0H02'/'0'/'0MATRIX OF DATA VALUES -- ',A6/' ',11A4) RETURN END