Trailing-Edge
-
PDP-10 Archives
-
decuslib10-02
-
43,50244/cross2.f4
There are no other files named cross2.f4 in the archive.
C PROGRAM CROSS2
C (DATA MANIPULATION PART OF PROGRAM CROSS)
C
C DESCRIPTION
C THIS PROGRAM WRITES MAP FILES AND MODIFIED DATA FILES CONTAINING
C CODED RESPONSES TO A QUESTIONNAIRE. A MAPPING OPTION ALLOWS
C RESPONSES TO BE GROUPED INTO NEW CATEGORIES, WHILE JOINING AND
C POOLING OPTIONS LET THE USER CONSTRUCT NEW VARIABLES. MODIFIED
C VERSIONS OF THE DATA FILE MAY BE SAVED FOR USE IN SUBSEQUENT
C RUNS OF THIS PROGRAM OR RELATED PROGRAMS. THE USER HAS ACCESS
C AT ALL TIMES TO EVERY VARIABLE IN THE SURVEY (AS MANY AS 128).
C
C SOURCE
C NORMAN W. JOHNSON, DEPARTMENT OF MATHEMATICS, WHEATON COLLEGE,
C NORTON, MASS.
C
C INSTRUCTIONS
C THE CODED RESPONSES TO THE QUESTIONNAIRE SHOULD BE READ FROM
C CARDS AND WRITTEN INTO AN ASCII DATA FILE BY THE PROGRAM SURVEY.
C A PRELIMINARY TABULATION OF MARGINAL FREQUENCIES FOR ALL VARI-
C ABLES THE USER INTENDS TO WORK WITH CAN BE OBTAINED BY RUNNING
C THE PROGRAM SORTER. CROSS-TABULATIONS AND OTHER ANALYSIS OF THE
C DATA CAN BE CARRIED OUT USING THE PROGRAM CROSS1.
C
C THE PROGRAM WILL FIRST REQUEST THE USER TO ENTER THE NAME OF
C THE DATA FILE. AFTER THIS IS DONE, A DESCRIPTION OF THE SURVEY
C WILL BE TYPED. THE USER MAY THEN PROCEED TO REDEFINE OR RE-
C STORE CATEGORIES WITH ONE OF THE COMMANDS "MAP" OR "UNMAP", MAY
C CONSTRUCT OR DELETE VARIABLES WITH ONE OF THE COMMANDS "JOIN",
C "POOL", OR "CUT", MAY TYPE "SAVE" TO PRESERVE THE CURRENT FORM
C OF THE DATA AS A NEW FILE, MAY RESTORE THE ORIGINAL FORM OF THE
C DATA WITH THE COMMAND "RESET", OR MAY TERMINATE THE EXECUTION OF
C THE PROGRAM BY TYPING "STOP".
C
C COMMANDS THAT TAKE VARIABLES AS ARGUMENTS MAY HAVE THE LIST OF
C VARIABLES ENTERED ON THE SAME LINE AS THE COMMAND.
C
C THE COMMAND "MAP" ENABLES THE USER TO REGROUP THE RESPONSES TO
C ANY QUESTION. FOR EACH VARIABLE OR BLOCK OF VARIABLES, THE USER
C SPECIFIES HOW MANY NEW CATEGORIES ARE TO BE CREATED, THEN LISTS
C THE CODE NUMBERS (0 TO 13) OF THE RESPONSES TO BE INCLUDED IN
C EACH GROUP. NUMBERS MAY BE LISTED INDIVIDUALLY, SEPARATED BY
C COMMAS, OR TWO NUMBERS MAY BE JOINED BY A HYPHEN TO FORM A BLOCK
C OF CONSECUTIVE RESPONSES. BY TYPING "1" OR "KEEP" WHEN THE NUM-
C BER OF NEW CATEGORIES IS REQUESTED, THE USER MAY PRESERVE THE
C CURRENT GROUPING. TYPING "0" OR "UNMAP" RESTORES THE ORIGINAL
C CODING. TYPING "-1" OR "REFLECT" REVERSES THE EXISTING CATE-
C GORIES. TYPING "X" OR "EXCLUDE" ELIMINATES ALL CATEGORIES. A
C LIST OF THE CURRENT CATEGORIES MAY BE OBTAINED BY TYPING "LIST".
C
C AFTER EACH MAPPING THE USER MUST INDICATE WHETHER ANY CATEGORIES
C ARE TO BE EXCLUDED. IF NOT, AN EXCLUSION CODE OF 0 IS ENTERED.
C OTHERWISE, THE EXCLUSION CODE IS 1 IF THE USER DESIRES TO OMIT
C THE HIGHEST NUMBERED CATEGORY, 2 IF THE TWO HIGHEST CATEGORIES
C ARE TO BE OMITTED, ETC. LIKEWISE, AN EXCLUSION CODE OF -1 MAY
C BE USED TO OMIT THE LOWEST NUMBERED CATEGORY, AND SO ON. AN EX-
C CLUSION CODE CANNOT LEAVE FEWER THAN TWO CATEGORIES. HOWEVER,
C THE USER MAY TYPE "X" TO ELIMINATE ALL CATEGORIES.
C
C THE COMMAND "UNMAP" CANCELS THE EFFECT OF THE CURRENT MAPPING OF
C THE VARIABLE OR VARIABLES SPECIFIED, THUS RESTORING THE ORIGINAL
C CODING OF THE RESPONSES TO EACH QUESTION. THE ORIGINAL CODING
C IS ALSO RESTORED WHEN THE PROGRAM IS RUN FROM THE BEGINNING,
C UNLESS A MODIFIED VERSION OF THE DATA FILE HAS BEEN SAVED.
C
C THE COMMAND "JOIN" ALLOWS THE USER TO COMBINE TWO OR THREE VARI-
C ABLES INTO ONE NEW VARIABLE. ALL COMBINATIONS OF CATEGORIES
C FOR THE GIVEN VARIABLES ARE ARRANGED IN A TABLE, WHICH THE USER
C FILLS IN WITH THE NUMBERS (0 TO 9 WITH 11, 12, AND 13 FOR EX-
C CLUSIONS) TO BE ASSIGNED TO THE CORRESPONDING CATEGORIES OF THE
C NEW VARIABLE. AS IN THE CASE OF THE "XTAB" COMMAND, WHEN THREE
C VARIABLES ARE LISTED, THE USER MAY SELECT OR REJECT A PARTICULAR
C CATEGORY OF THE THIRD VARIABLE. THE "JOIN" COMMAND ALSO ALLOWS
C SINGLE VARIABLES TO BE DUPLICATED AND PROVIDES A WAY OF HANDLING
C VARIABLES WITH TWO- OR THREE-DIGIT CATEGORY NUMBERS.
C
C THE COMMAND "POOL" MAY BE USED TO CONSTRUCT AN INDEX VARIABLE
C FROM A BLOCK OF VARIABLES WITH SCALED RESPONSES, E.G., QUESTIONS
C DESIGNED TO MEASURE RESPONDENTS' ATTITUDES. THE TOTAL SCORE OF
C EACH RESPONDENT FOR THE BLOCK OF QUESTIONS IS COMPUTED, DIVIDED
C BY THE NUMBER OF QUESTIONS, AND ROUNDED TO THE NEAREST INTEGER.
C THE RESULTING CATEGORY NUMBER PLACES THE RESPONDENT ON A SCALE
C FOR THE INDEX VARIABLE COMPARABLE TO THE ONE EMPLOYED FOR THE
C VARIABLES USED TO CONSTRUCT IT.
C
C THE COMMAND "CUT" PERMITS THE DELETION OF THE HIGHEST NUMBERED
C VARIABLE OR VARIABLES, EITHER TO MAKE ROOM FOR NEW VARIABLES TO
C BE CREATED BY JOINING OR POOLING OR TO ELIMINATE ONE OR MORE OF
C THOSE MOST RECENTLY CREATED. THE USER SPECIFIES THE NUMBER OF
C VARIABLES TO BE REMOVED BY ENTERING A DELETION CODE.
C
C THE COMMAND "SAVE" ENABLES THE USER TO PRESERVE THE CURRENT FORM
C OF THE DATA, INCORPORATING ALL MAPS, JOINS, POOLS, AND CUTS, AS
C A NEW DATA FILE. THIS FILE MUST BE GIVEN A NAME, DIFFERENT FROM
C THAT OF ANY EXISTING DATA FILE, CONSISTING OF FROM ONE TO FIVE
C CHARACTERS. THE NAME MAY BE SPECIFIED IN THE "SAVE" COMMAND
C (E.G., "SAVE FILNM") OR SEPARATELY.
C
C THE COMMAND "RESET" RESTORES THE INITIAL STATE OF THE DATA, THUS
C UNDOING THE EFFECTS OF ALL MAPS, UNMAPS, JOINS, POOLS, AND CUTS.
C
C AFTER ANY OF THE ABOVE COMMANDS IS CARRIED OUT, A NEW COMMAND
C MAY BE GIVEN. THE USER MAY SUPPRESS THE PRINTING OF TABLES OR
C ANY OTHER OUTPUT IN ORDER TO GIVE A NEW COMMAND IMMEDIATELY BY
C TYPING <CTRL>O AND PRESSING <RETURN>. FURTHER EXECUTION OF A
C COMMAND MAY BE HALTED AT ANY BREAK POINT BY TYPING "ABORT".
C
C WHENEVER THE USER IS EXPECTED TO GIVE A COMMAND OR TO PROVIDE
C CERTAIN INFORMATION NEEDED FOR THE EXECUTION OF A COMMAND, AN
C EXPLANATION OF WHAT IS REQUIRED MAY BE OBTAINED BY TYPING THE
C WORD "EXPLAIN" OR SIMPLY A QUESTION MARK.
C
C REFERENCES
C JAMES A. DAVIS, 'ELEMENTARY SURVEY ANALYSIS', PRENTICE-HALL,
C ENGLEWOOD CLIFFS, N.J., 1971.
C JOHAN GALTUNG, 'THEORY AND METHODS OF SOCIAL RESEARCH', COLUMBIA
C UNIVERSITY PRESS, NEW YORK, 1967.
C E. TERRENCE JONES, 'CONDUCTING POLITICAL RESEARCH', HARPER &
C ROW, NEW YORK, 1971.
C
C ..................................................................
C
INTEGER A(48),TODAY(2),BLANK,PRIME,STAR,DIFFER,EQUAL
INTEGER L(0/128),H(0/128),R(0/128)
INTEGER MAP(0/128,0/13),X(128),IA(0/21),OLD(13)
INTEGER JOIN(0/13,0/13,0/13)
LOGICAL GROUP,ERROR,ZERO,REJECT,BLURB,POOL,SWITCH
EQUIVALENCE (JOIN,NUM)
COMMON ENTRY(0/13),LIST
DATA TEMP1,TEMP2 /'TEMP1','TEMP2'/
TEMP = 'TEMP2'
BLANK = 17315143744
PRIME = 21073240128
STAR = 22548578304
DIFFER = 32472301568
EQUAL = 32749125632
CALL TIME(NOW)
LIST = NOW-851968
CALL DATE(TODAY)
TYPE 1, NOW,TODAY
1 FORMAT (' CROSS2',8X,A5,9X,2A5//)
C
C START: LOCATE DATA FILE.
20 TYPE 2
2 FORMAT (/' NAME OF SURVEY? ',$)
C ENTER FILE NAME.
30 ACCEPT 3, ORIG
3 FORMAT (12A5)
31 FORMAT (/A5)
32 FORMAT (//A5)
33 FORMAT (8X,A5)
34 FORMAT ('+'/$)
IF (ORIG.EQ.' ') GO TO 20
IF (ORIG.EQ.'STOP') GO TO 2000
DATA = ORIG
GROUP = RENAME(DATA,'.MAP',DATA,'.MAP')
IF (GROUP) CALL IFIL(21,DATA,'.MAP')
IF (GROUP) READ (21,31) DATA
IF (RENAME(DATA,'.DAT',DATA,'.DAT')) GO TO 40
TYPE 4, DATA
4 FORMAT (' CANNOT FIND DATA FILE ',A5/)
GO TO 20
40 CALL IFILE(1,DATA)
C INPUT DESCRIPTION OF SURVEY.
50 READ (1,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 TYPE 7, (A(I),I=1,48)
7 FORMAT (9X,48A1////)
LAST = 0
IF (.NOT.GROUP) GO TO 100
C GROUP RESPONSES TO EACH QUESTION.
80 READ (21,10) M
READ (21,14) (L(I),I=1,M)
READ (21,14) (H(I),I=1,M)
READ (21,16) (X(I),I=1,M)
DO 85 J=0,13
READ (21,16) (R(I),I=1,M)
DO 85 I=1,M
85 MAP(I,J) = JK(R(I))
READ (1,10) MAX
M = MIN0(M,MAX)
READ (1,32) ID
IF (LAST) 190,190,200
C INPUT NUMBER OF QUESTIONS.
100 READ (1,10) M
10 FORMAT (20I)
101 FORMAT (9I1,9L1)
102 FORMAT (I2)
103 FORMAT (3I,2A1)
104 FORMAT (I,2A1)
C INPUT LOWEST NUMBER USED AS CODED RESPONSE TO EACH QUESTION.
120 READ (1,14) (L(I),I=1,M)
C INPUT HIGHEST NUMBER USED AS CODED RESPONSE TO EACH QUESTION.
140 READ (1,14) (H(I),I=1,M)
14 FORMAT (5X,128I1)
C INPUT MAPPING INDICATOR FOR EACH QUESTION.
160 READ (1,16) (X(I),I=1,M)
16 FORMAT (5X,128A1)
180 DO 185 J=0,13
DO 185 I=1,M
185 MAP(I,J) = J
IF (LAST.GT.0) GO TO 200
190 READ (1,3) ID
IF (ID.NE.BLANK) GO TO 190
C INPUT NUMBER OF RESPONDENTS.
READ (1,10) LAST
TOTAL = LAST
GO TO 202
C
C ENTER COMMAND.
200 TYPE 201
201 FORMAT ('1')
202 TYPE 203
203 FORMAT (' ENTER COMMAND: ',$)
ACCEPT 3, (ENTRY(N),N=1,12)
CALL DECODE
READ (20,3) ANS,SAVE
IF (ANS.EQ.'START') GO TO 20
IF (ANS.EQ.' ') GO TO 200
IF (ANS.EQ.'DETAI') GO TO 210
IF (ANS.EQ.'EXPLA' .AND. SAVE.GT.'IN') GO TO 220
IF (ANS.EQ.'MAP') GO TO 1500
IF (ANS.EQ.'UNMAP') GO TO 1600
IF (ANS.EQ.'JOIN') GO TO 1700
IF (ANS.EQ.'POOL') GO TO 1800
IF (ANS.EQ.'CUT') GO TO 1890
IF (ANS.EQ.'SAVE') GO TO 1900
IF (ANS.EQ.'RESET') GO TO 1990
IF (ANS.EQ.'STOP') GO TO 2000
IF (ANS.EQ.'XTAB') TYPE 2031
IF (ANS.EQ.'ITEM') TYPE 2031
2031 FORMAT (' COMMAND NOT AVAILABLE--RUN CROSS1'/)
TYPE 204
204 FORMAT (
1 ' ENTER ONE OF THE FOLLOWING:'/
2 ' MAP, UNMAP, JOIN, POOL, CUT, SAVE, RESET, STOP, OR'/
3 ' DETAIL'/)
GO TO 200
210 TYPE 21
21 FORMAT (
1 ' TO REGROUP RESPONSES TO A QUESTION, TYPE "MAP".'/
2 ' TO RESTORE THE ORIGINAL CATEGORIES, TYPE "UNMAP".'/
3 ' TO DUPLICATE A VARIABLE WITH CURRENT CATEGORIES OR'/
4 ' TO COMBINE 2 OR 3 VARIABLES INTO ONE, TYPE "JOIN".'/
5 ' TO MAKE A SINGLE VARIABLE OF A BLOCK, TYPE "POOL".'/
6 ' TO DELETE HIGHEST NUMBERED VARIABLES, TYPE "CUT".'/
7 ' TO SAVE CURRENT VERSION OF DATA FILE, TYPE "SAVE".'/
8 ' TO RESTORE ALL DATA TO INITIAL STATE, TYPE "RESET".'/
9 ' TO TERMINATE THE PROGRAM, TYPE "STOP".'//
/ ' TO HALT EXECUTION OF A COMMAND, TYPE "ABORT".'/
1 ' TO GET HELP AT ANY POINT, TYPE "EXPLAIN" OR "?".'//
2 ' FOR A MORE COMPLETE EXPLANATION OF ANY OF THE ABOVE'/
3 ' COMMANDS, TYPE "EXPLAIN" AND THE NAME OF THE COMMAND.'/)
GO TO 200
220 REREAD 33, ANS
IF (ANS.EQ.'ABORT') TYPE 221
221 FORMAT (
1 ' FURTHER EXECUTION OF A COMMAND MAY BE HALTED AT ANY'/
2 ' BREAK POINT BY TYPING "ABORT". TO SUPPRESS THE PRINT-'/
3 ' ING OF TABLES OR OTHER OUTPUT, TYPE <CTRL>O AND PRESS'/
4 ' <RETURN>.'/)
IF (ANS.EQ.'EXPLA' .OR. ANS.EQ.'?') TYPE 222
222 FORMAT (
1 ' IF YOU NEED AN EXPLANATION OR FURTHER INSTRUCTIONS,'/
2 ' YOU MAY RESPOND TO ANY REQUEST FOR INPUT BY TYPING'/
3 ' "EXPLAIN" OR A QUESTION MARK.'/)
IF (ANS.EQ.'MAP') TYPE 1501
IF (ANS.EQ.'MAP') TYPE 1502
IF (ANS.EQ.'UNMAP') TYPE 1602
IF (ANS.EQ.'JOIN') TYPE 1702
IF (ANS.EQ.'POOL') TYPE 1802
IF (ANS.EQ.'CUT') TYPE 1891
IF (ANS.EQ.'SAVE') TYPE 1901
IF (ANS.EQ.'RESET') TYPE 1991
IF (ANS.EQ.'STOP') TYPE 2002
GO TO 200
232 FORMAT ('+INVALID ENTRY--VARIABLES RUN FROM 1 TO ',I3/)
233 FORMAT ('+INVALID ENTRY--VARIABLE WITHOUT CATEGORIES'/)
C
C MAP: REGROUP CATEGORIES.
1500 ZERO = ENTRY(0).NE.ANS .OR. ENTRY(1).EQ.' '
IF (ZERO) TYPE 150
150 FORMAT (' VARIABLES TO BE MAPPED? ',$)
IF (ZERO) ACCEPT 3, (ENTRY(N),N=1,12)
IF (ENTRY(1).EQ.'NONE' .OR. ENTRY(1).EQ.'ABORT') GO TO 200
IF (ENTRY(1).EQ.'STOP') GO TO 2000
BLURB = ENTRY(1).EQ.'EXPLA' .OR. ENTRY(1).EQ.'?'
IF (BLURB) TYPE 1501
IF (BLURB) TYPE 1502
1501 FORMAT (
1 ' ENTER ONE OR MORE VARIABLES WHOSE RESPONSES ARE TO BE'/
2 ' REGROUPED. (IF YOU DO NOT WANT TO MAP ANY VARIABLES,'/
3 ' TYPE "NONE".) A BLOCK OF CONSECUTIVE VARIABLES (TWO'/
4 ' NUMBERS JOINED BY A HYPHEN OR THE WORD "ALL") CAN BE'/
5 ' MAPPED SIMULTANEOUSLY. FOR EACH VARIABLE TO BE MAPPED')
1502 FORMAT (
6 ' SPECIFY THE NUMBER OF NEW CATEGORIES DESIRED. THEN'/
7 ' FOR EACH GROUP LIST THE CODE NUMBERS OF THE RESPONSES'/
8 ' TO BE INCLUDED IN IT (TWO NUMBERS MAY BE JOINED BY A'/
9 ' HYPHEN TO INDICATE A BLOCK OF CONSECUTIVE RESPONSES).'/
/ ' EVERY CATEGORY MUST BE MAPPED.'//
1 ' YOU CAN PRESERVE THE CURRENT GROUPING BY ENTERING "1"'/
2 ' OR "KEEP" FOR THE NUMBER OF NEW CATEGORIES; ENTERING'/
3 ' "0" OR "UNMAP" RESTORES THE ORIGINAL CODING (IN EITHER'/
4 ' CASE EXCLUSIONS MAY STILL BE MADE). ENTERING "-1" OR'/
5 ' "REFLECT" REVERSES EXISTING CATEGORIES. ENTERING "X"'/
6 ' OR "EXCLUDE" ELIMINATES ALL CATEGORIES. TO ASCERTAIN'/
7 ' THE CURRENT MAPPING, TYPE "LIST". IF YOU HAVE ENTERED'/
8 ' MORE VARIABLES THAN YOU WANT TO MAP, TYPE "ABORT".'/)
CALL DECODE
READ (20,10) (IA(N),N=1,20)
IF (ENTRY(0).EQ.'ALL') IA(1) = 1
IF (ENTRY(0).EQ.'ALL') IA(2) = -M
IF (IA(1).EQ.0) GO TO 1500
DO 1505 N=1,20
IF (IA(N).GE.0 .AND. IA(N).LE.M) GO TO 1505
IF (IA(N-1).GT.0.AND.IA(N-1).LE.-IA(N).AND.-IA(N).LE.M) GO TO 1505
TYPE 232, M
GO TO 1500
1505 CONTINUE
NVAR = 1
I = IA(1)
GO TO 1520
1510 TYPE 151
151 FORMAT ('+DUPLICATE MAPPING--START OVER'/)
1520 MIN = I
MAX = MAX0(I,-IA(NVAR+1))
IF (MAX.LE.I) TYPE 1521, I
1521 FORMAT (//
1 ' VARIABLE ',I3/)
IF (MAX.GT.I) TYPE 1522, MIN,MAX
1522 FORMAT (//
1 ' VARIABLES ',I3,' TO ',I3/)
TYPE 152
152 FORMAT (' HOW MANY NEW CATEGORIES? ',$)
ACCEPT 3, ENTRY(1)
IF (ENTRY(1).EQ.'ABORT') GO TO 200
IF (ENTRY(1).EQ.' ') GO TO 1520
IF (ENTRY(1).EQ.'REFLE' .OR. ENTRY(1).EQ.'-1') GO TO 1650
IF (ENTRY(1).EQ.'EXCLU' .OR. ENTRY(1).EQ.'X') GO TO 1660
IF (ENTRY(1).EQ.'LIST') GO TO 1690
IF (ENTRY(1).EQ.'STOP') GO TO 2000
IF (ENTRY(1).EQ.'EXPLA' .OR. ENTRY(1).EQ.'?') TYPE 1502
LOW = (ENTRY(1).EQ.'10')+1
IF (ENTRY(1).EQ.'10') ENTRY(1) = '9'
IF (ENTRY(1).EQ.'UNMAP') ENTRY(1) = '0'
IF (ENTRY(1).EQ.'KEEP') ENTRY(1) = '1'
CALL DECODE
READ (20,101,ERR=1520) NCAT
IF (NCAT.EQ.0 .AND. IA(NVAR+1).LT.0) GO TO 1610
IF (NCAT.EQ.1) GO TO 1590
CALL IFILE(1,DATA)
READ (1,32) ID
READ (1,14) (IL,N=1,I)
READ (1,14) (IH,N=1,I)
READ (1,16) (IX,N=1,I)
IF (NCAT.EQ.0) GO TO 1580
DO 1525 J=0,13
1525 MAP(I,J) = 10
TYPE 34
DO 1570 K=LOW,NCAT
GO TO 1540
1530 TYPE 153
153 FORMAT ('+INCORRECT GROUPING--REENTER'/$)
DO 1535 J=0,13
1535 IF (MAP(I,J).EQ.K) MAP(I,J) = 10
1540 TYPE 154, K
154 FORMAT ('+ GROUP ',I1,''': ',$)
ACCEPT 3, (ENTRY(N),N=1,10)
IF (ENTRY(1).EQ.'ABORT' .OR. ENTRY(1).EQ.'UNMAP') GO TO 1580
IF (ENTRY(1).EQ.'STOP') GO TO 2000
BLURB = ENTRY(1).EQ.'EXPLA' .OR. ENTRY(1).EQ.'?'
IF (BLURB) TYPE 1541
1541 FORMAT (
1 ' ENTER THE ORIGINAL CODE NUMBERS OF THE RESPONSES TO BE'/
2 ' INCLUDED IN EACH GROUP. TO START OVER, TYPE "UNMAP".'/
3 ' TO QUIT MAPPING, TYPE "ABORT".'//$)
IF (BLURB .OR. ENTRY(1).EQ.' ') GO TO 1540
IF (ENTRY(1).LT.'0') GO TO 1530
CALL DECODE
READ (20,10) (OLD(N),N=1,12)
IF (OLD(1).GT.13) GO TO 1530
IF (OLD(2).LT.0) GO TO 1545
J = OLD(1)
IF (MAP(I,J).NE.10) GO TO 1510
MAP(I,J) = K
1545 DO 1570 N=2,12
IF (IABS(OLD(N)).GT.13) GO TO 1530
IF (OLD(N)) 1550,1570,1560
1550 IF (OLD(N-1).LT.0 .OR. OLD(N-1).GT.-OLD(N)) GO TO 1530
DO 1555 J=OLD(N-1),-OLD(N)
IF (MAP(I,J).EQ.K) GO TO 1530
IF (MAP(I,J).NE.10) GO TO 1510
1555 MAP(I,J) = K
GO TO 1570
1560 IF (OLD(N-1).NE.0 .OR. N.EQ.2) GO TO 1565
IF (MAP(I,J).EQ.K) GO TO 1530
IF (MAP(I,0).NE.10) GO TO 1510
MAP(I,0) = K
1565 IF (OLD(N+1).LT.0) GO TO 1570
J = OLD(N)
IF (MAP(I,J).EQ.K) GO TO 1530
IF (MAP(I,J).NE.10) GO TO 1510
MAP(I,J) = K
1570 CONTINUE
DO 1575 J=IL,IH
IF (MAP(I,J).NE.10) GO TO 1575
TYPE 157
157 FORMAT ('+INCOMPLETE MAPPING--START OVER'/$)
ENTRY(1) = 'ERROR'
GO TO 1580
1575 CONTINUE
L(I) = LOW
H(I) = NCAT
X(I) = PRIME
GO TO 1590
1580 L(I) = IL
H(I) = IH
X(I) = IX
DO 1585 J=0,13
1585 MAP(I,J) = J
IF (ENTRY(1).NE.'ERROR') TYPE 161
IF (ENTRY(1).EQ.'ABORT') GO TO 200
IF (NCAT.NE.0) GO TO 1520
1590 IF (L(I)+1.LT.H(I)) GO TO 1680
TYPE 159
159 FORMAT (' NO EXCLUSIONS'/$)
K = 0
1595 NVAR = NVAR+1
I = IA(NVAR)
IF (I) 1630,200,1520
C
C UNMAP: RESTORE ORIGINAL CATEGORIES.
1600 ZERO = ENTRY(0).NE.ANS .OR. ENTRY(1).EQ.' '
IF (ZERO) TYPE 1601
1601 FORMAT (' VARIABLES TO BE UNMAPPED? ',$)
IF (ZERO) ACCEPT 3, (ENTRY(N),N=1,12)
IF (ENTRY(1).EQ.' ALL') ENTRY(1) = 'ALL'
IF (ENTRY(1).EQ.'NONE' .OR. ENTRY(1).EQ.'ABORT') GO TO 200
IF (ENTRY(1).EQ.'STOP') GO TO 2000
IF (ENTRY(1).EQ.'EXPLA' .OR. ENTRY(1).EQ.'?') TYPE 1602
1602 FORMAT (
1 ' ENTER ONE OR MORE VARIABLES WHOSE ORIGINAL CATEGORIES'/
2 ' ARE TO BE RESTORED. (IF YOU DO NOT WANT ANY VARIABLES'/
3 ' TO BE UNMAPPED, TYPE "NONE".) A BLOCK OF CONSECUTIVE'/
4 ' VARIABLES (TWO NUMBERS JOINED BY A HYPHEN OR THE WORD'/
5 ' "ALL") CAN BE UNMAPPED SIMULTANEOUSLY.'/)
CALL DECODE
READ (20,10) (IA(N),N=1,20)
IF (ENTRY(0).EQ.'ALL') IA(1) = 1
IF (ENTRY(0).EQ.'ALL') IA(2) = -M
IF (IA(1).EQ.0) GO TO 1600
DO 1605 N=1,20
IF (IA(N).GE.0 .AND. IA(N).LE.M) GO TO 1605
IF (IA(N-1).GT.0.AND.IA(N-1).LE.-IA(N).AND.-IA(N).LE.M) GO TO 1605
TYPE 232, M
GO TO 1600
1605 CONTINUE
NVAR = 1
I = IA(1)
1610 TYPE 161
161 FORMAT (' ORIGINAL CATEGORIES RESTORED'/)
1620 MIN = I
MAX = MAX0(I,-IA(NVAR+1))
CALL IFILE(1,DATA)
READ (1,32) ID
READ (1,184) (IL,I=0,MIN-1),(L(I),I=MIN,MAX)
READ (1,184) (IH,I=0,MIN-1),(H(I),I=MIN,MAX)
READ (1,186) (IX,I=0,MIN-1),(X(I),I=MIN,MAX)
DO 1625 I=MIN,MAX
DO 1625 J=0,13
1625 MAP(I,J) = J
IF (IA(NVAR+1).LT.0) NVAR = NVAR+1
IF (ANS.EQ.'MAP') GO TO 1595
NVAR = NVAR+1
I = IA(NVAR)
IF (I) 200,200,1620
C MAP BLOCK OF CONSECUTIVE VARIABLES.
1630 IF (NCAT.GT.1) GO TO 1640
DO 1635 I=MIN,MAX
IF (K.LT.0) L(I) = MIN0(L(I)-K,H(I)-1)
IF (K.GT.0) H(I) = MAX0(L(I)+1,H(I)-K)
1635 CONTINUE
GO TO 1595
1640 DO 1645 I=MIN,MAX
L(I) = L(MIN)
H(I) = H(MIN)
X(I) = PRIME
DO 1645 J=0,13
1645 MAP(I,J) = MAP(MIN,J)
GO TO 1595
C REFLECT BLOCK OF CONSECUTIVE VARIABLES.
1650 TYPE 165
165 FORMAT (' PREVIOUS CATEGORIES REVERSED'/)
DO 1655 I=MIN,MAX
X(I) = BLANK
DO 1655 J=0,13
IF (MAP(I,J).LT.L(I) .OR. MAP(I,J).GT.H(I)) GO TO 1655
MAP(I,J) = L(I)+H(I)-MAP(I,J)
IF (MAP(I,J).NE.J) X(I) = PRIME
1655 CONTINUE
IF (IA(NVAR+1).LT.0) NVAR = NVAR+1
GO TO 1595
C EXCLUDE BLOCK OF CONSECUTIVE VARIABLES.
1660 TYPE 166
166 FORMAT (' ALL CATEGORIES EXCLUDED'/)
DO 1665 I=MIN,MAX
L(I) = 9
H(I) = 0
X(I) = STAR
1665 CONTINUE
IF (IA(NVAR+1).LT.0) NVAR = NVAR+1
GO TO 1595
C EXCLUDE HIGHEST (OR LOWEST) CATEGORIES.
1670 TYPE 167
167 FORMAT (
1 ' ENTER NUMBER OF GROUPS TO BE EXCLUDED:'/
2 ' 0--FOR NO EXCLUSIONS'/
3 ' 1--FOR EXCLUSION OF THE HIGHEST NUMBERED GROUP'/
4 ' 2--FOR EXCLUSION OF THE TWO HIGHEST GROUPS'/
5 ' ETC. (NEGATIVE CODES EXCLUDE LOWEST GROUPS.)'/)
1680 TYPE 168
168 FORMAT (' ENTER EXCLUSION CODE: ',$)
ACCEPT 3, ENTRY(1)
IF (ENTRY(1).EQ.'ABORT' .OR. ENTRY(1).EQ.'UNMAP') GO TO 1580
IF (ENTRY(1).EQ.'X') GO TO 1660
IF (ENTRY(1).EQ.' ') GO TO 1680
IF (ENTRY(1).EQ.'STOP') GO TO 2000
CALL DECODE
READ (20,102,ERR=1670) K
IF (K.GE.10) K = K/10
IF (K.LT.0) L(I) = MIN0(L(I)-K,H(I)-1)
IF (K.GT.0) H(I) = MAX0(L(I)+1,H(I)-K)
GO TO 1595
C LIST CURRENT CATEGORIES.
1690 IF (L(I).GT.H(I)) TYPE 169
169 FORMAT (' NO CATEGORIES')
TYPE 34
DO 1695 J=0,13
IF (MAP(I,J).LT.L(I) .OR. MAP(I,J).GT.H(I)) GO TO 1695
TYPE 1691, J
1691 FORMAT ('+',I3,$)
IF (X(I).NE.BLANK) TYPE 1692, MAP(I,J),X(I)
1692 FORMAT ('+ --> ',I1,A1/$)
1695 CONTINUE
IF (X(I).EQ.BLANK) TYPE 34
GO TO 1520
C
C JOIN: DUPLICATE OR COMBINE VARIABLES.
1700 IF (M.GE.128) GO TO 1790
ZERO = ENTRY(0).NE.ANS .OR. ENTRY(1).EQ.' '
IF (ZERO) TYPE 1701
1701 FORMAT (' VARIABLES TO BE JOINED? ',$)
IF (M.GE.128) GO TO 1790
IF (ZERO) ACCEPT 3, (ENTRY(N),N=1,12)
IF (ENTRY(1).EQ.'NONE' .OR. ENTRY(1).EQ.'ABORT') GO TO 200
IF (ENTRY(1).EQ.'STOP') GO TO 2000
BLURB = ENTRY(1).EQ. 'EXPLA' .OR. ENTRY(1).EQ.'?'
IF (BLURB) TYPE 1702
1702 FORMAT (
1 ' ENTER ONE VARIABLE TO BE DUPLICATED (WITH THE CURRENT'/
2 ' DEFINITION OF CATEGORIES) OR TWO OR THREE VARIABLES'/
3 ' TO BE COMBINED INTO ONE NEW VARIABLE. TABLE HEADINGS'/
4 ' WILL BE PRINTED FOR EVERY COMBINATION OF CATEGORIES OF'/
5 ' THE OLD VARIABLES. DEFINE THE CATEGORIES OF THE NEW'/
6 ' VARIABLE BY FILLING IN THE TABLE. USE CATEGORY NUM-'/
7 ' BERS 0 TO 9 OR EXCLUSION CATEGORIES 11, 12, AND 13.'//
8 ' NOTE: THE THIRD VARIABLE LISTED MAY BE FOLLOWED BY AN'/
9 ' EQUALS SIGN AND A CATEGORY NUMBER (0 TO 9). AN ENTRY'/
/ ' IN THE FORM ''V1,V2,V3=C'' ALLOWS THE JOINING OF VARI-'/
1 ' ABLES V1 AND V2 FOR RESPONDENTS BELONGING TO CATEGORY'/
2 ' C OF VARIABLE V3, ALL OTHERS BEING EXCLUDED. AN ENTRY'/
3 ' IN THE FORM ''V1,0,V3=C'' PROVIDES FOR THE RESTRICTION'/
4 ' OF VARIABLE V1 TO RESPONDENTS IN CATEGORY C OF VARI-'/
5 ' ABLE V3. A PARTICULAR CATEGORY OF RESPONDENTS MAY BE'/
6 ' EXCLUDED BY FOLLOWING THE THIRD VARIABLE WITH AN IN-'/
7 ' EQUALITY SIGN (<>) AND THE CATEGORY NUMBER. IF YOU DO'/
8 ' NOT WANT TO JOIN ANY VARIABLES, TYPE "NONE".'/)
CALL DECODE
READ (20,103) I1,I2,I3,N3,N3X
IF (I1.EQ.0) GO TO 1700
ERROR = I1.LT.0 .OR. I1.GT.M .OR. I2.LT.0 .OR. I2.GT.M .OR.
1 I3.LT.0 .OR. I3.GT.M
IF (ERROR) TYPE 232, M
IF (ERROR) GO TO 1700
ERROR = L(I1).GT.H(I1) .OR. L(I2).GT.H(I2) .OR. L(I3).GT.H(I3)
IF (ERROR) TYPE 233
IF (ERROR) GO TO 1700
NEW = M+1
L(NEW) = 9
H(NEW) = 0
X(NEW) = BLANK
DO 1705 J=0,13
1705 MAP(NEW,J) = J
DO 1710 J3=0,13
DO 1710 J2=0,13
DO 1710 J1=0,13
1710 JOIN(J1,J2,J3) = 10
J3X = JK(N3X)
IF (J3X.GT.9) J3X = -1
REJECT = (N3.EQ.'<' .OR. N3.EQ.'>') .AND. J3X.GE.0
J3 = JK(N3)
IF (J3.GT.9) J3 = J3X
IF (I2.NE.0 .OR. J3.GE.0) GO TO 1715
I2 = I3
I3 = 0
1715 I3L = L(I3)
I3H = H(I3)
IF (J3.LT.0) GO TO 1720
I3L = J3
I3H = J3
1720 IF (I2.NE.0) TYPE 34
TYPE 172, NEW
172 FORMAT (//
1 ' NEW: VARIABLE ',I3)
IF (I2.EQ.0) TYPE 1721, I1
1721 FORMAT (
2 ' SOURCE: VARIABLE ',I3)
IF (I2.NE.0) TYPE 1722, I1,I2
1722 FORMAT (
2 ' DOWN: VARIABLE ',I3/
3 ' ACROSS: VARIABLE ',I3)
R(3) = EQUAL
IF (REJECT) R(3) = DIFFER
IF (I3L.NE.I3H) TYPE 1723, I3
1723 FORMAT (
4 ' CONTROL: VARIABLE ',I3)
IF (I3.NE.0 .AND. I3L.EQ.I3H) TYPE 1724, I3,R(3),J3,X(I3)
1724 FORMAT (
4 ' CONTROL: VARIABLE ',I3,2X,A2,' CATEGORY ',I1,A1)
IF (I2.NE.0) GO TO 1740
TYPE 34
DO 1730 J1=0,13
1730 JOIN(J1,0,J3) = J1
L(NEW) = L(I1)
H(NEW) = H(I1)
GO TO 1780
1740 TYPE 174
174 FORMAT (///' NEW CATEGORY NUMBERS:')
R(3) = 0
IF (X(I3).EQ.PRIME) R(3) = PRIME
DO 1780 J3=I3L,I3H
1750 TYPE 175, (J2,X(I2),J2=L(I2),H(I2))
175 FORMAT (//5X,$/('+',I3,A1,$))
IF (I3L.NE.I3H) TYPE 1751, J3,R(3)
1751 FORMAT ('+ (',I1,A1,')',$)
TYPE 34
TYPE 34
DO 1770 J1=L(I1),H(I1)
1760 TYPE 176, J1,X(I1)
176 FORMAT ('+',I1,A1,4X,$)
ACCEPT 3, (ENTRY(N),N=1,10)
IF (ENTRY(1).EQ.'ABORT') GO TO 200
IF (ENTRY(1).EQ.'DELET') GO TO 1740
IF (ENTRY(1).EQ.'STOP') GO TO 2000
BLURB = ENTRY(1).EQ.'EXPLA' .OR. ENTRY(1).EQ.'?'
IF (BLURB) TYPE 1761
1761 FORMAT (
1 ' DEFINE THE CATEGORIES OF YOUR NEW VARIABLE BY FILLING'/
2 ' IN THIS TABLE. USE CATEGORY NUMBERS 0 TO 9 OR EXCLU-'/
3 ' SION CATEGORIES 11, 12, AND 13. TO START OVER, TYPE'/
4 ' "DELETE". TO QUIT, TYPE "ABORT".'//)
IF (BLURB .OR. ENTRY(1).EQ.' ') GO TO 1760
CALL DECODE
READ (20,10) (JOIN(J1,J2,J3),J2=L(I2),H(I2))
DO 1770 J2=L(I2),H(I2)
J = JOIN(J1,J2,J3)
IF (J.GE.0 .AND. J.LE.13 .AND. J.NE.10) GO TO 1770
TYPE 177
177 FORMAT ('+ILLEGAL CATEGORY--REENTER'/)
GO TO 1760
1770 CONTINUE
DO 1780 J1=L(I1),H(I1)
DO 1780 J2=L(I2),H(I2)
J = JOIN(J1,J2,J3)
IF (J.GT.9) GO TO 1780
IF (J.LT.L(NEW)) L(NEW) = J
IF (J.GT.H(NEW)) H(NEW) = J
1780 CONTINUE
IF (.NOT.REJECT) GO TO 1820
DO 1785 J1=L(I1),H(I1)
DO 1785 J2=L(I2),H(I2)
J = JOIN(J1,J2,J3X)
JOIN(J1,J2,J3X) = 10
DO 1785 J3=L(I3),H(I3)
IF (J3.NE.J3X) JOIN(J1,J2,J3) = J
1785 CONTINUE
GO TO 1820
1790 TYPE 179
179 FORMAT (' NO ROOM FOR NEW VARIABLE'/)
GO TO 200
C
C POOL: CONSOLIDATE BLOCK OF VARIABLES.
1800 IF (M.GE.128) GO TO 1790
ZERO = ENTRY(0).NE.ANS .OR. ENTRY(1).EQ.' '
IF (ZERO) TYPE 1801
1801 FORMAT (' VARIABLES TO BE POOLED? ',$)
IF (M.GE.127) GO TO 1790
IF (ZERO) ACCEPT 3, (ENTRY(N),N=1,12)
IF (ENTRY(1).EQ.'NONE' .OR. ENTRY(1).EQ.'ABORT') GO TO 200
IF (ENTRY(1).EQ.'STOP') GO TO 2000
BLURB = ENTRY(1).EQ.'EXPLA' .OR. ENTRY(1).EQ.'?'
IF (BLURB) TYPE 1802
1802 FORMAT (
1 ' ENTER A BLOCK OF VARIABLES (TWO NUMBERS JOINED BY A'/
2 ' HYPHEN OR THE WORD "ALL") TO BE USED IN CONSTRUCTING'/
3 ' AN INDEX VARIABLE, CATEGORIZING RESPONDENTS BY THEIR'/
4 ' AVERAGE RESPONSE. THE "MAP" COMMAND CAN BE USED TO'/
5 ' REVERSE CATEGORIES OF CERTAIN VARIABLES OR TO EXCLUDE'/
6 ' VARIABLES FROM A BLOCK. IF YOU DO NOT WANT TO POOL'/
7 ' ANY VARIABLES, TYPE "NONE".'/)
CALL DECODE
READ (20,10) MIN,MAX
MAX = IABS(MAX)
IF (ENTRY(0).EQ.'ALL') MIN = 1
IF (ENTRY(0).EQ.'ALL') MAX = M
IF (MIN.EQ.0) GO TO 1800
ERROR = MIN.LT.0 .OR. MIN.GT.MAX .OR. MAX.GT.M
IF (ERROR) TYPE 232, M
IF (ERROR) GO TO 1800
NVAR = MAX-MIN+1
NEW = M+1
L(NEW) = 9
H(NEW) = 0
DO 1805 I=MIN,MAX
IF (L(I).GT.H(I)) NVAR = NVAR-1
IF (L(I).LT.L(NEW)) L(NEW) = L(I)
IF (H(I).GT.H(NEW)) H(NEW) = H(I)
1805 CONTINUE
IF (NVAR.GT.0) GO TO 1810
TYPE 233
GO TO 1800
1810 TYPE 181, NEW,MIN,MAX
181 FORMAT (//
1 ' NEW: VARIABLE ',I3/
2 ' SOURCE: VARIABLES ',I3,' TO ',I3/)
X(NEW) = BLANK
DO 1815 J=0,13
1815 MAP(NEW,J) = J
C WRITE NEW DATA FILE.
1820 POOL = ANS.EQ.'POOL'
TEMP = TEMP1
IF (SWITCH) TEMP = TEMP2
CALL IFILE(1,DATA)
CALL OFILE(21,TEMP)
READ (1,32) ID
WRITE (21,5) (A(I),I=1,48)
1830 WRITE (21,183) NEW
183 FORMAT (2X,I3,' VARIABLES')
IL = 'LOW'
READ (1,14) (R(I),I=1,M)
R(NEW) = L(NEW)
WRITE (21,184) IL,(R(I),I=1,NEW)
IH = 'HIGH'
READ (1,14) (R(I),I=1,M)
R(NEW) = H(NEW)
WRITE (21,184) IH,(R(I),I=1,NEW)
184 FORMAT (A5,128I1)
IX = NK(13)
READ (1,3) ID
WRITE (21,186) IX
DO 1860 K=1,LAST
READ (1,186) ID,(R(I),I=1,M)
IF (POOL) GO TO 1850
J1 = MAP(I1,JK(R(I1)))
J2 = MAP(I2,JK(R(I2)))
J3 = MAP(I3,JK(R(I3)))
R(NEW) = NK(JOIN(J1,J2,J3))
GO TO 1860
1850 KVAR = 0
KSUM = 0
DO 1855 I=MIN,MAX
IF (L(I).GT.H(I)) GO TO 1855
J = MAP(I,JK(R(I)))
IVAR = (J.LT.L(I) .OR. J.GT.H(I))+1
KVAR = KVAR+IVAR
KSUM = KSUM+IVAR*J
1855 CONTINUE
J = 10
KTAB = (2*KVAR.LT.NVAR)+1
LESS = 2*KSUM.LT.(L(NEW)+H(NEW))*KVAR
IF (KTAB.NE.0) J = (2*KSUM+KVAR+LESS)/(2*KVAR)
R(NEW) = NK(J)
1860 WRITE (21,186) ID,(R(I),I=1,NEW)
186 FORMAT (A5,128A1)
WRITE (21,187) LAST
187 FORMAT (/1X,I4,' RESPONDENTS')
END FILE 21
DATA = TEMP
IF (SWITCH) CALL OFILE(21,TEMP1)
SWITCH = .NOT.SWITCH
IF (SWITCH) CALL OFILE(21,TEMP2)
END FILE 21
M = NEW
GO TO 200
C
C CUT: DELETE HIGHEST NUMBERED VARIABLES.
1880 TYPE 188
188 FORMAT (
1 ' ENTER NUMBER OF VARIABLES TO BE DELETED:'/
2 ' 0--FOR NO DELETIONS'/
3 ' 1--FOR DELETION OF THE HIGHEST NUMBERED VARIABLE'/
4 ' 2--FOR DELETION OF THE TWO HIGHEST VARIABLES'/
5 ' ETC. (UP TO 9 AT ONE TIME)'/)
1890 TYPE 189
189 FORMAT (' ENTER DELETION CODE: ',$)
ACCEPT 3, ENTRY(1)
IF (ENTRY(1).EQ.'ABORT') GO TO 200
IF (ENTRY(1).EQ.' ') GO TO 1890
IF (ENTRY(1).EQ.'STOP') GO TO 2000
1891 FORMAT (
1 ' THIS COMMAND PERMITS THE DELETION OF THE HIGHEST NUM-'/
2 ' BERED VARIABLE OR VARIABLES, COMPLEMENTING THE EFFECT'/
3 ' OF THE COMMANDS "JOIN" AND "POOL".'/)
CALL DECODE
READ (20,101,ERR=1880) K
M = MAX0(M-K,2)
GO TO 200
C
C SAVE: PRESERVE CURRENT FORM OF DATA.
1900 IF (SAVE.NE.' ') GO TO 1920
1901 FORMAT (
1 ' WITH THIS COMMAND YOU CAN PRESERVE THE CURRENT FORM OF'/
2 ' THE DATA, MODIFIED BY ANY MAPS, JOINS, POOLS, OR CUTS,'/
3 ' AS A NEW DATA FILE. THIS FILE MUST BE GIVEN A NAME OF'/
4 ' FROM ONE TO FIVE CHARACTERS. THE NAME MAY FOLLOW THE'/
5 ' WORD "SAVE" OR MAY BE ENTERED SEPARATELY.'/)
1910 TYPE 191
191 FORMAT (' NEW FILE NAME? ',$)
ACCEPT 3, SAVE
IF (SAVE.EQ.'NONE' .OR. SAVE.EQ.'ABORT') GO TO 200
IF (SAVE.EQ.'STOP') GO TO 2000
BLURB = SAVE.EQ.'EXPLA' .OR. SAVE.EQ.'?'
IF (BLURB) TYPE 1911
1911 FORMAT (
1 ' THE CURRENT FORM OF THE DATA WILL BE PRESERVED AS A'/
2 ' NEW DATA FILE. ENTER THE NAME (FROM ONE TO FIVE CHAR-'/
3 ' ACTERS) TO BE GIVEN TO THIS FILE. IF YOU DO NOT WANT'/
4 ' TO SAVE THE CURRENT DATA, TYPE "NONE".'/)
IF (BLURB .OR. SAVE.EQ.' ') GO TO 1910
1920 IF (.NOT.RENAME(SAVE,'.DAT',SAVE,'.DAT')) GO TO 1930
TYPE 192
192 FORMAT ('+NAME OF EXISTING DATA FILE CANNOT BE USED.'/)
GO TO 1910
1930 IF (RENAME(SAVE,'.DAT',TEMP,'.DAT')) DATA = SAVE
SWITCH = SWITCH .XOR. RENAME(TEMP,'.DAT',SAVE,'.OLD')
IF (RENAME(SAVE,'.OLD',SAVE,'.MAP')) TYPE 193, SAVE,SAVE
193 FORMAT (' OLD FILE ',A5,'.MAP RENAMED ',A5,'.OLD'/)
TEMP = TEMP1
IF (SWITCH) TEMP = TEMP2
CALL OFILE(21,TEMP)
WRITE (21,31) DATA
WRITE (21,183) M
IL = 'LOW'
WRITE (21,184) IL,(L(I),I=1,M)
IH = 'HIGH'
WRITE (21,184) IH,(H(I),I=1,M)
IX = 'MAP'
WRITE (21,186) IX,(X(I),I=1,M)
DO 1960 J=0,13
DO 1950 I=1,M
1950 R(I) = NK(MAP(I,J))
1960 WRITE (21,196) J, (R(I),I=1,M)
196 FORMAT (I2,3X,128A1)
END FILE 21
SWITCH = SWITCH .XOR. RENAME(SAVE,'.MAP',TEMP,'.DAT')
GO TO 200
C
C RESET: RESTORE DATA TO INITIAL STATE.
1990 TYPE 199
199 FORMAT (' DATA RESTORED TO INITIAL STATE'/)
1991 FORMAT (
1 ' THIS COMMAND RESTORES THE INITIAL STATE OF THE DATA,'/
2 ' UNDOING THE EFFECTS OF ALL MAPS, UNMAPS, JOINS, POOLS,'/
3 ' AND CUTS.'/)
IF (DATA.EQ.TEMP) TEMP = ORIG
DATA = ORIG
IF (.NOT.GROUP) GO TO 1995
CALL IFIL(21,DATA,'.MAP')
READ (21,31) DATA
IF (ORIG.EQ.TEMP) TEMP = DATA
1995 CALL IFILE(1,DATA)
READ (1,5) ID
IF (GROUP) 80,100,100
C
C STOP: TERMINATE EXECUTION.
2000 TYPE 34
CALL OFIL(20,LIST,'.TMP')
END FILE 20
IF (DATA.NE.TEMP) STOP
2002 FORMAT (
1 ' THE COMMAND "STOP" MAY BE GIVEN AS A RESPONSE TO ANY'/
2 ' REQUEST FOR INFORMATION. EXECUTION OF THE PROGRAM IS'/
3 ' TERMINATED, AND THE DATA FILE REVERTS TO ITS ORIGINAL'/
4 ' FORM.'/)
CALL OFILE(21,TEMP)
END FILE 21
STOP
END
C
FUNCTION JK(N)
JK = N/536870912-48
IF (JK.GE.0) RETURN
JK = 10-(JK-3)/6
RETURN
END
C
FUNCTION NK(J)
IF (J.GE.10) J = (13-J)*(J-7)-J-3*(J/12)
NK = (J+48)*536870912
RETURN
END
C
SUBROUTINE DECODE
COMMON ENTRY(0/13),LIST
CALL OFIL(20,LIST,'.TMP')
WRITE (20,3) (ENTRY(N),N=1,12)
3 FORMAT (12A5)
END FILE 20
CALL IFIL(20,LIST,'.TMP')
IF (ENTRY(1).LT.'MAP 0' .OR. ENTRY(1).GT.'MAP Z') GO TO 50
READ (20,4) (ENTRY(N),N=0,12)
4 FORMAT (A4,12A5)
CALL OFIL(20,LIST,'.TMP')
WRITE (20,3) (ENTRY(N),N=0,11)
END FILE 20
CALL IFIL(20,LIST,'.TMP')
RETURN
50 DO 55 N=0,12
55 ENTRY(N) = ENTRY(N+1)
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.