C PROGRAM MERGE C C DESCRIPTION C THIS PROGRAM COMBINES UP TO 64 FILES OF RESPONSES TO THE SAME C QUESTIONS BY DIFFERENT RESPONDENTS. C C SOURCE C NORMAN W. JOHNSON, DEPARTMENT OF MATHEMATICS, WHEATON COLLEGE, C NORTON, MASS. C C INSTRUCTIONS C EACH SET OF CODED RESPONSES TO THE QUESTIONS SHOULD BE WRITTEN C INTO AN ASCII DATA FILE BY THE PROGRAM SURVEY. THE ORDER OF THE C QUESTIONS SHOULD BE THE SAME IN EACH FILE, THOUGH IT IS PERMIS- C SIBLE FOR SOME FILES TO HAVE EXTRA QUESTIONS AT THE END. C C THE PROGRAM WILL REQUEST THE NUMBER OF FILES TO BE MERGED AND C THEIR NAMES. THE NAME OF EACH FILE MAY BE ENTERED INDIVIDUALLY. C ALTERNATIVELY, INSTEAD OF ENTERING A FILE NAME, THE USER MAY C SIMPLY PRESS , IN WHICH CASE THE PROGRAM WILL ASSUME C THAT SUCCEEDING FILES ARE NAMED "SET1", "SET2", ETC. THE PRO- C GRAM WILL ALSO ASK FOR THE NAME (NOT MORE THAN 5 CHARACTERS) C THAT THE NEW DATA FILE IS TO HAVE AND FOR A DESCRIPTION OF THE C SURVEY (NOT MORE THAN 48 CHARACTERS). C C .................................................................. C INTEGER A(48),TODAY(2),BLANK INTEGER L(128),H(128),R(128) INTEGER DATA(64) DATA L,H /128*9,128*0/ BLANK = 17315143744 CALL TIME(NOW) CALL DATE(TODAY) TYPE 1, NOW,TODAY 1 FORMAT (' MERGE ',8X,A5,9X,2A5//) 20 TYPE 2 2 FORMAT (/' NUMBER OF FILES TO BE MERGED? ',$) ACCEPT 10, N IF (N.LT.2 .OR. N.GT.64) GO TO 20 TYPE 19 DO 35 J=1,N IF (J.GE.10) R(J) = BLANK TYPE 21, R(J),J 21 FORMAT ('+FILE',A1,I2,': ',$) C ENTER FILE NAME. 30 ACCEPT 3, DATA(J) 3 FORMAT (A5) IF (DATA(J).EQ.BLANK) GO TO 300 35 CONTINUE 40 TYPE 4 4 FORMAT (' NEW FILE NAME? ',$) C ENTER FILE NAME. ACCEPT 3, WHOLE TYPE 41 41 FORMAT (' DESCRIPTION: ',$) C ENTER DESCRIPTION OF SURVEY. 50 ACCEPT 5, (A(I),I=1,48) 5 FORMAT (48A1) DO 60 I=48,1,-1 IF (A(I).NE.BLANK) GO TO 80 60 A(I) = 0 M = 0 80 DO 180 J=1,N CALL IFILE(21,DATA(J)) READ (21,9) 9 FORMAT (//I) C INPUT NUMBER OF QUESTIONS. 100 READ (21,10) MJ 10 FORMAT (I) M = MAX0(M,MJ) C INPUT LOWEST NUMBER USED AS CODED RESPONSE TO EACH QUESTION. 120 READ (21,14) IL,(R(I),I=1,MJ) DO 130 I=1,MJ 130 L(I) = MIN0(L(I),R(I)) C INPUT HIGHEST NUMBER USED AS CODED RESPONSE TO EACH QUESTION. 140 READ (21,14) IH,(R(I),I=1,MJ) 14 FORMAT (A5,128I1) DO 150 I=1,MJ 150 H(I) = MAX0(H(I),R(I)) C INPUT MAPPING INDICATOR FOR EACH QUESTION. 160 READ (21,16) ID,(R(I),I=1,MJ) 16 FORMAT (A5,128A1) DO 180 I=1,MJ IF (R(I).EQ.BLANK) GO TO 180 170 TYPE 17, DATA(J) 17 FORMAT (' MAPPED VARIABLE FOUND IN FILE ',A5) PAUSE 180 CONTINUE FILE = RENAME(WHOLE,'.TMP',WHOLE,'.BAK') CALL OFIL(1,WHOLE,'.TMP') WRITE (1,19) 19 FORMAT () WRITE (1,5) (A(I),I=1,48) 200 WRITE (1,201) M 201 FORMAT (2X,I3,' VARIABLES') 220 WRITE (1,14) IL,(L(I),I=1,M) 240 WRITE (1,14) IH,(H(I),I=1,M) WRITE (1,19) LAST = 0 DO 280 J=1,N CALL IFILE(21,DATA(J)) READ (21,9) ID READ (21,9) ID C INPUT RESPONSES TO QUESTIONS BY EACH RESPONDENT. 250 READ (21,16) ID,(R(I),I=1,M) IF (ID.EQ.BLANK) GO TO 280 260 WRITE (1,16) ID,(R(I),I=1,M) LAST = LAST+1 GO TO 250 280 CONTINUE WRITE (1,19) 290 WRITE (1,29) LAST 29 FORMAT (1X,I4,' RESPONDENTS') END FILE 1 FILE = RENAME(WHOLE,'.BAK',WHOLE,'.DAT') FILE = RENAME(WHOLE,'.DAT',WHOLE,'.TMP') TYPE 29, LAST STOP 300 K = J-1 N1 = MIN0(9,N-K) DO 310 J=1,N1 310 DATA(J+K) = 'SET0'+256*J IF (N-K.LT.10) GO TO 40 DO 320 J=10,N-K 320 DATA(J+K) = 'SET00'+236*(J/10)+2*J GO TO 40 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.