FTN4
      SUBROUTINE PRAM(LU1,STRING,LENGTH,ISTRC,ARRAY)
     +,92069-16186 REV.2013 790319
C 
C 
C*****************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED.
C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR
C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR
C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. 
C****************************************************************** 
C 
C 
C     SOURCE:    92069-18186
C     RELOC:     92069-16186
C 
C 
C****************************************************************:
C 
C 
C*************************************************************
C PRAM RETURNS A 6-WORD ARRAY CONTAINING INFORMATION ABOUT
C SUCCESSIVE PARAMETERS IN STRING. THE ARRAY LOOKS LIKE THIS: 
C 1. INTEGER VALUE OR FIRST TWO CHARS.
C 2. 0 OR SECOND TWO CHARS. 
C 3. 0 OR THIRD TWO CHARS.
C 4. TYPE OF PARAMETER(0=NONE,1=INTEGER,3=NAMR) 
C 5. INTEGER SECURITY CODE. 
C 6. INTEGER CARTRIDGE REFERENCE NUMBER.
C THIS SUBR ASSUMES THAT ISTRC IS INCRED AUTOMATICALLY BY THE 
C SYSTEM SUBR CALLED NAMR AND IS PASSED IN TO IT UNALTERED FOR
C EACH SUCCESSIVE CALL. 
C*************************************************************
      INTEGER STRING,LENGTH,ISTRC,ARRAY 
      DIMENSION STRING(1),ARRAY(1)
      DIMENSION IPBUF(10) 
C*********************************************************
      DO 5 J =1,6 
5     ARRAY(J) = 0
C THE SYSTEM SUBR NAMR RETURNS A 10-WORD ARRAY. SEE THE 
C DOS/RTE RELOC LIBRARY MANUAL FOR DETAILS. 
      CALL NAMR(IPBUF,STRING,LENGTH,ISTRC)
C************************************************************ 
C BRANCH ACCORDING TO THE TYPE OF THE PARAMETER.
C 0= NO PARAMETER 
C 1= NUMERIC PARAMETER
C (BIT 0=1 AND BIT 1=1) = ASCII PARAMETER 
      IFLAG = IPBUF(4)
      IF (IFLAG .EQ. 0) GO TO 10
      IF (IFLAG .EQ. 1) GO TO 20
      IFLAG= IFLAG .AND. 3
      IF (IFLAG .EQ. 3) GO TO 30
C*************************************************************
C PROCESS INTERNAL ERROR THAT SHOULDNT HAVE HAPPENED. 
C 
      CALL DBER2(LU1,7777,6HXXXXXX,6HPRAM  ,2HAB) 
C*************************************************************
C PROCESS NO PARAMETER. 
C*********************************************************
C     PROCESS INTEGER PARAMETER.
20    ARRAY=IPBUF 
      ARRAY(4)=1
      RETURN
C********************************************************** 
C PROCESS NAMR PARAMETER. 
30    DO 40 I =1,6
40    ARRAY(I) = IPBUF(I) 
      ARRAY(4) = 3
C** THIS ROUTINE ALWAYS RETURNS NUMERIC SEC CODE AND CARTRIDGE
C** REFERENCE NUMBER. 
10    RETURN
C***********************************************************
      END 
                                                                                                      