*DECK,MLTDOC     MALET DOCUMENTATION EXTRACTION PROGRAM.
C*F45V1P0*
      PROGRAM MLTDOC (INPUT,OUTPUT,PRINT,OFILE,PFILE,TAPE1=INPUT, 
     *TAPE2=OFILE,TAPE3=PFILE,TAPE4=OUTPUT,TAPE5=PRINT) 
********************************************************************* 
*                                                                   * 
*  THIS PROGRAM HAS BEEN CONVERTED TO ASSEMBLE UNDER FORTRAN        * 
*  VERSION 5. THIS MODSET (CMLA141) IS YANKED TO ASSEMBLE UNDER     * 
*  VERSION4.  ANY CHANGES MUST ASSEMBLE UNDER BOTH VERSION 4 AND    * 
*  VERSION 5.                                                       * 
*                                                                   * 
********************************************************************* 
      COMMON/X/IIPG(9,60),IEPG(9,60),IMT(8),IST(8),IL(9),IILC,IIPC, 
     *IELC,IEPC,DDATE,IETOCL,IETOCP,IITOCL,IITOCP 
     *,ILINE,ILNB(60),IELN,ILL(10)                                       MLT000R
      DATA IILC/1/,IIPC/1/,IELC/1/,IEPC/1/,IEXT/0/,IMTF/0/
      DATA IETOCL/1/,IETOCP/1/,IITOCL/1/,IITOCP/1/
      DATA ILINE/0/,IAST/0/ 
      DATA (IMT(I),I=1,7)/7*1H /
      DATA (IST(I),I=1,7)/7*1H /
      DATA (ILNB(I),I=1,60)/60*1H /                                      MLT000R
*CALL CPYFTN
      DDATE=DATE()
      REWIND 1
      REWIND 2
      REWIND 3
      WRITE (4,2) 
    2 FORMAT(1H1,/, 
     1' CONTROL DATA PROPRIETARY NOTICE',/, 
     2' COPYRIGHT CONTROL DATA CORPORATION, 1979',//, 
     3' CONTAINED HEREIN IS MATERIAL WHICH IS CONFIDENTIAL OR',/, 
     4' OTHERWISE PROPRIETARY TO CONTROL DATA CORPORATION',/, 
     5' AND IS AUTHORIZED FOR REPRODUCTION OR USE ONLY UNDER',/,
     6' THE TERMS OF THE SOFTWARE LICENSE FOR CONTROL DATA',/,
     7' SOFTWARE PRODUCTS OR OTHER APPLICABLE CONTROL DATA',/,
     8' CONTRACT. THIS NOTICE MUST BE ATTACHED TO THE OUTSIDE',/, 
     9' OF THE MEDIA CONTAINING ANY AUTHORIZED COMPLETE OR',/,
     A' PARTIAL COPY, MODIFICATION, OR DERIVATIVE.',//, 
     B' THIS IS AN ENGINEERING SERVICES PROPRIETARY DOCUMENT.', 
     C/,1H1,/,30X,'TABLE OF CONTENTS',//) 
      WRITE (5,2) 
C 
C     GET INPUT AND TERMINATE IF EOF
C 
   10 READ (1,11,END=10000) IL
   11 FORMAT (BZ,9A10)
10000 IF (EOF(1)) 12,30,12
C 
C     EOF ON INPUT FILE 
C 
   12 CALL FLEXT
      CALL FLINT
      IF (IETOCL.GT.56) GO TO 15
      DO 13 I=IETOCL,56 
   13 WRITE (4,14)
   14 FORMAT (1H )
   15 WRITE (4,16) DDATE,IETOCP 
   16 FORMAT(/,28X,'CONTROL DATA PROPRIETARY',/,
     *1X,A10,18X,'EXTERNAL DOCUMENTATION',17X,'PAGE ',I4) 
      IF (IITOCL.GT.56) GO TO 18
      DO 17 I=IITOCL,56 
   17 WRITE (5,14)
   18 WRITE (5,19) DDATE,IITOCP 
   19 FORMAT(/,28X,'CONTROL DATA PROPRIETARY',/,
     *1X,A10,18X,'INTERNAL DOCUMENTATION',17X,'PAGE ',I4) 
      REWIND 2
      REWIND 3
C 
C     COPY OUTPUT TO BACK OF EXTERNAL TABLE OF CONTENT
C 
   20 READ (2,21,END=10001) IMT 
   21 FORMAT (BZ,8A10)
10001 IF (EOF(2)) 25,22,25
   22 WRITE (4,21) IMT
      GO TO 20
C 
C     COPY PRINT TO BACK OF INTERNAL TABLE OF CONTENTS
C 
   25 READ (3,28,END=10002) ILL 
   28 FORMAT (BZ,10A10) 
10002 IF (EOF(3)) 27,26,27
   26 WRITE (5,28) ILL                                                   MLT000R
      GO TO 25
C 
C    TERMINATE
C 
   27 STOP
C 
   30 IF ((SHIFT(IL(1),6).AND.O"77").EQ.R"*") GO TO 40
C 
C     HANDLE NO ASTERISK
C 
      IEXT=0
      IF(IAST.EQ.0) GO TO 31
      IAST = 0
      IF(IL(1).EQ.10H          ) GO TO 41 
   31 CONTINUE
      IF((IL(1).AND.MASK(54)).NE.L"   MODULE") GO TO 32 
      IELN = 1                                                           MLT000R
      ILINE = 0                                                          MLT000R
      GO TO 63                                                           MLT000R
   32 CONTINUE                                                           MLT000R
C                                                                        MLT000R
C     ENABLE LINE NUMBERS ONLY IF COL 1 IS BLANK,                        MLT000R
C     SLASH(/), OR NUMERIC.                                              MLT000R
C                                                                        MLT000R
      IELN = 0                                                           MLT000R
      ITEMP = SHIFT(IL(1),6).AND.O"77"
      IF(ITEMP.EQ.R" ") IELN = 1
      IF(ITEMP.EQ.R"/") IELN = 1
      IF((ITEMP.GE.O"33") .AND. (ITEMP.LE.O"44")) IELN = 1
C 
      ILINE = ILINE + 1                                                  MLT000R
      CALL WRINT
      IF((SHIFT(IL(1),18) .AND. MASK(24)) .NE. L"END ") GO TO 10
C 
C     END CARD DETECTED 
C 
      IMTF=0
C                                                                        MLT000R
C     DISABLE LINE NUMBERS AND SET LINE NUMBER TO 0                      MLT000R
C                                                                        MLT000R
      IELN = 0                                                           MLT000R
      ILINE = 0                                                          MLT000R
      GO TO 10
C 
   40 IELN = 0                                                           MLT000R
      IAST = 1
      IF((SHIFT(IL(1),12).AND.O"77").EQ.R"*") GO TO 50
C 
C     HANDLE ONE ASTERISK 
C 
   41 CALL WRINT
      IF (IEXT.EQ.0) GO TO 10 
      CALL WREXT
      GO TO 10
C 
   50 IEXT=0
      IF ((SHIFT(IL(1),18).AND.O"77").EQ.R"*") GO TO 60 
C 
C     HANDLE TWO ASTERISK 
C 
      IEXT=1
      CALL WRINT
      GO TO 10
C 
   60 IF ((SHIFT(IL(1),24).AND.O"77").EQ.R"*") GO TO 41 
C 
C     HANDLE THREE ASTERISK 
C 
C 
C     CHECK BLANK TITLE, PAGE EJECT IF IT IS
C 
      IF ((IL(1).AND.O"777777777777").NE.R"      ") GO TO 62
      DO 61 I=2,7 
      IF (IL(I).NE.1H ) GO TO 62
   61 CONTINUE
      CALL WRINT
      CALL FLEXT
      CALL FLINT
      GO TO 10
C 
   62 IF (IMTF.NE.0) GO TO 70 
C 
C     HANDLE FIRST OCCURENCE OF TITLE 
C 
   63 CALL FLEXT
      CALL FLINT
      CALL WRINT
      DO 64 I=1,8 
   64 IMT(I)=IL(I)
      IMTF=1
      DO 65 I=1,7 
   65 IST(I)=1H 
      READ (1,11,END=10003) IL
10003 IF (EOF(1)) 12,66,12
   66 IF ((IL(1).AND.MASK(18)).NE.L"***") GO TO 30
      IELN = 0                                                           MLT000R
      IF ((SHIFT(IL(1),24).AND.O"77").NE.R"*") GO TO 71 
      GO TO 41
C 
C     HANDLE SUBSEQUENT OCCURENCES OF TITLE 
C 
   70 CALL FLEXT
      CALL FLINT
   71 CALL WRINT
      DO 72 I=1,8 
   72 IST(I)=IL(I)
      GO TO 10
      END 
C*F45V1P0*
      SUBROUTINE WREXT
      COMMON/X/IIPG(9,60),IEPG(9,60),IMT(8),IST(8),IL(9),IILC,IIPC, 
     *IELC,IEPC,DDATE,IETOCL,IETOCP,IITOCL,IITOCP 
     *,ILINE,ILNB(60),IELN,ILL(10)                                       MLT000R
C 
C     MOVE LINE TO EXTERNAL DOCUMENTATION  BUFFER 
C 
      DO 10 I=1,9 
   10 IEPG(I,IELC)=IL(I)
      IELC=IELC+1 
C 
C     FLUSH BUFFER IF FULL
C 
      IF (IELC.GT.56) CALL FLEXT
      RETURN
C**  THIS PROGRAM VALID ON FTN4 AND FTN5 ** 
      END 
C*F45V1P0*
      SUBROUTINE WRINT
      COMMON/X/IIPG(9,60),IEPG(9,60),IMT(8),IST(8),IL(9),IILC,IIPC, 
     *IELC,IEPC,DDATE,IETOCL,IETOCP,IITOCL,IITOCP 
     *,ILINE,ILNB(60),IELN,ILL(10)                                       MLT000R
C 
C     MOVE LINE TO INTERNAL DOCUMENTATION  BUFFER 
C 
      DO 10 I=1,9 
   10 IIPG(I,IILC)=IL(I)
      IF(IELN.EQ.0) GO TO 12                                             MLT000R
   11 FORMAT (O3)                                                        MLT000R
      ENCODE(3,11,ILNB(IILC)) ILINE                                      MLT000R
   12 CONTINUE                                                           MLT000R
      IILC=IILC+1 
C 
C     FLUSH BUFFER IF FULL
C 
      IF (IILC.GT.56) CALL FLINT
      RETURN
C**  THIS PROGRAM VALID ON FTN4 AND FTN5 ** 
      END 
C*F45V1P0*
      SUBROUTINE FLEXT
      COMMON/X/IIPG(9,60),IEPG(9,60),IMT(8),IST(8),IL(9),IILC,IIPC, 
     *IELC,IEPC,DDATE,IETOCL,IETOCP,IITOCL,IITOCP 
     *,ILINE,ILNB(60),IELN,ILL(10)                                       MLT000R
      DIMENSION IEMT(8),IEST(8),ISTX(8),IPT(5)
      DATA IEMT/8*1H /,IEST/8*1H /
      DATA IPT/O"2",O"20002",O"200020002",O"2000200020002",O"20002000200
     +020002"/
      IF (IELC.EQ.1) RETURN 
C 
C     WRITE MAIN TITLE TO EXTERNAL DOCUMENTATION FILE 
C 
      WRITE (2,11) IMT
   11 FORMAT (1H1,R7,6A10,A1) 
C 
C     WRITE SUB TITLE TO EXTERNAL DOCUMENTATION FILE
C 
      WRITE (2,12) IST
   12 FORMAT (1X,R7,6A10,A1,//) 
C 
C     WRITE BUFFER
C 
      J=IELC-1
      DO 13 I=1,J 
   13 WRITE (2,14)(IEPG(K,I),K=1,8) 
   14 FORMAT (1X,R9,6A10,A2)
C 
C     WRITE BOTTOM OF PAGE
C 
      IF (IELC.GT.56) GO TO 17
      DO 15 I=IELC,56 
   15 WRITE (2,16)
   16 FORMAT (1H )
   17 WRITE (2,18) DDATE,IEPC 
   18 FORMAT(/,28X,'CONTROL DATA PROPRIETARY',/,
     *1X,A10,18X,'EXTERNAL DOCUMENTATION',17X,'PAGE ',I4) 
C 
C     TEST FOR NEW TITLE
C 
      DO 20 I=1,8 
      IF (IMT(I).NE.IEMT(I)) GO TO 22 
   20 CONTINUE
C 
C     TEST FOR NEW SUBTITLE 
C 
      DO 21 I=1,8 
      IF (IST(I).NE.IEST(I)) GO TO 30 
   21 CONTINUE
      GO TO 51
C 
C     PUT MAIN TITLE IN EXTERNAL TABLE OF CONTENTS
C 
   22 IETOCL=IETOCL+2 
      IF (IETOCL.LE.57) GO TO 26
      IF (IETOCL.GT.58) GO TO 23
      WRITE (4,16)
   23 IETOCL=2
      WRITE (4,24) DDATE,IETOCP 
   24 FORMAT(/,28X,'CONTROL DATA PROPRIETARY',/,
     *1X,A10,18X,'EXTERNAL DOCUMENTATION',17X,'PAGE ',I4,/, 
     *1H1,/,30X,'TABLE OF CONTENTS',//) 
      IETOCP=IETOCP+1 
      WRITE (4,25) IMT
   25 FORMAT (1X,R7,6A10,A1)
      GO TO 28
   26 WRITE (4,27) IMT
   27 FORMAT (/,1X,R7,6A10,A1)
C 
C     MOVE NEW TITLE IN TO COMPARE AREA 
C 
   28 DO 29 I=1,8 
   29 IEMT(I)=IMT(I)
C 
C     PUT SUB TITLE IN EXTERNAL TABLE OF CONTENTS 
C 
   30 IETOCL=IETOCL+1 
      IF (IETOCL.LE.57) GO TO 33
      IETOCL=2
      WRITE (4,31) DDATE,IETOCP 
   31 FORMAT(/,28X,'CONTROL DATA PROPRIETARY',/,
     *1X,A10,18X,'EXTERNAL DOCUMENTATION',17X,'PAGE ',I4) 
      WRITE (4,32)
   32 FORMAT (1H1,/,30X,'TABLE OF CONTENTS',//) 
      IETOCP=IETOCP+1 
   33 DO 34 I=1,8 
   34 ISTX(I)=IST(I)
      I=7 
   35 J=ISTX(I) 
      DO 36 K=1,5 
      L=K-1 
      IF ((J.AND.O"7777").NE.R"  ") GO TO 37
   36 J=SHIFT(J,48) 
      ISTX(I)=ISTX(I)+IPT(5)
      I=I-1 
      IF (I.GT.0) GO TO 35
      GO TO 40
   37 IF (L.EQ.0) GO TO 40
      ISTX(I)=ISTX(I)+IPT(L)
   40 WRITE (4,41) ISTX,IEPC
   41 FORMAT (7X,R7,6A10,A1,I4) 
C 
C     MOVE NEW TITLE IN TO COMPARE AREA 
C 
      DO 50 I=1,8 
   50 IEST(I)=IST(I)
   51 IELC=1
      IEPC=IEPC+1 
      RETURN
      END 
C*F45V1P0*
      SUBROUTINE FLINT
      COMMON/X/IIPG(9,60),IEPG(9,60),IMT(8),IST(8),IL(9),IILC,IIPC, 
     *IELC,IEPC,DDATE,IETOCL,IETOCP,IITOCL,IITOCP 
     *,ILINE,ILNB(60),IELN,ILL(10)                                       MLT000R
      DIMENSION IIMT(8),IIST(8),ISTX(8),IPT(5)
      DATA IIMT/8*1H /,IIST/8*1H /
      DATA IPT/O"2",O"20002",O"200020002",O"2000200020002",O"20002000200
     +020002"/
      IF (IILC.EQ.1) RETURN 
C 
C     WRITE MAIN TITLE TO INTERNAL DOCUMENTATION FILE 
C 
      WRITE (3,11) IMT
   11 FORMAT (1H1,R7,6A10,A1) 
C 
C     WRITE SUB TITLE TO INTERNAL DOCUMENTATION FILE
C 
      WRITE (3,12) IST
   12 FORMAT (1X,R7,6A10,A1,//) 
C 
C     WRITE BUFFER
C 
      J=IILC-1
      DO 13 I=1,J 
   13 WRITE (3,14) ILNB(I),(IIPG(K,I),K=1,9)                             MLT000R
   14 FORMAT (1X,A3,1X,9A10)                                             MLT000R
C                                                                        MLT000R
C     SET BLANKS INTO LINE NUMBER BUFFER (ILNB)                          MLT000R
C                                                                        MLT000R
      DO 141 I=1,60                                                      MLT000R
      ILNB(I) = 1H                                                       MLT000R
  141 CONTINUE                                                           MLT000R
C                                                                        MLT000R
C 
C     WRITE BOTTOM OF PAGE
C 
      IF (IILC.GT.56) GO TO 17
      DO 15 I=IILC,56 
   15 WRITE (3,16)
   16 FORMAT (1H )
   17 WRITE (3,18) DDATE,IIPC 
   18 FORMAT(/,28X,'CONTROL DATA PROPRIETARY',/,
     *1X,A10,18X,'INTERNAL DOCUMENTATION',17X,'PAGE ',I4) 
C 
C     TEST FOR NEW TITLE
C 
      DO 20 I=1,8 
      IF (IMT(I).NE.IIMT(I)) GO TO 22 
   20 CONTINUE
C 
C     TEST FOR NEW SUBTITLE 
C 
      DO 21 I=1,8 
      IF (IST(I).NE.IIST(I)) GO TO 30 
   21 CONTINUE
      GO TO 51
C 
C     PUT MAIN TITLE IN INTERNAL TABLE OF CONTENTS
C 
   22 IITOCL=IITOCL+2 
      IF (IITOCL.LE.57) GO TO 26
      IF (IITOCL.GT.58) GO TO 23
      WRITE (5,16)
   23 IITOCL=2
      WRITE (5,24) DDATE,IITOCP 
   24 FORMAT(/,28X,'CONTROL DATA PROPRIETARY',/,
     *1X,A10,18X,'INTERNAL DOCUMENTATION',17X,'PAGE ',I4,/, 
     *1H1,/,30X,'TABLE OF CONTENTS',//) 
      IITOCP=IITOCP+1 
      WRITE (5,25) IMT
   25 FORMAT (1X,R7,6A10,A1)
      GO TO 28
   26 WRITE (5,27) IMT
   27 FORMAT (/,1X,R7,6A10,A1)
C 
C     MOVE NEW TITLE IN TO COMPARE AREA 
C 
   28 DO 29 I=1,8 
   29 IIMT(I)=IMT(I)
C 
C     PUT SUB TITLE IN INTERNAL TABLE OF CONTENTS 
C 
   30 IITOCL=IITOCL+1 
      IF (IITOCL.LE.57) GO TO 33
      IITOCL=2
      WRITE (5,31) DDATE,IITOCP 
   31 FORMAT(/,28X,'CONTROL DATA PROPRIETARY',/,
     *1X,A10,18X,'INTERNAL DOCUMENTATION',17X,'PAGE ',I4) 
      WRITE (5,32)
   32 FORMAT (1H1,/,30X,'TABLE OF CONTENTS',//) 
      IITOCP=IITOCP+1 
   33 DO 34 I=1,8 
   34 ISTX(I)=IST(I)
      I=7 
   35 J=ISTX(I) 
      DO 36 K=1,5 
      L=K-1 
      IF ((J.AND.O"7777").NE.R"  ") GO TO 37
   36 J=SHIFT(J,48) 
      ISTX(I)=ISTX(I)+IPT(5)
      I=I-1 
      IF (I.GT.0) GO TO 35
      GO TO 40
   37 IF (L.EQ.0) GO TO 40
      ISTX(I)=ISTX(I)+IPT(L)
   40 WRITE (5,41) ISTX,IIPC
   41 FORMAT (7X,R7,6A10,A1,I4) 
C 
C     MOVE NEW TITLE IN TO COMPARE AREA 
C 
      DO 50 I=1,8 
   50 IIST(I)=IST(I)
   51 IILC=1
      IIPC=IIPC+1 
      RETURN
      END 
