***********************************************************************
C
	PROGRAM GAMKED
C
C	PURPOSE:
C	   To transform a given GAMMA macro (extension .GMC) to RT-11
C	   ASCII format where it can be edited with an ordinary editor,
C	   e.g. KED, EDIT, TECO, VTECO, etc.
C
C	USAGE:
C	   See file GAMKED.DOC
C
C	INPUT DATA:
C	   A GAMMA macro with the file name having the extension .GMC
C
C	OUTPUT DATA:
C	   - The same macro in RT-11 format in the file GAMKED.TMP
C	   - The file GAMKEC.COM with the form
C		RU GAMKE1
C		!XXXXXX.GMC
C	     where XXXXXX.GMC is the name of the GAMMA macro to be edited.
C
C	SUBROUTINES AND FUNCTION SUBPROGRAMS USED:
C	   ANS
C	   RADCO
C	   Various SYSLIB routines
C
C	DATE/AUTHOR:
C	   HEINEMANN JULI 1981
C
C	   24-Sep-82	A. Virjo (enhancements)
C	   Central University Hospital of Tampere
C	   SF-33520 Tampere 52, Finland
C
C***********************************************************************
C
	REAL*8 RFN		!File name in Rad-50
	LOGICAL*1 MNAME(14),MBUFF(512),ARRAY(512)
	LOGICAL*1 YES,ERR
C
C   Get the name of the Gamma macro
C
 90	WRITE (5,100)
 100	FORMAT (' GAMMA-11 macro to be edited',
	1' (without .GMC extension)? ',$)
C
	DO 85 I=1,14
 85	MNAME(I)=' '
	READ (5,110)(MNAME(I),I=1,10)
 110	FORMAT (10A1)
	DO 80 I=1,14
	IS=I
	IF (MNAME(I).EQ.' ') GOTO 81
 80	CONTINUE
C
 81	MNAME(IS)='.'
	MNAME(IS+1)='G'
	MNAME(IS+2)='M'
	MNAME(IS+3)='C'
C
C   Check the Gamma macro name for correct syntax
C
	CALL RADCO(MNAME,RFN,ERR)		!Check and convert to Rad-50
	IF (.NOT.ERR) GOTO 82
	CALL ITTOUR("007)		!Ring the bell
	GOTO 90
C
C   Write the name of the Gamma macro in question as a comment in
C   the command file GAMKEC.COM for later use
C
 82	CALL ASSIGN (3,'SY0:GAMKEC.COM',14,'NEW')
	WRITE (3,310) (MNAME(I),I=1,14)
 310	FORMAT('RUN SY0:GAMKE1'/'!',14A1)
	CALL CLOSE(3)
C
C   Read the macro
C
	CALL ASSIGN (1,MNAME,14,'OLD')
	DEFINE FILE 1(1,256,U,IREC)
	READ (1'1,ERR=40) MBUFF
	CALL CLOSE(1)
C
	DO 5 I=1,512,51		!SETZT ALLE ("1) GLEICH ("0)
 5	MBUFF(I)="0
C
	DO 6 I=1,512		!SETZT ARRAY = "0
6	ARRAY(I)="0
C
C*** ERSETZT ALLE ("200) DURCH <CR><LF> UND UEBERSPRINGT DEN REST
C    DER ZEILE, WEIL DAHINTER NOCH 'SCHROTT' STEHEN KANN ***
C
	DO 10 I=1,512
	IF (MBUFF(I).EQ."200) GOTO 200
	ARRAY(I)=MBUFF(I)
	GOTO 10
 200	ARRAY(I)="15
	ARRAY(I+1)="12
	I=((I-1)/51+1)*51+1
 10	CONTINUE
C
C   Remove 0:s from the RT11 ASCII file
C
	J=0
	DO 20 I=1,512
	IF (ARRAY(I).EQ.0) GOTO 20
	J=J+1
	ARRAY(J)=ARRAY(I)
 20	CONTINUE
	DO 21 I=J+1,512
 21	ARRAY(I)=0
C
C*** SCHREIBT DAS MACRO IM RT11-FORMAT IN 'GAMKED.TMP'
C
	CALL ASSIGN (2,'SY0:GAMKED.TMP',14,'NEW')
	DEFINE FILE 2(1,256,U,NREC)
	WRITE (2'1) ARRAY
C
 22	CALL CLOSE(2)
	CALL EXIT
C	EINGEGEBENER GAMMA-11 makro-NAME NICHT VORHANDEN
C
 40	CALL CLOSE(1)
	CALL ITTOUR("007)	!Ring the bell
	WRITE (5,150)(MNAME(J),J=1,14)
 150	FORMAT (//' *** GAMMA-11 macro ',14A1,' does not exist.'
	@/'$    Do you want it to be created (N)?	')
	CALL ANS(YES)
	IF (YES) GOTO 50
	GOTO 90
C
 50	CALL ASSIGN (2,'SY0:GAMKED.TMP')
	DEFINE FILE 2(1,256,U,NREC)
	WRITE (2'1)	!Write a block of zeroes to GAMKED.TMP
	GOTO 22
C
	END
