C
C COMPRESS A MACRO FILE BY DELETING COMMENTS AND CONDITIONAL
C ASSEMBLY SECTIONS OF NO RELEVANCE.
C
C ASSUME AL LEAST 4 CHARACTERS IN CONDITIONAL AND THOSE UNIQUE
C ALLOW FOR UPPER AND LOWER CASE VERSIONS OF REQUIRED CONDITIONAL
C BUT NOT MIXED CASE.
C
C LANGUAGE: FORTRAN-77
C
C BARRY DEVLIN, UNIVERSITY COLLEGE DUBLIN, APRIL 1984
C
	LOGICAL COPY,FLET,ENDIF
	CHARACTER*10 FNAME,FNOUT,COND,CONDA
	CHARACTER*80 LINE
	CHARACTER*1  LETR,LINO(80),BLANK
	DATA BLANK /' '/
C
C Ask for input filename and construct output filename.
C
	TYPE 10
 10	FORMAT(' File to be compressed: ',$)
	ACCEPT 11,FNAME
 11	FORMAT(A10)
	OPEN(UNIT=10,DEVICE='DSK:',FILE=FNAME)
	IDOT = INDEX(FNAME,'.')
	FNOUT = FNAME(1:IDOT)//'OUT'
	OPEN(UNIT=11,DEVICE='DSK:',FILE=FNOUT)
	TYPE 15
 15	FORMAT(' Conditional assembly section to be included: ',$)
	ACCEPT 11,COND
	DO 17 I=1,10
	N=ICHAR(COND(I:I))
	IF(N.GT.64.AND.N.LT.91)N=N+32
	CONDA(I:I)=CHAR(N)
 17	CONTINUE
C
C Main loop: read in line and search for relevant pieces.
C
	COPY = .TRUE.
	ENDIF = .FALSE.
 20	READ(10,25,END=999) LINE
 25	FORMAT(A80)
	FLET=.FALSE.
	DO 30 I=1,80
 30	LINO(I)=BLANK
	ICOM = 1
	DO 100 I = 1 , 80
	LETR = LINE(I:I)
	IF(LETR.EQ.' '.OR.LETR.EQ.CHAR(9)) THEN
		GOTO 100
	ELSE IF(LETR.EQ.';') THEN
		GOTO 110
	ELSE IF(LINE(I:(I+1)).EQ.'IF'.AND..NOT.FLET) THEN
		FLET = .TRUE.
		IF(INDEX(LINE,COND(1:4)).NE.0)THEN
		GOTO 100
		ELSE
		GOTO 50
		END IF
 50		IF(INDEX(LINE,CONDA(1:4)).EQ.0)THEN
		COPY=.FALSE.
		GOTO 100
		END IF
	ELSE IF(LINE(I:(I+4)).EQ.'ENDIF'.AND..NOT.FLET) THEN
		IF(.NOT.COPY)ENDIF=.TRUE.
		GOTO 100
	ELSE
		ICOM = I
		FLET = .TRUE.
	END IF
 100	CONTINUE
 110	IF(.NOT.COPY) GOTO 130
	IF(ICOM.EQ.1) GOTO 20
	DO 115 I = 1,ICOM
	LINO(I) = LINE(I:I)
 115	CONTINUE
	WRITE(11,120) (LINO(I),I=1,ICOM)
 120	FORMAT(80(A1))
 130	IF(.NOT.ENDIF)GOTO 20
	ENDIF = .FALSE.
	COPY = .TRUE.
	GOTO 20
 999	STOP
	END