SUBROUTINE GOF2(TITLE,LAST,YR,TSUM3,I3) C C THIS SUBROUTINE PERFORMS A GOODNESS OF FIT TEST USING C CONTINGENCY TABLES. THE FORMAT OF THESE TABLES IS: C +--------+--------+ +---------+--------+ C ! CA-OA ! CN-OA ! ! CM-OA ! Z-OA ! C +--------+--------+ +---------+--------+ C ! CA-OY ! CN-OY ! ! CM-OY ! Z-OY ! C +--------+--------+ +---------+--------+ C ! CA-NA ! CN-NA ! ! CM-NA ! Z-NA ! C +--------+--------+ +---------+--------+ C ! CM-NY ! Z-NY ! C +---------+--------+ C WHERE C CM IS THE NUMBER OF CAPTURED MARKED IN PERIOD I C Z IS THE NUMBER CAUGHT BEFORE AND AFTER, BUT NOT C IN PERIOD I C CA IS THE NUMBER CAUGHT AS ADULTS IN PERIOD I, AND C CAUGHT LATER C CN IS THE NUMBER CAUGHT AS ADULTS IN PERIOD I, AND C NOT CAUGHT LATER C -OA IS A SUBDIVISION OF EACH OF THE PRECEDING CATAGORIES C WHICH STANDS FOR "OLD ADULTS" C -OY IS A SUBDIVISION OF EACH OF THE PRECEDING CATAGORIES C WHICH STANDS FOR "OLD YOUNG" C -NA IS A SUBDIVISION OF EACH OF THE PRECEDING CATAGORIES C WHICH STANDS FOR "NEW ADULTS" C -NY IS A SUBDIVISION OF EACH OF THE PRECEDING CATAGORIES C WHICH STANDS FOR "NEW YOUNG" C IMPLICIT DOUBLE PRECISION (A-H,O-Z) INTEGER IDIM PARAMETER (IDIM=50) INTEGER YR(IDIM) DOUBLE PRECISION CA(IDIM,4),CM(IDIM,4),CN(IDIM,4),Z(IDIM,4) DOUBLE PRECISION EX1(2,4),EX2(2,4),OBS1(2,4),OBS2(2,4) CHARACTER*128 TITLE COMMON /BLK2/CA,CM,CN,Z TSUM1=0. TSUM2=0. I1=0 I2=0 WRITE(7,10)CHAR(12),TITLE 10 FORMAT(A1,A128//20X,'Contingency table goodness-of-fit test', ,' (from Pollock, Hines and Nichols in prep.)'/ / 21X,80('-')) IF(CM(2,3).LE..0D0.AND.CM(2,4).LE..0D0)GO TO 130 C C FOR EACH PERIOD PERIOD FROM 2,3,...LAST-1 C COMPUTE 2 EXPECTED VALUE MATRICES AND C CHI SQUARE VALUES. ALSO, PRINT OUT CONTINGENCY C TABLES C DO 100 I=2,LAST-1 DO 20 J=1,4 OBS1(1,J)=CM(I,J) OBS1(2,J)=Z(I,J) OBS2(1,J)=CA(I,J) 20 OBS2(2,J)=CN(I,J) CALL EXVAL(OBS2,EX2) CALL EXVAL(OBS1,EX1) WRITE(7,40)YR(I) 40 FORMAT(/34X,'Adults Young Adults',38X, , 2(' Adults Young ')/' i=',I4,25X,3(' 1st cap '),37X, , 4(' 1st cap ')/32X,2(' before i'),3X,'in i',37X, , 'before i-1 before i-1 in i-1 in i-1') WRITE(7,50) 50 FORMAT(32X,'+',3('--------+'),36X,'+',4('--------+')) WRITE(7,60)(OBS2(1,J),J=1,3),(OBS1(1,J),J=1,4) 60 FORMAT(' Cap in i, released & recap !',3(F8.2,'!'), , 16X, 'Cap in i !',4(F8.2,'!')) WRITE(7,70)(EX2(1,J),J=1,3),(EX1(1,J),J=1,4) 70 FORMAT(' Expected value',17X,'!',3(F8.2,'!'), , 16X,'Expected value',6X,'!',4(F8.2,'!')) WRITE(7,50) WRITE(7,80)(OBS2(2,J),J=1,3),(OBS1(2,J),J=1,4) 80 FORMAT(' Cap in i, released & not recap !',3(F8.2,'!'), , 16X, 'Cap after, not in i !',4(F8.2,'!')) WRITE(7,70)(EX2(2,J),J=1,3),(EX1(2,J),J=1,4) C POOL TABLE ( BY COLS) UNTIL ALL EXP. VALS >= 2.0 CALL POOL(EX1,OBS1) IDF1=0 SUM1=.0D0 DO 83 J=1,4 IF(EX1(1,J).LT..2D1.OR.EX1(2,J).LT..2D1)GO TO 83 IDF1=IDF1+1 DO 82 II=1,2 82 SUM1=SUM1+(OBS1(II,J)-EX1(II,J))**2/EX1(II,J) 83 CONTINUE IDF1=MAX(IDF1-1,0) IF(IDF1.LT.1)SUM1=0. C POOL TABLE ( BY COLS) UNTIL ALL EXP. VALS >= 2.0 CALL POOL(EX2,OBS2) IDF2=0 SUM2=.0D0 DO 88 J=1,3 IF(EX2(1,J).LT..2D1.OR.EX2(2,J).LT..2D1)GO TO 88 IDF2=IDF2+1 DO 87 II=1,2 87 SUM2=SUM2+(OBS2(II,J)-EX2(II,J))**2/EX2(II,J) 88 CONTINUE IDF2=MAX(IDF2-1,0) IF(IDF2.LT.1)SUM2=0. C C OUTPUT Total chi-square OF EACH TABLE & PROB. C P1=CHIPRB(IDF1,SUM1) P2=CHIPRB(IDF2,SUM2) WRITE(7,50) WRITE(7,90)SUM2,IDF2,P2,SUM1,IDF1,P1 90 FORMAT(2(' Chi-square = ',F8.4,' with ',I2, , ' degrees of freedom (Prob.=',F6.4,') ')) TSUM1=TSUM1+SUM1 TSUM2=TSUM2+SUM2 I1=I1+IDF1 I2=I2+IDF2 100 CONTINUE WRITE(7,110) 110 FORMAT(/1X,132('-')) P1=CHIPRB(I1,TSUM1) P2=CHIPRB(I2,TSUM2) WRITE(7,90)TSUM2,I2,P2,TSUM1,I1,P1 TSUM3=TSUM1+TSUM2 I3=I1+I2 PROB=CHIPRB(I3,TSUM3) WRITE(7,120)TSUM3,I3,PROB 120 FORMAT(25X,'Overall chi-square = ',F8.4,' with ',I2, ,' degrees of freedom (Prob. =',F6.4,')'/1X,132('-')) GO TO 150 130 WRITE(7,140) 140 FORMAT(/' **** Insufficient data for this test ****'/) 150 RETURN END