      SUBROUTINE JCLPNT (NF,
     1     IU01,IU02,IU03,IU04,IU05,IU06,IU07,IU08,IU09,IU10,
     2     IU11,IU12,IU13,IU14,IU15,IU16,IU17,IU18,IU19,IU20,
     3     IU21,IU22,IU23,IU24,IU25,IU26,IU27,IU28,IU29,IU30,
     4     IU31,IU32,IU33,IU34,IU35,IU36,IU37,IU38,IU39,IU40,
     5     IU41,IU42,IU43,IU44,IU45,IU46,IU47,IU48,IU49,IU50,
     6     IU51,IU52,IU53,IU54,IU55,IU56,IU57,IU58,IU59,IU60,
     7     IU61,IU62,IU63,IU64,IU65,IU66,IU67,IU68,IU69,IU70,
     8     IU71,IU72,IU73,IU74,IU75,IU76,IU77,IU78,IU79,IU80,
     9     IU81,IU82,IU83,IU84,IU85,IU86,IU87,IU88,IU89,IU90)
C
C     * JUL 06/09 - F.MAJAESS (ALLOW FILE OPENING IN "APPEND" MODE)
C     * SEP 18/06 - F.MAJAESS (INITIALIZE "IUA,IUST" IN A DO LOOP INSTEAD OF
C                              VIA "DATA" STATEMENT)
C     * JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)
C     * JUN 28/02 - S.KHARIN  (IF LDIR=.TRUE. IN COMMON BLOCK JCLPNTD, TEST
C     *                        WHETHER THE FIRST ARGUMENT IS A DIRECTORY. 
C     *                        RETURN DIRECTORY NAME AND ITS LENGTH IN COMMON 
C     *                        BLOCK JCLPNTD. ARG IN COMMON BLOCK JCLPNTA 
C     *                        CONTAINS THE LIST OF COMMAND LINE ARGUMENTS.)
C     * JUN 03/02 - F.MAJAESS (ENSURE CLOSURE OF UNITS 97 AND 98 IS
C     *                        DONE PRIOR TO THE SYSTEM CALL TO RENAME
C     *                        "Scratch" FILE INTO "Input_Cards").
C     * MAR 20/00 - F.MAJAESS (INCREASE NUMBER OF FILES FROM 40 TO 90,
C     *                        ABANDON CHECKING ON UNITS 44,45 & 48,
C     *                        ONLY RESTRICT 97 & 98 UNITS USE IF UNIT
C     *                        "5" IS PART OF THE UNITS LIST, ALSO
C     *                        ENSURE CLOSURE OF UNITS 97 & 98 IF USED,
C     *                        LIFT THE RESTRICTION OF "THE KEYWORD
C     *                        'input=' MUST COINCIDE WITH UNIT 5;
C     *                        ie. HANDLE SIMILAR TO 'output='",
C     *                        RETURN IN "IUA" ARRAY THE LIST OF UNIT
C     *                        NUMBERS ASSIGNED AND IN "IUST" THE UNITS
C     *                        STATUS)
C     * APR 26/95 - F.MAJAESS (REPLACE OPEN WITH "ACCESS='APPEND'" BY
C     *                        A CALL TO "OFAPPND" ROUTINE AND INCREASE
C     *                        THE NUMBER OF FILES FROM 25 TO 40)
C     * FEB 23/94 - F.MAJAESS (ENFORCE USING INTEGER*4 WITH C-ROUTINES)
C     * OCT 08/93 - F.MAJAESS (INCREASE PATH/FILENAME STRING TO 128)
C     * JUL 29/93 - F.MAJAESS ( REPLACE "ACCESS=APPEND" FOR IBM VERSION)
C     * AUG 17/92 - T.JANG. (ADDED "ACCESS=APPEND" to OPEN STATEMENT
C     *                      FOR THE OUTPUT FILE)
C     * JUN 02/92 - E.CHAN. (ADD CALLS TO ME32O64 AND INTEFLT AND PUT
C     *                      RETURNED VALUES IN COMMON BLOCK MACHTYP)
C     * FEB 19/92 - E.CHAN.
C     * THIS ROUTINE IS BASED ON THE VERSION OF JCLPNT THAT WAS
C     * DESIGNED TO RUN ON A CRAY OPERATING SYSTEM.
C
C     * JCLPNT PERFORMS FIVE FUNCTIONS:
C     *
C     *  1) ASSIGN FORTRAN UNITS BY EXTRACTING THE FILE NAMES FROM
C     *     THE COMMAND LINE AND ATTACHING THESE TO THEIR RESPECTIVE
C     *     UNIT NUMBERS PASSED FROM THE CALLING PROGRAM.
C     *
C     *  2) MAP FORTRAN UNIT NUMBERS TO THE CORRESPONDING C FILE
C     *     DESCRIPTORS AND PASS THE INFORMATION TO SUBROUTINES THROUGH
C     *     COMMON BLOCK JCLPNTC. THIS INFORMATION IS REQUIRED BY
C     *     FORTRAN SUBROUTINES WHICH DO I/O USING C ROUTINES.
C     *
C     *  3) CALL THE TWO FUNCTIONS ME32O64 AND INTEFLT WHICH RETURN
C     *     THE MACHINE TYPE AND THE LENGTH OF AN INTEGER. THE
C     *     INFORMATION IS PASSED TO LOW LEVEL I/O ROUTINES THROUGH
C     *     A COMMON BLOCK.
C     *
C     *  4) PRINT ON UNIT 6 THE COMMAND LINE OF THE CALLING PROGRAM
C     *     WHICH IS CRACKED WITH THE USE OF THE C LIBRARY
C     *     SUBROUTINE GETARG.
C     *
C     *  5) LINES USED AS INPUT TO THE CALLING PROGRAM ARE READ AND
C     *     STRIPPED FROM THE FILE 'Input_Cards'. 'Input_Cards' MUST BE
C     *     GENERATED AT THE BEGINNING OF THE JOB AND MUST CONTAIN ALL
C     *     THE NECESSARY INPUT LINES FOR ALL THE PROGRAMS USED IN THE JOB.
C
C     * ON ENTRY,  NF MUST BE EQUAL TO THE NUMBER OF FILES TO BE ASSIGNED.
C     *            LDIR - LOGICAL PARAMETER IN THE COMMON BLOCK JCLPNTD:
C     *                 = .TRUE.,  TEST WHETHER THE 1ST ARGUMENT IS A DIRECTORY.
C     *                 = .FALSE., DON'T RUN THE TEST. ASSUME IT IS A FILE.
C     * ON RETURN, NF IS SET TO THE NUMBER OF FILES ACTUALLY ASSIGNED
C     *            (UNITS 5 AND 6 ARE ALWAYS ASSIGNED, IF NOT TO FILES,
C     *            THEN TO STANDARD INPUT AND OUTPUT, RESPECTIVELY).
C     *            "IUA(1)...IUA(NF)" CONTAINS THE ACTUAL NUMBERS OF UNITS
C     *                                        ASSIGNED,
C     *            "IUST(I), I=1,100" = 1, IF UNIT "I" IS ASSIGNED,
C     *                                               "UNFORMATTED",
C     *                               =-1, IF UNIT "I" IS ASSIGNED,
C     *                                                 "FORMATTED",
C     *                               = 0, OTHERWISE.
C     *           IF LDIR =.TRUE. ON ENTRY, THEN ON RETURN
C     *              LDIR =.FALSE., IF THE FIRST ARGUMENT IS A FILE.
C     *              LDIR =.TRUE.,  IF THE FIRST ARGUMENT IS A DIRECTORY, AND
C     *            DIRNAM = THE DIRECTORY NAME,
C     *            LENDIR = THE DIRECTORY NAME LENGTH.
C
C     * THE MAXIMUM NUMBER OF UNITS THAT MAY BE ASSIGNED IS SET TO 90.
C
C     * IF EITHER UNIT 5 OR 6 IS EXPLICITLY ASSIGNED, THE CORRESPONDING
C     * UNIT NUMBER MUST BE THE LAST ARGUMENT PASSED IN THE CALLING
C     * STATEMENT. IF BOTH UNITS ARE ASSIGNED, UNIT 5 MUST BE REFERENCED
C     * BEFORE UNIT 6. BY DEFAULT, UNIT 6 IS ASSIGNED TO STANDARD OUTPUT
C     * AND UNIT 5 IS ASSIGNED TO THE FILE 'Ftn_Unit_5' WHICH CONTAINS THE
C     * INPUT LINES FOR THE CALLING PROGRAM (EXTRACTED FROM 'Input_Cards').
C
C     * TWO KEYWORDS ARE RECOGNIZED ON THE PROGRAM COMMAND LINE. THESE
C     * ARE 'input=' AND 'output='.
C
C     * THE UNDERSCORE IS RECOGNIZED AS A SPECIAL CHARACTER. IF AN
C     * UNDERSCORE IS USED IN PLACE OF A FILE NAME, THE CORRESPONDING
C     * UNIT IS NOT ASSIGNED.
C
C     * BY DEFAULT, FILES ARE OPENED FOR UNFORMATTED I/O. IF FORMATTED
C     * I/O IS DESIRED FOR A PARTICULAR UNIT, SPECIFY THE UNIT NUMBER
C     * WITH A MINUS SIGN PRECEDING THE NUMBER IN THE CALL TO JCLPNT.
C
C     * EXAMPLE:
C     *
C     *   IN SCRIPT:    pgmname(file1,_,file2,output=dummy)
C     *
C     *   IN PROGRAM:   NF=5
C     *                 CALL JCLPNT(NF,1,2,-8,5,6)
C     *
C     * UNIT 1 IS ASSIGNED TO file1 AND IS OPENED FOR UNFORMATTED I/O
C     * UNIT 2 IS NOT ASSIGNED
C     * UNIT 8 IS ASSIGNED TO file2 AND IS OPENED FOR FORMATTED I/O
C     * UNIT 5 IS ASSIGNED TO Ftn_Unit_5 (DEFAULT)
C     * UNIT 6 IS ASSIGNED TO dummy
C
C     * THE COMMAND LINE READ HAS A MAXIMUM OF 512 CHARACTERS.
C
      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)
      INTEGER ARGLEN
      PARAMETER ( LINLEN = 512, ARGLEN = 128 )
C
      INTEGER       IU(90), FD(100),IUA(100),IUST(100)
      INTEGER*4     IARGC,NZERO4,I4
      CHARACTER*128 ARG(90),DIRNAM
      CHARACTER*512 LINE
      CHARACTER     BLANK, COMMA, LPAREN, RPAREN, UNDSCOR
      LOGICAL       STDIN, STDOUT, LDIR

C     * IUA/IUST  - ARRAY KEEPING TRACK OF UNITS ASSIGNED/STATUS.

      COMMON /JCLPNTU/ IUA,IUST

C     * FD - ARRAY WITH FILE DESCRIPTORS.

      COMMON /JCLPNTC/ FD

C     * APPNDMD - LOGICAL SWITCH ALLOWING "APPEND" MODE FILE OPENING
C     *           =.TRUE. ; FILES OPENED IN "APPEND" MODE.
C     *           =.FALSE. (DEFAULT STANDARD "OPEN" BEHAVIOUR)
C     *           

      LOGICAL       APPNDMD
      COMMON /JCLPNTP/ APPNDMD

C     * ARG - ARRAY WITH COMMAND LINE ARGUMENTS

      COMMON /JCLPNTA/ ARG

C     * ON INPUT:
C     *  LDIR   = LOGICAL PARAMETER:
C     *         = .TRUE., TEST WHETHER THE FIRST ARGUMENT IS A DIRECTORY.
C     *         = .FALSE., DONT RUN THE TEST.
C     * ON OUTPUT:
C     *  LDIR   = .TRUE.,  IF THE FIRST ARGUMENT IS A DIRECTORY,
C     *           .FALSE., OTHERWISE.
C     *  DIRNAM = THE DIRECTORY NAME.
C     *  LENDIR = NUMBER OF CHARACTERS IN THE DIRECTORY NAME.

      COMMON /JCLPNTD/ LDIR,LENDIR,DIRNAM

C     * STDOUT - SWITCH INDICATING UNIT 6 ASSIGNMENT TO THE STANDARD
C     *          OUTPUT (TRUE) OR NOT (FALSE).

      COMMON /JCLPNTR/ STDOUT

      COMMON /MACHTYP/ MACHINE,INTSIZE
C
      DATA BLANK   /' '/, COMMA /','/, LPAREN /'('/, RPAREN /')'/
      DATA UNDSCOR /'_'/, NZERO4/0/
C -------------------------------------------------------------------------
C
C     * INITIALIZE IUA & IUST ARRAYS.
C
      DO I=1,100
       IUA(I) = 0
       IUST(I)= 0
      ENDDO
C

      STDIN  = .FALSE.
      STDOUT = .TRUE.
C
C     * IF NF.GT.90 ABORT.
C
      IF (NF.GT.90) CALL                            XIT('JCLPNT',-1)
C
C     * PLACE UNIT NUMBERS IN ARRAY IU.
C
      GOTO(100,99,98,97,96,95,94,93,92,91,
     1      90,89,88,87,86,85,84,83,82,81,
     2      80,79,78,77,76,75,74,73,72,71,
     3      70,69,68,67,66,65,64,63,62,61,
     4      60,59,58,57,56,55,54,53,52,51,
     5      50,49,48,47,46,45,44,43,42,41,
     6      40,39,38,37,36,35,34,33,32,31,
     7      30,29,28,27,26,25,24,23,22,21,
     8      20,19,18,17,16,15,14,13,12,11), NF
   11 IU(90) = IU90
   12 IU(89) = IU89
   13 IU(88) = IU88
   14 IU(87) = IU87
   15 IU(86) = IU86
   16 IU(85) = IU85
   17 IU(84) = IU84
   18 IU(83) = IU83
   19 IU(82) = IU82
   20 IU(81) = IU81
   21 IU(80) = IU80
   22 IU(79) = IU79
   23 IU(78) = IU78
   24 IU(77) = IU77
   25 IU(76) = IU76
   26 IU(75) = IU75
   27 IU(74) = IU74
   28 IU(73) = IU73
   29 IU(72) = IU72
   30 IU(71) = IU71
   31 IU(70) = IU70
   32 IU(69) = IU69
   33 IU(68) = IU68
   34 IU(67) = IU67
   35 IU(66) = IU66
   36 IU(65) = IU65
   37 IU(64) = IU64
   38 IU(63) = IU63
   39 IU(62) = IU62
   40 IU(61) = IU61
   41 IU(60) = IU60
   42 IU(59) = IU59
   43 IU(58) = IU58
   44 IU(57) = IU57
   45 IU(56) = IU56
   46 IU(55) = IU55
   47 IU(54) = IU54
   48 IU(53) = IU53
   49 IU(52) = IU52
   50 IU(51) = IU51
   51 IU(50) = IU50
   52 IU(49) = IU49
   53 IU(48) = IU48
   54 IU(47) = IU47
   55 IU(46) = IU46
   56 IU(45) = IU45
   57 IU(44) = IU44
   58 IU(43) = IU43
   59 IU(42) = IU42
   60 IU(41) = IU41
   61 IU(40) = IU40
   62 IU(39) = IU39
   63 IU(38) = IU38
   64 IU(37) = IU37
   65 IU(36) = IU36
   66 IU(35) = IU35
   67 IU(34) = IU34
   68 IU(33) = IU33
   69 IU(32) = IU32
   70 IU(31) = IU31
   71 IU(30) = IU30
   72 IU(29) = IU29
   73 IU(28) = IU28
   74 IU(27) = IU27
   75 IU(26) = IU26
   76 IU(25) = IU25
   77 IU(24) = IU24
   78 IU(23) = IU23
   79 IU(22) = IU22
   80 IU(21) = IU21
   81 IU(20) = IU20
   82 IU(19) = IU19
   83 IU(18) = IU18
   84 IU(17) = IU17
   85 IU(16) = IU16
   86 IU(15) = IU15
   87 IU(14) = IU14
   88 IU(13) = IU13
   89 IU(12) = IU12
   90 IU(11) = IU11
   91 IU(10) = IU10
   92 IU(9)  = IU09
   93 IU(8)  = IU08
   94 IU(7)  = IU07
   95 IU(6)  = IU06
   96 IU(5)  = IU05
   97 IU(4)  = IU04
   98 IU(3)  = IU03
   99 IU(2)  = IU02
  100 IU(1)  = IU01
C
C     * RETRIEVE THE NUMBER OF ARGUMENTS (IARGC IS A C LIBRARY FUNCTION).
C
      NARGS = IARGC()
      IF (NARGS. GT. NF) CALL                       XIT('JCLPNT',-2)

C     * LOOP OVER ALL REQUESTED UNIT NUMBERS AND
C     * SET FLAG FOR STANDARD INPUT IF UNIT 5 IS USED.

      DO 145 I = NF,1,-1
        IF ( IU(I).EQ.5 ) THEN
         STDIN = .TRUE.
         GO TO 147
        ENDIF
 145  CONTINUE

 147  DO 155 I = 1,NF

C
C       * CHECK FOR CONFLICTS WITH UNITS 97 AND 98 WHICH ARE USED BELOW
C       * IF UNIT 5 (STANDARD INPUT) IS PART OF THE LIST.
C
        IF ( STDIN .AND.
     1       ( ABS(IU(I)).EQ.97 .OR.
     2         ABS(IU(I)).EQ.98     )) CALL         XIT('JCLPNT',-3)

C
C       * MAP FORTRAN UNIT NUMBERS TO C FILE DESCRIPTORS. THE I'TH ELEMENT
C       * OF THE ARRAY FD CONTAINS THE C FILE DESCRIPTOR CORRESPONDING TO
C       * FORTRAN UNIT I.
C
        FD( ABS(IU(I)) ) = I + 2
C
 155  CONTINUE
C
C     * DETERMINE THE MACHINE TYPE.
C
      MACHINE = ME32O64(IDUMMY)
      INTSIZE = INTEFLT(IDUMMY)
C -------------------------------------------------------------------------
C
C     * BEGIN ACCUMULATING THE NUMBER OF UNITS ACTUALLY OPENED (INCLUDING
C     * UNITS 5 AND 6).
C
      J=NF
      NF=0
      DO 170 I = 1,J
        IF ( IU(I).EQ.5 .OR. IU(I).EQ.6 ) THEN
         NF = NF + 1
         IUA(NF) = IU(I)
         IUST(IU(I)) = -1
        ENDIF
 170  CONTINUE
C
C     * READ IN EACH ARGUMENT ON THE COMMAND LINE, STORE IT
C     * INTO THE ARRAY ARG, AND OPEN THE REQUESTED FILES.
C
      DO 150 I = 1,NARGS
C
C       * RETRIEVE A FILE NAME.
C
        I4=I
        CALL GETARG(I4,ARG(I))
C
C       * SKIP FILE ASSIGNMENT IF ARG(I) IS AN UNDERSCORE.
C
        IF (ARG(I) .EQ. UNDSCOR)                                    THEN
          GOTO 150
        ENDIF
C
C     * CHECK IF THE FIRST ARGUMENT IS A DIRECTORY
C
        IF (I.EQ.1.AND.LDIR) CALL DIRTST(ARG(1),LDIR,LENDIR,DIRNAM)
        
C
C       * ENSURE THAT THE FILE NAME IS DIFFERENT FROM ALL THE PREVIOUS
C       * FILE NAMES.
C
        IM1 = I - 1
        DO 130 J = 1,IM1
          IF ( ARG(I) .EQ. ARG(J) ) CALL            XIT('JCLPNT',-4)
  130   CONTINUE
C
C       * PERFORM THE UNIT ASSIGNMENTS.
C
        IF (IU(I).EQ.6 .OR. ARG(I)(1:7).EQ.'output=')               THEN
C
C         * CASE 1: REASSIGNMENT OF STANDARD OUTPUT TO A FILE.
C
          STDOUT = .FALSE.
          IF (ARG(I)(1:7) .EQ. 'output=')                           THEN
            CALL OFAPPND( 6, ARG(I)(8:ARGLEN), 'FORMATTED',IOS)
          ELSE
            CALL OFAPPND( 6, ARG(I), 'FORMATTED',IOS)
            ARG(I) = 'output='//ARG(I)
          ENDIF
C
        ELSEIF (IU(I).EQ.5 .OR. ARG(I)(1:6).EQ.'input=')            THEN
          IF(.NOT.STDIN)            CALL            XIT('JCLPNT',-5)
C
C         * CASE 2: REASSIGNMENT OF STANDARD INPUT TO A FILE.
C
          STDIN = .FALSE.
          IF (ARG(I)(1:6) .EQ. 'input=')                            THEN
            OPEN( 5, FILE = ARG(I)(7:ARGLEN) )
          ELSE
            OPEN( 5, FILE = ARG(I) )
            ARG(I) = 'input='//ARG(I)
          ENDIF
C
        ELSE
          IF( IU(I) .EQ. 0 ) CALL                   XIT('JCLPNT',-6)
C
C         * CASE 3: ASSIGNMENT OF ANY OTHER UNIT TO A FILE. IF UNIT
C                   NUMBER IS NEGATIVE, OPEN THE FILE FOR FORMATTED I/O.
C
          NF = NF + 1
          IF ( IU(I) .LT. 0 )                                       THEN
            IF(I.GT.1.OR..NOT.LDIR) THEN 
              IF (APPNDMD) THEN
                CALL OFAPPND(-IU(I), ARG(I), 'FORMATTED',IOS )
              ELSE
                OPEN(-IU(I), FILE=ARG(I), FORM='FORMATTED' )
              ENDIF
            ENDIF
            IUST(-IU(I)) = -1
            IUA(NF) = -IU(I)
          ELSE
            IF(I.GT.1.OR..NOT.LDIR) THEN
              IF (APPNDMD) THEN
               CALL OFAPPND( IU(I), ARG(I), 'UNFORMATTED',IOS )
              ELSE
               OPEN( IU(I), FILE=ARG(I), FORM='UNFORMATTED' )
              ENDIF
            ENDIF
            IUST( IU(I)) =  1
            IUA(NF) =  IU(I)
          ENDIF
C
        ENDIF
C
  150 CONTINUE
C
C -------------------------------------------------------------------------
C
C     * RECONSTRUCT COMMAND LINE BY USING THE ARGUMENTS STORED IN THE ARRAY
C     * ARG AND BY INSERTING PARENTHESES AND COMMAS AS FIELD SEPARATORS.
C     * IF STANDARD INPUT AND/OR OUTPUT HAS BEEN REASSIGNED (I.E. STDIN
C     * AND/OR STDOUT IS .FALSE.), THE ASSOCIATED FILE NAME IS ECHOED ON
C     * THE RECONSTRUCTED COMMAND LINE.
C
C     * GET THE PROGRAM NAME AND BEGIN COMMAND LINE RECONSTRUCTION.
C
      CALL GETARG(NZERO4,LINE)
C
C     * GET POSITION OF THE LAST NON-BLANK CHARACTER IN THE ARRAY LINE
C     * USING THE FUNCTION LEN_TRIM.
C
      N = LEN_TRIM(LINE)
C
C     * LOOP TO ADD EACH ELEMENT OF ARG(I) TO COMMAND LINE.
C
      DO 200 I = 1,NARGS
C
C       * ADD THE LEFT PARENTHESIS IF THIS IS THE FIRST FILE NAME.
C
        IF (I .EQ. 1)                                               THEN
          N = N + 1
          LINE(N:N) = LPAREN
        ENDIF
C
C       * GET POSITON OF THE LAST NON-BLANK CHARACTER IN ARG(I) AND
C       * CHECK FOR FILE NAME TRUNCATION.
C
        M = LEN_TRIM( ARG(I) )
        IF (M .GE. ARGLEN)                                          THEN
          WRITE (6,6000) ARG(I)
          CALL                                      XIT('JCLPNT',-7)
        ENDIF
C
C       * PRINT OUT WARNING IF COMMAND LINE IS TOO LONG.
C
        LAST = N + M
        IF (LAST .GT. LINLEN)                                       THEN
          LINE(N+1:LINLEN) = ARG(I)
          WRITE (6,6010) LINE
          WRITE (6,6020)
          GOTO 250
        ENDIF
C
C       * INSERT ARGUMENT INTO RECONSTRUCTED COMMAND LINE AND SET
C       * N TO THE NEW POSITION OF THE FIRST BLANK CHARACTER.
C
        LINE(N+1:LAST) = ARG(I)
        N = LAST + 1
C
C       * ADD FIELD SEPARATORS.
C
        IF (I .EQ. NARGS)                                           THEN
          LINE(N:N) = RPAREN
        ELSE
          LINE(N:N) = COMMA
        ENDIF
C
  200 CONTINUE
C
C     * WRITE RECONSTRUCTED COMMAND LINE. IF UNIT 6 IS NOT ASSIGNED TO
C     * STANDARD OUTPUT, NO CARRIAGE CONTROLS ARE USED IN THE FORMAT
C     * STATEMENT. THIS IS TO MINIMIZE THE PRINTOUT WHEN PROGRAM
C     * OUTPUT IS STORED IN A FILE AND THEN SENT TO A PLOTTER.
C
      IF (STDOUT)                                                   THEN
        WRITE(6,6030) (LINE(I:I),I=1,N)
      ELSE
        LAST = N + 3
        LINE(N+1:LAST) = ' **'
        WRITE(6,6040) (LINE(I:I),I=1,LAST)
      ENDIF
C
C -------------------------------------------------------------------------
C
C     * IF PROGRAM INPUT CARDS FROM UNIT 5 ARE EXPECTED,
C     * READ CARDS FROM UNIT 97 (ASSIGNED TO FILE 'Input_Cards')
C     * UNTIL '+W 00' OR '*EOR' IS FOUND. THE CARDS ARE COPIED ONTO
C     * UNIT 5 (ASSIGNED TO FILE 'Ftn_Unit_5') WHICH IS TO USED BY THE
C     * CALLING PROGRAM. THE REMAINING INPUT CARDS ARE FIRST COPIED
C     * INTO THE FILE 'Scratch'. 'Scratch' IS THEN MOVED BACK INTO
C     * 'Input_Cards' AT THE UNIX LEVEL (THEREBY OVERWRITING THE
C     * ORIGINAL 'Input_Cards').
C
  250 IF (STDIN)                                                    THEN
        OPEN(5,FILE='Ftn_Unit_5')
        OPEN(97,FILE='Input_Cards')
        OPEN(98,FILE='Scratch')
        REWIND 5
        REWIND 97
        REWIND 98
C
C       * COPY LINES FROM 'Input_Cards' TO 'Ftn_Unit_5' UNTIL CCRN
C       * END OF RECORD MARK IS FOUND.
C
  300   READ(97,1000,END=900) LINE
        IF (LINE(1:5). NE. '+W 00' .AND. LINE(1:4) .NE. '*EOR')     THEN
          WRITE(5,1000) LINE
        ELSE
          GOTO 350
        ENDIF
        GOTO 300
C
  350   ENDFILE 5
        REWIND 5
C
C       * COPY REMAINING LINES IN 'Input_Cards' TO 'Scratch'.
C
  400   READ(97,1000,END=450) LINE
        WRITE(98,1000) LINE
        GOTO 400
C
C       * MOVE 'Scratch' BACK INTO 'Input_Cards'.
C
  450   CONTINUE
        CLOSE (97)
        CLOSE (98)
        CALL SYSTEM(' \mv Scratch Input_Cards')
        RETURN
C
C       * REPOSITION FILE POINTERS AND WRITE END OF FILE MARKS IF
C       * NO MORE CARDS ARE AVAILABLE IN FILE 'Input_Cards'.
C
  900   ENDFILE 5
        REWIND 5
        REWIND 97
        ENDFILE 97
        CLOSE (97)
        CLOSE (98)
      ENDIF
      RETURN
C
C -------------------------------------------------------------------------
 1000 FORMAT (A80)
 6000 FORMAT (/,'*** WARNING: FILE NAME ',/,4X,A128,
     1        /,'*** TRUNCATED ON RECONSTRUCTED COMMAND LINE.')
 6010 FORMAT ('0** ',A512)
 6020 FORMAT (/,'*** WARNING: RECONSTRUCTED COMMAND LINE TRUNCATED',
     1        ' TO 512 CHARACTERS.')
 6030 FORMAT ('0** ',512A1)
 6040 FORMAT (' ** ',512A1)
      END
