C     PROGRAM UNITE
C
C     DESCRIPTION
C	THIS PROGRAM COMBINES TWO FILES OF RESPONSES TO DIFFERENT QUES-
C	TIONS BY THE SAME RESPONDENTS.
C
C     SOURCE
C	NORMAN W. JOHNSON, DEPARTMENT OF MATHEMATICS, WHEATON COLLEGE,
C	NORTON, MASS.
C
C     INSTRUCTIONS
C	CODED RESPONSES TO THE TWO SETS OF QUESTIONS SHOULD BE WRITTEN
C	INTO ASCII DATA FILES BY THE PROGRAM SURVEY.  THE ORDER OF THE
C	RESPONDENTS AND THE FIRST 4 CHARACTERS OF THE 5-CHARACTER IDEN-
C	TIFICATION OF EACH RESPONDENT SHOULD BE THE SAME IN BOTH FILES.
C
C	THE PROGRAM WILL REQUEST THE NAMES OF THE TWO FILES TO BE UNITED
C	AND, FOR EACH, THE RANGE OF QUESTIONS TO BE INCLUDED.  THE USER
C	SHOULD ENTER EITHER THE WORD "ALL", TWO NUMBERS JOINED BY A HY-
C	PHEN TO INDICATE A BLOCK OF CONSECUTIVE QUESTIONS, OR ONE NUMBER
C	FOR A SINGLE QUESTION.  THE TOTAL NUMBER OF QUESTIONS INCLUDED
C	FROM BOTH FILES MUST NOT EXCEED 128.  THE TWO FILES WILL BE
C	CHECKED TO SEE THAT THE NUMBER OF RESPONDENTS AND THEIR IDENTI-
C	FICATIONS AGREE.  THE PROGRAM WILL ALSO ASK FOR THE NAME (NOT
C	MORE THAN 5 CHARACTERS) THAT THE NEW DATA FILE IS TO HAVE AND
C	FOR A DESCRIPTION OF THE SURVEY (NOT MORE THAN 48 CHARACTERS).
C
C	MORE THAN TWO FILES CAN BE COMBINED BY REPEATED EXECUTIONS OF
C	THIS PROGRAM.
C
C     ..................................................................
C
      INTEGER A(48),TODAY(2),BLANK,UNIT
      INTEGER R(128)
      INTEGER DATA(2),MAP(2)
      LOGICAL GROUP(2),JUMP
      BLANK = 17315143744
      CALL TIME(NOW)
      CALL DATE(TODAY)
      TYPE 1, NOW,TODAY
    1 FORMAT (' UNITE ',8X,A5,9X,2A5//)
   20 TYPE 2
    2 FORMAT (/' FILES TO BE UNITED?'/)
      DO 130  J=1,2
      TYPE 21, J
   21 FORMAT (' FILE ',I1,': ',$)
C     ENTER FILE NAME.
   30 ACCEPT 3, MAP(J)
    3 FORMAT (A5)
   31 FORMAT (/A5)
      IF (MAP(J).EQ.' ') GO TO 20
      GROUP(J) = RENAME(MAP(J),'.MAP',MAP(J),'.MAP')
      UNIT = 20+J
      IF (GROUP(J)) CALL IFIL(UNIT,MAP(J),'.MAP')
      IF (GROUP(J)) READ (UNIT,31) DATA(J)
      IF (.NOT.GROUP(J)) DATA(J) = MAP(J)
    5 FORMAT (48A1)
      CALL IFILE(UNIT,DATA(J))
C     INPUT NUMBER OF QUESTIONS.
   70 READ (UNIT,7) M
    7 FORMAT (//I)
      READ (UNIT,7) ID
      GO TO 90
   80 TYPE 8, M
    8 FORMAT ('+INVALID ENTRY--NUMBERS RUN FROM  1  TO ',I3/)
   90 TYPE 9
    9 FORMAT ('+WHICH QUESTIONS? ',$)
C     ENTER RANGE OF QUESTIONS TO BE INCLUDED.
  100 ACCEPT 10, IA,IB
   10 FORMAT (2I)
      IB = IABS(IB)
      IF (IA.LT.0 .OR. IA.GT.M .OR. IB.GT.M) GO TO 80
      IF (IB.EQ.0) IB = IA
      IF (IA.EQ.0 .AND. IB.NE.0 .OR. IA.GT.IB) GO TO 80
      IA = MAX0(IA,1)
      IF (IB.EQ.0) IB = M
      IF (J.EQ.2) GO TO 120
  110 I1A = IA
      I1B = IB
      GO TO 130
  120 I2A = IA
      I2B = IB
  130 CONTINUE
      M = I1B-I1A+I2B-I2A+2
      IF (M.LE.128) GO TO 165
  140 TYPE 14
   14 FORMAT (' TOO MANY QUESTIONS--START OVER')
      GO TO 20
  150 TYPE 15
   15 FORMAT (' FILES OF DIFFERENT LENGTH--CAN''T UNITE')
      STOP
  160 TYPE 16, ID1,ID2
   16 FORMAT (' IDENTIFICATION MISMATCH: ',A4,' = ',A4,'?')
      PAUSE
  165 READ (21,24) ID1
      READ (22,24) ID2
      IF (ID1.EQ.BLANK .AND. ID2.NE.BLANK) GO TO 150
      IF (ID1.NE.BLANK .AND. ID2.EQ.BLANK) GO TO 150
      IF (ID1.NE.ID2) GO TO 160
      IF (ID1.NE.BLANK) GO TO 165
C     INPUT NUMBER OF RESPONDENTS.
      READ (21,10) LAST
  170 TYPE 17
   17 FORMAT (' NEW FILE NAME? ',$)
C     ENTER FILE NAME.
      ACCEPT 3, UNION
      FILE = RENAME(UNION,'.TMP',UNION,'.BAK')
  180 TYPE 18
   18 FORMAT (' DESCRIPTION: ',$)
C     ENTER DESCRIPTION OF SURVEY.
      ACCEPT 5, (A(I),I=1,48)
      DO 190  I=48,1,-1
      IF (A(I).NE.BLANK) GO TO 200
  190 A(I) = 0
  200 CALL OFIL(1,UNION,'.TMP')
      WRITE (1,27)
      WRITE (1,5) (A(I),I=1,48)
  210 CALL IFILE(21,DATA(1))
      READ (21,7) ID
  220 CALL IFILE(22,DATA(2))
      READ (22,7) ID
  230 WRITE (1,23) M
   23 FORMAT (2X,I3,' VARIABLES')
      DO 240  K=1,2
      READ (21,24) ID,(I1R,I=0,I1A-1),(R(I+1-I1A),I=I1A,I1B)
      READ (22,24) ID,(I2R,I=0,I2A-1),(R(I+M-I2B),I=I2A,I2B)
  240 WRITE (1,24) ID,BLANK,(R(I),I=1,M)
   24 FORMAT (A4,A1,128I1)
      IF (JUMP) GO TO 250
      READ (21,26) ID
      READ (22,26) ID
      WRITE (1,27)
  250 DO 260  K=JUMP+1,LAST
      READ (21,26) ID,(I1R,I=0,I1A-1),(R(I+1-I1A),I=I1A,I1B)
      READ (22,26) ID,(I2R,I=0,I2A-1),(R(I+M-I2B),I=I2A,I2B)
  260 WRITE (1,26) ID,BLANK,(R(I),I=1,M)
   26 FORMAT (A4,A1,128A1)
      IF (JUMP) GO TO 390
      WRITE (1,27)
   27 FORMAT ()
  280 WRITE (1,28) LAST
   28 FORMAT (1X,I4,' RESPONDENTS')
  290 END FILE 1
      FILE = RENAME(UNION,'.BAK',UNION,'.DAT')
      FILE = RENAME(UNION,'.DAT',UNION,'.TMP')
      IF (.NOT.GROUP(1) .OR. .NOT.GROUP(2)) GO TO 400
      FILE = RENAME(UNION,'.TMP',UNION,'.OLD')
  300 CALL OFIL(1,UNION,'.TMP')
      WRITE (1,31) UNION
  310 CALL IFIL(21,MAP(1),'.MAP')
      READ (21,7) ID
  320 CALL IFIL(22,MAP(2),'.MAP')
      READ (22,7) ID
      LAST = 14
      JUMP = .TRUE.
      GO TO 230
  390 END FILE 1
      FILE = RENAME(UNION,'.OLD',UNION,'.MAP')
      FILE = RENAME(UNION,'.MAP',UNION,'.TMP')
  400 TYPE 40
   40 FORMAT ('1CORRESPONDING VARIABLE NUMBERS:'/)
  401 FORMAT (1X,A5,3X,16I4)
  410 DO 415  K=0,7
      M1 = MIN0(16*(K+1),I1B-I1A+1)
      TYPE 27
      IF (JUMP) DATA(1) = MAP(1)
      TYPE 401, DATA(1),(I,I=16*K+I1A,M1+I1A-1)
      TYPE 401, UNION,(I,I=16*K+1,M1)
  415 IF (M1.GE.I1B-I1A+1) GO TO 420
  420 DO 425  K=0,7
      M2 = MIN0(M1+16*(K+1),M)
      TYPE 27
      IF (JUMP) DATA(2) = MAP(2)
      TYPE 401, DATA(2),(I,I=16*K+I2A,M2+I2B-M)
      TYPE 401, UNION,(I,I=M1+16*K+1,M2)
  425 IF (M2.GE.M) GO TO 430
  430 TYPE 43
   43 FORMAT ('1')
      STOP
      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.