      PROGRAM DCXTRCT 
C     PROGRAM DCXTRCT(IN,       OUT,       OUTPUT,                      )       G2
C    1          TAPE1=IN, TAPE2=OUT, TAPE6=OUTPUT)
C     --------------------------------------------                              G2
C                                                                               G2
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       G2
C     MAR 31/93 - F.MAJAESS (REVISED FOR EXAMPLE COMMENT LINES)                 
C     JAN 26/93 - F.MAJAESS (MODIFIED TO RUN ON UNIX)                           
C     JAN 23/91 - F.MAJAESS (ADD 'J' SECTION)                                   
C     MAY 26/88 - F.MAJAESS.
C                                                                               G2
CDCXTRCT - EXTRACTS PROGRAM DOCOMENTATIONS FROM A SOURCE LIBRARY        1  1    G1
C                                                                               G3
CAUTHOR  - F.MAJAESS.                                                           G3
C                                                                               G3
CPURPOSE - EXTRACTS PROGRAM DOCUMENTATIONS FROM THE PROGRAM SOURCE LIBRARY      G3
C          ACCORDING TO AN EXTRACTION KEY IN COLUMNS 81 AND 82.                 G3
C          NOTE - "PRDCDOC" PROGRAM SHOULD BE USED JOINTLY WITH "DCXTRCT"       G3
C                 TO UPDATE THE PROGRAM SOURCE LIBRARY DOCUMENTATION FILE.      G3
C                                                                               G3
CINPUT FILE...                                                                  G3
C                                                                               G3
C      IN    = INPUT FILE CONTAINING PROGRAM SOURCE CODES WITH DOCUMENTATION    G3
C              LINES HAVING 2 CHARACTERS EXTRACTION KEY IN COLUMNS 81 AND 82.   G3
C                                                                               G3
COUTPUT FILE...                                                                 G3
C                                                                               G3
C      OUT   = CONTAINS JUST THE PROGRAM DOCUMENTATIONS WITH 16 CHARACTERS      G3
C              ADDED SORT KEY IN COLUMNS 81-96.                                 G3
C                                                                               G3
C------------------------------------------------------------------------ 
C 
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)
      INTEGER LINES 
C 
      CHARACTER*1 DIAG(10),DIAGX,KEYIN2,SCTN,SBSCTN,DECK*8,ALINE*80,
     1                                                    HLINE*80
C 
      DATA DIAG/'A','B','C','D','E','F','G','H','I','J'/
      DATA NDSCTN/10/ 
C-------------------------------------------------------------- 
      NFF=3
      CALL JCLPNT(NFF,-1,-2,6)
C 
      REWIND 1
      REWIND 2
C 
      DECK='********' 
      LINES=0 
      ICNT=0
C 
C     * READ IN DOCUMENTATION LINES, REPLACE THE EXTRACTION KEY IN COLUMNS
C     * 81-82 BY A SORT KEY IN COLUMNS 81-96. (DECKNAME IS INCLUDED IN THE
C     * SORT KEY).
C 
  100 READ(1,1000,END=900)ALINE,DIAGX,KEYIN2
      IF(ALINE(1:5).EQ.'%DECK')THEN 
        ICNT=0
        DECK=ALINE(7:14)
        GO TO 100 
      ENDIF 
C 
C     * CHECK FOR THE VALIDITY OF DIAGX VALUE READ. 
C 
      IF(DIAGX.EQ.' ') GO TO 100
C 
      DO 10 I=1,NDSCTN
        IF(DIAGX.EQ.DIAG(I))GO TO 20
  10  CONTINUE
      GO TO 100 
C 
C     * IF REQUESTED, REPLACE THE LAST ',' IN THE PROGRAM CALL STATEMENT
C     * BY ')'. 
C 
  20  IF((KEYIN2.EQ.'2').AND.(ALINE(73:73).EQ.')'))THEN 
        DO 25 I=72,1,-1 
          IF(ALINE(I:I).EQ.',')THEN 
             ALINE(I:I)=ALINE(73:73)
             ALINE(73:73)=' ' 
             GO TO 27 
          ENDIF 
  25    CONTINUE
      ENDIF 
C 
C     * ADJUST LINES IN THE EXAMPLE SECTIONS WHICH SHOULD BE DISPLAYED 
C     * UNSHIFTED.
C     * BY ')'. 
C 
  27  IF(KEYIN2.EQ.'5')THEN 
          IF(ALINE(1:2).EQ.'C*') ALINE(1:2)='* '
          IF(ALINE(1:2).EQ.'C.') ALINE(1:2)='*.'
      ENDIF 
C 
C     * SETUP AND WRITE OUT THE SORT KEY. 
C 
  30  IF(KEYIN2.EQ.'0')THEN 
        SCTN=DIAGX
        DIAGX=KEYIN2
        SBSCTN='0'
      ELSE
        IF(KEYIN2.EQ.'1')THEN 
          SCTN=KEYIN2 
          SBSCTN='0'
        ELSE
          SCTN='2'
          SBSCTN=KEYIN2 
        ENDIF 
      ENDIF 
C 
      ICNT=ICNT+1 
      LINES=LINES+1 
      IF(KEYIN2.NE.'1')THEN 
        WRITE(2,2000)ALINE,DIAGX,SCTN,DECK,SBSCTN,ICNT
      ELSE
        HLINE=ALINE 
        HLINE(71:80)='          ' 
        WRITE(2,2000)HLINE,DIAGX,SCTN,DECK,SBSCTN,ICNT
        KEYIN2='0'
        GO TO 30
      ENDIF 
      GO TO 100 
C 
  900 WRITE(6,6000) LINES 
      IF(LINES.EQ.0) CALL                          XIT('DCXTRCT',-1) 
      CALL XIT('DCXTRCT',0) 
C-------------------------------------------------------------------- 
 1000 FORMAT(A80,2A1) 
 2000 FORMAT(A80,'~',2A1,A8,A1,'.',I4)
 6000 FORMAT('0 DCXTRCT WROTE ',I5,' LINES.') 
      END 
