>AAQ2>AAA"&III2!IMK1bQQIF<	)FIIII~			~AAA> 

C***********************************************************************
C                                                                      *
C     G O D D A R D  C O M P U T E R  S C I E N C E  I N S T I T U T E *
C                                                                      *
C     (1) PROGRAM NAME,          TWO-WAY CROSS TABULATION              *
C     (2) CALLING NAME,          CRTAB                                 *
C     (3) STATUS/CHANGE LEVEL,   PGM.=GCSL032,  PCR.= 00-08-67         *
C     (4) PROGRAMMED BY,         STEWART H. CROSSLAND                  *
C     (5) ADAPTED TO HP FORMAT   ROLAND JAHN 03-70                     *
C                                                                      *
C           SUPPORTED IN PART BY GRANT NO. FR00197 BY THE              *
C           SPECIAL RESEARCH RESOURCES BRANCH, NIH-USPHS               *
C                                                                      *
C***********************************************************************
      PROGRAM GCS32 
      DIMENSION   MTAB(99,25),NCOM(3,36),MTOT(99),ID(99)
C 
C     SET-UP CROSS-TAB LABELS, IDENTIFICATION OF
C     CELLS BY THEIR ORDINAL POSITION.
C 
      ID(1)    =  0 
      DO 10 I   =  2,99 
   10 ID(I)    =  ID(I-1)+1 
C 
C     INITIALIZE THE CROSS-TAB MATRIX 
C 
   20 DO 30 I   =  1,99 
      DO 30 J   =  1,25 
   30 MTAB(I,J)=  0 
C 
C     READ THE HEADER AND PARAMETERS
C 
      DO 40 I   =  1,3
   40 READ (5, 140) (NCOM(I,J),J=1,36)
      READ (5, 150)  ISW2,NPRS,LIMX,LIMY
      LIMIT    =  LIMX+1
      LIMY1    =  LIMY+1
C 
C     CHECK IF VALUE FOR LIMX IS EXCEEDED 
C 
      IF          (LIMX-25) 60,60,50
   50 WRITE (6, 220)
      GO TO        240
C 
C     CALL THE READ SUBROUTINE AND PERFORM
C     THE CROSS-TABULATION
C 
   60 DO 70 I   =  1,NPRS 
      CALL        READ (NX,NY)
      NX       =  NX+1
      NY       =  NY+1
   70 MTAB(NX,NY)=MTAB(NX,NY)+1 
C 
C     PRINT THE HEADER AND PARAMETERS 
C 
      I1=1
      I2=15 
   73 WRITE (6, 130)
      WRITE (6, 140) (NCOM(1,J),J=1,36) 
      WRITE (6, 160)  ISW2,NPRS,LIMX,LIMY 
      WRITE (6, 170) (NCOM(2,J),J=1,29) 
      WRITE (6, 180) (NCOM(3,J),J=1,29) 
      IF (LIMIT-I2) 75,75,77
   75 I2=LIMIT
   77 WRITE (6, 200) (ID(K),K=I1,I2)
      WRITE (6, 230)
C 
C     DETERMINE ROW TOTALS AND PRINT RESULTS
C 
      LINES    =  14
      DO 110 J   =  1,LIMY1 
      J1=J-1
      NTOT   =  0 
      DO 80 I   =  1,LIMIT
   80 NTOT   =  NTOT+MTAB(J,I)
      IF          (LINES-50) 100,100,90 
   90 LINES    =  14
      WRITE (6, 130)
      WRITE (6, 140) (NCOM(1,K),K=1,36) 
      WRITE (6, 160)  ISW2,NPRS,LIMX,LIMY 
      WRITE (6, 170) (NCOM(2,K),K=1,29) 
      WRITE (6, 180) (NCOM(3,K),K=1,29) 
      WRITE (6, 200) (ID(K),K=I1,I2)
      WRITE (6, 230)
  100 IF (LIMIT-I2) 104,104,108 
  104 WRITE (6, 190)  J1,(MTAB(J,K),K=I1,I2),NTOT 
      GO TO 110 
  108 WRITE (6, 190)  J1,(MTAB(J,K),K=I1,I2)
  110 LINES    =  LINES+1 
C 
C     CALCULATE AND PRINT COLUMN TOTALS 
C 
      DO 120 I   =  1,LIMIT 
      MTOT(I)=  0 
      DO 120 J   =  1,LIMY1 
  120 MTOT(I)=  MTOT(I)+MTAB(J,I) 
      WRITE (6, 210)  (MTOT(K),K=I1,I2) 
      IF (LIMIT-I2) 240,240,125 
  125 I1=16 
      I2=LIMIT
      GO TO 73
C 
C     FORMAT STATEMENTS 
C 
  130 FORMAT( 30(/) 26HCROSS-TABULATION (GCSL032)/) 
  140 FORMAT( 36A2 )
  150 FORMAT(I1,I4,2I2) 
  160 FORMAT(/ 16HINPUT PARAMETERS,4X,5HISW2=I1,3X,7HNPAIRS=I4,8X,7HLI
     1MITX=I2,3X,7HLIMITY=I2//) 
  170 FORMAT( 13HX-AXIS ID. = ,29A2 ) 
  180 FORMAT( 13HY-AXIS ID. = ,29A2 ) 
  190 FORMAT( 3X,I2,2X,16I4)
  200 FORMAT(// 33X,7HX-AXIS /7X,15I4)
  210 FORMAT(/ 7X,15I4) 
  220 FORMAT(// 53H/*/*/* LIMITX PARAMETER EXCEEDED - JOB ABORTED / 
     1*/*/*)
  230 FORMAT(/ 7HY-AXIS ) 
C 
C     BATCH CONTROL LOGIC 
C 
  240 IF          (ISW2)20, 250,20
  250 CONTINUE
      END 
      SUBROUTINE READ(NX,NY)
      READ (5, 100) NX,NY 
  100 FORMAT(2X,I2,2X,I2) 
      RETURN
      END 
$III2			IIII>AAA"AAAA~			~@@@@AAA>~			~~			~				>AAA>	)F>AAQ2>AAA"&III2!IMK1bQQIF  

 *TEST CASE FOR GCSL032 
 THIS IS ID FOR THE X-AXIS
 THIS IS ID FOR THE Y-AXIS
000502020 
   1   1
   1   2
   1   3
   1   4
   1   5
   1   6
   1   7
   1   8
   1   9
   1  10
   1   1
   2   2
   3   3
   4   4
   5   5
   6   6
   7   7
   8   8
   9   9
  10  10
  10   1
  10   2
  10   3
  10   4
  10   5
  10   6
  10   7
  10   8
  10   9
  10  10
  11   1
  12   2
  13   3
  14   4
  15   5
  16   6
  17   7
  18   8
  19   9
  20  10
  20  11
  20  12
  20  13
  20  14
  20  15
  20  16
  20  17
  20  18
  20  19
  20  20
                                      