*********************************************************************** 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 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