*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/15 17:51:59  mclareni
* Initial revision
*
*
#include "sys/CERNLIB_machine.h"
#include "pilot.h"
      PROGRAM FCASPLIT
 
C CERN PROGLIB#         FCASPLIT        .VERSION KERNFOR  4.32  920229
C ORIG. 01/10/88  JZ
 
      PARAMETER   (NARADD = 0)
      CHARACTER    CHIDF*8, CHIDC*8, CHIDA*8, CHIDD*4
      CHARACTER    CHIDX*7, CHIDY*6, CHOVER*(*)
      CHARACTER    CHPOF*(*), CHPOC*(*), CHPOA*(*)
      CHARACTER    CHEXFOR*(*), CHEXCC*(*), CHEXAS*(*)
      CHARACTER    CHWHF*(*), CHWHC*(*), CHWHA*(*)
      CHARACTER    CHEXOBJ*(*)
 
      PARAMETER   (CHIDF = 'CDECK  I' )
      PARAMETER   (CHIDC = '/*DECK I' )
      PARAMETER   (CHIDX =  'DECK  I' )
      PARAMETER   (CHIDY =   'DECK I' )
      PARAMETER   (CHIDD =         'D>, ' )
 
      PARAMETER   (CHIDA = '|DECK  I' )
      PARAMETER   (CHOVER= 'UNKNOWN')
 
      PARAMETER   (CHPOF = '( OPT(2)')
      PARAMETER   (CHPOC = '( ALIAS($*) ')
      PARAMETER   (CHPOA = ' ')
 
      PARAMETER   (CHEXFOR = '.fortran ')
      PARAMETER   (CHEXCC  = '.c ')
      PARAMETER   (CHEXAS  = '.assemble ')
      PARAMETER   (CHEXOBJ = ' TEXT ')
 
      PARAMETER   (CHWHF = 'FORTVS2 ')
      PARAMETER   (CHWHC = 'EXEC CC ')
      PARAMETER   (CHWHA = 'HASM ')
 
      PARAMETER   (MLMKLN=100)
      PARAMETER   (MXLENG=128, MXMKLN=64)
      CHARACTER    CHHOLD*(MXLENG)
      CHARACTER    CHOPT(7)*(MXLENG)
      DIMENSION    NCHOPT(7)
      EQUIVALENCE (NOPF,NCHOPT(1))
      EQUIVALENCE (NOPC,NCHOPT(2))
      EQUIVALENCE (NOPA,NCHOPT(3))
 
      CHARACTER    CHCMP(3)*(MXLENG)
      DIMENSION    NCHCMP(3)
      EQUIVALENCE (CHCMP(1),CHOPT(4)), (NCHCMP(1),NCHOPT(4))
      EQUIVALENCE (NNF,NCHCMP(1))
      EQUIVALENCE (NNC,NCHCMP(2))
      EQUIVALENCE (NNA,NCHCMP(3))
 
      CHARACTER    CHFIN*(MXLENG)
      EQUIVALENCE (CHFIN,CHOPT(7)), (NCHFIN,NCHOPT(7))
 
      CHARACTER    CHFSH*(MXLENG), CHFMK*(MXLENG)
      CHARACTER    CHMKLN*(MXMKLN+4)
 
      PARAMETER   (MXCBUF=100)
      DIMENSION    LXCBUF(MXCBUF)
      CHARACTER*80 CHCBUF(MXCBUF)
 
      CHARACTER    CHLINE*80, CHNAME*80, CHTEXT*511
      CHARACTER    CHUSE*1
      CHARACTER*21 UXTOVM,FILNAM
      CHARACTER*2  OFM
      LOGICAL      LEXIST
 
      PARAMETER   (NKEYS=11)
      CHARACTER    CHKEYS(NKEYS)*4
      DATA CHKEYS  / '-noh', '-log'
     +,              '-fo ', '-co ', '-ao '
     +,              '-f  ', '-c  ', '-a  '
     +,              '+fo ', '+co ', '+ao ' /
 
 
      PRINT 9001
 9001 FORMAT (' FCASPLIT executing.')
 
 
 9002 FORMAT (
     F ' FCASPLIT     [-f  nmft] [-c  nmcc] [-a  nmas]   [-noh] [-log]'
     F/'              [+fo incf] [+co incc] [+ao incs]'
     F/'              [-fo optf] [-co optc] [-ao opts]'
     F/'     f.e  [fca_n] [optf      [optc      [opts]]]'/
     F/' splits file  f.e  having a mixture of Fortran / C / assembler'
     F/' routines into separate files n.f or n.c or n.s, "n" being the'
     F/' name of each routine, creating at the same time a Shell script'
     F/' y.shfca  and a Make file  y.mkfca  either of which can be used'
     F/' to compile all routines individually.'/
     F/' Defaults are defined in fcasplit for the names by which the'
     F/' compilers are called; with the -f, -c, -a options they could'
     F/' be changed.'/
     F/' Defaults are also defined for the options with which they are'
     F/' called; with the -fo, -co, -ao options they can be re-defined;'
     F/' with the +fo, +co, +ao options they can be incremented.'/
     F/' To be backward compatible the options can also be specified by'
     F/' the positional parameters after the file-name.')
 9003 FORMAT (1X
     F/' If the  -noh  option is given (or if the first parameter after'
     F/' the file-name is "fca_n") the identifying header line of each'
     F/' routine is not written out. If the -log option is given'
     F/' the name of each routine is printed on standard output.')
 9004 FORMAT (1X
     F/' Each routine must start with an identifying line :'
     F/'  "', A,  'D>, "      in cols.  1-12  for Fortran'
     F/'  "', A,  'D>, "      in cols.  1-12  for C'
     F/'  "', A,  'D>, "      in cols.  1-12  for assembler'
     F/'   "DECK  ID>, "      in cols.  2-12  or'
     F/'    "DECK ID>, "      in cols.  3-12  for anything else'
     F/'              "name"  in cols. 13-40  gives the name'/
     F/'        In the last two cases, or if "name" contains an'
     F/'        extension,  the file created will be "name"'
     F/'        without extension .f, .c or .s added to it'
     F/'        and without an entry into the script.'/
     F/'        A trailing blank terminates the name,'
     F/'        symbol . followed by blank also terminates,'
     F/'        symbols  ; < # !   all terminate,'
     F/'        symbol   */        also  terminates.'
     F/1X)
 
C------            Acquire the parameters
 
      NARGS = IARGC() + NARADD
 
      CHOPT(1) = CHPOF
      CHOPT(2) = CHPOC
      CHOPT(3) = CHPOA
 
      CHCMP(1) = CHWHF
      CHCMP(2) = CHWHC
      CHCMP(3) = CHWHA
      CHFIN    = 'f.e'
 
      IFINFI = 0
      IFLNH  = 0
      IFLLOG = 0
 
C--       Get the keyed options, until the input file name
 
      OFM  ='A'
      JARG = 0
   11 JOPT = 0
   12 IF (JARG.GE.NARGS)           GO TO 21
      JARG = JARG + 1
      CALL GETARG (JARG, CHHOLD)
 
      IF(CHHOLD(1:5).EQ.'-mode') THEN
        JARG=JARG+1
        CALL GETARG(JARG,OFM)
        GOTO 11
      ENDIF
      IF (JOPT.EQ.0)               GO TO 13
 
C----     Store option values read
 
C--       positional trailing options
      IF (JOPT.LT.0)  THEN
          IF (JOPT.EQ.-1)  THEN
              IF (CHHOLD(1:5).EQ.'fca_n')  THEN
                  IFLNH = 7
                  GO TO 12
                ENDIF
            ENDIF
          CHOPT(-JOPT) = CHHOLD
          JOPT = JOPT - 1
          GO TO 12
        ENDIF
 
C--       keyed options
      IF (JOPT.LE.6)  THEN
          CHOPT(JOPT) = CHHOLD
          IF(CHHOLD(1:1).NE.'('.AND.JOPT.LE.3)
     +    CHOPT(JOPT) = '('//CHHOLD
        ELSE
                                  IPAR=1
          IF (CHHOLD(1:1).EQ.'(') IPAR=2
          IF (JOPT.EQ.7)  CHOPT(1) = CHPOF // ' ' // CHHOLD(IPAR:)
          IF (JOPT.EQ.8)  CHOPT(2) = CHPOC // ' ' // CHHOLD(IPAR:)
          IF (JOPT.EQ.9)  CHOPT(3) = CHPOA // ' ' // CHHOLD(IPAR:)
        ENDIF
      GO TO 11
 
C----     Analyse key, if any
 
C-         -noh -log  -fo -co -ao   -f  -c  -a  +fo +co +ao
C-            1    2    3   4   5    6   7   8    9  10  11
C-                      1   2   3    4   5   6    7   8   9
 
   13 DO 14  JKEY=1,NKEYS
      IF (CHHOLD(1:4).EQ.CHKEYS(JKEY))  THEN
          IF (JKEY.EQ.1)  THEN
              IFLNH = 7
              GO TO 11
            ENDIF
          IF (JKEY.EQ.2)  THEN
              IFLLOG = 7
              GO TO 11
            ENDIF
          JOPT = JKEY - 2
          GO TO 12
        ENDIF
   14 CONTINUE
 
C----     File-name read
 
      CHFIN = CHHOLD
      IFINFI = 7
 
C----     Get the positional options if given
 
      JOPT = -1
      GO TO 12
 
C------            Parameters have all been read
 
C--       Length of the option strings = true length + 2 (blanks)
 
   21 DO  24  JJ=1,7
      DO  23  J=MXLENG,1,-1
      IF (CHOPT(JJ)(J:J).NE.' ')     GO TO 24
   23 CONTINUE
      J = 0
   24 NCHOPT(JJ) = J + 2
      NCHFIN = NCHFIN - 2
 
C--       Derive the name of the script  yyy.shfca
C-        from the input file,  say  dir/yyy.ext
 
      N  = NCHFIN
      JA = 1
      JE = N
      J  = N
   26 IF (CHFIN(J:J).EQ.'/')  THEN
          JA = J + 1
          GO TO 27
        ELSEIF (CHFIN(J:J).EQ.'.')  THEN
          IF (JE.EQ.N)  JE = J - 1
        ENDIF
      J = J - 1
      IF (J.NE.0)                  GO TO 26
   27 CONTINUE
C---  Remove filetype if CHFIN=fn.ft.fm
      IDOT=INDEX(CHFIN(JA:JE),'.')
      IF(IDOT.GT.0) JE=IDOT-1
      CHFSH  = 'sh'//CHFIN(JA:JE) // '.exec'
      CHFMK  = 'mk'//CHFIN(JA:JE) // '.exec'
      NCHFSH = JE+8 - JA
 
      IF  (IFINFI.EQ.0)  THEN
          PRINT 9002
          PRINT 9003
          PRINT 9004, CHIDF, CHIDC, CHIDA
        ENDIF
 
      PRINT 9026, CHFIN(1:NCHFIN), CHFSH(1:NCHFSH), CHFMK(1:NCHFSH)
      PRINT 9027, CHCMP(1)(1:NNF),CHOPT(1)(1:NOPF)
      PRINT 9028, CHCMP(2)(1:NNC),CHOPT(2)(1:NOPC)
      PRINT 9029, CHCMP(3)(1:NNA),CHOPT(3)(1:NOPA)
 9026 FORMAT (5X,'        Input file : ',A/
     F        5X,'      Shell script : ',A/
     F        5X,'         Make file : ',A)
 9027 FORMAT (5X,'   Fortran    name : ',A/
     F        5X,'   Fortran options : ',A)
 9028 FORMAT (5X,'        CC    name : ',A/
     F        5X,'        CC options : ',A)
 9029 FORMAT (5X,' Assembler    name : ',A/
     F        5X,' Assembler options : ',A)
 
C----        Stop if no file-name, help information printed
 
      IF (IFINFI.EQ.0)  THEN
          PRINT 9030
          STOP
        ENDIF
 
 9030 FORMAT (' !!! No file-name given, no execution !!!')
 
C------------      Process the input file       ------------------
 
      FILNAM=UXTOVM(CHFIN(1:NCHFIN))
      LF=LENOCC(FILNAM)
      INQUIRE(FILE=FILNAM(1:LF),EXIST=LEXIST)
      IF (.NOT.LEXIST)  THEN
          PRINT 9031,FILNAM(1:LF)
          STOP
        ENDIF
 
 9031 FORMAT (' fcasplit: input file ',A,' not found ')
 
C--                Open input and .shfca file
      OPEN (11, FILE=FILNAM(1:LF),STATUS='OLD',ACTION='READ',
     +          FORM='UNFORMATTED')
      FILNAM=UXTOVM(CHFSH(1:NCHFSH)//'.'//OFM)
      LF=LENOCC(FILNAM)
      CALL FILEINF(I,'RECFM','U')
      OPEN (21, FILE=FILNAM(1:LF),STATUS=CHOVER)
      FILNAM=UXTOVM(CHFMK(1:NCHFSH)//'.'//OFM)
      LF=LENOCC(FILNAM)
      CALL FILEINF(I,'RECFM','U')
      OPEN (22, FILE=FILNAM(1:LF),STATUS=CHOVER)
      REWIND 11
      REWIND 21
      REWIND 22
      WRITE(21,*) '/* Compilation exec */'
      WRITE(21,*) '   Address Command'
C     WRITE(21,*) '   Trace C'
      WRITE(21,*) '   cc=0'
 
      CHMKLN = 'ROUTINES = '
      NXMKLN = 11
 
      NTEXT  = -12
      NIGNOR = 0
      NROUT  = 0
      NLINES = 0
      NTCBUF = 0
      NXCBUF = 0
 
      NLMKLN = 0
      NPCSMK = 0
 
      CALL CLTOU(CHFIN(JA:JE))
C-------           Read next line        -------------------------
 
   31 CONTINUE
      READ (11,NUM=N,END=81) CHLINE
C     N = LEN(CHLINE)
 
      DO  33  NCHLN=N,2,-1
      IF (CHLINE(NCHLN:NCHLN).NE.' ')  GO TO 34
   33 CONTINUE
      NCHLN = 1
 
   34 IF (NCHLN.GE.13)  THEN
          IF (CHLINE(9:12).EQ.CHIDD)   GO TO 59
        ENDIF
   35 IF (NTEXT.LT.0)              GO TO 58
   36 IF (JTYPE.NE.1)              GO TO 41
 
C--       Check new line is a Fortran comment line
 
      IF (CHLINE(1:1).EQ.'C')      GO TO 38
      IF (CHLINE(1:1).EQ.'c')      GO TO 38
      IF (CHLINE(1:1).EQ.'*')      GO TO 38
      IF (NCHLN.NE.1)              GO TO 41
      IF (CHLINE(1:1).NE.' ')      GO TO 41
 
   38 IF (NXCBUF.EQ.MXCBUF)        GO TO 41
      NXCBUF = NXCBUF + 1
      CHCBUF(NXCBUF)(1:NCHLN) = CHLINE(1:NCHLN)
      LXCBUF(NXCBUF) = NCHLN
      GO TO 31
 
C-------           Write next line       -------------------------
 
C--        NTEXT = <0  idle unheaded lines (not coming here)
C-                  0  normal running
C-                 >0  about to write the first line of new routine
C-                     if =1 : no entry to script and make file
 
C-        start a new routine only when the first true line is ready
 
   41 IF (NTEXT.EQ.0)              GO TO 46
      IF (NTEXT.EQ.1)              GO TO 44
 
C--       compilation command for this routine to the shell script
 
C--   Substitute $* by filename in command line
      INM=INDEX(CHTEXT(1:NTEXT),'$*')
      IF(INM.GT.0) THEN
C       CALL UCOPY2(CHTEXT(INM+2:),CHTEXT(INM+NPUT:),NTEXT-INM-1)
        DO 42 N=NTEXT+NPUT-2,INM+NPUT,-1
           CHTEXT(N:N)=CHTEXT(N-NPUT+2:N-NPUT+2)
  42    CONTINUE
        CHTEXT(INM:INM+NPUT-1)=CHNAME(1:NPUT)
        NTEXT=NTEXT+NPUT-2
      ENDIF
 
      WRITE (21,8000) 'cmd="'//CHTEXT(1:NTEXT)//'"'
      WRITE (21,8000) 'Say "     "cmd ; cmd ; If rc>cc Then cc=rc'
      WRITE (21,8000) 'If rc=0 Then Do'
      WRITE (21,8000) '   tfile="'//CHNAME(1:NPUT)//' TEXT A"'
      WRITE (21,8000)
     +      '"COPY" tfile "'//CHFIN(JA:JE)//' = = (APP" ;'
     +    //'"ERASE" tfile'
      WRITE (21,8000) 'End'
 
C--       register the routine name for the Make file
 
      CHTEXT =  CHNAME(1:NPUT) // CHEXOBJ // ' '
      NTEXT  =  NPUT + LEN(CHEXOBJ) + 1
      IF (NXMKLN+NTEXT.GT.MXMKLN) THEN
          NLMKLN = NLMKLN + 1
          IF (NLMKLN.LT.MLMKLN) THEN
              NXMKLN = NXMKLN + 1
              CHMKLN(NXMKLN:NXMKLN) = CHAR(92)
              WRITE (22,8000) CHMKLN(1:NXMKLN)
              NXMKLN = 0
            ELSE
              WRITE (22,8000) CHMKLN(1:NXMKLN)
              NXMKLN = 0
              NLMKLN = 0
              WRITE (22,9042)
              NPCSMK = NPCSMK + 1
              WRITE (CHMKLN,9043) NPCSMK
              NXMKLN = 11
            ENDIF
        ENDIF
 
 9042 FORMAT('#')
 9043 FORMAT('ROUTINE',I1,' = ')
 
      CHMKLN(NXMKLN+1:NXMKLN+NTEXT) = CHTEXT(1:NTEXT)
      NXMKLN = NXMKLN + NTEXT
 
C--       Open the output file if first line ready
   44 CONTINUE
      IF(INDEX(CHNAME(1:NCUM),'.assemble').EQ.0)
     +  CALL FILEINF(I,'RECFM','U')
      OPEN  (27, FILE=UXTOVM(CHNAME(1:NCUM)//'.'//OFM),STATUS=CHOVER)
      REWIND 27
 
      NTEXT = 0
      NROUT = NROUT + 1
      IF (IFLLOG.NE.0)  PRINT 9044, NROUT,CHNAME(1:NCUM)
 9044 FORMAT (' make',I4,1X,A)
 
C--       Transfer the comment lines from the buffer
 
   46 IF (NXCBUF.EQ.0)             GO TO 48
      DO  47  J=1,NXCBUF
      WRITE (27,8000) CHCBUF(J)(1:LXCBUF(J))
   47 CONTINUE
      NLINES = NLINES + NXCBUF
      NXCBUF = 0
 
C--       Transfer the current line
 
   48 WRITE (27,8000) CHLINE(1:NCHLN)
      NLINES = NLINES + 1
      GO TO 31
 
C--                Ignore leading unheaded lines
 
   58 NIGNOR = NIGNOR + 1
      IF (NTEXT.EQ.-1)             GO TO 31
      PRINT 9058, CHLINE(1:NCHLN)
      NTEXT = NTEXT + 1
      IF (NTEXT.NE.-1)             GO TO 31
      PRINT 9059
      GO TO 31
 9058 FORMAT (' ignored: ',A)
 9059 FORMAT (10X,'...')
 
C-------           Start new routine ?   -------------------------
 
   59 JTYNX = 0
      IF (CHLINE(1:8).EQ.CHIDF)    GO TO 61
      IF (CHLINE(1:8).EQ.CHIDC)    GO TO 62
      IF (CHLINE(1:8).EQ.CHIDA)    GO TO 63
      IF (CHLINE(2:8).EQ.CHIDX)    GO TO 60
      IF (CHLINE(3:8).EQ.CHIDY)    GO TO 60
      GO TO 35
 
C--                Yes, start new routine
 
   63 JTYNX = 1
   62 JTYNX = JTYNX + 1
   61 JTYNX = JTYNX + 1
   60 JPUT = 0
      JDOT = 0
      JDOP = 0
      NUS  = MIN(NCHLN,40)
 
C--       skip leading blanks before the name
 
      JGO = 13
   65 IF (CHLINE(JGO:JGO).EQ.' ')  THEN
          JGO = JGO + 1
          GO TO 65
        ENDIF
 
      IF (JGO.GT.NUS)              GO TO 35
 
C--       Convert name to lower case and find termination
 
      DO 66  JTK=JGO,NUS
      CHUSE = CHLINE(JTK:JTK)
      JV    = ICHAR(CHUSE)
      IF (CHUSE.EQ.' ')            GO TO 67
      IF (CHUSE.EQ.'.')  THEN
          IF (CHLINE(JTK+1:JTK+1).EQ.' ')   GO TO 67
          JDOP = JDOT
          JDOT = JPUT+1
        ENDIF
      IF (CHUSE.EQ.';')            GO TO 67
      IF (CHUSE.EQ.'<')            GO TO 67
      IF (CHUSE.EQ.'#')            GO TO 67
      IF (CHUSE.EQ.'!')            GO TO 67
      IF (CHUSE.EQ.'*')  THEN
          IF (CHLINE(JTK+1:JTK+1).EQ.'/')   GO TO 67
        ENDIF
C     IF (JV.LT.91)  THEN
C         IF (JV.GE.65)  CHUSE = CHAR(JV+32)
C       ENDIF
      JPUT = JPUT + 1
      CHNAME(JPUT:JPUT) = CHUSE
   66 CONTINUE
 
C--                Handle explicit extension
 
   67 JTYPE = JTYNX
      IF (JDOT.EQ.JPUT)  THEN
          JDOT = JDOP
          JPUT = JPUT - 1
        ENDIF
 
      NTEXT = 1
      NPUT  = JPUT
      NCUM  = NPUT
      IF (JDOT.NE.0)  JTYPE = -JTYPE
 
C----              Handle normal case with standard extensions
 
      IF (JTYPE.LE.0)              GO TO 80
 
C--       Fortran
 
      IF (JTYPE.NE.1)              GO TO 74
      N  =  LEN(CHEXFOR)
      CHNAME(NPUT+1:NPUT+N) = CHEXFOR
      NCUM   =  NPUT + N
      CHTEXT =  CHCMP(1)(1:NNF)//CHNAME(1:NPUT)//' '//CHOPT(1)(1:NOPF)
      NTEXT  =  NNF + NOPF + NPUT+1
      GO TO 80
 
C--       CC
 
   74 IF (JTYPE.NE.2)              GO TO 77
      N  =  LEN(CHEXCC)
      CHNAME(NPUT+1:NPUT+N) = CHEXCC
      NCUM   =  NPUT + N
      CHTEXT =  CHCMP(2)(1:NNC)//CHNAME(1:NPUT)//' '//CHOPT(2)(1:NOPC)
      NTEXT  =  NNC + NOPC + NPUT+1
      GO TO 80
 
C--       Assembler
 
   77 IF (JTYPE.NE.3)              GO TO 80
      N  =  LEN(CHEXAS)
      CHNAME(NPUT+1:NPUT+N) = CHEXAS
      NCUM   =  NPUT + N
      CHTEXT =  CHCMP(3)(1:NNA)//CHNAME(1:NPUT)//' '//CHOPT(3)(1:NOPA)
      NTEXT  =  NNA + NOPA + NPUT+1
 
   80 CLOSE (27)
      NTCBUF = NTCBUF + NXCBUF
      NXCBUF = 0
      IF (JTYPE.LT.1)              GO TO 31
      IF (IFLNH.NE.0)              GO TO 31
      GO TO 36
 
C-------           Done                  -------------------------
 
C----           Complete the Make file
 
   81 WRITE (22,8000) CHMKLN(1:NXMKLN-1)
 
C--       Fortran inference
 
      CHNAME = CHEXFOR // CHEXOBJ // ':'
      NPUT   = LEN(CHEXFOR) + LEN(CHEXOBJ) + 1
      CHTEXT = CHAR(9) // CHCMP(1)(1:NNF) // CHOPT(1)(1:NOPF) //
     +            '$*' // CHEXFOR
      NTEXT   = 3 + NNF + NOPF + LEN(CHEXFOR)
      WRITE (22,9083) CHNAME(1:NPUT), CHTEXT(1:NTEXT)
 
C--       CC inference
 
      CHNAME = CHEXCC // CHEXOBJ // ':'
      NPUT   = LEN(CHEXCC) + LEN(CHEXOBJ) + 1
      CHTEXT = CHAR(9) // CHCMP(2)(1:NNC) // CHOPT(2)(1:NOPC) //
     +            '$*' // CHEXCC
      NTEXT   = 3 + NNC + NOPC + LEN(CHEXCC)
      WRITE (22,9083) CHNAME(1:NPUT), CHTEXT(1:NTEXT)
 
C--       Assembler inference
 
      CHNAME = CHEXAS // CHEXOBJ // ':'
      NPUT   = LEN(CHEXAS) + LEN(CHEXOBJ) + 1
      CHTEXT = CHAR(9) // CHCMP(3)(1:NNA) // CHOPT(3)(1:NOPA) //
     +            '-o $*.o  $*' // CHEXAS
      NTEXT   = 12 + NNA + NOPA + LEN(CHEXAS)
      WRITE (22,9083) CHNAME(1:NPUT), CHTEXT(1:NTEXT)
 
      IF (NPCSMK.EQ.0) THEN
         WRITE (22,9084) CHFIN(JA:JE)
      ELSE
         WRITE (22,9085) CHFIN(JA:JE),(I,I=1,NPCSMK)
         WRITE (22,9086) (I,I,I=1,NPCSMK)
      ENDIF
 
      WRITE(21,*) '   Exit cc'
C--                Print summary
 
      PRINT 9087, NLINES,NROUT
      IF (NIGNOR.NE.0)  PRINT 9088, NIGNOR
      IF (NTCBUF.NE.0)  PRINT 9089, NTCBUF
 8000 FORMAT (A)
 9083 FORMAT (/A/A)
 9084 FORMAT(/A,': $(ROUTINES)',/)
 9085 FORMAT(/A,':',10(' rout',I1))
 9086 FORMAT(/,'rout: $(ROUTINES)',/,
     +        ('rout',I1,': $(ROUTINE',I1,')',/))
 9087 FORMAT (1X,I6,' lines written for',I6,' decks')
 9088 FORMAT (1X,I6,' leading unheaded lines ignored.')
 9089 FORMAT (1X,I6,' trailing comment lines ignored.')
      END
