C  Teresa--This program will count violations of stochastic dominance
C   and violations of coalescing in Birnbaum & Martin 
C   for Subdesign 3.  Data are organized in 17 lines 
C   With line 12 having subdesign 3  
C   Read the subject ID from each case, to check if the data
C   are properly read and coded.  This version set for N = 99 2/5/98
C **************************************************************
C
      PROGRAM TERESA
      IMPLICIT DOUBLEPRECISION(A-H,O-Z)  
	  DIMENSION D1(110,5,2),ISNAME(110)
      DIMENSION KCI1(110,5)
	  DIMENSION KCT1(5,4)
	  DIMENSION KCS(110,8,4)
	  DIMENSION KST(110,2,4),IST(110,4),KT(2,4)
C THESE ARE THE FILES TO BE USED
      OPEN (5, FILE = 'TERESA3.DAT', STATUS = 'OLD')
	  OPEN (6, FILE = 'TERESA.OUT',STATUS = 'NEW')
C      OPEN (6, FILE = 'COMPAY2S.OUT', STATUS = 'NEW')
C
C     ********************************* READ IN THE DATA
      NSUB = 100
	  DO 200 IS = 1,NSUB
	  READ(5,101) ((D1(IS,IR,JC),JC=1,2),IR=1,5),ISNAME(IS)
  101 FORMAT(11(/),10F4.0/////28X,I4)
  200 CONTINUE
      WRITE(6,102)
  102 FORMAT(2X, ' WARNING--ROWS 1, 3, 5 ARE REFLECTED')
C RECODE THE DATA FOR ROWS 1, 3, 5   +++++++++++++ RECODE
      DO 210 IS = 1,NSUB
	  DO 210 JC=1,2
	  D1(IS,1,JC)= -1*D1(IS,1,JC)
	  D1(IS,3,JC)= -1*D1(IS,3,JC)
	  D1(IS,5,JC)= -1*D1(IS,5,JC)
  210 CONTINUE

C
C ****************************************************************
C
C HERE WE BEGIN TO COUNT THE DATA AS FOLLOWS:
C                                   CELL = 1 IF NEGATIVE&NEGATIVE
C                                   CELL = 2 IF NEGATIVE&POSITIVE
C                                   CELL = 3 IF POSITIVE&NEGATIVE
C                                   CELL = 4 IF POSITIVE&POSITIVE
C 
C  DATA ARE RECODED TO MATCH ROWS 2 AND 4 IN CODING SHEET
C 
C   
C***************************************************************** 
	  DO 300 IS = 1,NSUB
	  DO 250 IR =1,5
	  IF (D1(IS,IR,1) .LT. 0.0 .AND. D1(IS,IR,2) .LT. 0.0) THEN
     	 KCI1(IS,IR)=1
	  ELSE IF (D1(IS,IR,1) .LT. 0.0 .AND. D1(IS,IR,2) .GE. 0.0) THEN
     	 KCI1(IS,IR)=2
	  ELSE IF (D1(IS,IR,1) .GE. 0.0 .AND. D1(IS,IR,2) .LT. 0.0) THEN
     	 KCI1(IS,IR)=3
      ELSE 
	  	 KCI1(IS,IR)=4
	  END IF
  250 CONTINUE
  300 CONTINUE
C NOW FIND TOTALS FOR EACH DESIGN AND SUBJECT
C FIRST SET TOTALS TO ZERO
      DO 350 IR = 1,5
	  DO 350 IC = 1,4
	  KCT1(IR,IC)=0
  350 CONTINUE
C ************************* COMPUTE SUBJECT SUMMARIES *********
      DO 450 IS =1,NSUB
	  ID =1
	  DO 450 IC =1,4
	  KCS(IS,ID,IC)=0
  450 CONTINUE
C ***************************************
      DO 400 IS=1,NSUB
      DO 400 IC=1,4
	  DO 375 IR=1,5
	  IF (KCI1(IS,IR) = IC) THEN
	     KCT1(IR,IC) = KCT1(IR,IC)+1
		 KCS(IS,1,IC)=KCS(IS,1,IC)+1
      END IF
  375 CONTINUE     
  400 CONTINUE
C NOW PRINT OUT RESULTS
C NOW PRINT OUT SUMMARY OVER SUBJECTS
      WRITE(6,401) 
  401 FORMAT(//' DESIGN = 1  TESTS OF COALESCING AND STOCH DOM')
      WRITE(6,501)
      DO 600 IR = 1,5
  501 FORMAT('  ROW =',4X, 2X,'   NN    NP   PN   PP ' )
  502 FORMAT(/,26X,'   NN    NP   PN   PP ')
	  WRITE(6,503)IR,(KCT1(IR,IC),IC=1,4)
  503 FORMAT(3X,I3,7X,4I5)
  600 CONTINUE
C NOW PRINT OUT EACH SUBJECTS TOTALS OVER ROWS
C SET SUBJECT TOTALS TO ZERO
      DO 750 IS=1,NSUB
	  DO 750 IC =1,4
	  KST(IS,1,IC)=0
	  IST(IS,IC)=0
	  KT(1,IC)=0
	  KT(2,IC)=0
  750 CONTINUE
      DO 760 IS =1,NSUB
	  DO 760 IC = 1,4
	  KST(IS,1,IC) =KCS(IS,1,IC)
	  KT(1,IC)=KT(1,IC)+KST(IS,1,IC)
  760 CONTINUE
  801 FORMAT(/'COALESCING FOR SUB=',I4,'    NN    NP   PN   PP ')
      DO 850 IS=1,NSUB
C	   WRITE(6,801) ISNAME(IS)
	  ID =1
C      WRITE(6,852) ISNAME(IS),ID,(KCS(IS,ID,IC),IC=1,4)
  852 FORMAT(' SUB=',I4,8X,'DESIGN=',I3,8X,4I5)
  850 CONTINUE 
      WRITE(6,871)
  871 FORMAT(//' COALESCING TOTALS SUB     NN    NP   PN   PP ')
      DO 880 IS=1,NSUB
	  WRITE(6,881) ISNAME(IS), (KST(IS,1,IC),IC=1,4)
  881 FORMAT(' SUB=',I3,7X,'        ',4I5)
  880 CONTINUE
      WRITE(6,883) (KT(1,IC),IC=1,4)
  883 FORMAT(//' SUM=',5X,'SUMS         ',4I5)	  	
  890 CONTINUE
  892 FORMAT(//' OVER ALL TOTALS      NN    NP   PN   PP',/,20X,4I5)
	  WRITE(6,999)
  999 FORMAT(///' NORMAL END')
      STOP
	  END