Directory of image this file is from
This file as a plain text file

C
C     ..................................................................
C
C        SAMPLE MAIN PROGRAM FOR DATA SCREENING - DASCR
C
C        PURPOSE
C           PERFORM DATA SCREENING CALCULATIONS ON A SET OF OBSERVATIONS
C
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C           SUBST
C           TAB1
C           LOC
C           BOOL
C           HIST
C           MATIN
C
C        METHOD
C           DERIVE A SUBSET OF OBSERVATIONS SATISFYING CERTAIN
C           CONDITIONS ON THE VARIABLES. FOR THIS SUBSET, THE FREQUENCY
C           OF A SELECTED VARIABLE OVER GIVEN CLASS INTERVALS IS
C           OBTAINED. THIS IS PLOTTED IN THE FORM OF A HISTOGRAM.
C           TOTAL, AVERAGE, STANDARD DEVIATION, MINIMUM, AND MAXIMUM
C           ARE ALSO CALCULATED.
C
C     ..................................................................
C
      DIMENSION A(1000),C(63),UBO(3),S(200),R(21),FREQ(20),
     1PCT(20),STATS(5)
      EXTERNAL BOOL
   10 FORMAT(1H1,22HDATA SCREENING PROBLEM,I3)
   11 FORMAT(1H0,44HDIMENSIONED AREA TOO SMALL FOR INPUT MATRIX ,I4)
   12 FORMAT(1H0,20HEXECUTION TERMINATED)
   13 FORMAT(1H0,42HINCORRECT NUMBER OF DATA CARDS FOR MATRIX ,I4)
   14 FORMAT(1H0,18HGO ON TO NEXT CASE)
   15 FORMAT(1H0,11HEND OF CASE)
   16 FORMAT(7(F2.0,F1.0,F7.0))
   17 FORMAT(3F10.0)
   18 FORMAT(1H0,13HSUBSET VECTOR,///)
   19 FORMAT(1H ,I3,F5.0)
   20 FORMAT(1H1,32HSUMMARY STATISTICS FOR VARIABLE ,I3)
   21 FORMAT(1H0,7HTOTAL =,F10.3,2X,9HAVERAGE =,F10.3,2X,20HSTANDARD DEV
     1IATION =,F10.3,2X,9HMINIMUM =,F10.3,2X,9HMAXIMUM =,F10.3)
   22 FORMAT(2I2)
C	DOUBLE PRECISION TMPFIL,FILE
C	OPEN (UNIT=5, DEVICE='CDR', ACCESS='SEQIN')
C	OPEN (UNIT=6, DEVICE='LPT', ACCESS='SEQOUT')
C	FILE = TMPFIL('SSP')
C	OPEN (UNIT=9, DEVICE='DSK', FILE=FILE, ACCESS='SEQINOUT',
C	1	DISPOSE='DELETE')
C
      KC=0
   24 KC=KC+1
      CALL MATIN(ICOD,A,1000,NO,NV,MS,IER)
      IF(NO) 25,50,25
   25 IF(IER-1) 40,30,35
   30 WRITE(6,11) ICOD
      WRITE(6,14)
      GO TO 24
   35 WRITE(6,13)
      WRITE(6,12)
      GO TO 50
   40 READ(5,22)NC,NOVAR
      JC=NC*3
      READ(5,16)(C(I),I=1,JC)
      READ(5,17)(UBO(I),I=1,3)
      CALL SUBST(A,C,R,BOOL,S,NO,NV,NC)
      WRITE(6,10)KC
      WRITE(6,18)
      WRITE(6,19) (I,S(I),I=1,NO)
      CALL TAB1(A,S,NOVAR,UBO,FREQ,PCT,STATS,NO,NV)
      WRITE(6,20) NOVAR
      WRITE(6,21)(STATS(I),I=1,5)
      JZ=UBO(2)
      CALL HIST(KC,FREQ,JZ)
      WRITE(6,15)
      GO TO 24
   50	CONTINUE
      END