PROGRAM DCKSPL
C-Title  : DCKSPL Program
C-Purpose: Split FORTRAN source file into decks
C-Author : A.Trkov, Ijstitute J.Stefan, Ljubljana, Slovenia.
C-Version: 1993 Original code
C-V  94/02 - Write DCKLST file.
C-V  01/08 A.Trkov:
C-V        - Allow lower case "*deck" statements in the source file.
C-V        - Allow longer decknames.
C-V        - Define output deck file extension from input.
C-V        - If the output extension is not ".DCK" or ".dck"
C-V          the heading "*deck" card is omitted.
C-V  01/12 A.Trkov
C-V        - Remove special characters and trailing blanks.
C-V  02/03 A.Trkov
C-V        - Update the instructions.
C-M
C-M  Manual for Program DCKSPL
C-M  =========================
C-M    The FORTRAN source file is assumed to contain records
C-M  befinning with "*DECK dkname" where 'dkname' is the appropriate
C-M  name. Each deck is written onto a new file named 'dkname.ext'
C-M  where 'ext' is the file extension requested from input. If the
C-M  extension is not "dck" of "DCK", the record "$DECK dkname" is
C-M  not transferred to output.
C-M    An output file DCKLST.TMP is also prepared, on which all the
C-M  decknames on the source file are listed in the format
C-M  "CALL FORL dkname". This is to allow the design of batch
C-M  procedures for automatic compilation of all decks.
C-M
C-M  Instructions:
C-M  The following input parameters are requested from input:
C-M  -  Source filename
C-M  -  Extension forsplit deck files.
C-
      PARAMETER    (MXLN=132)
      CHARACTER*132 RECI
      CHARACTER*40  FLNM,FLDK
      CHARACTER*4   FEXT
      CHARACTER*1   A(MXLN)
      EQUIVALENCE  (A(1),RECI)
C* ASCII Codes of special characters (to be ignored)
      DATA IB,IN,IC,IL,L/32,0,13,10,137/
C*
      DATA FEXT   /'.FOR'/
      DATA FLDK   /'DCKLST.TMP'/
C* Logical file units
      DATA LIN,LOU,LKB,LTT,LDK /1,-2, 5, 6, 8 /
      NDK=0
      NRC=0
      MLN=0
      WRITE(LTT,692) ' DCKSPL - Split Source File into Decks  '
      WRITE(LTT,692) ' -------------------------------------  '
      WRITE(LTT,692)
C* Define the source filename
   10 WRITE(LTT,692) '$Enter the deck source filename       : '
      READ (LKB,692) FLNM
      OPEN(UNIT=LIN,FILE=FLNM,STATUS='OLD',ERR=10)
C* Read 3-character file extension (default=FOR)
      WRITE(LTT,692) '$Enter 3-character file extension     : '
      READ (LKB,692,END=18) FLNM
      IF(FLNM(1:3).NE.'   ') FEXT(2:4)=FLNM(1:3)
   18 CONTINUE
C* Open the file containing the list of all decks
      OPEN (UNIT=LDK,FILE=FLDK,STATUS='UNKNOWN')
C* Read the source deck file
   20 READ(LIN,694,END=91) RECI
      IF(RECI(1:6).NE.'*DECK ' .AND. RECI(1:6).NE.'*deck ') GO TO 40
      WRITE(LDK,696) RECI(7:12)
C* Open the new deck file
      IF(LOU.GT.0) THEN
        CLOSE(UNIT=LOU)
        WRITE(LTT,698) NRC,MLN,FLNM
        NRC=0
        MLN=0
      END IF
      I2=41
   22 I2=I2-1
      IF(I2.GT.7 .AND. RECI(I2:I2).EQ.' ') GO TO 22
      FLNM= RECI(7:I2)//FEXT
      LOU = ABS(LOU)
C***** VAX
C     OPEN (UNIT=LOU,FILE=FLNM,STATUS='NEW',CARRIAGECONTROL='LIST')
C***** VAX
C***** STANDARD
      OPEN (UNIT=LOU,FILE=FLNM,STATUS='UNKNOWN')
C***** STANDARD
      NDK = NDK+1
      IF(FEXT.NE.'.DCK' .AND. FEXT.NE.'.dck') GO TO 20
C* Copy the statements to the deck file
   40 IF(LOU.LE.0) GO TO 20
      K1=1
      K2=MXLN+1
C* Scan the line
   50 K2=K2-1
C* Remove line feed in column-1 if present
      IA=ICHAR(A(K1))
      IF(IA.EQ.IL) K1=K1+1
      IF(K1.GE.K2) GO TO 52
C* Remove trailing blanks, null, line-feed and carriage return
      IA=ICHAR(A(K2))
      IF(IA.EQ.IB .OR.
     1   IA.EQ.IN .OR.
     1   IA.EQ.IC .OR.
     1   IA.EQ.IL) GO TO 50
   52 WRITE(LOU,695) (A(J),J=K1,K2)
      NRC=NRC+1
      MLN=MAX(MLN,K2-K1+1)
      GO TO 20
C* Processing completed
   91 WRITE(LTT,699) NDK
      STOP 'DCKSPL Completed'
  692 FORMAT(2A40)
  694 FORMAT(A132)
  695 FORMAT(132A1)
  696 FORMAT('CALL FORL ',A6)
  698 FORMAT(I10,' Records of max.width',I4,' in deck ',A40)
  699 FORMAT(' Number of decks written :',I4)
      END