PROGRAM BROWN CHARACTER*8 CONTAB(62),CONTB2(6) DOUBLE PRECISION ADDSUM(5) CHARACTER*8 CONAME(3,18,5) CHARACTER*8 ESNAME(2,19),MNAME(8) DOUBLE PRECISION ZY,PP DIMENSION IN11(20,2,2),IN12(20,2,2),IN2(20,2,2),IN3(20,2,2) INTEGER SSS,CASEB DIMENSION IP1(5),IP2(18,5),IP3(18,5),IP4(18,5),IP5(18,5),IP6(18,5) DIMENSION IPARM1(5),IPARM2(12,5),IPARM3(12,5),IPARM4(12,5) DIMENSION IPA1(3),IPA2(3) DIMENSION SUBCOV(20,18),STERR(8) DIMENSION E(20,20),ZZ(20,20) DIMENSION RSTAR(20,20),QSTAR(20,20),YSTAR(20,20),ALPHA(4,20), *ROW(4),SUMCS(7),ISMDF(7),C(20),AKEY(5) DIMENSION FHAT(20),SHAT(20),FHATP(20),SHATP(20),FHAT2P(20), *SHAT2P(20),FHAT3P(20),FHAT4P(20),SHATF(20),SHATFP(20),HAT(204) DIMENSION SFHAT(20),SSHAT(20),SFHATP(20),SSHATP(20),SFHT2P(20), *SSHT2P(20),SFHT3P(20),SFHT4P(20),SSHATF(20),SSHTFP(20),SD(204) DIMENSION R(20,20),Q(20,20),Y(20,20),N(20),M(20),L(20),RROW(20), *RCOL(20),QROW(20),QCOL(20),YROW(20),YCOL(20),W(20),Z(21), *T(21),U(21),V(21),A(20),B(20),SUMAB(21),RQY(20,20,3),NML(20,3), * YR(20) REAL N,M,L,NML INTEGER S,SS,CASE,YR,SEX COMMON R,Q,Y,RROW,QROW,YROW,RCOL,QCOL,YCOL,K,SS,N,M,L COMMON /AA/FHAT,SHAT,FHATP,SHATP,FHAT2P,SHAT2P,FHAT3P,FHAT4P,SHATF *,SHATFP,S0HATF,S1HATF,S2HATF,SHATQ COMMON /BB/SFHAT,SSHAT,SFHATP,SSHATP,SFHT2P,SSHT2P,SFHT3P,SFHT4P, *SSHATF,SSHTFP,SS0HTF,SS1HTF,SS2HTF,SSHATQ COMMON/CC/ALPHA,C,ROW,JC,JR,SUMCS,ISMDF,KEY COMMON/D/ IPARM1,IPARM2,IPARM3,IPARM4,KEYY COMMON /DCHAR/ ESNAME,MNAME COMMON/EE/CASE,IE,I,IERR COMMON/FF/ IP1,IP2,IP3,IP4,IP5,IP6 COMMON /FFCHAR/ CONAME COMMON/GG/SUBCOV COMMON /HH/IN11,IN12 COMMON /OO/ IPA1,IPA2 COMMON /OOCHAR/ CONTAB,CONTB2 COMMON/PP/ADDSUM,AKEY COMMON /TT/YR,STERR CHARACTER TITLE*80 COMMON /TTCHAR/ TITLE EQUIVALENCE (IN11,IN2,IN3) EQUIVALENCE (HAT,FHAT),(SD,SFHAT),(R,RQY),(N,NML) EQUIVALENCE (E,RSTAR),(ZZ,QSTAR) CHARACTER LINE*8 CHARACTER MATXNA(3,3,2)*4 CHARACTER OUTFIL*20 CHARACTER MATXID(3)*13 DATA MATXNA/'ADUL','TS',' ','YOUN','G',' ','YEAR','LING','S', *'ADUL','T MA','LE','ADUL','T FE','MALE',' ',' ',' '/ DATA LINE/'--------'/ CALL BLOCKD DO 998 I=1,4 ISMDF(I)=0 998 SUMCS(I)=0 CHI2=0. IDF2=0 C READ IN DATA C CARD1 TITLE C CARD2 PARAMETER CARD...ROWS,COLS, 3 OR 2 MATRIX CASE (1 FOR 2 MAT C CASE OF MALES AND FEMALES), FIRST YEAR C INPUT MATRICES IN ORDER ADULTS, YOUNG, SUBADULTS(IF PRESENT) 103 FORMAT(A80) WRITE(0,8801) 8801 FORMAT(' Enter the name for the output file:') READ(5,'(A20)') OUTFIL OPEN(6,FILE=OUTFIL,STATUS='UNKNOWN') 8001 WRITE(0,8802) 8802 FORMAT(' Enter the title between two apostrophes'/ 1 ' (Example ''TITLE'') (Use Ctrl-Z to end program):') READ(5,*,END=8000)TITLE IOPT=0 IPRT=0 CASE=2 MATXID(1)='adults' MATXID(2)='young' MATXID(3)='subadults' KEY=1 WRITE(0,100) 100 FORMAT(' Enter the number of years of banding, the number of', 1 /' years of recoveries, and the first year of banding.', 2 /' Then enter 1 for a statistical test that the survival and', 3 /' recovery rates are equal for adult males and females,', 4 /' 2 for parameter estimation and testing for banding studies', 5 /' involving both young and adult birds (usual case),', 6 /' or 3 for parameter estimation and testing for banding' 7 /' studies involving young, subadult, and adult birds.' 8 /' Then enter 0 or 1 for IOPT') READ(5,*) K,SS,YR(1),CASE,IOPT IF(CASE .EQ. 0) CASE=2 IF (CASE.EQ.2) CALL DEFINE DO 106 I=2,K YR(I)=YR(I-1)+1 106 CONTINUE IF (K.LT.20) THEN DO 8901 I=K+1,20 YR(I)=9999 8901 CONTINUE ENDIF C SUBTRACT ROWS FROM COLUMNS. IF NOT A SQUARE MATRIX S IS GREATER THAN C AND KEY=2. OTHERWISE KEY=1. S=SS-K IF(S.GT.0) KEY=2 KEYY=KEY CASEB=CASE SEX=1 IF(CASE.EQ.1) THEN CASE=2 SEX=2 MATXID(1)='adult males' MATXID(2)='adult females' ENDIF C READ IN MATRICES C NML AND RQY ARE LARGE ARRAYS EQUIVALENCED TO THE SMALLER ONES; NAMELY C AND R,Q, & Y RESPECTIVELY. DO 114 II=1,CASE WRITE(0,102) MATXID(II) 102 FORMAT(' Begin entry of recovery matrix for ',A) DO 2 I=1,K DO 8803 J=1,SS 8803 RQY(I,J,II)=0. WRITE(0,8804) SS-I+1,I READ(5,*)(RQY(I,J,II),J=I,SS) 2 CONTINUE 8804 FORMAT(' Enter ',I2,' values of row ',I2,' of recovery matrix:') WRITE(0,8806) MATXID(II) 8806 FORMAT(' Enter banding totals for ',A) READ(5,*) (NML(I,II),I=1,K) 114 CONTINUE WRITE(0,8807) OUTFIL 8807 FORMAT(' Executing BROWNIE, output in file ',A) C PRINT OUT INPUT DATA WRITE(6,104) TITLE 104 FORMAT('1',20X,A80) CALL PRTIN(MATXNA,CASE,K,SS,NML,YR,SEX) 105 IF (CASE.NE.3.OR.S.NE.1) GO TO 1 WRITE(6,101) 101 FORMAT('1 ERROR-S CANNOT HAVE THE VALUE 1 IN THE 3 AGE-GROUP CASE' *) GO TO 8001 1 IF(SEX.EQ.2)GO TO 1041 C PARAMETER FOR ESTIMATE PRINTOUT INITIALIZED - IPARM4 HOLDS THE OUTSIDE C OF EACH ESTIMATE VECTOR IN EACH HYPOTHESIS DO 5000 I=1,5 DO 5000 J=1,12 5000 IPARM4(J,I)=0 DO 5001 I=1,5 IPARM4(1,I)=K IPARM4(2,I)=K-1 IPARM4(3,I)=K IPARM4(4,I)=K-1 IPARM4(5,I)=K IF (I.EQ.1) IPARM4(5,I)=S IPARM4(6,I)=K-1 IF (I.EQ.1)IPARM4(6,I)=1 IF(I.EQ.2)IPARM4(6,I)=S IF (I.EQ.1) GO TO 5001 IPARM4(7,I)=K IF(I.EQ.3)IPARM4(7,I)=1 IF(I.EQ.2) GO TO 5001 IPARM4(8,I)=1 IF(I.EQ.5)IPARM4(8,I)=K DO 5002 J=9,12 IF(I.EQ.3.AND.J.GT.9)GO TO 5001 IF(I.EQ.4.AND.J.GT.10)GO TO 5001 5002 IPARM4(J,I)=1 5001 CONTINUE IPARM4(7,2)=S C DIFFERENCES FOR S=0 INCORPORATED IF(S.GT.0)GO TO 5005 IPARM1(1)=4 IPARM1(3)=6 IPARM1(4)=8 IPARM1(5)=11 IPARM2(8,4)=13 IPARM2(9,5)=11 IPARM2(10,5)=12 IPARM2(11,5)=13 DO 5003 I=4,5 IPARM4(6,I)=K-2 5003 IPARM4(7,I)=K-1 DO 5004 I=2,5,3 IPARM4(1,I)=K-1 IPARM4(2,I)=K-2 5004 IPARM4(4,I)=K-2 IPARM4(6,2)=1 IPARM4(7,2)=1 C THESE STATEMENTS RESET VARIABLES IN THE DATA BLOCK WHICH MAY HAVE BEEN C CHANGED BY MORE THAN ONE SET OF DATA 5005 IF (S.EQ.0) GO TO 842 IPARM1(1)=4 IPARM1(3)=9 IPARM1(4)=10 IPARM2(8,4)=11 IPARM2(9,5)=13 IPARM2(10,5)=14 IPARM2(11,5)=15 C PARAMETER FOR COVAR,CORR PRINTOUT AND COMPUTATION INITIALIZED - IP5 C HOLDS THE OUTSIDE PARAM. OF EACH COVAR VECTOR IN EACH HYPOTHESIS 842 J=K-2 IF(S.GT.0)J=K-1 DO 5006 I=1,18 IP5(I,5)=J IP5(I,4)=K-1 IP5(I,3)=K-1 IP5(I,2)=J 5006 IP5(I,1)=K-1 DO 5007 I=2,7,4 5007 IP5(I,1)=K-2 IP5(1,2)=J+1 IP5(8,2)=J-1 IP5(10,2)=J-1 IP5(4,3)=K-2 IP5(6,3)=K-2 IP5(9,3)=K-2 IP5(4,4)=K-2 IP5(5,4)=K-2 IP5(8,4)=J IP5(12,4)=J IP5(13,4)=J IP5(10,4)=K-2 IP5( 9,4)=J+1 DO 5008 I=4,6,2 5008 IP5(I,5)=J-1 IP5(10,5)=J-1 DO 5009 I=9,14,5 5009 IP5(I,5)=J+1 C COMPUTING BASIC WORK VECTORS IN ESTIMATE COMPUTATION 1041 CALL ROWCOL(CASE) CALL ADJUST (T,RROW,RCOL,K+1) CALL ADJUST(U,QROW,QCOL,K+1) IF(CASE.EQ.2)GO TO 5021 CALL ADJUST(V,YROW,YCOL,K+1) A(1)=RCOL(1) SUMAB(1)=T(1) SUMAB(K)=0 B(1)=0 B(2)=T(2)-RROW(2) DO 40 I=2,K IF(I-3) 42,41,41 41 B(I)=T(I)+V(I)+U(I)-RROW(I)-YROW(I)-YROW(I-1)+Y(I-1,I-1)-QROW(I)-Q 1ROW(I-1)+Q(I-1,I-1)-QROW(I-2)+Q(I-2,I-2)+Q(I-2,I-1) 42 A(I)=RCOL(I)+YCOL(I)+QCOL(I)-Y(I,I)-Q(I,I)-Q(I-1,I) IF(K-I) 40,40,43 43 SUMAB(I)=T(I)+V(I)+U(I)-YROW(I)-QROW(I)-QROW(I-1)+Q(I-1,I-1) 40 CONTINUE 5021 IF(S.LE.0) GO TO 5020 T(K+1)=T(K)-RCOL(K) U(K+1)=U(K)-QCOL(K) Z(K+1)=T(K+1)+U(K+1)-QROW(K)+Q(K,K) IF(CASE.EQ.2)GO TO 5020 CALL ADJ2(V,YCOL,K,S,2) B(K+1)=T(K+1)+V(K+1)+U(K+1)-YROW(K)+Y(K,K)-QROW(K)+Q(K,K)-QROW(K-1 1)+Q(K-1,K-1)+Q(K-1,K) 5020 DO 10 I=1,K W(I)=RCOL(I)+QCOL(I)-Q(I,I) IF(I.EQ.1) GO TO 11 Z(I)=T(I)+U(I)-RROW(I)-QROW(I)-QROW(I-1)+Q(I-1,I-1) GO TO 10 11 Z(1)=0 10 CONTINUE C INITIALIZE STABLE OF SUBTOTALS USED AS MULTIPLICANDS IN ESTIMATING C THE COVARIANCES DO 120 I=1,K SUBCOV(I,3)=-1/M(I) SUBCOV(I,4)=-1/N(I) IF(I.EQ.K)GO TO 120 SUBCOV(I,1)=1/RROW(I)-1/N(I)-1/(W(I)+Z(I+1)) SUBCOV(I,2)=-(1/RROW(I+1)-1/N(I+1)) SUBCOV(I,5)=1/N(I+1) SUBCOV(I,6)=0 IF(RROW(I)-R(I,I).NE.0) *SUBCOV(I,6)=1/(RROW(I)-R(I,I))-1/N(I) SUBCOV(I,9)=-SUBCOV(I,2) SUBCOV(I,18)=1/N(I+1) IF(KEY.EQ.1.AND.I.EQ.K-1)GO TO 120 SUBCOV(I,7)=0 IF(RROW(I+1)-R(I+1,I+1).NE.0) *SUBCOV(I,7)=-(1/(RROW(I+1)-R(I+1,I+1))-1/N(I+1)) SUBCOV(I,8)=-SUBCOV(I,7)+1/(Z(I+2)-RROW(I+1)+R(I+1,I+1))-1/(W(I+1 *)+Z(I+2)-RROW(I+1)) 120 CONTINUE C PRINT OUT BASIC WORK VECTORS WRITE(6,44) 44 FORMAT('0'/'0BASIC SUBTOTALS') WRITE(6,107) 107 FORMAT('0',1X,'I',2X,'RROW(I)',2X,'RCOL(I)',2X,'QROW(I)',2X,'QCOL( *I)',5X,'T(I)',5X,'U(I)',5X,'W(I)',5X,'Z(I)') IF (CASE.EQ.3) WRITE(6,45) 45 FORMAT('+',77X,'YROW(I)',2X,'YCOL(I)',5X,'V(I)',5X,'A(I)',5X,'B(I) *',1X,'SUMAB(I)') DO 108 I=1,K WRITE(6,109)I,RROW(I),RCOL(I),QROW(I),QCOL(I),T(I),U(I),W(I),Z(I) IF(CASE.EQ.3)WRITE(6,47)YROW(I),YCOL(I),V(I),A(I),B(I),SUMAB(I) 108 CONTINUE IF(S.GT.0) WRITE (6,46)T(K+1),U(K+1),Z(K+1) IF(S.GT.0.AND.CASE.EQ.3)WRITE(6,48)V(K+1),B(K+1) 109 FORMAT(I3,8F9.2) 47 FORMAT('+',75X,6F9.2) 46 FORMAT(39X,2F9.2,9X,F9.2) 48 FORMAT('+',93X,F9.2,9X,F9.2) C BRANCH TO 2 OR 3 MATRIX CASE GO TO (1042,21,20),CASEB C********************************************************************** C LOOP TO CALCULATE ESTIMATORS, VARIANCE, AND STANDARD DEVIATION UNDER H 21 DO 3 I=1,SS C SUBTOTALS FOR ALL I'S IF(I.GT.K)GO TO 9 SUB1= RROW(I)/N(I) SUB2=(RCOL(I)+QCOL(I)-Q(I,I))/(T(I)+U(I)-QROW(I)) SUB3= 1-SUB2 SUB5= (QROW(I)-Q(I,I)) SUB7=1/RROW(I)-1/N(I) SUB11= SUB1*SUB3 C BRANCH ICHK=2*(MAX0(K-1,I)-(K-1))+KEY GO TO (6,7,5,4,9),ICHK C I=1...K-1 KEY=1 6 SUB11=SUB1-(SUB1*SUB2) C I=1...K-1 KEY=2 7 SUB4=(RROW(I+1)+1)/(N(I+1)+1) SHAT(I)=SUB11/SUB4 SHATP(I)=((QROW(I)-Q(I,I))/M(I))/SUB4 SUB8=1/RROW(I+1)-1/N(I+1) SSHAT(I)=SHAT(I)**2*(SUB7+SUB8+1/Z(I+1)-1/(W(I)+Z(I+1))) SSHATP(I)=SHATP(I)**2*(1/(QROW(I)-Q(I,I))-1/M(I)+SUB8) GO TO 8 C I=K KEY=2 4 SUB6=SUB1*SUB3 SUB12=SUB7 SHATQ=0. IF (SUB5.NE.0.) SHATQ=SUB6*M(K)/SUB5 SUB9=1/(T(K)+U(K)-QROW(K)) SUB10=1/(T(K+1)+U(K+1)-QROW(K)+Q(K,K)) SSHATQ=0. IF (QROW(K)-Q(K,K).NE.0.) +SSHATQ=SHATQ**2*(SUB7-SUB9+SUB10+1/(QROW(K)-Q(K,K))-1/M(K)) C I=1...K KEY=1,2 8 FHAT(I)=SUB1*SUB2 SFHAT(I)=FHAT(I)**2*(SUB7+1/W(I)-1/(T(I)+U(I)-QROW(I))) 5 FHATP(I)= Q(I,I)/M(I) SFHATP(I)=FHATP(I)*(1-FHATP(I))/M(I) C I=K KEY=1 IF(I.NE.K.OR.KEY.EQ.2)GO TO 3 FHAT(I)=SUB1 SFHAT(I)=FHAT(I)*(1-FHAT(I))/N(I) GO TO 3 C I=K...SS KEY=2 9 SHATF(I-K)=(RCOL(I)+QCOL(I))/(T(K+1)+U(K+1))*SUB6 C USED IN EXPECTED VALUES MATRIX SHATFP(I-K)=SHATF(I-K)/SHATQ IF(RCOL(I)+QCOL(I).EQ.0) GO TO 3 SSHATF(I-K)=SHATF(I-K)**2*(SUB12+SUB10-SUB9+1/(RCOL(I)+QCOL(I))-1/ 1(T(K+1)+U(K+1))) 3 CONTINUE IF (IOPT.GT.1) GO TO 8002 IF (K.LT.3) GO TO 8002 IF (K.EQ.3.AND.S.EQ.0) GO TO 8002 CALL OPTION(R,Q,RROW,QROW,RCOL,QCOL,T,U,W,E,ZZ,FHAT,FHATP, & SHAT,SHATP,SHATF,SHATQ,N,M,K,SS,IOPT,CHI2,IDF2) 8002 CONTINUE CALL SUM(SHAT,RROW,N,1) C PRINTS OUT ESTIMATES,STAN. DEVIA.,CONFIDENCE LEVELS AFTER COMPLICATED C INDEX MANOUVERING CALL FILNDX(HAT,SD,1) C COMPUTES AND PRINTS COVARIANCE AND CORRELATIONS CALL COVCOR(1,K) C COMPUTES MATRIX OF EXPECTED VALUES FOR R MATRIX - H1 DO 9000 I=1,K IF(I.EQ.K) GO TO 88771 CFBIAS=N(I+1)*(RROW(I+1)+1)/(RROW(I+1)*(N(I+1)+1)) SHAT(I)=SHAT(I)*CFBIAS SHATP(I)=SHATP(I)*CFBIAS 88771 CONTINUE DO 9000 J=1,SS E(I,J)=0 9000 ZZ(I,J)=0 DO 9005 I=1,K E(I,I)=N(I)*FHAT(I) III=I+1 DO 9002 J=III,SS E(I,J)=N(I) IF(I.EQ.K)GO TO 9004 IF(J.LE.K)E(I,J)=N(I)*FHAT(J) JJJ=J-1 IF(J.GT.K) JJJ=K-1 DO 9003 JJ=I,JJJ 9003 E(I,J)=E(I,J)*SHAT(JJ) IF (J.LE.K) GO TO 9002 9004 E(I,J)=E(I,J)*SHATF(J-K) 9002 CONTINUE 9005 CONTINUE CALL EXPECT(R,E,ZZ,N,K,S,1,1) C COMPUTES MATRIX OF EXPECTED VALUES FOR Q MATRIX - H1 DO 9020 I=1,K DO 9020 J=1,SS E(I,J)=0 9020 ZZ(I,J)=0 DO 9021 I=1,K E(I,I)=M(I)*FHATP(I) IF(I.LE.K-1)E(I,I+1)=M(I)*SHATP(I)*FHAT(I+1) III=I+2 IF(I.EQ.K)III=I+1 DO 9022 J=III,SS E(I,J)=M(I) IF(I.LT.K)E(I,J)=E(I,J)*SHATP(I) IF(I.LE.K-2.AND.J.LE.K)E(I,J)=E(I,J)*FHAT(J) IF(I.GT.K-2)GO TO 9024 KK=I+1 JJJ=J-1 IF(J.GT.K) JJJ=K-1 DO 9023 JJ=KK,JJJ 9023 E(I,J)=E(I,J)*SHAT(JJ) IF(J.LE.K)GO TO 9022 9024 IF(I.LT.K) E(I,J)=E(I,J)*SHATF(J-K) IF(I.EQ.K) E(K,J)=E(K,J)*SHATFP(J-K) 9022 CONTINUE 9021 CONTINUE CALL EXPECT(Q,E,ZZ,M,K,S,1,2) C ********************************************************************** C COMPUTING BASIC WORK VECTORS FOR H2 C LOOP AROUND ESTIMATORS,VAR,SD. FOR H2 29 IF(K.GT.2)GO TO 37 WRITE(6,38)TITLE 38 FORMAT('1',A80/'0HYPOTHESIS 2 SKIPPED BECAUSE K IS LESS THAN 3') GO TO 89 37 XCHK=0 DO 30 I=1,SS C SUBTOTALS CALCULATED IF(I.GT.K)GO TO 35 SUB1=(RROW(I)-R(I,I))/N(I) SUB8=RROW(I)-R(I,I) IF(SUB8.EQ.0.AND.I.LT.K.AND.KEY.EQ.1)XCHK=1 IF(SUB8.EQ.0.AND.I.LT.K+1.AND.KEY.EQ.2)XCHK=1 IF (SUB8.NE.0)SUB8=1/SUB8 SUB5=(QROW(I)-Q(I,I))/M(I) SUB14=QROW(I)-Q(I,I) IF(SUB14.NE.0)SUB14=1/SUB14 C BRANCH ICHK=2*(MAX0(K-2,I)-(K-2))+KEY GO TO (31,31,33,31,34,36,35),ICHK C K=1...K-2 KEY=1,2 C ALSO K-1 KEY=2 31 SUB2=RCOL(I+1)-R(I+1,I+1)+QCOL(I+1)-Q(I+1,I+1) SUB3=T(I+1)+U(I+1)-RROW(I+1)-QROW(I+1) SHAT(I)=0 SHATP(I)=0 IF(RROW(I+1)-R(I+1,I+1).EQ.0)GO TO 32 SHAT(I)=SUB1*((N(I+1)+1)/(RROW(I+1)-R(I+1,I+1)+1))*(1-(SUB2/SUB3)) SHATP(I)=SUB5*((N(I+1)+1)/(RROW(I+1)-R(I+1,I+1)+1))*(1-(SUB2/SUB3) *) IF(KEY.EQ.2)SHATP(I)=SUB5*(N(I)/(RROW(I)-R(I,I))*SHAT(I)) SUB11=1/(RROW(I+1)-R(I+1,I+1)) SUB12=1/(Z(I+2)-RROW(I+1)+R(I+1,I+1)) SUB13=1/(W(I+1)+Z(I+2)-RROW(I+1)) SSHAT(I)=SHAT(I)**2*(SUB8-1/N(I)+SUB11-1/N(I+1)+SUB12-SUB13) SSHATP(I)=SHATP(I)**2*(SUB14-1/M(I)+SUB11-1/N(I+1)+SUB12-SUB13) GO TO 32 C I=K KEY=2 36 SUB6=SUB5 SUB7=SUB1 SUB15=SUB8 SUB16=SUB14 SUB18=1/(T(K+1)+U(K+1)) GO TO 32 C I=K-1 KEY=1 33 SHATF(1)=SUB1 SHATFP(1)=SUB5 SSHATF(1)=(SHATF(1)*(1-SHATF(1)))/N(K) SSHTFP(1)=(SHATFP(1)*(1-SHATFP(1)))/M(K) C I=2...K-1 KEY=1,2 C ALSO I=K KEY=2 32 IF(I.LT.2) GO TO 34 FHAT(I)=SUB1*SUB20/(SUB21-SUB20) SUB9=1/(W(I)-R(I,I)) SUB10=Z(I+1)-RROW(I)+R(I,I) IF(I.EQ.K)SUB10=T(K+1)+U(K+1)-RROW(K)+R(K,K)-QROW(K)+Q(K,K) SFHAT(I)=FHAT(I)**2*(SUB8-1/N(I)+1/SUB10+SUB9) 34 FHATP(I)=Q(I,I)/M(I) SFHATP(I)=(FHATP(I)*(1-FHATP(I)))/M(I) FHAT3P(I)=R(I,I)/N(I) SFHT3P(I)=(FHAT3P(I)*(1-FHAT3P(I)))/N(I) SUB20=SUB2 SUB21=SUB3 GO TO 30 C I=K+1...SS KEY=2 35 SUB4=(RCOL(I)+QCOL(I))/(T(K+1)+U(K+1)) SHATF(I-K)=SUB4*SUB7 SHATFP(I-K)=SUB4*SUB6 IF(RCOL(I)+QCOL(I).EQ.0) GO TO 30 SUB17=1/(RCOL(I)+QCOL(I)) SSHATF(I-K)=SHATF(I-K)**2*(SUB15-1/N(K)+SUB17-SUB18) SSHTFP(I-K)=SHATFP(I-K)**2*(SUB16-1/M(K)+SUB17-SUB18) 30 CONTINUE CALL SUM(SHAT,RROW,N,2) C PRINTS OUT ESTIMATES,STAN. DEVIA.,CONFIDENCE LEVELS AFTER COMPLICATED C INDEX MANOUVERING CALL FILNDX(HAT,SD,2) C COMPUTES AND PRINTS COVARIANCE AND CORRELATIONS CALL COVCOR(2,K) C COMPUTES MATRIX OF EXPECTED VALUES FOR R MATRIX - H2 IF(XCHK.EQ.1) GO TO 8966 DO 9010 I=1,K DO 9010 J=1,SS E(I,J)=0 9010 ZZ(I,J)=0 KK=K-2 IF(S.GT.0) KK=K-1 DO 88772 I=1,KK CFBIAS=N(I+1)*(RROW(I+1)-R(I+1,I+1)+1)/((N(I+1)+1)*(RROW(I+1)- * R(I+1,I+1))) SHAT(I)=SHAT(I)*CFBIAS 88772 SHATP(I)=SHATP(I)*CFBIAS KK=K-1 IF (S.GT.0)KK=K DO 9011 I=1,K E(I,I)=N(I)*FHAT3P(I) III=I+1 DO 9012 J=III,SS E(I,J)=N(I) IF(I.EQ.KK)GO TO 9015 IF(J.LE.KK) E(I,J)=N(I)*FHAT(J) JJJ=J-1 IF(J.GT.KK) JJJ=KK-1 DO 9013 JJ=I,JJJ 9013 E(I,J)=E(I,J)*SHAT(JJ) IF(J.LE.KK)GO TO 9012 9015 E(I,J)=E(I,J)*SHATF(J-KK) 9012 CONTINUE 9011 CONTINUE CALL EXPECT(R,E,ZZ,N,K,S,2,1) C COMPUTES MATRIX OF EXPECTED VALUES FOR Q MATRIX - H2 DO 9030 I=1,K DO 9030 J=1,SS E(I,J)=0 9030 ZZ(I,J)=0 KK=K-3 IF(S.GT.0)KK=K-2 DO 9031 I=1,K E(I,I)=M(I)*FHATP(I) IF(I.LE.KK+1)E(I,I+1)=M(I)*SHATP(I)*FHAT(I+1) III=I+2 IF(I.EQ.KK+2)III=I+1 DO 9032 J=III,SS E(I,J)=M(I) IF(I.LE.KK.AND.J.LE.KK+2)E(I,J)=M(I)*FHAT(J) IF(I.LE.KK+1)E(I,J)=E(I,J)*SHATP(I) IF(I.GT.KK)GO TO 9034 JJJ=J-1 IF(J.EQ.K.AND.S.EQ.0)JJJ=K-2 IF(J.GT.K)JJJ=K-1 SUMCS(6)=SUMCS(4)+SUMCS(2) ISMDF(6)=ISMDF(4)+ISMDF(2) II=I+1 DO 9033 JJ=II,JJJ 9033 E(I,J)=E(I,J)*SHAT(JJ) IF(J.LT.KK+3)GO TO 9032 9034 IF(I.LT.KK+2)E(I,J)=E(I,J)*SHATF(J-KK-2) IF(I.EQ.KK+2)E(I,J)=E(I,J)*SHATFP(J-KK-2) 9032 CONTINUE 9031 CONTINUE CALL EXPECT(Q,E,ZZ,M,K,S,2,2) CALL TEXT(3) GO TO 89 8966 WRITE(6,8967)TITLE 8967 FORMAT('1',A80/'0MATRIX OF EXPECTED VALUES NOT CALCULATED BECAUSE * R(I,.)-R(I,I)=0') C LEAVE 2 MATRIX ESTIMATE SECTION CALL TEXT(3) GO TO 89 C ********************************************************************** C SUBTOTALS FOR COVARIANCE IN 3 MATRIX CASE 20 SUBCOV(1,10)=-1/L(1) KK=K-1 DO 5010 I=1,KK IF(I.GT.1) *SUBCOV(I,10)=1/YROW(I)-1/L(I)-1/(YROW(I)+QROW(I-1)-Q(I-1,I-1)) SUBCOV(I,11)=-1/L(I) SUBCOV(I,12)=-(1/YROW(I+1)-1/L(I+1)) SUBCOV(I,13)=1/L(I+1) SUBCOV(I,15)=1/(YROW(I)-Y(I,I))-1/L(I) SUBCOV(I,17)=1/RROW(I)-1/N(I)-1/SUMAB(I) IF(I.EQ.KK.AND.KEY.EQ.1)GO TO 5010 SUBCOV(I,14)=-(1/(YROW(I+1)-Y(I+1,I+1))-1/L(I+1)) SUBCOV(I,16)=-SUBCOV(I,7)+1/(B(I+2)-RROW(I+1)+R(I+1,I+1))-1/(A(I+1 * )+B(I+2)-RROW(I+1)) 5010 CONTINUE SUBCOV(K,11)=-1/L(K) C ********************************************************************* C 3 MATRIX ESTIMATE SECTION C DEFINING BASIC PARAMETERS H4 AND THE 3 MATRIX CASE DO 50 I=1,K SUB1=RROW(I)/N(I) SUB4=YROW(I)/L(I) IF(I.GE.2) *SUB5=(Y(I,I)+Q(I-1,I))/(YROW(I)+QROW(I-1)-Q(I-1,I-1)) SUB8=1/RROW(I)-1/N(I) SUB10=1/YROW(I)-1/L(I) C BRANCH ICHK=2*(MAX0(K-1,I)-(K-1))+KEY GO TO (51,51,53,53),ICHK C I=1...K-1 KEY=1,2 51 SUB3=N(I+1)/RROW(I+1) SUB2=A(I)/SUMAB(I) SUB9=1/SUMAB(I) SHAT(I)=SUB1*(1-SUB2)*SUB3 SSHAT(I)=SHAT(I)**2*(SUB8+1/RROW(I+1)-1/N(I+1)+1/B(I+1)-SUB9) IF (I.LT.2) GO TO 52 SHATP(I)=SUB3*SUB4*(1-SUB5) SSHATP(I)=SHATP(I)**2*(SUB10+1/RROW(I+1)-1/N(I+1)+1/(YROW(I)-Y(I,I 1)+QROW(I-1)-Q(I-1,I-1)-Q(I-1,I))-1/(YROW(I)+QROW(I-1)-Q(I-1,I-1))) 52 SHAT2P(I)=((QROW(I)-Q(I,I))/M(I))*(L(I+1)/YROW(I+1)) SSHT2P(I)=SHAT2P(I)**2*(1/(QROW(I)-Q(I,I))-1/M(I)+1/YROW(I+1)-1/L 1(I+1)) FHAT(I)=SUB1*SUB2 SFHAT(I)=FHAT(I)**2*(SUB8+1/A(I)-SUB9) C I=1...K KEY=1,2 53 IF(I.LT.2) GO TO 54 FHATP(I)=SUB4*SUB5 SFHATP(I)=FHATP(I)**2*(SUB10+1/(Y(I,I)+Q(I-1,I))-1/(YROW(I)+QROW(I 1-1)-Q(I-1,I-1))) 54 FHAT2P(I)=Q(I,I)/M(I) SFHT2P(I)=(FHAT2P(I)*(1-FHAT2P(I))/M(I)) 50 CONTINUE C CONSTANTS FOR H4, C BOTH KEYS FHATP(1)=Y(1,1)/L(1) SFHATP(1)=(FHATP(1)*(1-FHATP(1)))/L(1) SHATP(1)=(N(2)/RROW(2))*(YROW(1)/L(1))*(1-Y(1,1)/YROW(1)) SSHATP(1)=SHATP(1)**2*(-1/L(1)+1/RROW(2)-1/N(2)+1/(YROW(1 1)-Y(1,1))) GO TO (61,62),KEY C KEY=1 61 FHAT(K)=RROW(K)/N(K) SFHAT(K)=(FHAT(K)*(1-FHAT(K)))/N(K) GO TO 63 C KEY=2 62 SUB11=1/(T(K)+V(K)+U(K)-YROW(K)-QROW(K)-Q(K-1,K-1)) SUB12=1/(RCOL(K+1)+YCOL(K+1)+QCOL(K+1)-Q(K,K+1)) SUB13=1/(T(K+1)+V(K+1)+U(K+1)-QROW(K)+Q(K,K)) SUB14=1/RROW(K)-1/N(K) FHAT(K)=RROW(K)/N(K)*(A(K)/(T(K)+V(K)+U(K)-YROW(K)-QROW(K)-QROW(K 1-1)+Q(K-1,K-1))) SFHAT(K)=FHAT(K)**2*(SUB14+1/A(K)-SUB11) SUB6=(RCOL(K+1)+YCOL(K+1)+QCOL(K+1)-Q(K,K+1))/(T(K+1)+V(K+1)+U(K+1 1)-QROW(K)+Q(K,K)) S0HATF=SUB6*(RROW(K)/N(K)-FHAT(K)) S1HATF=((YROW(K)-Y(K,K))/L(K))*SUB6 S2HATF=Q(K,K+1)/M(K) SS0HTF=S0HATF**2*(SUB14+1/(T(K+1)+V(K+1)+U(K+1)-YROW(K)+Y(K,K 1)-QROW(K)+Q(K,K)-QROW(K-1)+Q(K-1,K-1)+Q(K-1,K))-SUB11+SUB12-SUB13) SS1HTF=S1HATF**2*(1/(YROW(K)-Y(K,K))-1/L(K)+SUB12-SUB13) SS2HTF=(S2HATF*(1-S2HATF))/M(K) 63 CONTINUE CALL SUM(SHAT,RROW,N,3) C PRINTS OUT ESTIMATES,STAN. DEVIA.,CONFIDENCE LEVELS AFTER COMPLICATED C INDEX MANOUVERING CALL FILNDX(HAT,SD,3) C COMPUTES AND PRINTS COVARIANCE AND CORRELATIONS CALL COVCOR(3,K) C ********************************************************************* C H5 ESTIMATES VARIANCES DO 70 I=1,K C SUBTOTALS SUB1=RROW(I)/N(I) SUB3=(YROW(I)-Y(I,I))/L(I) SUB5=1/RROW(I)-1/N(I) C BRANCH ICHK= 2*(MAX0(K-2,I)-(K-2))+KEY GO TO (71,71,72,71,74,73),ICHK C 1...K-2 KEY=1 C ALSO K-1 FOR KEY=2 71 SUB10=YROW(I+1)-Y(I+1,I+1) SUB8=QROW(I)-Q(I,I)-Q(I,I+1) SHAT2P(I)=(SUB8/M(I))*(L(I+1)/SUB10) SSHT2P(I)=SHAT2P(I)**2*(1/SUB8-1/M(I)+1/SUB10-1/L(I+1)) C 1...K-1 KEY=1,2 72 SUB2=A(I)/(A(I)+B(I+1)) SUB6=1/RROW(I+1)-1/N(I+1) SUB7=1/(A(I)+B(I+1)) SUB9=1/(YROW(I)-Y(I,I)) SHAT(I)=(SUB1*(1-SUB2))/(RROW(I+1)/N(I+1)) SSHAT(I)=SHAT(I)**2*(SUB5+SUB6+1/B(I+1)-SUB7) SHATP(I)=SUB3*(N(I+1)/RROW(I+1)) SSHATP(I)=SHATP(I)**2*(SUB9-1/L(I)+SUB6) FHAT(I)=SUB1*SUB2 SFHAT(I)=FHAT(I)**2*(SUB5+1/A(I)-SUB7) C 2...K-1 KEY=1,2 C ALSO K KEY=2 73 IF(I.LT.2)GO TO 74 IF(KEY.EQ.1)FHAT3P(I)=Q(I-1,I)/M(I-1)*1/SHAT2P(I-1) SUB11=QROW(I-1)-Q(I-1,I-1)-Q(I-1,I) IF(KEY.EQ.2)FHAT3P(I)=Q(I-1,I)/SUB11*SUB3 SFHT3P(I)=FHAT3P(I)**2*(1/(YROW(I)-Y(I,I))-1/L(I)+1/SUB11+1/ *Q(I-1,I)) C 1...K KEY=1,2 74 FHATP(I)=Y(I,I)/L(I) SFHATP(I)=(FHATP(I)*(1-FHATP(I)))/L(I) FHAT2P(I)=Q(I,I)/M(I) SFHT2P(I)=(FHAT2P(I)*(1-FHAT2P(I)))/M(I) 70 CONTINUE C CONSTANTS GO TO (75,76),KEY 75 FHAT(K)=RROW(K)/N(K) SFHAT(K)=FHAT(K)*(1-FHAT(K))/N(K) S2HATF=Q(K-1,K)/M(K-1) SS2HTF=S2HATF*(1-S2HATF)/M(K-1) GO TO 77 76 FHAT(K)=RROW(K)/N(K)*(A(K)/(T(K)+V(K)+U(K)-YROW(K)-QROW(K-1)+Q(K-1 1,K-1)-QROW(K))) SFHAT(K)=FHAT(K)**2*(1/RROW(K)-1/N(K)+1/A(K)-1/(T(K)+V(K)+U(K)- 1YROW(K)-QROW(K)-QROW(K-1)+Q(K-1,K-1))) SUB4=(RCOL(K+1)+YCOL(K+1)+QCOL(K+1)-Q(K,K+1))/(T(K+1)+V(K+1)+U(K+1 1)-QROW(K)+Q(K,K)) S0HATF=(RROW(K)/N(K)-FHAT(K))*SUB4 S1HATF=((YROW(K)-Y(K,K))/L(K))*SUB4 C SS0HTF,SS1HTF SAME AS H4 KEY=2 S2HATF=Q(K,K+1)/M(K) SS2HTF=S2HATF*(1-S2HATF)/M(K) 77 CONTINUE CALL SUM(SHAT,RROW,N,4) C PRINTS OUT ESTIMATES,STAN. DEVIA.,CONFIDENCE LEVELS AFTER COMPLICATED C INDEX MANOUVERING CALL FILNDX(HAT,SD,4) C COMPUTES AND PRINTS COVARIANCE AND CORRELATIONS CALL COVCOR(4,K) C ********************************************************************* C H6 ESTIMATES AND VARIANCES DO 80 I=1,K C SUBTOTALS SUB1=(RROW(I)-R(I,I))/N(I) SUB2=(YROW(I)-Y(I,I))/L(I) IF(KEY.EQ.1.AND.I.EQ.K)GO TO 86 SUB5=1/(RROW(I)-R(I,I)) SUB10=1/(YROW(I)-Y(I,I)) C BRANCH 86 ICHK=2*(MAX0(K-2,I)-(K-2))+KEY GO TO (81,81,82,82,84,83),ICHK C 1...K-2 KEY=1,2 81 SHAT2P(I)=((QROW(I)-Q(I,I)-Q(I,I+1))/M(I))*(L(I+1)/(YROW(I+1)-Y(I+ 11,I+1))) SSHT2P(I)=SHAT2P(I)**2*(1/(QROW(I)-Q(I,I)-Q(I,I+1))-1/M(I)+1/ *(YROW(I+1)-Y(I+1,I+1))-1/L(I+1)) C 1...K-2 85 SUB3=N(I+1)/(RROW(I+1)-R(I+1,I+1)) SUB4=(B(I+2)-RROW(I+1)+R(I+1,I+1))/(SUMAB(I+1)-RROW(I+1)) SUB7=1/(RROW(I+1)-R(I+1,I+1)) SUB8=1/(B(I+2)-RROW(I+1)+R(I+1,I+1)) SUB9=1/(SUMAB(I+1)-RROW(I+1)) SHAT(I)=SUB1*SUB3*SUB4 SSHAT(I)=SHAT(I)**2*(SUB5-1/N(I)+SUB7-1/N(I+1)+SUB8-SUB9) SHATP(I)=SUB2*SUB3*SUB4 SSHATP(I)=SHATP(I)**2*(SUB10-1/L(I)+SUB7-1/N(I+1)+SUB8-SUB9) C 2...K-1 KEY=1,2 IF(I.LT.2)GO TO 84 82 FHAT(I)=SUB1*((A(I)-R(I,I))/(B(I+1)-RROW(I)+R(I,I))) SFHAT(I)=FHAT(I)**2*(SUB5-1/N(I)+1/(B(I+1)-RROW(I)+R(I,I))+1/(A(I) 1-R(I,I))) C ALSO K KEY=2 83 SUB6=1/(QROW(I-1)-Q(I-1,I-1)-Q(I-1,I)) FHAT3P(I)=Q(I-1,I)/(QROW(I-1)-Q(I-1,I-1)-Q(I-1,I))*SUB2 SFHT3P(I)=FHAT3P(I)**2*(SUB10-1/L(I)+SUB6+1/Q(I 1-1,I)) C 1...K KEY=1,2 84 FHATP(I)=Y(I,I)/L(I) FHAT2P(I)=Q(I,I)/M(I) FHAT4P(I)=R(I,I)/N(I) SFHATP(I)=(FHATP(I)*(1-FHATP(I)))/L(I) SFHT2P(I)=(FHAT2P(I)*(1-FHAT2P(I)))/M(I) SFHT4P(I)=(FHAT4P(I)*(1-FHAT4P(I)))/N(I) IF(I.EQ.K)SUB11=SUB5 IF(I.NE.K-1) GO TO 80 SUB13=SUB5 SUB14=SUB10 80 CONTINUE C CONSTANTS H6 GO TO(87,88),KEY 87 S0HATF=(RROW(K-1)-R(K-1,K-1))/N(K-1) S1HATF=(YROW(K-1)-Y(K-1,K-1))/L(K-1) S2HATF=Q(K-1,K)/M(K-1) SS0HTF=(S0HATF*(1-S0HATF))/N(K-1) SS1HTF=(S1HATF*(1-S1HATF))/L(K-1) SS2HTF=(S2HATF*(1-S2HATF))/M(K-1) GO TO 90 88 FHAT(K)=(RROW(K)-R(K,K))/N(K)*((A(K)-R(K,K))/(T(K+1)+V(K+1)+U(K+1) 1-RROW(K)+R(K,K)-YROW(K)+Y(K,K)-QROW(K)+Q(K,K)-QROW(K-1)+Q(K-1,K-1 2)+Q(K-1,K))) SUB12=1/(B(K+1)-RROW(K)+R(K,K)) SFHAT(K)=FHAT(K)**2*(SUB5-1/N(K)+SUB12+1/(A(K)-R(K,K))) SHAT(K-1)=((RROW(K-1)-R(K-1,K-1))/N(K-1))*((A(K)-R(K,K))/(T(K)+V(K 1)+U(K)-RROW(K)-YROW(K)-QROW(K)-QROW(K-1)+Q(K-1,K-1)))*(1/FHAT(K)) SUB15=1/(T(K)+V(K)+U(K)-RROW(K)-YROW(K)-QROW(K)-QROW(K-1)+Q(K-1,K- *1)) SSHAT(K-1)=SHAT(K-1)**2*(SUB13-1/N(K-1)+SUB5-1/N(K)+SUB12-SUB15) SHATP(K-1)=((YROW(K-1)-Y(K-1,K-1))/L(K-1))*(N(K-1)/(RROW(K-1)-R(K- 11,K-1)))*SHAT(K-1) SSHATP(K-1)=SHATP(K-1)**2*(SUB14-1/L(K-1)+SUB5-1/N(K)+SUB12-SUB15 1) S2HATF=Q(K,K+1)/M(K) SS2HTF=S2HATF*(1-S2HATF)/M(K) SHATQ=(RROW(K)-R(K,K))/N(K)*(L(K)/(YROW(K)-Y(K,K))) SSHATQ=SHATQ**2*(SUB5-1/N(K)+SUB10-1/L(K)) 90 CALL SUM(SHAT,RROW,N,5) C PRINTS OUT ESTIMATES,STAN. DEVIA.,CONFIDENCE LEVELS AFTER COMPLICATED C INDEX MANOUVERING CALL FILNDX(HAT,SD,5) C COMPUTES AND PRINTS COVARIANCE AND CORRELATIONS CALL COVCOR(5,K) C ********************************************************************* 89 CONTINUE C SECTION THAT COMPUTES CHI SQUARE DO 999 I=1,4 ISMDF(I)=0 999 SUMCS(I)=0 C INITIALIZE STAR VARIABLES CALL STAR(RSTAR,1,K,SS) CALL STAR(QSTAR,2,K,SS) DO 6098 I=1,SS 6098 C(I)=0 DO 6099 I=1,4 6099 ROW(I)=0 C CREATE CONTINGENCY TABLES C DEGREES OF FREEDOM J=0 IF(S.GT.0)J=1 ICHK=(J*2+(CASE-1)) GO TO (1015,1013,1012,1014),ICHK 1015 ISMDF(1)=2*K-1 ISMDF(2)=K-2 ISMDF(3)=K-2 GO TO 1016 1012 ISMDF(1)=2*K ISMDF(2)=K-1 ISMDF(3)=K IF(S.EQ.1)ISMDF(3)=K-1 GO TO 1016 1013 ISMDF(1)=K-2 ISMDF(2)=K-2 GO TO 1016 1014 ISMDF(1)=K-1 ISMDF(2)=K-1 1016 CONTINUE KK=K IF(KEY.EQ.1)KK=K-1 IF(CASE.EQ.3) GO TO 1011 DO 1001 I=1,K IN11(I,1,1)=RROW(I) IN11(I,2,1)=QROW(I) IN11(I,1,2)=N(I)-RROW(I) IN11(I,2,2)=M(I)-QROW(I) 1001 CONTINUE DO 1002 I=1,KK IN12(I,1,1)=W(I) IN12(I,2,1)=Q(I,I) IN12(I,1,2)=T(I)+U(I)-QROW(I)-W(I) IN12(I,2,2)=QROW(I)-Q(I,I) 1002 CONTINUE LLL=2 CALL CHIPRT(1,1,K,LLL) WRITE(6,8020) 8020 FORMAT('0'/'0THIS TEST OF THE HYPOTHESIS H0 AGAINST THE HYPOTHESIS * H1 TESTS THE ASSUMPTION THAT YOUNG AND ADULTS HAVE THE'/' SAME SU *RVIVAL AND RECOVERY RATES.') DO 1003 I=2,KK IN2(I,1,1)=R(I,I) IN2(I,2,1)=W(I)-R(I,I) IN2(I,1,2)=RROW(I)-R(I,I) IN2(I,2,2)=IN12(I,1,2)-RROW(I)+R(I,I) 1003 CONTINUE CALL CHIPRT(2,2,KK,1) WRITE(6,8021) 8021 FORMAT('0'/'0THIS TEST OF THE HYPOTHESIS H1 AGAINST THE HYPOTHESIS * H2 TESTS THE ASSUMPTION THAT RECOVERY RATES FOR NEWLY'/' RELEASED * ADULTS ARE THE SAME AS FOR SURVIVORS OF PREVIOUSLY BANDED COHORTS *.') IN3(1,1,1)=Q(1,2) IN3(1,2,1)=R(1,2) IN3(1,1,2)=QROW(1)-Q(1,1)-Q(1,2) IN3(1,2,2)=RROW(1)-R(1,1)-R(1,2) KKK=KK-1 DO 1004 I=2,KKK IN3(I,1,1)=Q(I,I+1) IN3(I,2,1)=RSTAR(I,I+1)+QSTAR(I-1,I+1) IN3(I,1,2)=QROW(I)-Q(I,I)-Q(I,I+1) IN3(I,2,2)=Z(I+1)-RSTAR(I,I+1)-QSTAR(I-1,I+1) 1004 CONTINUE IF(KEY.EQ.1.OR.S.EQ.1)GO TO 1005 IN3(K,1,1)=Q(K,K+1) IN3(K,2,1)=RCOL(K+1)+QCOL(K+1)-Q(K,K+1) IN3(K,1,2)=QROW(K)-Q(K,K)-Q(K,K+1) IN3(K,2,2)=T(K+1)+U(K+1)-QROW(K)+Q(K,K)-RCOL(K+1)-QCOL(K+1)+Q(K,K+ *1) KKK=K 1005 CALL CHIPRT(3,1,KKK,1) WRITE(6,8022) 8022 FORMAT('0'/'0REJECTION OF H2 IN FAVOR OF H3 WOULD INDICATE THAT SU *RVIVAL AND RECOVERY RATES ARE AGE-DEPENDENT FOR AT LEAST'/ *' THE FIRST TWO YEARS.') IF(IOPT.GT.1.) GO TO 8025 WRITE(6,8023) 8023 FORMAT('0'/'0'/'0THE HYPOTHESES H01 AND H02 ARE MORE RESTRICTIVE T *HAN H1 BUT ARE NOT COMPARABLE IN THIS SENSE WITH H0, THUS H01'/ *' AND H02 DO NOT FIT INTO THE ABOVE SERIES. IN PRACTICE THE MODEL *S UNDER H02 AND H1 ARE LIKELY TO BE OF MOST USE, SO A'/ *' LIKELIHOOD RATIO TEST TO DISTINGUISH BETWEEN THESE MODELS IS COM *PUTED BELOW. THIS TESTS THE ASSUMPTION THAT YOUNG AND'/ *' ADULT SURVIVAL RATES ARE CONSTANT FROM YEAR TO YEAR.') WRITE(6,8024)(LINE,I=1,5),CHI2,IDF2 8024 FORMAT('0'/' LIKELIHOOD RATIO TEST OF H02 VS H1.'/1X,4A8,A3/ *'0'/' CHI-SQUARE VALUE',40X,'=',F8.2/' DEGREES OF FREEDOM',38X *,'=',I8) ZY=CHI2 IF (ZY.GT.0. .AND. ZY.LT.10000.) CALL CHI(IDF2,ZY,PP,IDUMMY) 8025 CONTINUE GO TO 1000 1011 CONTINUE DO 1006 I=2,KK IN11(I,1,1)=Y(I,I) IN11(I,2,1)=Q(I-1,I) IN11(I,1,2)=YROW(I)-Y(I,I) IN11(I,2,2)=QROW(I-1)-Q(I-1,I-1)-Q(I-1,I) 1006 CONTINUE LLL=5 CALL CHIPRT(LLL,2,KK,1) DO 1007 I=2,KK IN2(I,1,1)=R(I,I) IN2(I,2,1)=A(I)-R(I,I) IN2(I,1,2)=RROW(I)-R(I,I) IN2(I,2,2)=B(I+1)-RROW(I)+R(I,I) 1007 CONTINUE LLL=6 CALL CHIPRT(LLL,2,KK,1) 1000 CONTINUE C ********************************************************************* C GOODNESS OF FIT TEST C CREATE MATRIX CONTINGENCY TABLE IS DERIVED FROM ISMDF(4)=0 IE=4 KK=K C BRANCH ON CASE IF(CASE.EQ.3)GO TO 7050 IF(S.LT.2)KK=K-2+S C FIRST TABLE IH=3 WRITE(6,828)TITLE 828 FORMAT('1',A80) WRITE(6,825)IH,(LINE,J=1,7),(LINE,J=1,8) 825 FORMAT('0CHI-SQUARE GOODNESS OF FIT TEST OF THE MODEL UNDER H', *I1/1X,6A8,A5/'0',19X,'CONTINGENCY TABLES',44X, *'CORRESPONDING CHI-SQUARE'/82X,'STATISTICS AND DEGREES OF FREEDOM' */20X,2A8,A2,44X,4A8,A1) SSS=SS-1 DO 7003 I=2,KK J=0 DO 7000 II=I,SSS J=J+1 ALPHA(1,J)=R(I,II+1) ALPHA(2,J)=Q(I-1,II+1) IF(I.NE.2)ALPHA(3,J)=RSTAR(I-1,II+1)+QSTAR(I-2,II+1) IF(I.EQ.2) ALPHA(3,J)=RSTAR(1,II+1) DO 7000 JJ=1,3 C(J)=C(J)+ALPHA(JJ,J) ROW(JJ)=ROW(JJ)+ALPHA(JJ,J) 7000 CONTINUE JC=J JR=3 7003 CALL CMBINE IF(S.LE.2)GO TO 7030 C SECOND TABLE J=0 DO 7002 I=2,S J=J+1 ALPHA(1,J)=Q(K,K+I) ALPHA(2,J)=RSTAR(K,K+I)+QSTAR(K-1,K+I) DO 7002 JJ=1,2 C(J)=C(J)+ALPHA(JJ,J) ROW(JJ)=ROW(JJ)+ALPHA(JJ,J) 7002 CONTINUE JC=J JR=2 I=K+1 CALL CMBINE C GOODNESS OF FIT TEST FOR H1 7030 SUMCS(5)=SUMCS(4)+SUMCS(2)+SUMCS(3) ISMDF(5)=ISMDF(4)+ISMDF(2)+ISMDF(3) WRITE(6,826) (LINE,J=1,5),SUMCS(4),ISMDF(4),(LINE,J=1,5) 826 FORMAT(' '/' ',36X,'!',4A8,A7,'!'/37X,'!TOTAL CHI-SQUARE',3X,F7.2, *' WITH',I3,' D.F.!'/37X,'!',4A8,A7,'!'/' ') IDF=ISMDF(4) ZY=SUMCS(4) CALL CHI(IDF,ZY,PP,IDUMMY) C GOODNESS OF FIT TEST FOR H2 SUMCS(6)=SUMCS(4)+SUMCS(3) ISMDF(6)=ISMDF(4)+ISMDF(3) SUMCS(7)=SUMCS(4) ISMDF(7)=ISMDF(4) SUMCS(4)=SUMCS(5)+SUMCS(1) ISMDF(4)=ISMDF(5)+ISMDF(1) IH=0 II=4 III=7 GO TO 7060 C ********************************************************************* C 3 MATRIX CASE - GOODNESS OF FIT TEST 7050 CALL STAR(YSTAR,3,K,SS) SSS=K IF(S.LT.2)SSS=K-2 C FIRST TABLE IH=6 IT=1 WRITE(6,828)TITLE WRITE(6,825)IH,(LINE,J=1,7),(LINE,J=1,8) J=0 DO 7051 I=2,SS J=J+1 ALPHA(1,J)=R(1,I) ALPHA(2,J)=Y(1,I) DO 7051 JJ=1,2 C(J)=C(J)+ALPHA(JJ,J) ROW(JJ)=ROW(JJ)+ALPHA(JJ,J) 7051 CONTINUE JC=J JR=2 I=1 CALL CMBINE C SECOND TABLE KK=SS-1 DO 7054 I=2,SSS J=0 DO 7052 II=I,KK J=J+1 ALPHA(1,J)=R(I,II+1) ALPHA(2,J)=Y(I,II+1) ALPHA(3,J)=Q(I-1,II+1) IF(I.NE.2)ALPHA(4,J)=RSTAR(I-1,II+1)+YSTAR(I-1,II+1)+QSTAR(I-2,II+ *1) IF(I.EQ.2)ALPHA(4,J)=RSTAR(1,II+1)+YSTAR(1,II+1) DO 7052 JJ=1,4 C(J)=C(J)+ALPHA(JJ,J) ROW(JJ)=ROW(JJ)+ALPHA(JJ,J) 7052 CONTINUE JC=J JR=4 7054 CALL CMBINE IF(S.LE.2)GO TO 7070 C THIRD TABLE J=0 KK=SS-2 DO 7053 I=K,KK J=J+1 ALPHA(1,J)=Q(K,I+2) ALPHA(2,J)=RCOL(I+2)+YCOL(I+2)+QSTAR(K-1,I+2) DO 7053 JJ=1,2 C(J)=C(J)+ALPHA(JJ,J) ROW(JJ)=ROW(JJ)+ALPHA(JJ,J) 7053 CONTINUE JC=J JR=2 I=K+1 CALL CMBINE 7070 CONTINUE WRITE(6,826) (LINE,J=1,5),SUMCS(4),ISMDF(4),(LINE,J=1,5) IDF=ISMDF(4) ZY=SUMCS(4) CALL CHI(IDF,ZY,PP,IDUMMY) C GOODNESS OF FIT TEST FOR H4 AND H5 SUMCS(5)=SUMCS(4)+SUMCS(2)+SUMCS(1) ISMDF(5)=ISMDF(4)+ISMDF(2)+ISMDF(1) SUMCS(6)=SUMCS(4)+SUMCS(2) ISMDF(6)=ISMDF(4)+ISMDF(2) IH=4 II=5 III=6 C PRINT REMAINING GOODNESS OF FIT TESTS 7060 CONTINUE WRITE(6,828)TITLE DO 7061 I=II,III WRITE(6,7041)IH,(LINE,J=1,7) 7041 FORMAT(////'0CHI-SQUARE GOODNESS OF FIT TEST OF THE MODEL UNDER H' *,I1/1X,6A8,A5) WRITE(6,826) (LINE,J=1,5),SUMCS(I),ISMDF(I),(LINE,J=1,5) IDF=ISMDF(I) ZY=SUMCS(I) CALL CHI(IDF,ZY,PP,IDUMMY) 7061 IH=IH+1 IF (CASE.EQ.2) WRITE(6,88774) 88774 FORMAT(/'0 FROM THE MODELS ABOVE, ONE SHOULD CHOOSE THE SIMPLEST M *ODEL (FEWEST PARAMETERS) THAT ADEQUATELY DESCRIBES THE DATA.'/ *'0ADEQUACY MAY BE JUDGED BY EXAMINING THE RESULTS OF (1) THE GOODN *ESS OF FIT TESTS, AND (2) THE TESTS BETWEEN SPECIFIC '/'0MODELS. F *REQUENTLY, H02 OR H1 IS ADEQUATE.') GO TO 8001 C ********************************************************************** C TESTS FOR DIFFERENCES DUE TO SEX 1042 SUMCS(4)=0 I=1 WRITE(6,1031)TITLE,I DO 1030 I=1,K IN11(I,1,1)=RROW(I) IN11(I,1,2)=N(I)-RROW(I) IN11(I,2,1)=QROW(I) IN11(I,2,2)=M(I)-QROW(I) 1030 CONTINUE LL=10 CALL CHIPRT(LL,1,K,1) I=2 WRITE(6,1031)TITLE,I KK=K IF(S.EQ.0)KK=K-1 DO 1033 I=1,KK IN11(I,1,1)=RCOL(I) IN11(I,1,2)=T(I)-RCOL(I) IN11(I,2,1)=QCOL(I) IN11(I,2,2)=U(I)-QCOL(I) 1033 CONTINUE LL=10 CALL CHIPRT(LL,1,KK,1) 1031 FORMAT('1',A80/'0CONTINGENCY CHI-SQUARE TEST FOR DIFFERENCES DUE *TO SEX'/'0MATRIX',I3) IF(S.LT.2)GO TO 1035 I=3 WRITE(6,1031)TITLE,I WRITE(6,1050) 1050 FORMAT('0',4X,'CONTINGENCY TABLE FOR S GREATER THAN 1') DO 1034 I=1,S ALPHA(1,I)=RCOL(K+I) ALPHA(2,I)=QCOL(K+I) DO 1034 J=1,2 C(I)=C(I)+ALPHA(J,I) ROW(J)=ROW(J)+ALPHA(J,I) 1034 CONTINUE JC=S JR=2 I=K+1 ALPHA(4,4)=9999 CALL CMBINE 1035 ISMDF(4)=2*K+S-1 WRITE(6,826) (LINE,J=1,5),SUMCS(4),ISMDF(4),(LINE,J=1,5) IDF=ISMDF(4) ZY=SUMCS(4) CALL CHI(IDF,ZY,PP,IDUMMY) GO TO 8001 8000 STOP END