Trailing-Edge
-
PDP-10 Archives
-
decus_20tap2_198111
-
decus/20-0047/survey.for
There is 1 other file named survey.for in the archive. Click here to see a list.
C PROGRAM SURVEY
C
C DESCRIPTION
C THIS PROGRAM READS CODED RESPONSES TO A QUESTIONNAIRE AND WRITES
C THEM INTO AN ASCII DATA FILE.
C
C SOURCE
C NORMAN W. JOHNSON, DEPARTMENT OF MATHEMATICS, WHEATON COLLEGE,
C NORTON, MASS.
C
C INSTRUCTIONS
C THERE SHOULD BE NO MORE THAN 128 QUESTIONS. RESPONSES MAY BE
C CODED BY ANY DIGIT FROM 0 TO 9. ADDITIONAL SYMBOLS THAT MAY BE
C USED ARE THE MINUS SIGN (-), THE AMPERSAND (&), AND THE BLANK,
C INTERPRETED RESPECTIVELY AS THE NUMBERS 11, 12, AND 13. THESE
C SHOULD BE RESERVED FOR SUCH CATEGORIES AS "NOT APPLICABLE",
C "DON'T KNOW", AND "NO RESPONSE".
C
C THE FIRST 5 COLUMNS OF EACH DATA CARD ARE FOR IDENTIFICATION,
C WITH THE FIRST 4 COLUMNS BEING UNIQUE TO THE RESPONDENT. THE
C NEXT 67 COLUMNS OF THE CARD ARE FOR THE CODED RESPONSES, ONE
C COLUMN PER QUESTION. THE LAST 8 COLUMNS ARE NOT USED. IF THERE
C ARE MORE THAN 67 QUESTIONS, A SECOND CARD FOR EACH RESPONDENT
C MAY BE PREPARED IN THE SAME MANNER.
C
C THE SET OF DATA CARDS MUST BE PRECEDED BY FIVE OR SEVEN PROGRAM
C CARDS. THE FIRST OF THESE HAS PUNCHED IN ITS FIRST 5 COLUMNS
C THE NAME THAT THE DATA FILE IS TO HAVE. THE SECOND MAY BE USED
C FOR A DESCRIPTION OF THE SURVEY (NOT MORE THAN 48 CHARACTERS).
C THE THIRD CARD SPECIFIES THE NUMBER OF QUESTIONS (ANY FORMAT
C IS ACCEPTABLE). THE LAST TWO CARDS OR PAIRS OF CARDS, PUNCHED
C IN THE SAME FORMAT AS THE DATA CARDS, INDICATE RESPECTIVELY THE
C LOWEST NUMBER AND THE HIGHEST NUMBER TO BE COUNTED AS A RESPONSE
C TO EACH QUESTION. NUMBERS OUTSIDE THIS RANGE ARE TREATED AS "NO
C RESPONSE" AND EXCLUDED FROM THE TOTAL. ON THESE CARDS BLANKS
C AND MINUS SIGNS ARE EQUIVALENT TO ZEROS, AND AMPERSANDS MAY NOT
C BE USED.
C
C THE LAST DATA CARD MUST BE FOLLOWED BY A SINGLE BLANK CARD OR A
C PAIR OF BLANK CARDS, ACCORDING AS ONE OR TWO CARDS ARE USED FOR
C EACH RESPONDENT.
C
C THIS PROGRAM ASSUMES THAT INPUT IS FROM THE USER TERMINAL AND
C OUTPUT IS TO THE DISK. IF A DIFFERENT INPUT DEVICE, SUCH AS THE
C SYSTEM CARD READER, IS TO BE USED, IT SHOULD BE ASSIGNED LOGICAL
C UNIT 5 PRIOR TO RUNTIME. ALSO, FOR INPUT FROM THE CARD READER,
C THE USER SHOULD RESPOND TO THE PROGRAM'S REQUEST FOR DATA BY
C TYPING "@CDR:". FOR INPUT FROM A FILE ON THE DISK, THE USER
C SHOULD TYPE "@DSK:FILNAM.EXT", WHERE 'FILNAM.EXT' IS THE NAME
C OF A CARD-IMAGE SOURCE FILE.
C
C SPECIAL INSTRUCTIONS FOR NONSTANDARD SOURCE DECKS
C DATA CARDS DO NOT NEED TO BE PREPARED IN EXACT ACCORDANCE WITH
C THE ABOVE INSTRUCTIONS TO BE ACCEPTABLE, PROVIDED THAT (1) THERE
C ARE NO MORE THAN TWO CARDS PER RESPONDENT, (2) EACH CARD CON-
C TAINS AN IDENTIFICATION LABEL, AND (3) THE ONLY RESPONSE CODES
C USED ARE DIGITS, MINUS SIGNS, AMPERSANDS, AND BLANKS. WHEN A
C NONSTANDARD SOURCE DECK IS INPUT, THE PROGRAM CARD SPECIFYING
C THE NUMBER OF QUESTIONS MUST BE REPLACED BY A FORMAT CARD GIVING
C THE BLOCKS OF COLUMNS IN WHICH IDENTIFICATION AND RESPONSES ARE
C PUNCHED ON EACH DATA CARD.
C
C FOR EXAMPLE, IF THE SOURCE DECK CONTAINS ONE CARD PER RESPONDENT
C WITH RESPONSES PUNCHED IN COLUMNS 1 THROUGH 72 AND IDENTIFICA-
C TION IN COLUMNS 74 THROUGH 80, THE FORMAT CARD SHOULD READ:
C 74-80,1-72
C FOR A SOURCE DECK CONTAINING TWO CARDS PER RESPONDENT, HAVING
C IDENTIFICATION IN THE FIRST 4 COLUMNS OF EACH CARD AND RESPONSES
C IN COLUMNS 5 THROUGH 80 OF THE FIRST CARD AND 5 THROUGH 64 OF
C THE SECOND CARD, BUT WITH THE LAST 8 RESPONSES TO BE IGNORED,
C THE FORMAT CARD SHOULD READ:
C 1-4,5-80/1-4,5-56
C
C RELATED PROGRAMS
C THE PROGRAM SORTER TABULATES THE RESPONSES TO EACH QUESTION OF
C THE QUESTIONNAIRE BY FREQUENCIES AND PERCENTAGES. THE PROGRAM
C CROSS CORRELATES RESPONSES TO SELECTED QUESTIONS TO GIVE MAR-
C GINAL FREQUENCIES, CROSS-TABULATIONS, AND OTHER STATISTICS AND
C PERMITS THE COLLAPSING OF TABLES AND THE COMBINING OF VARIABLES.
C THE PROGRAM MERGE COMBINES UP TO 64 FILES OF RESPONSES TO THE
C SAME SET OF QUESTIONS. THE PROGRAM UNITE COMBINES TWO FILES OF
C RESPONSES TO DIFFERENT QUESTIONS BY THE SAME RESPONDENTS.
C
C ..................................................................
C
INTEGER A(48),TODAY(2),IFMT(13),AFMT(13),NEW(7),END(4)
INTEGER XOFF,BLANK,TWELVE,ELEVEN,ZERO,NINE
INTEGER R(128),IR(2)
LOGICAL SKIP
COMMON IFMT,AFMT,NEW,END
DATA IFMT /' ( A 4 , 1 X, ',
1 ' 67 I1 / 5 X, 61 I1 ) '/
DATA AFMT /' ( A 4 , 1 X, ',
1 ' 67 A1 / 5 X, 61 A1 ) '/
IR(1) = 'LOW'
IR(2) = 'HIGH'
XOFF = 17260188454
BLANK = 17315143744
TWELVE = 20536369216
ELEVEN = 24294465600
ZERO = 25905078336
NINE = 30736916544
CALL TIME(NOW)
CALL DATE(TODAY)
TYPE 1, NOW,TODAY
1 FORMAT (' SURVEY',8X,A5,9X,2A5//)
20 TYPE 2
2 FORMAT (/' ENTER DATA.'//)
C ENTER FILE NAME.
30 ACCEPT 3, DATA,FILNAM,EXT
3 FORMAT (3A5)
IF (DATA.EQ.' ') GO TO 20
SKIP = DATA.LT.'A'
IF (DATA.EQ.'@DSK:') CALL IFIL(5,FILNAM,EXT)
IF (SKIP) READ (5,3) DATA
FILE = RENAME(DATA,'.TMP',DATA,'.BAK')
CALL OFIL(1,DATA,'.TMP')
WRITE (1,17)
C ENTER DESCRIPTION OF SURVEY.
50 READ (5,5) (A(I),I=1,48)
5 FORMAT (48A1)
DO 60 I=48,1,-1
IF (A(I).NE.BLANK) GO TO 70
60 A(I) = 0
70 WRITE (1,5) (A(I),I=1,48)
C ENTER NUMBER OF QUESTIONS OR FORMAT INFORMATION.
100 READ (5,10) (NEW(2*I-1),END(I),I=1,4)
10 FORMAT (8I)
M = NEW(1)
IF (END(1).NE.0) CALL FORMAT(M)
IF (M.GE.2 .AND. M.LE.128) GO TO 110
IF (SKIP) STOP 100
TYPE 3, XOFF
PAUSE 'MISSING OR IMPROPER SPECIFICATION'
GO TO 100
110 WRITE (1,11) M
11 FORMAT (2X,I3,' VARIABLES')
IF (END(1).EQ.0 .AND. M.GT.67) GO TO 120
IF (END(1).NE.0 .AND. NEW(5).NE.0) GO TO 120
DO 115 I=9,12
IFMT(I) = BLANK
115 AFMT(I) = BLANK
120 DO 140 K=1,2
GO TO 130
125 TYPE 3, XOFF,ID
IERR = IERR+1
IF (SKIP) GO TO 140
PAUSE 'ILLEGAL CHARACTER IN INPUT STRING'
C ENTER LOWEST NUMBER USED AS CODED RESPONSE TO EACH QUESTION.
C ENTER HIGHEST NUMBER USED AS CODED RESPONSE TO EACH QUESTION.
130 READ (5,IFMT,ERR=125) ID,(R(I),I=1,M)
140 WRITE (1,14) IR(K),(R(I),I=1,M)
14 FORMAT (A4,1X,128I1)
WRITE (1,17)
LAST = 0
C ENTER RESPONSES TO QUESTIONS BY EACH RESPONDENT.
150 READ (5,AFMT,END=170) ID,(R(I),I=1,M)
IF (ID.EQ.BLANK) GO TO 170
DO 155 I=1,M
IF (R(I).GE.ZERO .AND. R(I).LE.NINE) GO TO 155
IF (R(I).EQ.BLANK) GO TO 155
IF (R(I).EQ.TWELVE) GO TO 155
IF (R(I).EQ.ELEVEN) GO TO 155
TYPE 3, XOFF,ID,R(I)
IERR = IERR+1
IF (SKIP) GO TO 155
PAUSE 'ILLEGAL CHARACTER IN INPUT STRING'
GO TO 150
155 CONTINUE
160 WRITE (1,16) ID,(R(I),I=1,M)
16 FORMAT (A4,1X,128A1)
LAST = LAST+1
GO TO 150
170 WRITE (1,17)
17 FORMAT ()
180 WRITE (1,18) LAST
18 FORMAT (1X,I4,' RESPONDENTS')
END FILE 1
FILE = RENAME(DATA,'.BAK',DATA,'.DAT')
FILE = RENAME(DATA,'.DAT',DATA,'.TMP')
IF (IERR.NE.0 .AND. SKIP) TYPE 19
19 FORMAT (/' ILLEGAL CHARACTERS IN ABOVE LINES'/)
TYPE 18, LAST
STOP
END
C
SUBROUTINE FORMAT(M)
INTEGER IFMT(13),AFMT(13),NEW(7),END(4),NEWFMT(7)
COMMON IFMT,AFMT,NEW,END
M = 0
NEW(5) = NEW(7)
IF (NEW(1).LT.1 .OR. -END(1).GT.80 .OR. NEW(1).GT.-END(1)) RETURN
IF (NEW(3).LT.1 .OR. -END(2).GT.80 .OR. NEW(3).GT.-END(2)) RETURN
IF (NEW(5).LT.0 .OR. -END(4).GT.80 .OR. NEW(5).GT.-END(4)) RETURN
M = 2-END(2)-NEW(3)-END(4)-NEW(5)+(NEW(5).EQ.0)
IF (M.LT.2 .OR. M.GT.128) RETURN
NEW(2) = MIN0(1-END(1)-NEW(1),4)
NEW(4) = 1-END(2)-NEW(3)
NEW(6) = 1-END(4)-NEW(5)
ENCODE (35,103,NEWFMT) NEW
103 FORMAT (3(' T',I2,',',I3,2X),I5)
IF (NEW(1).EQ.1) NEWFMT(1) = ' '
IF (NEW(3).EQ.NEW(1)+NEW(2)) NEWFMT(3) = ' '
IF (NEW(5).EQ.1) NEWFMT(5) = ' '
DO 105 I=1,6
IFMT(2*I) = NEWFMT(I)
105 AFMT(2*I) = NEWFMT(I)
RETURN
END
C
C LOGICAL FUNCTION RENAME(NEWNAM,NEWEXT,OLDNAM,OLDEXT)
C RETURNS VALUE .FALSE. IF FILE OLDNAM.EXT DOES NOT EXIST.
C OTHERWISE, RENAME IS .TRUE. AND FILE IS RENAMED NEWNAM.EXT
C WITH PROTECTION <155>. THIS SUBPROGRAM IS WRITTEN IN THE
C MACRO-10 ASSEMBLER LANGUAGE.