      SUBROUTINE GRTRIN(IX,NCHTO2,ICSTR,NCSTR)
CCCCC SUBROUTINE GRTRIN(IX,NCHTOT,ICSTR,NCSTR)
C
C     PURPOSE--TRANSLATE THE INTEGER IX
C              INTO ITS CHARACTER EQUIVALENT.
C              NCHTOT = DESIRED NUMBER OF DIGITS IN INTEGER FORMAT.
C              (SO THAT THE OUTPUT WILL CORRESPOND TO   I(NCHTOT)   FORMAT.
C              THE OUTPUT WILL BE RIGHT-JUSTIFIED AS
C              ONE WOULD EXPECT FROM AN I FORTRAN INTEGER FORMAT.
C     NOTE--THE RESULTING TRANSLATED VALUES
C           WILL BE PLACED IN SPECIFIC ELEMENTS
C           OF THE A130 CHARACTER VARIABLE ICSTR.
C           THE VALUE OF THE VARIABLE    NCSTR
C           REPRESENTS THE NUMBER OF CHARACTERS IN ICSTR
C           THAT HAVE ALREADY BEEN FILLED.
C           THE RESULTING TRANSLATED VALUES WILL GO
C           (RIGHT-JUSTIFIED) INTO THE NEXT    NCHTOT
C           CHARACTERS OF ICSTR.
C           AND THE VALUE OF    NCSTR    WILL BE
C           UPDATED ACCORDINGLY, THAT IS,
C           NEW NCSTR = OLD NCSTR + NCHTOT
C     DANGER--NCSTR IS BOTH AN INPUT ARGUMENT
C             AND AN OUTPUT ARGUMENT OF THIS SUBROUTINE.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --MAY 1988
C                       IF NCHTOT IS NEGATIVE, MAKE LEADING ZEROS
C                       EXPLICIT ZEROS RATHER THAN SPACES.  THIS IS
C                       REQUIRED BY THE QUIC DRIVER IN PARTICULAR.
C     UPDATED         --JANUARY  1989. SUN (BY BILL ANDERSON)
C     UPDATED         --JANUARY  1989. POSTSCRIPT (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CGM (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. QMS QUIC (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. CALCOMP (BY ALAN HECKERT)
C     UPDATED         --JANUARY  1989. ZETA (BY ALAN HECKERT)
C     UPDATED         --JULY     1996. LAHEY DRIVER (ALAN HECKERT)
C     UPDATED         --OCTOBER  1996. QUICKWIN DRIVER (ALAN)
C     UPDATED         --OCTOBER  1996. OPENGL DRIVER (ALAN)
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*130 ICSTR
C
      DIMENSION IDIGIT(20)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
C  MAY,1988: CHECK FOR NEGATIVE NCHTOT
      NCHTOT=ABS(NCHTO2)
C
      IASC0=48
C
      IREV=(-999)
      IDIG=(-999)
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRIN')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRTRIN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IX
   52 FORMAT('IX = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NCHTOT
   53 FORMAT('NCHTOT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)NCSTR
   61 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO67
      DO65I=1,NCSTR
      WRITE(ICOUT,66)I,ICSTR(I:I)
   66 FORMAT('I,ICSTR(I:I) = ',I8,2X,A1)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
   67 CONTINUE
      WRITE(ICOUT,69)IBUGG4,ISUBG4,IERRG4
   69 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***********************************
C               **  STEP 1--                     **
C               **  SAVE THE OLD VALUE OF NCSTR  **
C               ***********************************
C
      NCSOLD=NCSTR
C
C
C               ********************************************
C               **  STEP 2--                              **
C               **  FILL THE NEXT   NCHTOT   ELEMENTS     **
C               **  IN ICSTR() WITH BLANKS.               **
C               **  UPDATE NCSTR BY NCSTR + NCHTOT.       **
C               **  MAY,1988: - FILL WITH EXPLICIT ZEROS  **
C               **  IF NCHTOT SENT AS NEGATIVE            **
C               ********************************************
C
C
      IF(NCHTO2.LT.0)GOTO1290
C
      DO1200I=1,NCHTOT
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=' '
 1200 CONTINUE
      GOTO1299
 1290 CONTINUE
      DO1295I=1,NCHTOT
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)='0'
 1295 CONTINUE
 1299 CONTINUE
C
C               ********************************
C               **  STEP 3--                  **
C               **  STRIP OUT THE DIGITS      **
C               **  (IN RIGHT TO LEFT ORDER)  **
C               ********************************
C
      ITEN=10
C
      IABSIX=IABS(IX)
      IRESUL=IABSIX
C
      NUMDIG=0
      DO1300I=1,20
      IDIVID=IRESUL
      IRESUL=IDIVID/ITEN
      IREM=IDIVID-IRESUL*ITEN
      NUMDIG=NUMDIG+1
      IDIGIT(NUMDIG)=IREM
      IF(IRESUL.EQ.0)GOTO1390
 1300 CONTINUE
 1390 CONTINUE
C
C               *****************************************************
C               **   STEP 4--                                      **
C               **   CHECK TO SEE THAT TOTAL NUMBER OF CHARACTERS  **
C               **   (= NUMBER OF DIGITS IF IX >= 0, AND           **
C               **   = NUMBER OF DIGITS + 1 IF IX < 0)             **
C               **   IS LESS THAN OR EQUAL TO NCHTOT.              **
C               **   IF YES, THEN GO TO NEXT STEP.                 **
C               **   IF NO, THEN FILL THE NCHTOT ELEMENTS          **
C               **  WITH ASTERISKS                                 **
C               *****************************************************
C
      NUMTOT=NUMDIG
      IF(IX.LT.0)NUMTOT=NUMTOT+1
C
      IF(NUMTOT.LE.NCHTOT)GOTO1490
      DO1400I=1,NCHTOT
      J=I+NCSOLD
      ICSTR(J:J)='*'
 1400 CONTINUE
      GOTO9000
 1490 CONTINUE
C
C               ****************************************
C               **  STEP 5--                          **
C               **  IF HAVE A VALID NUMBER OF DIGITS, **
C               **  TRANSLATE EACH DIGIT TO ITS       **
C               **  CHARACTER EQUIVALENT.             **
C               **  IN DOING SO, PLACE THE ASCII      **
C               **  CHARACTER EQUIVALENT              **
C               **  IN THE USUAL RIGHT-TO-LEFT ORDER  **
C               **  IN ICSTR(.).  IF IX < 0, INSERT   **
C               **  A MINUS BEFORE THE NUMBER.        **
C               **  HAVE THE CHARACTER STRING         **
C               **  RIGHT JUSTIFIED IN THE            **
C               **  NCHTOT ELEMENTS.                  **
C               ****************************************
C
      J=NCSOLD+(NCHTOT-NUMTOT)
      IF(IX.LT.0)J=J+1
      IF(IX.LT.0)ICSTR(J:J)='-'
C
      DO1500I=1,NUMDIG
      IREV=NUMDIG-I+1
      IDIG=IDIGIT(IREV)
      J=J+1
      IASCDI=IDIG+IASC0
CCCCC ICSTR(J:J)=CHAR(IASCDI)
      CALL DPCONA(IASCDI,ICSTR(J:J))
 1500 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRIN')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRTRIN--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IX
 9012 FORMAT('IX = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NCHTOT
 9013 FORMAT('NCHTOT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IDIVID,IRESUL,IREM,NUMDIG,IDIGIT(NUMDIG)
 9021 FORMAT('IDIVID,IRESUL,IREM,NUMDIG,IDIGIT(NUMDIG) = ',5I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IREV,NCSTR,IDIG,ICSTR(NCSTR:NCSTR)
 9022 FORMAT('IREV,NCSTR,IDIG,ICSTR(NCSTR:NCSTR) = ',3I8,2X,A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)IASC0,IX
 9023 FORMAT('IASC0,IX = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)NUMDIG,NUMTOT
 9031 FORMAT('NUMDIG,NUMTOT = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMDIG.LE.0)GOTO9037
      DO9035I=1,NUMDIG
      WRITE(ICOUT,9036)I,IDIGIT(I)
 9036 FORMAT('I,IDIGIT(I) = ',2I8)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9037 CONTINUE
      WRITE(ICOUT,9041)NCSTR
 9041 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9047
      DO9045I=1,NCSTR
      WRITE(ICOUT,9046)I,ICSTR(I:I)
 9046 FORMAT('I,ICSTR(I:I) = ',I8,2X,A1)
      CALL DPWRST('XXX','BUG ')
 9045 CONTINUE
 9047 CONTINUE
      WRITE(ICOUT,9048)NCSOLD
 9048 FORMAT('NCSOLD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9049)IBUGG4,ISUBG4,IERRG4
 9049 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRTRPG(IPATT,ISTRIN,NCSTRI)
C
C     PURPOSE--TRANSLATE A 1-WORD (4-CHARACTER) REPRESENTATION
C              FOR A MARKER INTO A MULTI-WORD REPRESENTATION
C              THAT SUBROUTINE DPSCR7 CAN UNDERSTAND.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 IPATT
      CHARACTER*4 ISTRIN
C
      CHARACTER*1 IC1
C
      DIMENSION ISTRIN(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRPG')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRTRPG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IPATT
   52 FORMAT('IPATT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4
   59 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      NCSTRI=0
      DO1100I=1,4
      ISTRIN(I)='    '
 1100 CONTINUE
C
      DO1200I=1,4
      IREV=4-I+1
      IC1=IPATT(IREV:IREV)
      IF(IC1.NE.' ')GOTO1250
 1200 CONTINUE
 1250 CONTINUE
      NCSTRI=IREV
      IF(NCSTRI.LE.0)NCSTRI=1
C
      DO1300I=1,NCSTRI
      ISTRIN(I)=IPATT(I:I)
 1300 CONTINUE
C
      IF(NCSTRI.LE.1)GOTO1490
      NCSTRI=NCSTRI+1
      ISTRIN(NCSTRI)='('
      NCSTRI=NCSTRI+1
      ISTRIN(NCSTRI)=')'
 1490 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRPG')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRTRPG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IPATT
 9012 FORMAT('IPATT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NCSTRI
 9013 FORMAT('NCSTRI = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO9015I=1,NCSTRI
      WRITE(ICOUT,9016)I,ISTRIN(I)
 9016 FORMAT('I,ISTRIN(I) = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4
 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRTRRE(X,NCHTOT,NCHDEC,ICSTR,NCSTR)
C
C     PURPOSE--TRANSLATE THE REAL (= FLOATING POINT) NUMBER X
C              INTO ITS CHARACTER EQUIVALENT.
C              NCHTOT = DESIRED NUMBER OF CHARACTERS FOR TOTAL NUMBER.
C              NCTDEC = DESIRED NUMBER OF CHARACTERS FOR DECIMAL PART OF NUMBER.
C              THE OUTPUT WILL CORRESPOND TO A FORTRAN F FORMAT.
C              AS IN    F NCHTOT.NCHDEC     FORMAT (E.G., F10.5).
C              THE OUTPUT WILL BE RIGHT-JUSTIFIED AS ONE
C              WOULD EXPECT FROM A F FORTRAN FLOATING POINT FORMAT.
C     NOTE--THE RESULTING TRANSLATED VALUES
C           WILL BE PLACED IN SPECIFIC ELEMENTS
C           OF THE A130 CHARACTER VARIABLE ICSTR.
C           THE VALUE OF THE VARIABLE    NCSTR
C           REPRESENTS THE NUMBER OF CHARACTERS IN ICSTR
C           THAT HAVE ALREADY BEEN FILLED.
C           THE RESULTING TRANSLATED VALUES WILL GO
C           (RIGHT-JUSTIFIED) INTO THE NEXT    NCHTOT
C           CHARACTERS OF ICSTR.
C           AND THE VALUE OF    NCSTR    WILL BE
C           UPDATED ACCORDINGLY, THAT IS,
C           NEW NCSTR = OLD NCSTR + NCHTOT
C     DANGER--NCSTR IS BOTH AN INPUT ARGUMENT
C             AND AN OUTPUT ARGUMENT OF THIS SUBROUTINE.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*130 ICSTR
C
      DIMENSION IINTDI(20)
      DIMENSION IDECDI(20)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IASC0=48
C
      IREV=(-999)
      IDIG=(-999)
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRRE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRTRRE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)X
   52 FORMAT('X = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)NCHTOT
   53 FORMAT('NCHTOT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)NCSTR
   61 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO67
      DO65I=1,NCSTR
      WRITE(ICOUT,66)I,ICSTR(I:I)
   66 FORMAT('I,ICSTR(I:I) = ',I8,2X,A1)
      CALL DPWRST('XXX','BUG ')
   65 CONTINUE
   67 CONTINUE
      WRITE(ICOUT,69)IBUGG4,ISUBG4,IERRG4
   69 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ***********************************
C               **  STEP 1--                     **
C               **  SAVE THE OLD VALUE OF NCSTR  **
C               ***********************************
C
      NCSOLD=NCSTR
C
C
C               ********************************************
C               **  STEP 2--                              **
C               **  FILL THE NEXT   NCHTOT   ELEMENTS     **
C               **  IN ICSTR() WITH BLANKS.               **
C               **  UPDATE NCSTR BY NCSTR + NCHTOT.       **
C               ********************************************
C
      DO1200I=1,NCHTOT
      NCSTR=NCSTR+1
      ICSTR(NCSTR:NCSTR)=' '
 1200 CONTINUE
C
C               ********************************
C               **  STEP 3--                  **
C               **  STRIP OUT THE DIGITS      **
C               **  OF THE INTEGER PART       **
C               **  (IN RIGHT TO LEFT ORDER)  **
C               ********************************
C
      ITEN=10
C
      IX=X
      IABSIX=IABS(IX)
C
      IRESUL=IABSIX
      NUMIND=0
      DO1300I=1,20
      IDIVID=IRESUL
      IRESUL=IDIVID/ITEN
      IREM=IDIVID-IRESUL*ITEN
      NUMIND=NUMIND+1
      IINTDI(NUMIND)=IREM
      IF(IRESUL.EQ.0)GOTO1390
 1300 CONTINUE
 1390 CONTINUE
C
C               ********************************
C               **  STEP 4--                  **
C               **  STRIP OUT NCHDEC DIGITS   **
C               **  OF THE DECIMAL PART       **
C               **  (IN RIGHT TO LEFT ORDER)  **
C               ********************************
C
      ITEN=10
C
      AIABIX=IABSIX
      ABSX=ABS(X)
      DEC=AIABIX-ABSX
      IF(DEC.LT.0.0)DEC=0.0
      DEC=ABSX-AIABIX
      DEC2=DEC*(10.0**NCHDEC)
C
      IY=DEC2
      IABSIY=IABS(IY)
C
      IRESUL=IABSIY
      NUMDED=0
      IF(NCHDEC.LE.0)GOTO1490
      DO1400I=1,NCHDEC
      IDIVID=IRESUL
      IRESUL=IDIVID/ITEN
      IREM=IDIVID-IRESUL*ITEN
      NUMDED=NUMDED+1
      IDECDI(NUMDED)=IREM
 1400 CONTINUE
 1490 CONTINUE
C
C               *****************************************************
C               **   STEP 5--                                      **
C               **   CHECK TO SEE THAT TOTAL NUMBER OF CHARACTERS  **
C               **   (= NUMBER OF DIGITS + 1 IF IX >= 0, AND       **
C               **   = NUMBER OF DIGITS + 2 IF IX < 0)             **
C               **   IS LESS THAN OR EQUAL TO NCHTOT.              **
C               **   IF YES, THEN GO TO NEXT STEP.                 **
C               **   IF NO, THEN FILL THE NCHTOT ELEMENTS          **
C               **   WITH ASTERISKS                                **
C               *****************************************************
C
      NUMTOT=NUMIND+1+NUMDED
      IF(X.LT.0.0)NUMTOT=NUMTOT+1
C
      IF(NUMTOT.LE.NCHTOT)GOTO1590
      DO1500I=1,NCHTOT
      J=I+NCSOLD
      ICSTR(J:J)='*'
 1500 CONTINUE
      GOTO9000
 1590 CONTINUE
C
C               ****************************************
C               **  STEP 6--                          **
C               **  IF HAVE A VALID NUMBER OF DIGITS, **
C               **  TRANSLATE EACH DIGIT TO ITS       **
C               **  CHARACTER EQUIVALENT.             **
C               **  IN DOING SO, PLACE THE ASCII      **
C               **  CHARACTER EQUIVALENT              **
C               **  IN THE USUAL RIGHT-TO-LEFT ORDER  **
C               **  IN ICSTR(.).  IF IX < 0, INSERT   **
C               **  A MINUS BEFORE THE NUMBER.        **
C               **  HAVE THE CHARACTER STRING         **
C               **  RIGHT JUSTIFIED IN THE            **
C               **  NCHTOT ELEMENTS.                  **
C               ****************************************
C
      J=NCSOLD+(NCHTOT-NUMTOT)
      IF(X.LT.0.0)J=J+1
      IF(X.LT.0.0)ICSTR(J:J)='-'
C
      DO1610I=1,NUMIND
      IREV=NUMIND-I+1
      IDIG=IINTDI(IREV)
      J=J+1
      IASCDI=IDIG+IASC0
CCCCC ICSTR(J:J)=CHAR(IASCDI)
      CALL DPCONA(IASCDI,ICSTR(J:J))
 1610 CONTINUE
C
      J=J+1
      ICSTR(J:J)='.'
C
      DO1620I=1,NUMDED
      IREV=NUMDED-I+1
      IDIG=IDECDI(IREV)
      J=J+1
      IASCDI=IDIG+IASC0
CCCCC ICSTR(J:J)=CHAR(IASCDI)
      CALL DPCONA(IASCDI,ICSTR(J:J))
 1620 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRRE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRTRRE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)X
 9012 FORMAT('X = ',E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NCHTOT,NCHDEC
 9013 FORMAT('NCHTOT,NCHDEC = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NUMIND,NUMDED,NUMTOT
 9014 FORMAT('NUMIND,NUMDED,NUMTOT = ',3I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)IDIVID,IRESUL,IREM,NUMIND,IINTDI(NUMIND)
 9021 FORMAT('IDIVID,IRESUL,IREM,NUMIND,IINTDI(NUMIND) = ',5I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IREV,NCSTR,IDIG,ICSTR(NCSTR:NCSTR)
 9022 FORMAT('IREV,NCSTR,IDIG,ICSTR(NCSTR:NCSTR) = ',3I8,2X,A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)IASC0,IX
 9023 FORMAT('IASC0,IX = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)NUMIND,NUMTOT
 9031 FORMAT('NUMIND,NUMTOT = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMIND.LE.0)GOTO9037
      DO9035I=1,NUMIND
      WRITE(ICOUT,9036)I,IINTDI(I)
 9036 FORMAT('I,IINTDI(I) = ',2I8)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9037 CONTINUE
      WRITE(ICOUT,9041)NUMDED,NUMTOT
 9041 FORMAT('NUMDED,NUMTOT = ',2I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMDED.LE.0)GOTO9047
      DO9045I=1,NUMDED
      WRITE(ICOUT,9046)I,IDECDI(I)
 9046 FORMAT('I,IDECDI(I) = ',2I8)
      CALL DPWRST('XXX','BUG ')
 9045 CONTINUE
 9047 CONTINUE
      WRITE(ICOUT,9051)NCSTR
 9051 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9057
      DO9055I=1,NCSTR
      WRITE(ICOUT,9056)I,ICSTR(I:I)
 9056 FORMAT('I,ICSTR(I:I) = ',I8,2X,A1)
      CALL DPWRST('XXX','BUG ')
 9055 CONTINUE
 9057 CONTINUE
      WRITE(ICOUT,9058)NCSOLD
 9058 FORMAT('NCSOLD = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9059)IBUGG4,ISUBG4,IERRG4
 9059 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRTRRP(IPATTT,IHORPA,IVERPA,IDUPPA,IDDOPA)
C  MARCH, 1988: FOR EACH PAATTERN TYPE, SET IPATT TO A STANDARD
C               NAME.
C
C     PURPOSE--CONVERT A 1 WORD REPRESENTATION FOR THE PATTERN
C              (FOR A REGION)
C              INTO 4 SINGLE-WORD REPRESENTATIONS
C              BASED ON HORIZONTAL, VERTICAL,
C              DIAGONAL UP, AND DIAGONAL DOWN
C              COMPONENTS OF THE PATTERN.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 IPATTT
      CHARACTER*4 IHORPA
      CHARACTER*4 IVERPA
      CHARACTER*4 IDUPPA
      CHARACTER*4 IDDOPA
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRRP')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRTRRP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IPATTT
   52 FORMAT('IPATTT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IBUGG4,ISUBG4,IERRG4
   59 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      IHORPA='OFF'
      IVERPA='OFF'
      IDUPPA='OFF'
      IDDOPA='OFF'
C
      IF(IPATTT.EQ.'    ')GOTO110
      IF(IPATTT.EQ.'BLAN')GOTO110
      IF(IPATTT.EQ.'NONE')GOTO110
      IF(IPATTT.EQ.'EMPT')GOTO110
C
      IF(IPATTT.EQ.'HORI')GOTO210
      IF(IPATTT.EQ.'H   ')GOTO210
      IF(IPATTT.EQ.'VERT')GOTO220
      IF(IPATTT.EQ.'V   ')GOTO220
      IF(IPATTT.EQ.'SOLI')GOTO220
      IF(IPATTT.EQ.'DU  ')GOTO230
      IF(IPATTT.EQ.'D1  ')GOTO230
      IF(IPATTT.EQ.'DD  ')GOTO240
      IF(IPATTT.EQ.'D2  ')GOTO240
C
      IF(IPATTT.EQ.'HV  ')GOTO310
      IF(IPATTT.EQ.'VH  ')GOTO310
      IF(IPATTT.EQ.'DUDD')GOTO320
      IF(IPATTT.EQ.'D1D2')GOTO320
      IF(IPATTT.EQ.'DDDU')GOTO320
      IF(IPATTT.EQ.'D2D1')GOTO320
C
      IF(IPATTT.EQ.'HDU ')GOTO410
      IF(IPATTT.EQ.'HD1 ')GOTO410
CCCCC OCTOBER 1992.  ADD FOLLOWING 2 LINES
      IF(IPATTT.EQ.'HOD1')GOTO410
      IF(IPATTT.EQ.'D1HO')GOTO410
      IF(IPATTT.EQ.'HDD ')GOTO420
      IF(IPATTT.EQ.'HD2 ')GOTO420
CCCCC OCTOBER 1992.  ADD FOLLOWING 4 LINES
      IF(IPATTT.EQ.'HOD2')GOTO420
      IF(IPATTT.EQ.'D2HO')GOTO420
      IF(IPATTT.EQ.'DDHO')GOTO420
      IF(IPATTT.EQ.'HODD')GOTO420
CCCCC OCTOBER 1992.  ADD FOLLOWING 6 LINES
      IF(IPATTT.EQ.'HO12')GOTO425
      IF(IPATTT.EQ.'12HO')GOTO425
      IF(IPATTT.EQ.'H12 ')GOTO425
      IF(IPATTT.EQ.'12H ')GOTO425
      IF(IPATTT.EQ.'HD12')GOTO425
      IF(IPATTT.EQ.'D12H')GOTO425
C
      IF(IPATTT.EQ.'VDU ')GOTO430
      IF(IPATTT.EQ.'VD1 ')GOTO430
CCCCC OCTOBER 1992.  ADD FOLLOWING 2 LINES
      IF(IPATTT.EQ.'VED1')GOTO430
      IF(IPATTT.EQ.'D1VE')GOTO430
      IF(IPATTT.EQ.'VDD ')GOTO440
CCCCC OCTOBER 1992.  ADD FOLLOWING 2 LINES
      IF(IPATTT.EQ.'VED2')GOTO440
      IF(IPATTT.EQ.'D2VE')GOTO440
CCCCC OCTOBER 1992.  ADD FOLLOWING 4 LINES
      IF(IPATTT.EQ.'VE12')GOTO445
      IF(IPATTT.EQ.'12VE')GOTO445
      IF(IPATTT.EQ.'V12 ')GOTO445
      IF(IPATTT.EQ.'12V ')GOTO445
      IF(IPATTT.EQ.'VD12')GOTO445
      IF(IPATTT.EQ.'D12V')GOTO445
C
      IF(IPATTT.EQ.'HVDU')GOTO510
      IF(IPATTT.EQ.'HVD1')GOTO510
      IF(IPATTT.EQ.'VHDU')GOTO510
      IF(IPATTT.EQ.'VHD1')GOTO510
      IF(IPATTT.EQ.'HVDD')GOTO520
      IF(IPATTT.EQ.'HVD2')GOTO520
      IF(IPATTT.EQ.'VHDD')GOTO520
      IF(IPATTT.EQ.'VHD2')GOTO520
CCCCC OCTOBER 1992.  ADD FOLLOWING LINES
      IF(IPATTT.EQ.'HV12')GOTO610
      IF(IPATTT.EQ.'12HV')GOTO610
C
      IF(IPATTT.EQ.'ALL')GOTO610
C
      GOTO9000
C
  110 CONTINUE
      IHORPA='OFF'
      IVERPA='OFF'
      IDUPPA='OFF'
      IDDOPA='OFF'
      IPATTT='EMPT'
      GOTO9000
C
  210 CONTINUE
      IHORPA='ON'
      IVERPA='OFF'
      IDUPPA='OFF'
      IDDOPA='OFF'
      IPATTT='HORI'
      GOTO9000
C
  220 CONTINUE
      IHORPA='OFF'
      IVERPA='ON'
      IDUPPA='OFF'
      IDDOPA='OFF'
      IF(IPATTT.EQ.'V')IPATTT='VERT'
      GOTO9000
C
  230 CONTINUE
      IHORPA='OFF'
      IVERPA='OFF'
      IDUPPA='ON'
      IDDOPA='OFF'
      IPATTT='D1'
      GOTO9000
C
  240 CONTINUE
      IHORPA='OFF'
      IVERPA='OFF'
      IDUPPA='OFF'
      IDDOPA='ON'
      IPATTT='D2'
      GOTO9000
C
  310 CONTINUE
      IHORPA='ON'
      IVERPA='ON'
      IDUPPA='OFF'
      IDDOPA='OFF'
      IPATTT='HV'
      GOTO9000
C
  320 CONTINUE
      IHORPA='OFF'
      IVERPA='OFF'
      IDUPPA='ON'
      IDDOPA='ON'
      IPATTT='D1D2'
      GOTO9000
C
  410 CONTINUE
      IHORPA='ON'
      IVERPA='OFF'
      IDUPPA='ON'
      IDDOPA='OFF'
      IPATTT='HD1'
      GOTO9000
C
  420 CONTINUE
      IHORPA='ON'
      IVERPA='OFF'
      IDUPPA='OFF'
      IDDOPA='ON'
      IPATTT='HD2'
      GOTO9000
C
CCCCC OCTOBER 1992.  ADD FOLLOWING BLOCK OF CODE
  425 CONTINUE
      IHORPA='ON'
      IVERPA='OFF'
      IDUPPA='ON'
      IDDOPA='ON'
      IPATTT='HD12'
      GOTO9000
C
  430 CONTINUE
      IHORPA='OFF'
      IVERPA='ON'
      IDUPPA='ON'
      IDDOPA='OFF'
      IPATTT='VD1'
      GOTO9000
C
  440 CONTINUE
      IHORPA='OFF'
      IVERPA='ON'
      IDUPPA='OFF'
      IDDOPA='ON'
      IPATTT='VD2'
      GOTO9000
C
CCCCC OCTOBER 1992.  ADD FOLLOWING BLOCK OF CODE
  445 CONTINUE
      IHORPA='OFF'
      IVERPA='ON'
      IDUPPA='ON'
      IDDOPA='ON'
      IPATTT='VD12'
      GOTO9000
C
  510 CONTINUE
      IHORPA='ON'
      IVERPA='ON'
      IDUPPA='ON'
      IDDOPA='OFF'
      IPATTT='HVD1'
      GOTO9000
C
  520 CONTINUE
      IHORPA='ON'
      IVERPA='ON'
      IDUPPA='OFF'
      IDDOPA='ON'
      IPATTT='HVD2'
      GOTO9000
C
  610 CONTINUE
      IHORPA='ON'
      IVERPA='ON'
      IDUPPA='ON'
      IDDOPA='ON'
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT.      **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRRP')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRTRRP--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IPATTT
 9012 FORMAT('IPATTT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IHORPA,IVERPA,IDUPPA,IDDOPA
 9013 FORMAT('IHORPA,IVERPA,IDUPPA,IDDOPA = ',A4,2X,A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IBUGG4,ISUBG4,IERRG4
 9019 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRTRSA(PX1,PY1,AX1,AY1,ISUBN0)
C
C     THIS ROUTINE IS A MODIFIED VERSION OF GRTRSD.  IT IS USED
C     ONLY BY THE META FILE DEVICES (I.E., "GENERAL", "GENERAL CODED"
C     AND FOR FUTURE PURPOSES "CGM").  GRTRSA CONVERTS FROM DATAPLOT
C     UNITS TO DEVICE INTEGER UNITS, BUT IT ALSO APPLIES "WINDOW"
C     TRANSFORMATIONS NEEDED BY THE "MULTI-PLOT" AND "WINDOW
C     COORDINATE" COMMANDS.  THE METAFILE DOES NOT SUPPORT ANY
C     PARTICULAR NUMBER OF PICTURE POINTS.  IT DOES HOWEVER NEED
C     TO APPLY THE "WINDOW" TRANSFORMATIONS.
C
C     PURPOSE--TRANSLATE THE STANDARDIZED (0.0 TO 100.0) COORDINATES (PX1,PY1)
C              INTO (INTEGER PICTURE POINT) DEVICE COORDINATES (AX1,AY1)
C     ISUBN0 = NAME OF SUBROUTINE WHICH CALLED GRWRST.
C              (AND THEREBY HAVE WALKBACK INFORMATION).
C     NOTE--THE ONLY VARIABLES IN THE    PLOT CONTROL COMMON
C           THAT ARE USED HEREIN ARE THE ONES IN /RWIND/
C
C     WRITTEN BY--ALAN HECKERT
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--89.2
C     ORIGINAL VERSION--JANUARY   1989.
C     UPDATED         --APRIL     1992.  FIX SOME DEBUG STATEMENTS
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ISUBN0
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOPA.INC'
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRSA')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRTRSA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ISUBN0
   52 FORMAT('ISUBN0 (NAME OF THE CALLING SUBROUTINE) = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IMANUF,IMODEL
   53 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMHPP,NUMVPP
   54 FORMAT('NUMHPP,NUMVPP = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)ANUMHP,ANUMVP
   55 FORMAT('ANUMHP,ANUMVP = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)PX1,PY1
   56 FORMAT('PX1,PY1 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)PWXMIN,PWXMAX,PWYMIN,PWYMAX
   61 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)IBUGG4
   69 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *************************************
C               **  STEP 1--                       **
C               **  CARRY OUT THE TRANSFORMATION.  **
C               *************************************
C
      AX1=PWXMIN+(PX1/100.0)*(PWXMAX-PWXMIN)
      IF(AX1.LE.0.0)AX1=0.0
      IF(AX1.GE.100.)AX1=100.
C
      AY1=PWYMIN+(PY1/100.0)*(PWYMAX-PWYMIN)
      IF(AY1.LE.0.0)AY1=0.0
      IF(AY1.GE.100.)AY1=100.
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRSA')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRTRSA--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IMANUF,IMODEL
 9012 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NUMHPP,NUMVPP
 9013 FORMAT('NUMHPP,NUMVPP = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ANUMHP,ANUMVP
 9014 FORMAT('ANUMHP,ANUMVP = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PX1,PY1
 9015 FORMAT('PX1,PY1   = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
CCCCC THE FOLLOWING 4 LINES WERE COMMENTED OUT   APRIL 1992
CCCCC WRITE(ICOUT,9016)PWX1,PWY1
C9016 FORMAT('PWX1,PWY1 = ',E15.7,E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,9017)X1,Y1
C9017 FORMAT('X1,Y1     = ',E15.7,E15.7)
CCCCC CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)AX1,AY1
 9018 FORMAT('AX1,AY1   = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)PWXMIN,PWXMAX,PWYMIN,PWYMAX
 9021 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
 
      SUBROUTINE GRTRSD(PX1,PY1,IX1,IY1,ISUBN0)
C
C     PURPOSE--TRANSLATE THE STANDARDIZED (0.0 TO 100.0) COORDINATES (PX1,PY1)
C              INTO (INTEGER PICTURE POINT) DEVICE COORDINATES (IX1,IY1)
C     ISUBN0 = NAME OF SUBROUTINE WHICH CALLED GRWRST.
C              (AND THEREBY HAVE WALKBACK INFORMATION).
C     NOTE--THE ONLY VARIABLES IN THE    PLOT CONTROL COMMON
C           THAT ARE USED HEREIN ARE THE ONES IN /RWIND/
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     UPDATED   --MARCH     1990. PATCH FOR X11, USE OFFSET VARIABLES
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED--SEPTEMBER 1986.
C     UPDATED--MAY 1990.    FOR X11, USE OFFSET VARIABLES
C     UPDATED--JUNE   1990. FIXED BUG WHEN USING OFFSETS
C     UPDATED--OCTOBER 1996.  SUPPORT MICROSOFT QWIN DRIVER
C     UPDATED--OCTOBER 1996.  SUPPORT MICROSOFT QWIN DRIVER
C     UPDATED--MARCH   2002.  SUPPORT SVG DRIVER
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ISUBN0
C
C-----COMMON----------------------------------------------------------
C
CCCCC THE FOLLOWING LINE WAS INSERTED MARCH 1989
      INCLUDE 'DPCOPA.INC'
C
      INCLUDE 'DPCOPC.INC'
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERRG4='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRSD')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRTRSD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)ISUBN0
   52 FORMAT('ISUBN0 (NAME OF THE CALLING SUBROUTINE) = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)IMANUF,IMODEL
   53 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NUMHPP,NUMVPP
   54 FORMAT('NUMHPP,NUMVPP = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)ANUMHP,ANUMVP
   55 FORMAT('ANUMHP,ANUMVP = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)PX1,PY1
   56 FORMAT('PX1,PY1 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)PWXMIN,PWXMAX,PWYMIN,PWYMAX
   61 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)IBUGG4
   69 FORMAT('IBUGG4 = ',A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *************************************
C               **  STEP 1--                       **
C               **  CARRY OUT THE TRANSFORMATION.  **
C               *************************************
C
CCCCC X1=(PX1/100.0)*ANUMHP
      PWX1=PWXMIN+(PX1/100.0)*(PWXMAX-PWXMIN)
      X1=(PWX1/100.0)*ANUMHP
      IX1=X1+0.5
CCCCC FOLLOWING LINE ADDED MARCH, 1990
      IX1=IX1+IOFFSH
      IF(IX1.LE.0)IX1=0
CCCCC JUNE, 1990.  FOLLOWING LINE MODIFIED.  NEED TO ACCOUNT FOR OFFSET
CCCCC WHEN TEST FOR MAXIMUM POINT.
CCCCC IF(IX1.GE.NUMHPP)IX1=NUMHPP-1
      ITEMP=NUMHPP+IOFFSH
      IF(IX1.GE.ITEMP)IX1=ITEMP-1
C
CCCCC Y1=(PY1/100.0)*ANUMVP
CCCCC NEED TO MODIFY FOLLOWING LINE FOR QWIN DRIVER SINCE IT MEASURES
CCCCC FROM TOP TO BOTTOM.  OCTOBER 1996.
      IF(IMANUF.EQ.'QWIN')THEN
        PWYMNT=100.0-PWYMIN
        PWYMXT=100.0-PWYMAX
        PWY1=PWYMNT+(PY1/100.0)*(PWYMXT-PWYMNT)
      ELSE
        PWY1=PWYMIN+(PY1/100.0)*(PWYMAX-PWYMIN)
      ENDIF
      Y1=(PWY1/100.0)*ANUMVP
      IY1=Y1+0.5
CCCCC FOLLOWING LINE ADDED MARCH, 1990
      IY1=IY1+IOFFSV
CCCCC IF(IMANUF.EQ.'REGI')IY1=NUMVPP-1-IY1
C  ABOVE LINE MODIFIED FOR X11 DRIVER MARCH, 1990.
C  ABOVE LINE MODIFIED FOR QWIN DRIVER OCTOBER 1996
CCCCC SAME MODIFICATION FOR PNG, JPG (GD) DEVICE  FEBRUARY 2001
CCCCC SAME MODIFICATION FOR SVG DEVICE  MARCH 2002
CCCCC IF(IMANUF.EQ.'REGI'.OR.IMANUF.EQ.'X11 '.OR.IMANUF.EQ.'QWIN')
CCCCC IF(IMANUF.EQ.'REGI'.OR.IMANUF.EQ.'X11 ')
      IF(IMANUF.EQ.'REGI'.OR.IMANUF.EQ.'X11 '.OR.IMANUF.EQ.'GD'.OR.
     &   IMANUF.EQ.'SVG')
     &IY1=NUMVPP-1-IY1
      IF(IY1.LE.0)IY1=0
CCCCC JUNE, 1990 FOR OFFSET.
CCCCC IF(IY1.GE.NUMVPP)IY1=NUMVPP-1
      ITEMP=NUMVPP+IOFFSV
      IF(IY1.GE.ITEMP)IY1=ITEMP-1
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRSD')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRTRSD--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IMANUF,IMODEL
 9012 FORMAT('IMANUF,IMODEL = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)NUMHPP,NUMVPP
 9013 FORMAT('NUMHPP,NUMVPP = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)ANUMHP,ANUMVP
 9014 FORMAT('ANUMHP,ANUMVP = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)PX1,PY1
 9015 FORMAT('PX1,PY1   = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)PWX1,PWY1
 9016 FORMAT('PWX1,PWY1 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)X1,Y1
 9017 FORMAT('X1,Y1     = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9018)IX1,IY1
 9018 FORMAT('IX1,IY1   = ',I8,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)PWXMIN,PWXMAX,PWYMIN,PWYMAX
 9021 FORMAT('PWXMIN,PWXMAX,PWYMIN,PWYMAX = ',4E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRTRST(ICSTR,NCSTR,
     1ICTRA1,NCTRA1,ICTRA2,NCTRA2,NUMTRA,
     1IBUGG4,ISUBG4,IERRG4)
C
C     PURPOSE--APPLY VARIOUS USER-DEFINED
C              TRANSLATIONS
C              TO EACH OUTPUT GRAPHICS LINE (CHARACTER*130)
C              SO AS TO CREATE A NEW OUTPUT GRAPHICS LINE.
C     EXAMPLE--CHANGE ESC FF TO ESC ESC FF
C              SO AS TO CIRCUMVENT SOME NETWORKS
C              "EATING UP" ESCAPES.
C     CAUTION--THE INPUT ARGUMENTS ICSTR AND NCSTR
C              ARE CHANGED WITHIN THIS SUBROUTINE
C              AND THUS ARE ALSO OUTPUT ARGUMENTS.
C     CAUTION--ICSTR IS CHARACTER*130--NOT CHARACTER*132.
C              THE SAME IS TRUE FOR ICSTR2.
C     NOTE--EVERY OCCURRANCE (NOT JUST THE FIRST
C           OCCURRANCE) WILL BE TRANSLATED ON THE
C           INPUT LINE.
C     WRITTEN BY--JAMES J. FILLIBEN
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86.6
C     ORIGINAL VERSION--MARCH 1986.
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*130 ICSTR
      CHARACTER*30 ICTRA1
      CHARACTER*30 ICTRA2
C
      CHARACTER*4 IBUGG4
      CHARACTER*4 ISUBG4
      CHARACTER*4 IERRG4
C
      CHARACTER*30 ICS1
      CHARACTER*30 ICS2
      CHARACTER*130 ICSTR2
C
      CHARACTER*4 IFOUST
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
CCCCC CHARACTER*4 ISTEPN
C
      DIMENSION ICTRA1(*)
      DIMENSION NCTRA1(*)
      DIMENSION ICTRA2(*)
      DIMENSION NCTRA2(*)
C
C-----COMMON----------------------------------------------------------
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='GRTR'
      ISUBN2='ST  '
C
      IERRG4='NO'
      IFOUST='NO'
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRST')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRTRST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG4,ISUBG4,IERRG4
   52 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)NCSTR
   61 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)(ICSTR(I:I),I=1,100)
   62 FORMAT('ICSTR(I:I) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)NUMTRA
   71 FORMAT('NUMTRA = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMTRA.LE.0)GOTO79
      DO72ITRA=1,NUMTRA
      WRITE(ICOUT,73)ITRA,NCTRA1(ITRA),ICTRA1(ITRA)
   73 FORMAT('ITRA,NCTRA1(ITRA),ICTRA1(ITRA) = ',I8,I8,2X,A30)
      CALL DPWRST('XXX','BUG ')
   72 CONTINUE
      DO75ITRA=1,NUMTRA
      WRITE(ICOUT,76)ITRA,NCTRA2(ITRA),ICTRA2(ITRA)
   76 FORMAT('ITRA,NCTRA2(ITRA),ICTRA2(ITRA) = ',I8,I8,2X,A30)
      CALL DPWRST('XXX','BUG ')
   75 CONTINUE
   79 CONTINUE
   90 CONTINUE
C
C               ***********************************
C               **  STEP 11--                    **
C               **  LOOP THROUGH EACH ELEMENT    **
C               **  IN THE TRANSLATION TABLE.    **
C               ***********************************
C
      IF(NUMTRA.LE.0)GOTO1190
      DO1100ITRA=1,NUMTRA
C
C               ***********************************
C               **  STEP 12--                    **
C               **  FOR THIS GIVEN ELEMENT       **
C               **  IN THE TRANSLATION TABLE,    **
C               **  EXTRACT THE "OLD" SUBSTRING  **
C               ***********************************
C
      NCS1=NCTRA1(ITRA)
      ICS1=ICTRA1(ITRA)
C
C               ***********************************
C               **  STEP 13--                    **
C               **  FOR THIS GIVEN ELEMENT       **
C               **  IN THE TRANSLATION TABLE,    **
C               **  EXTRACT THE "NEW" SUBSTRING  **
C               ***********************************
C
      NCS2=NCTRA2(ITRA)
      ICS2=ICTRA2(ITRA)
C
C               **************************************
C               **  STEP 14--                       **
C               **  APPLY THE DESIRED CHANGE        **
C               **  TO EVERY OCCUURANCE OF THE      **
C               **  OLD STRING IN THE TARGET LINE;  **
C               **  THUS CREATE A NEW LINE.         **
C               **************************************
C
      CALL GRTRS2(ICS1,NCS1,ICS2,NCS2,
     1ICSTR,NCSTR,ICSTR2,NCSTR2,IFOUST,
     1IBUGG4,ISUBG4,IERRG4)
C
C               ******************************************
C               **  STEP 15--                           **
C               **  COPY THE NEWLY-CREATED LINE         **
C               **  BACK ONTO THE ORIGINAL LINE.        **
C               ******************************************
C
      IF(IFOUST.EQ.'NO')GOTO1590
      NCSTR=NCSTR2
      ICSTR=ICSTR2
 1590 CONTINUE
C
C               ***********************************
C               **  STEP 16--                    **
C               **  FINISH THE LOOP              **
C               **  SO AS TO MOVE ONTO THE       **
C               **  NEXT ELEMENT                 **
C               **  OF THE TRANSLATION TABLE,    **
C               ***********************************
 
 1100 CONTINUE
 1190 CONTINUE
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRST')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRTRST--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG4,ISUBG4,IERRG4
 9012 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)NCSTR
 9021 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)(ICSTR(I:I),I=1,100)
 9022 FORMAT('ICSTR(I:I) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)NUMTRA
 9031 FORMAT('NUMTRA = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NUMTRA.LE.0)GOTO9039
      DO9032ITRA=1,NUMTRA
      WRITE(ICOUT,9033)ITRA,NCTRA1(ITRA),ICTRA1(ITRA)
 9033 FORMAT('ITRA,NCTRA1(ITRA),ICTRA1(ITRA) = ',I8,I8,2X,A30)
      CALL DPWRST('XXX','BUG ')
 9032 CONTINUE
      DO9035ITRA=1,NUMTRA
      WRITE(ICOUT,9036)ITRA,NCTRA2(ITRA),ICTRA2(ITRA)
 9036 FORMAT('ITRA,NCTRA2(ITRA),ICTRA2(ITRA) = ',I8,I8,2X,A30)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)NCSTR2
 9041 FORMAT('NCSTR2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)(ICSTR2(I:I),I=1,100)
 9042 FORMAT('ICSTR2(I:I) = ',100A1)
      CALL DPWRST('XXX','BUG ')
 9035 CONTINUE
 9039 CONTINUE
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRTRS2(ICS1,NCS1,ICS2,NCS2,
     1ICSTR,NUMCST,ICSTR2,NUMCS2,IFOUST,
     1IBUGG4,ISUBG4,IERRG4)
C
C     PURPOSE--APPLY A SINGLE USER-DEFINED
C              TRANSLATION
C              TO EACH OUTPUT GRAPHICS LINE
C              SO AS TO CREATE A NEW OUTPUT GRAPHICS LINE.
C              IN PARTICULAR, SCAN ICSTR(.) (CHARACTER*130)
C              FOR EVERY OCCURRANCE
C              OF THE STRING IN ICS1(.).
C              IF FOUND, THEN FORM THE NEW LINE ICSTR2(.)
C              WHICH IS THE SAME AS ICSTR(.) EXCEPT
C              EVERY ICS1(.) HAS BEEN CHANGED TO ICS2(.).
C              IF NOT FOUND, THEN ICSTR2(.) = ICSTR(.)
C     EXAMPLE--CHANGE ESC FF TO ESC ESC FF
C              SO AS TO CIRCUMVENT SOME NETWORKS
C              "EATING UP" ESCAPES.
C     CAUTION--ICSTR IS CHARACTER*130--NOT CHARACTER*132.
C              THE SAME IS TRUE FOR ICSTR2.
C     WRITTEN BY--JAMES J. FILLIBEN
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--86.6
C     ORIGINAL VERSION--MARCH 1986.
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*30 ICS1
      CHARACTER*30 ICS2
      CHARACTER*130 ICSTR
      CHARACTER*130 ICSTR2
C
      CHARACTER*4 IFOUST
C
      CHARACTER*4 IBUGG4
      CHARACTER*4 ISUBG4
      CHARACTER*4 IERRG4
C
      CHARACTER*4 ISUBN1
      CHARACTER*4 ISUBN2
CCCCC CHARACTER*4 ISTEPN
C
C-----COMMON----------------------------------------------------------
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      ISUBN1='GRTR'
      ISUBN2='S2  '
C
      IERRG4='NO'
      IFOUST='NO'
C
      ICLIM1=1
      ICLIM2=130
C
      JPIM1=(-999)
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRS2')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRTRS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,52)IBUGG4,ISUBG4,IERRG4
   52 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)NUMCST
   61 FORMAT('NUMCST = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)(ICSTR(I:I),I=1,100)
   62 FORMAT('ICSTR(I:I) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)NCS1,ICS1
   71 FORMAT('NCS1,ICS1 = ',I8,2X,A30)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,72)NCS2,ICS2
   72 FORMAT('NCS2,ICS2 = ',I8,2X,A30)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,81)NUMCS2
   81 FORMAT('NUMCS2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,82)(ICSTR2(I:I),I=1,100)
   82 FORMAT('ICSTR2(I:I) = ',100A1)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               *****************************
C               **  STEP 11--              **
C               **  COPY THE OLD LINE      **
C               **  TO THE NEW LINE.       **
C               *****************************
C
      NUMCS2=NUMCST
      ICSTR2=ICSTR
C
C               *******************************
C               **  STEP 21--                **
C               **  TREAT THE CASE WHEN      **
C               **  STRING 1 IS NULL         **
C               **  (THAT IS, NCS1 <=  0)  **
C               *******************************
C
      IF(NCS1.LE.0)GOTO2100
      GOTO2900
C
 2100 CONTINUE
CCCCC WRITE(ICOUT,774)J,K,NUMCST,JPIM1,NCS1,L,IMIN,IMAX
CC774 FORMAT('FROM 2100--J,K,NUMCST,JPIM1,NCS1,L,IMIN,IMAX = ',8I8)
CCCCC CALL DPWRST('XXX','BUG ')
      IFOUST='YES'
C
C     STEP 21.1--COPY STRING 2 TO THE BEGINNING OF LINE 1
C
      K=0
C
      IMIN=ICLIM1
      IMAX=ICLIM1+NCS2-1
      IF(IMIN.GT.IMAX)GOTO2129
      L=0
      DO2120I=IMIN,IMAX
      K=K+1
      L=L+1
      ICSTR2(K:K)=ICS2(L:L)
CCCCC WRITE(ICOUT,777)I,K,ICSTR2(K:K),IMIN,IMAX
CCCCC CALL DPWRST('XXX','BUG ')
 2120 CONTINUE
 2129 CONTINUE
C
C     STEP 21.2--PUSH (COPY) THE OLD LINE TO THE RIGHT
C
      IMIN=ICLIM1+NCS2
      IMAX=ICLIM2
      IF(IMIN.GT.IMAX)GOTO2139
      DO2130I=IMIN,IMAX
      I2=I-NCS2
      IF(I2.GT.NUMCST)GOTO2139
      K=K+1
      ICSTR2(K:K)=ICSTR(I2:I2)
CCCCC WRITE(ICOUT,777)I,K,ICSTR2(K:K),IMIN,IMAX
CCCCC CALL DPWRST('XXX','BUG ')
 2130 CONTINUE
 2139 CONTINUE
C
      NUMCS2=K
      GOTO9000
C
 2900 CONTINUE
C
C               **********************************
C               **  STEP 31--                   **
C               **  TREAT THE CASE WHEN         **
C               **  THE OLD STRING IS NON-NULL  **
C               **  (THAT IS, NCS1 >= 1)      **
C               **********************************
C
      J=0
      K=0
 3100 CONTINUE
CCCCC WRITE(ICOUT,776)
CC776 FORMAT('-------------------------------')
CCCCC CALL DPWRST('XXX','BUG ')
CCCCC WRITE(ICOUT,780)J,K,NUMCST,JPIM1,NCS1
CC780 FORMAT('AFTER 3100--J,K,NUMCST,JPIM1,NCS1 = ',5I8)
CCCCC CALL DPWRST('XXX','BUG ')
      J=J+1
      IF(J.GT.NUMCST)GOTO3900
      IF(J.GT.ICLIM2)GOTO3900
C
      IF(J.LT.ICLIM1)GOTO3210
      DO3200I=1,NCS1
      JPIM1=J+(I-1)
CCCCC IF(ICS1(I).EQ.IMASK)GOTO3200
      IF(ICSTR(JPIM1:JPIM1).EQ.ICS1(I:I))GOTO3200
      GOTO3210
 3200 CONTINUE
CCCCC WRITE(ICOUT,781)J,K,NUMCST,JPIM1,NCS1
CC781 FORMAT('AFTER 3200 C--J,K,NUMCST,JPIM1,NCS1 = ',5I8)
CCCCC CALL DPWRST('XXX','BUG ')
      GOTO3390
C
 3210 CONTINUE
CCCCC WRITE(ICOUT,779)J,K,NUMCST,JPIM1,NCS1
CC779 FORMAT('AFTER 3210--J,K,NUMCST,JPIM1,NCS1 = ',5I8)
CCCCC CALL DPWRST('XXX','BUG ')
      K=K+1
      ICSTR2(K:K)=ICSTR(J:J)
      GOTO3100
C
 3390 CONTINUE
CCCCC WRITE(ICOUT,782)J,K,NUMCST,JPIM1,NCS1
CC782 FORMAT('AFTER 3390 C--J,K,NUMCST,JPIM1,NCS1 = ',5I8)
CCCCC CALL DPWRST('XXX','BUG ')
C
      IFOUST='YES'
      IF(NCS2.LE.0)GOTO3350
      DO3300I=1,NCS2
      K=K+1
      ICSTR2(K:K)=ICS2(I:I)
 3300 CONTINUE
 3350 CONTINUE
CCCCC WRITE(ICOUT,783)J,K,NUMCST,JPIM1,NCS1
CC783 FORMAT('AFTER 3350 C--J,K,NUMCST,JPIM1,NCS1 = ',5I8)
CCCCC CALL DPWRST('XXX','BUG ')
      J=JPIM1
      GOTO3100
C
 3400 CONTINUE
CCCCC WRITE(ICOUT,784)J,K,NUMCST,JPIM1,NCS1
CC784 FORMAT('AFTER 3400 C--J,K,NUMCST,JPIM1,NCS1 = ',5I8)
CCCCC CALL DPWRST('XXX','BUG ')
      J=J+1
      IF(J.GT.NUMCST)GOTO3900
      K=K+1
      ICSTR2(K:K)=ICSTR(J:J)
      GOTO3400
C
 3900 CONTINUE
      NUMCS2=K
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRS2')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRTRS2--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9012)IBUGG4,ISUBG4,IERRG4
 9012 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)NUMCST
 9021 FORMAT('NUMCST = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)(ICSTR(I:I),I=1,100)
 9022 FORMAT('ICSTR(I:I) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)NCS1,ICS1
 9031 FORMAT('NCS1,ICS1 = ',I8,2X,A30)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9032)NCS2,ICS2
 9032 FORMAT('NCS2,ICS2 = ',I8,2X,A30)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9041)NUMCS2
 9041 FORMAT('NUMCS2 = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9042)(ICSTR2(I:I),I=1,100)
 9042 FORMAT('ICSTR2(I:I) = ',100A1)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9051)ICLIM1,ICLIM2
 9051 FORMAT('ICLIM1,ICLIM2 = ',2I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9052)IFOUST
 9052 FORMAT('IFOUST = ',A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRTRTK(ICSTR,NCSTR)
C
C     PURPOSE--TRANSLATE 1 LINE OF TEKTRONIX 4014 ASCII DIRECTIVES
C              INTO A SERIES OF DUMMY FORTRAN CALLS BY WHICH
C              OTHER NON-TEKTRONIX GRAPHICS DEVICES MAY BE DRIVEN
C              (E.G., CALCOMP, HP, CHROMATICS, ETC.)
C     INPUT --ICSTR  = THE CHARACTER*130 STRING
C                      CONTAINING THE CONTROL STRING.
C             NCSTR  = THE NUMBER OF ELEMENTS IN ICSTR(.:.)
C                      TO BE PROCESSED.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--SEPTEMBER 1984.
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*130 ICSTR
C
      CHARACTER*1 ICTEXT
      CHARACTER*1 IC1
      CHARACTER*1 IC2
      CHARACTER*4 ILINTY
      CHARACTER*5 ICBYTE
      CHARACTER*4 IOP
C
      DIMENSION ICTEXT(130)
C
      DIMENSION X(100)
      DIMENSION Y(100)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCONP.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IERRG4='NO'
C
      ISIZE=(-999)
      ICBYTE='     '
      JP4=(-999)
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRTK')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRTRTK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)NCSTR
   54 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO57
      DO55I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,56)I,ICSTR(I:I),IASCNE
   56 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
   55 CONTINUE
   57 CONTINUE
      WRITE(ICOUT,69)IBUGG4,ISUBG4,IERRG4
   69 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
      I=0
C
 1000 CONTINUE
      I=I+1
      IF(I.GT.NCSTR)GOTO9000
      IC1=ICSTR(I:I)
      IP1=I+1
      IC2=ICSTR(2:2)
C
      IF(IC1.EQ.IESCC.AND.IC2.EQ.IFFC)GOTO1100
C
      IF(IC1.EQ.ISYNC)GOTO1200
C
      IF(IC1.EQ.IESCC.AND.IC2.EQ.IBELC)GOTO1300
C
      IF(IC1.EQ.IESCC.AND.IC2.EQ.'`')GOTO1400
      IF(IC1.EQ.IESCC.AND.IC2.EQ.'a')GOTO1400
      IF(IC1.EQ.IESCC.AND.IC2.EQ.'b')GOTO1400
      IF(IC1.EQ.IESCC.AND.IC2.EQ.'c')GOTO1400
C
      IF(IC1.EQ.IESCC.AND.IC2.EQ.';')GOTO1500
      IF(IC1.EQ.IESCC.AND.IC2.EQ.':')GOTO1500
      IF(IC1.EQ.IESCC.AND.IC2.EQ.'9')GOTO1500
      IF(IC1.EQ.IESCC.AND.IC2.EQ.'8')GOTO1500
C
      IF(IC1.EQ.IGSC)GOTO1600
C
      IF(IC1.EQ.IUSC)GOTO1700
C
      GOTO9000
C
C
C               ***********************************
C               **  STEP 1--                     **
C               **  TREAT THE ERASE SCREEN CASE  **
C               ***********************************
C
 1100 CONTINUE
CCCCC CALL ERASESCREEN
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK')WRITE(ICOUT,1101)
 1101 FORMAT('ERASE SCREEN')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK')CALL DPWRST('XXX','BUG ')
      I=I+1
      GOTO1000
C
C               *************************************
C               **  STEP 2--                       **
C               **  TREAT THE SEND NULL LINE CASE  **
C               *************************************
C
 1200 CONTINUE
      I1=I
      I2=I
      DO1210J=I,NCSTR
      IF(ICSTR(J:J).EQ.ISYNC)I2=J
      IF(ICSTR(J:J).EQ.ISYNC)GOTO1210
      GOTO1211
 1210 CONTINUE
 1211 CONTINUE
      NUMNUL=I2-I1+1
CCCCC CALL SENDNULLLINE(CONSISTING OF NUMNUL CHARACTERS)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK')WRITE(ICOUT,1212)NUMNUL
 1212 FORMAT('SEND A NULL LINE CONSISTING OF ',I8,'CHARACTERS')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK')CALL DPWRST('XXX','BUG ')
      I=I2
      GOTO1000
C
C               *****************
C               **  STEP 3--   **
C               **  RING BELL  **
C               *****************
C
 1300 CONTINUE
CCCCC CALL RINGBELL
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK')WRITE(ICOUT,1301)
 1301 FORMAT('RING BELL')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK')CALL DPWRST('XXX','BUG ')
      I=I+1
      GOTO1000
C
C               ************************************
C               **  STEP 4--                      **
C               **  TREAT THE SET LINE TYPE CASE  **
C               ************************************
C
C
 1400 CONTINUE
CCCCC IF(IC2.EQ.'`')CALL SETLINE(SOLID)
CCCCC IF(IC2.EQ.'a')CALL SETLINE(DOTTED)
CCCCC IF(IC2.EQ.'b')CALL SETLINE(DASHED)
CCCCC IF(IC2.EQ.'c')CALL SETLINE(DOT-DASHED)
      ILINTY='SOLI'
      IF(IC2.EQ.'`')ILINTY='SOLI'
      IF(IC2.EQ.'a')ILINTY='DOTT'
      IF(IC2.EQ.'b')ILINTY='DASH'
      IF(IC2.EQ.'c')ILINTY='DODA'
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK')WRITE(ICOUT,1411)ILINTY
 1411 FORMAT('SET LINE TYPE TO ',A4)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK')CALL DPWRST('XXX','BUG ')
      I=I+1
      GOTO1000
C
C               *****************************************
C               **  STEP 5--                           **
C               **  TREAT THE SET CHARACTER SIZE CASE  **
C               *****************************************
C
 1500 CONTINUE
CCCCC IF(IC2.EQ.';')CALL SETCHARSIZE(SMALLEST)
CCCCC IF(IC2.EQ.':')CALL SETCHARSIZE(NEXTTOSMALLEST)
CCCCC IF(IC2.EQ.'9')CALL SETCHARSIZE(NEXTTOLARGEEST)
CCCCC IF(IC2.EQ.'8')CALL SETCHARSIZE(LARGEST)
      ICHASZ=1
      IF(IC2.EQ.';')ISIZE=1
      IF(IC2.EQ.':')ISIZE=2
      IF(IC2.EQ.'9')ISIZE=3
      IF(IC2.EQ.'8')ISIZE=4
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK')WRITE(ICOUT,1511)ISIZE
 1511 FORMAT('SET CHARACTER SIZE TO ',I8)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK')CALL DPWRST('XXX','BUG ')
      I=I+1
      GOTO1000
C
C               **********************************************
C               **  STEP 6--                                **
C               **  TREAT THE GRAPHICS MODE MOVE/DRAW CASE  **
C               **********************************************
C
 1600 CONTINUE
      IOP='MOVE'
      IP1=I+1
      NPLOTP=0
      DO1610J=IP1,NCSTR,5
      JP4=J+4
      ICBYTE(1:5)=ICSTR(J:JP4)
CCCCC IB1=ICHAR(ICBYTE(1:1))
      CALL DPCOAN(ICBYTE(1:1),IB1)
CCCCC IB2=ICHAR(ICBYTE(2:2))
      CALL DPCOAN(ICBYTE(2:2),IB2)
CCCCC IB3=ICHAR(ICBYTE(3:3))
      CALL DPCOAN(ICBYTE(3:3),IB3)
CCCCC IB4=ICHAR(ICBYTE(4:4))
      CALL DPCOAN(ICBYTE(4:4),IB4)
CCCCC IB5=ICHAR(ICBYTE(5:5))
      CALL DPCOAN(ICBYTE(5:5),IB5)
C     A TEKTRONIX 4014 (ENHANCED GRAPHICS)
C     HAS A VISIBLE SCREEN CONSISTING OF
C     4096 HORIZONTAL PICTURE POINTS, AND
C     3124 VERTICAL PICTURE POINTS,
C     (WITH (0,0) AT THE BOTTOM LEFT), THEREFORE,
C     IXPP BELOW WILL RANGE FROM 0 TO 4095, AND
C     IYPP BELOW WILL RANGE FROM 0 TO 3123.
C     IXP BELOW WILL RANGE FROM 0 TO 1.
C     IYP BELOW WILL RANGE FROM 0 TO 1.
C
      IXPP=(IB4-32)*32+(IB5-64)
      IYPP=(IB1-32)*32+(IB3-96)
      IXPP=4*IXPP
      IYPP=4*IYPP
      XPP=IXPP
      YPP=IYPP
      XP=XPP/4095.
      YP=YPP/3123.
C
C     THE FOLLOWING SETTINGS ARE FOR A TYPICAL
C     ALPHANUMERIC TERMINAL SCREEN
C     (80 COLUMNS WIDE BY 24 ROWS DEEP
C     WITH (1,1) AT BOTTOM LEFT).
C
      XLEFT=1.00
      XRIGHT=80.00
      YBOT=1.00
      YTOP=24.00
C
      X2=(XLEFT-0.5)+((XRIGHT+0.5)-(XLEFT-0.5))*XP
      Y2=(YBOT-0.5)+((YTOP+0.5)-(YBOT-0.5))*YP
      IX2=X2+0.5
      IY2=Y2+0.5
C
CCCCC IF(IOP.EQ.'MOVE')CALL PENUP
CCCCC IF(IOP.EQ.'MOVE')CALL MOVETO(IX2,IY2)
CCCCC IF(IOP.EQ.'DRAW')CALL PENDOWN
CCCCC IF(IOP.EQ.'DRAW')CALL DRAWTO(IX2,IY2)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK'.AND.
     1IOP.EQ.'MOVE')WRITE(ICOUT,1611)IX2,IY2
 1611 FORMAT('PEN UP   AND MOVE TO ',I8,I8)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK'.AND.
     1IOP.EQ.'MOVE')CALL DPWRST('XXX','BUG ')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK'.AND.
     1IOP.EQ.'MOVE')WRITE(ICOUT,1612)IX2,IY2
 1612 FORMAT('PEN DOWN AND DRAW TO ',I8,I8)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK'.AND.
     1IOP.EQ.'MOVE')CALL DPWRST('XXX','BUG ')
      IOP='DRAW'
      NPLOTP=NPLOTP+1
      X(NPLOTP)=IX2
      Y(NPLOTP)=IY2
 1610 CONTINUE
CCCCC IF(NPLOTP.GE.2)CALL PLOT(X,Y,NPLOTP)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK'.AND.
     1NPLOTP.GE.2)WRITE(ICOUT,1621)NPLOTP
 1621 FORMAT('PLOT',I8,' POINTS FROM 2 VECTORS X (HOR) ',
     1'AND Y (VER)')
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK'.AND.
     1NPLOTP.GE.2)CALL DPWRST('XXX','BUG ')
      DO1625J=1,NPLOTP
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK')WRITE(ICOUT,1626)
     1J,X(J),Y(J)
 1626 FORMAT('      J,X(J),Y(J) = ',I8,2F15.7)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK')CALL DPWRST('XXX','BUG ')
 1625 CONTINUE
C
      I=JP4
      GOTO1000
C
C               **********************************************************
C               **  STEP 7--                                            **
C               **  TREAT THE ALPHANUMERIC MODE WRITE TEXT STRING CASE  **
C               **********************************************************
C
 1700 CONTINUE
      IP1=I+1
      NCTEXT=0
      DO1710J=IP1,NCSTR
      IF(ICSTR(J:J).EQ.IGSC)GOTO1790
      ICTEXT(NCTEXT)=ICSTR(J:J)
      NCTEXT=NCTEXT+1
 1710 CONTINUE
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK')
     1WRITE(ICOUT,1711)NCTEXT
 1711 FORMAT('WRITE THE ',I8,' TEXT STRING--',80A1)
      IF(IBUGG4.EQ.'ON'.OR.ISUBG4.EQ.'TRTK')
     1CALL DPWRST('XXX','BUG ')
CCCCC CALL WRITETEXT(ICTEXT,NCTEXT)
 1790 CONTINUE
      I=I+NCTEXT
      GOTO1000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'TRTK')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRTRTK--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)IGUNIT,IMANUF
 9013 FORMAT('IGUNIT,IMANUF = ',I8,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)NCSTR
 9014 FORMAT('NCSTR = ',I8)
      CALL DPWRST('XXX','BUG ')
      IF(NCSTR.LE.0)GOTO9017
      DO9015I=1,NCSTR
CCCCC IASCNE=ICHAR(ICSTR(I:I))
      CALL DPCOAN(ICSTR(I:I),IASCNE)
      WRITE(ICOUT,9016)I,ICSTR(I:I),IASCNE
 9016 FORMAT('I,ICSTR(I:I),IASCNE = ',I8,2X,A1,I8)
      CALL DPWRST('XXX','BUG ')
 9015 CONTINUE
 9017 CONTINUE
      WRITE(ICOUT,9029)IBUGG4,ISUBG4,IERRG4
 9029 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRWRTE(PX1,PY1,ICTEXT,NCTEXT,
     1IPATTT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILLT,ICOL,
     1JPATTT,JFONT,JCASE,JJUST,JDIR,ANGLE2,JFILLT,JCOL,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1JTHICK,PTHIC2,
     1PXLEC,PXLECG,PYLEC,PYLECG,
     1ISYMBL,ISPAC,
     1IMPSW2,AMPSCH,AMPSCW,
     1PX99,PY99)
C
C     PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE,
C              GO TO THE POINT (PX1,PY1) AND WRITE
C              OUT THE TEXT STRING CONTAINED IN THE
C              CHARACTER VECTOR ICTEXT(.),
C              WHICH CONSISTS OF    NCTEXT    CHARACTERS.
C     NOTE--PX1 AND PY1 ARE IN STANDARDIZED COORDINATES
C           THAT IS, EACH IS 0.0 TO 100.0.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED--JULY        1996. FORCE LAHEY DEVICE TO SOFTWARE CHAR.
C     UPDATED--SEPTEMBER   1999. ARGUMENT LIST TO GRWRTG
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ICTEXT
      CHARACTER*4 IPATTT
      CHARACTER*4 IFONT
      CHARACTER*4 ICASE
      CHARACTER*4 IJUST
      CHARACTER*4 IDIR
      CHARACTER*4 IFILLT
      CHARACTER*4 ICOL
C
      CHARACTER*4 ISYMBL
      CHARACTER*4 ISPAC
      CHARACTER*4 IMPSW2
C
      CHARACTER*4 IFONT2
C
      DIMENSION ICTEXT(*)
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'WRTE')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRWRTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)PX1,PY1
   53 FORMAT('PX1,  PY1   = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)PX99,PY99
   54 FORMAT('PX99,PY99 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)NCTEXT
   55 FORMAT('NCTEXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)(ICTEXT(I),I=1,NCTEXT)
   56 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)JSIZE
   57 FORMAT('JSIZE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IPATTT,JPATTT
   59 FORMAT('IPATTT,JPATTT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)IFONT,JFONT
   60 FORMAT('IFONT,JFONT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ICASE,JCASE
   61 FORMAT('ICASE,JCASE = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IJUST,JJUST
   62 FORMAT('IJUST,JJUST= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IDIR,JDIR
   63 FORMAT('IDIR,JDIR= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)ANGLE,ANGLE2
   64 FORMAT('ANGLE,ANGLE2= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IFILLT,JFILLT
   65 FORMAT('IFILLT,JFILLT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)ICOL,JCOL
   66 FORMAT('ICOL,JCOL= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)PHEIGH,JHEIG2,PHEIG2
   67 FORMAT('PHEIGH,JHEIG2,PHEIG2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)PWIDTH,JWIDT2,PWIDT2
   68 FORMAT('PWIDTH,JWIDT2,PWIDT2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PVEGAP,JVEGA2,PVEGA2
   69 FORMAT('PVEGAP,JVEGA2,PVEGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PHOGAP,JHOGA2,PHOGA2
   70 FORMAT('PHOGAP,JHOGA2,PHOGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)PTHICK,JTHICK,PTHIC2
   71 FORMAT('PTHICK,JTHICK,PTHIC2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)PXLEC,PXLECG
   73 FORMAT('PXLEC,PXLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)PYLEC,PYLECG
   74 FORMAT('PYLEC,PYLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)ISYMBL,ISPAC
   75 FORMAT('ISYMBL,ISPAC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE DIRECTION     **
C               **  AND THE FONT                          **
C               ********************************************
C
CCCCC FOLLOWING SECTION MODIFIED JULY 1996.
      IF(IGFONT.EQ.'OFF')THEN
        IF(IFONT.NE.'TEKT')GOTO1300
        IF(IDIR.EQ.'HORI')GOTO1100
        IF(IDIR.EQ.'VERT')GOTO1200
        GOTO1300
      ELSE
        IF(IGFONT.NE.'TEKT')GOTO1300
        IF(IDIR.EQ.'HORI')GOTO1100
        IF(IDIR.EQ.'VERT')GOTO1200
        GOTO1300
      ENDIF
C
C               **************************************
C               **  STEP 11--                       **
C               **  TREAT THE HORIZONTAL DIRECTION  **
C               **************************************
C
 1100 CONTINUE
      CALL GRWRTH(PX1,PY1,ICTEXT,NCTEXT,
     1IPATTT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILLT,ICOL,
     1JPATTT,JFONT,JCASE,JJUST,JDIR,ANGLE2,JFILLT,JCOL,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1JTHICK,PTHIC2,
     1PXLEC,PXLECG,PYLEC,PYLECG,
     1ISYMBL,ISPAC,
     1PX99,PY99)
      GOTO9000
C
C               ************************************
C               **  STEP 12--                     **
C               **  TREAT THE VERTICAL DIRECTION  **
C               ************************************
C
 1200 CONTINUE
      CALL GRWRTV(PX1,PY1,ICTEXT,NCTEXT,
     1IPATTT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILLT,ICOL,
     1JPATTT,JFONT,JCASE,JJUST,JDIR,ANGLE2,JFILLT,JCOL,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1JTHICK,PTHIC2,
     1PXLEC,PXLECG,PYLEC,PYLECG,
     1ISYMBL,ISPAC,
     1PX99,PY99)
      GOTO9000
C
C               ************************************
C               **  STEP 13--                     **
C               **  TREAT THE GENERAL DIRECTION   **
C               ************************************
C
 1300 CONTINUE
      IFONT2=IFONT
      IF(IFONT.EQ.'TEKT')IFONT2='SIMP'
      CALL GRWRTG(PX1,PY1,ICTEXT,NCTEXT,
     1IPATTT,IFONT2,ICASE,IJUST,IDIR,ANGLE,IFILLT,ICOL,
     1JPATTT,JFONT,JCASE,JJUST,JDIR,ANGLE2,JFILLT,JCOL,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1JTHICK,PTHIC2,
     1PXLEC,PXLECG,PYLEC,PYLECG,
     1ISYMBL,ISPAC,
     1IMPSW2,AMPSCH,AMPSCW,
     1PX99,PY99)
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'WRTE')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRWRTE--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)PX1,PY1
 9013 FORMAT('PX1,  PY1   = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)PX99,PY99
 9014 FORMAT('PX99,PY99 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NCTEXT
 9015 FORMAT('NCTEXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)(ICTEXT(I),I=1,NCTEXT)
 9016 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)JSIZE
 9017 FORMAT('JSIZE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IPATTT,JPATTT
 9019 FORMAT('IPATTT,JPATTT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)IFONT,JFONT
 9020 FORMAT('IFONT,JFONT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)ICASE,JCASE
 9021 FORMAT('ICASE,JCASE= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IJUST,JJUST
 9022 FORMAT('IJUST,JJUST= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)IDIR,JDIR
 9023 FORMAT('IDIR,JDIR= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)ANGLE,ANGLE2
 9024 FORMAT('ANGLE,ANGLE2= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)IFILLT,JFILLT
 9025 FORMAT('IFILLT,JFILLT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)ICOL,JCOL
 9026 FORMAT('ICOL,JCOL= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)PHEIGH,JHEIG2,PHEIG2
 9027 FORMAT('PHEIGH,JHEIG2,PHEIG2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)PWIDTH,JWIDT2,PWIDT2
 9028 FORMAT('PWIDTH,JWIDT2,PWIDT2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)PVEGAP,JVEGA2,PVEGA2
 9029 FORMAT('PVEGAP,JVEGA2,PVEGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9030)PHOGAP,JHOGA2,PHOGA2
 9030 FORMAT('PHOGAP,JHOGA2,PHOGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)PTHICK,JTHICK,PTHIC2
 9031 FORMAT('PTHICK,JTHICK,PTHIC2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)PXLEC,PXLECG
 9033 FORMAT('PXLEC,PXLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)PYLEC,PYLECG
 9034 FORMAT('PYLEC,PYLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)ISYMBL,ISPAC
 9035 FORMAT('ISYMBL,ISPAC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GRWRTG(PX1,PY1,ICTEXT,NCTEXT,
     1IPATT,IFONT,ICASE,IJUST,IDIR,ANGLE,IFILL,ICOL,
     1JPATT,JFONT,JCASE,JJUST,JDIR,ANGLE2,JFILL,JCOL,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,PTHICK,
     1JSIZE,
     1JHEIG2,JWIDT2,JVEGA2,JHOGA2,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1JTHICK,PTHIC2,
     1PXLEC,PXLECG,PYLEC,PYLECG,
     1ISYMBL,ISPAC,
     1IMPSW2,AMPSCH,AMPSCW,
     1PX99,PY99)
C
C     PURPOSE--FOR A SPECIFIC GRAPHICS DEVICE,
C              AND FOR A GENERAL (SOFTWARE-GENERATED HERSHEY) FONT,
C              GO TO THE POINT (PX1,PY1) AND WRITE OUT
C              THE TEXT STRING
C              (IN A GENERAL DIRECTION)
C              CONTAINED IN THE
C              CHARACTER VECTOR ICTEXT(.),
C              WHICH CONSISTS OF NCTEXT CHARACTERS.
C     NOTE--PX1 AND PY1 ARE IN STANDARDIZED COORDINATES
C           THAT IS, EACH IS 0.0 TO 100.0.
C
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-921-3651
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--83.6
C     ORIGINAL VERSION (AS A SEPARATE SUBROUTINE)--MAY       1983.
C     UPDATED         --SEPTEMBER1997. SUPPORT MULTIPLOT SCALE FACTOR
C
C-----NON-COMMON VARIABLES (GRAPHICS)-------------------------------------------
C
      CHARACTER*4 ICTEXT
C
      CHARACTER*4 IPATT
      CHARACTER*4 IFONT
      CHARACTER*4 ICASE
      CHARACTER*4 IJUST
      CHARACTER*4 IDIR
      CHARACTER*4 IFILL
      CHARACTER*4 ICOL
C
      CHARACTER*4 ISYMBL
      CHARACTER*4 ISPAC
      CHARACTER*4 IMPSW2
C
      CHARACTER*4 IFOUND
      CHARACTER*4 IBUGD2
      CHARACTER*4 IERROR
C  FOLLOWING LINE ADDED NOVEMBER 1994.
      CHARACTER*4 ISUBN0
C
      CHARACTER*4 ISTRIN
C
C  FOLLOWING LINE ADDED JANUARY 1988
C
      CHARACTER*130 ICSTR
C
      DIMENSION ICTEXT(*)
      DIMENSION ISTRIN(130)
C
C
C-----COMMON----------------------------------------------------------
C
      INCLUDE 'DPCOGR.INC'
      INCLUDE 'DPCOBE.INC'
      INCLUDE 'DPCOST.INC'
C
C-----COMMON VARIABLES (GENERAL)--------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C
C-----START POINT-----------------------------------------------------
C
CCCCC ADD FOLLOWING LINE NOVEMBER 1994.
      ISUBN0='WRTG'
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'WRTG')GOTO90
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,51)
   51 FORMAT('***** AT THE BEGINNING OF GRWRTG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,53)PX1,PY1
   53 FORMAT('PX1,PY1 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,54)PX99,PY99
   54 FORMAT('PX99,PY99 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,55)NCTEXT
   55 FORMAT('NCTEXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,56)(ICTEXT(I),I=1,NCTEXT)
   56 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,57)JSIZE
   57 FORMAT('JSIZE = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,59)IPATT
   59 FORMAT('IPATT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,60)IFONT,JFONT
   60 FORMAT('IFONT,JFONT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,61)ICASE,JCASE
   61 FORMAT('ICASE,JCASE = ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,62)IJUST,JJUST
   62 FORMAT('IJUST,JJUST= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,63)IDIR,JDIR
   63 FORMAT('IDIR,JDIR= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,64)ANGLE,ANGLE2
   64 FORMAT('ANGLE,ANGLE2= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,65)IFILL,JFILL
   65 FORMAT('IFILL,JFILL= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,66)ICOL,JCOL
   66 FORMAT('ICOL,JCOL= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,67)PHEIGH,JHEIG2,PHEIG2
   67 FORMAT('PHEIGH,JHEIG2,PHEIG2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,68)PWIDTH,JWIDT2,PWIDT2
   68 FORMAT('PWIDTH,JWIDT2,PWIDT2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,69)PVEGAP,JVEGA2,PVEGA2
   69 FORMAT('PVEGAP,JVEGA2,PVEGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,70)PHOGAP,JHOGA2,PHOGA2
   70 FORMAT('PHOGAP,JHOGA2,PHOGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,71)PTHICK,JTHICK,PTHIC2
   71 FORMAT('PTHICK,JTHICK,PTHIC2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,73)PXLEC,PXLECG
   73 FORMAT('PXLEC,PXLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,74)PYLEC,PYLECG
   74 FORMAT('PYLEC,PYLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,75)ISYMBL,ISPAC
   75 FORMAT('ISYMBL,ISPAC = ',A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,79)IBUGG4,ISUBG4,IERRG4
   79 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
   90 CONTINUE
C
C               ********************************************
C               **  STEP 1--                              **
C               **  BRANCH ACCORDING TO THE MANUFACTURER  **
C               **  AND THE MODEL                         **
C               ********************************************
C
      IF(IMANUF.EQ.'GENE')GOTO1030
      GOTO1100
C
C
 1030 CONTINUE
      IF(IFNTSW.EQ.'OFF')GOTO1100
      IF(IMODEL.EQ.'CODE')GOTO3200
      GOTO3100
C
C               *************************************************
C               **  STEP 11--                                  **
C               **  TREAT THE GENERAL MODEL                    **
C               **  (TEKTRONIX, HP, DEVICE-INDEPENDENT, ETC.)  **
C               *************************************************
C
 1100 CONTINUE
      NUMCHA=NCTEXT
      DO1110I=1,NUMCHA
      ISTRIN(I)=ICTEXT(I)
 1110 CONTINUE
      X0=PX1
      Y0=PY1
C
      HEIGHT=PHEIGH+PVEGAP
      WIDTH=PWIDTH+PHOGAP
C
      IBUGD2=IBUGG4
      HMAX=100.0
      VMAX=100.0
      AMAX=360.0
C
      CALL DPSCR7(ISTRIN,NUMCHA,X0,Y0,
     1IFONT,ICASE,IJUST,ANGLE,HMAX,VMAX,AMAX,WIDTH,HEIGHT,
     1PHEIGH,PWIDTH,PVEGAP,PHOGAP,
     1PHEIG2,PWIDT2,PVEGA2,PHOGA2,
     1ANUMHP,ANUMVP,
     1IPATT,PTHICK,ICOL,
     1JPATT,JTHICK,PTHIC2,JCOL,
     1ISYMBL,ISPAC,
     1IFILL,
     1IMPSW2,AMPSCH,AMPSCW,
     1PX99,PY99,IFOUND,IBUGD2,IERROR)
C
      GOTO9000
C
C               *****************************************************
C               **  FOR GENERAL DEVICE (AND "SET GENERAL FONT ON") **
C               **  LET POST PROCESSOR WRITE THE STRING IN  ONE OF **
C               **  ITS OWN FONTS. NOTE THAT THE DATAPLOT FONTS    **
C               **  WILL BE MAPPED TO THE POST PROCESSORS FONTS.   **
C               **  NOTE THAT IN THIS CASE, IT IS ASSUMMED THAT    **
C               **  THE POST PROCESSOR WILL ALSO SET THE "ANGLE"   **
C               **  AND THE JUSTIFICATION.                         **
C               *****************************************************
 3100 CONTINUE
      PX1P=PX1
      PY1P=PY1
      ICSTR(1:8)='MOVE TO '
      NCSTR=8
      NCHTOT=10
      NCHDEC=5
      CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
      PX1P=AX
      PY1P=AY
      CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(19:20)='  '
      NCSTR=20
      CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(NCTEXT.LE.0)GOTO3190
      ICSTR(1:11)='WRITE TEXT '
      NCSTR=11
      K=0
      DO3112J=1,NCTEXT
      K=J+NCSTR
      ICSTR(K:K)=ICTEXT(J)
 3112 CONTINUE
      NCSTR=K
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3190 CONTINUE
      GOTO9000
C
C               ***************************************************************
C               **  STEP 32--                                                **
C               **  TREAT THE CODED GENERAL (DEVICE-INDEPENDENT) CASE        **
C               ***************************************************************
C
 3200 CONTINUE
      PX1P=PX1
      PY1P=PY1
      ICSTR(1:5)='MOTO '
      NCSTR=5
      NCHTOT=10
      NCHDEC=5
      CALL GRTRRE(PX1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      ICSTR(16:17)='  '
      NCSTR=17
      CALL GRTRSA(PX1P,PY1P,AX,AY,ISUBN0)
      PX1P=AX
      PY1P=AY
      CALL GRTRRE(PY1P,NCHTOT,NCHDEC,ICSTR,NCSTR)
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
      IF(NCTEXT.LE.0)GOTO3290
      ICSTR(1:5)='WRTE '
      NCSTR=5
      K=0
      DO3212J=1,NCTEXT
      K=J+NCSTR
      ICSTR(K:K)=ICTEXT(J)
 3212 CONTINUE
      NCSTR=K
      CALL GRWRST(ICSTR,NCSTR,ISUBN0)
 3290 CONTINUE
      GOTO9000
C
C               *****************
C               **  STEP 90--  **
C               **  EXIT       **
C               *****************
C
 9000 CONTINUE
      IF(IBUGG4.EQ.'OFF'.AND.ISUBG4.NE.'WRTG')GOTO9090
      WRITE(ICOUT,999)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9011)
 9011 FORMAT('***** AT THE END       OF GRWRTG--')
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9013)PX1,PY1
 9013 FORMAT('PX1,PY1 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9014)PX99,PY99
 9014 FORMAT('PX99,PY99 = ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9015)NCTEXT
 9015 FORMAT('NCTEXT = ',I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9016)(ICTEXT(I),I=1,NCTEXT)
 9016 FORMAT('(ICTEXT(I),I=1,NCTEXT) = ',25A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9017)JSIZE
 9017 FORMAT('JSIZE = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9019)IPATT
 9019 FORMAT('IPATT = ',A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9020)IFONT,JFONT
 9020 FORMAT('IFONT,JFONT= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9021)ICASE,JCASE
 9021 FORMAT('ICASE,JCASE= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9022)IJUST,JJUST
 9022 FORMAT('IJUST,JJUST= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9023)IDIR,JDIR
 9023 FORMAT('IDIR,JDIR= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9024)ANGLE,ANGLE2
 9024 FORMAT('ANGLE,ANGLE2= ',2E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9025)IFILL,JFILL
 9025 FORMAT('IFILL,JFILL= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9026)ICOL,JCOL
 9026 FORMAT('ICOL,JCOL= ',A4,I8)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9027)PHEIGH,JHEIG2,PHEIG2
 9027 FORMAT('PHEIGH,JHEIG2,PHEIG2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9028)PWIDTH,JWIDT2,PWIDT2
 9028 FORMAT('PWIDTH,JWIDT2,PWIDT2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9029)PVEGAP,JVEGA2,PVEGA2
 9029 FORMAT('PVEGAP,JVEGA2,PVEGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9030)PHOGAP,JHOGA2,PHOGA2
 9030 FORMAT('PHOGAP,JHOGA2,PHOGA2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9031)PTHICK,JTHICK,PTHIC2
 9031 FORMAT('PTHICK,JTHICK,PTHIC2= ',E15.7,I8,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9033)PXLEC,PXLECG
 9033 FORMAT('PXLEC,PXLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9034)PYLEC,PYLECG
 9034 FORMAT('PYLEC,PYLECG= ',E15.7,E15.7)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9035)ISYMBL,ISPAC
 9035 FORMAT('ISYMBL,ISPAC = ',A4,A4)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,9039)IBUGG4,ISUBG4,IERRG4
 9039 FORMAT('IBUGG4,ISUBG4,IERRG4 = ',A4,2X,A4,2X,A4)
      CALL DPWRST('XXX','BUG ')
 9090 CONTINUE
C
      RETURN
      END
      SUBROUTINE GTRCDF(X,A,B,C,D,ANU1,ANU3,ALPHA,CDF)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE CUMULATIVE DISTRIBUTION
C              FUNCTION VALUE FOR THE GENERALIZED TRAPEZOID
C              DISTRIBUTION.
C              THIS DISTRIBUTION HAS THE FOLLOWING CDF FUNCTION:
C              F(X,A,B,C,D,N1,N2,ALPHA)
C              = 0                                    X < A
C              = [2*ALPHA*(B-A)*NU3/
C              (2*ALPHA*(B-A)*NU3+(ALPHA+1)*(C-B)*NU1*NU3+2*(D-C)*NU1)]
C              *((X-A)/(B-A))**NU1
C                                                     A <= X <  B
C              = [2*ALPHA*(B-A)*NU3 + 2*(X-B)*NU1*NU3*
C              {1 + (ALPHA-1)*(2*C-B-X)/(2*(C-B)}]/
C              [(2*ALPHA*(B-A)*NU3+(ALPHA+1)*(C-B)*NU1*NU3+2*(D-C)*NU1)]
C              *{(ALPHA-1)*(C-X)/(C-B)+1}
C                                                     B <= X <  C
C              = 1 -
C              [2*(D-C)*NU1]/
C              (2*ALPHA*(B-A)*NU3+(ALPHA+1)*(C-B)*NU1*NU3+2*(D-C)*NU1)]
C              *((D-X)/(D-C))**NU3
C                                                     C <= X <  D
C              = 1                                    X >= D
C              WHERE
C                  A <= B <= C <= D, NU1, NU3, ALPHA > 0
C              THIS DISTRIBUTION MODELS A "GROWTH PHASE",
C              A "STABLE PHASE", AND A "DECAY PHASE".
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
C                                WHICH THE CUMULATIVE DISTRIBUTION
C                                FUNCTION IS TO BE EVALUATED.
C                     --A      = THE SINGLE PRECISION SHAPE PARAMETER
C                       B      = THE SINGLE PRECISION SHAPE PARAMETER
C                       C      = THE SINGLE PRECISION SHAPE PARAMETER
C                       D      = THE SINGLE PRECISION SHAPE PARAMETER
C                       ANU1   = THE SINGLE PRECISION SHAPE PARAMETER
C                       ANU3   = THE SINGLE PRECISION SHAPE PARAMETER
C                       ALPHA  = THE SINGLE PRECISION SHAPE PARAMETER
C     OUTPUT ARGUMENTS--CDF    = THE SINGLE PRECISION CUMULATIVE
C                                DISTRIBUTION FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION CUMULATIVE DISTRIBUTION
C             FUNCTION VALUE CDF.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--X SHOULD BE BETWEEN A AND D, INCLUSIVELY.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--J. RENE VAN DORP AND SAMIEL KOTZ, "GENERALIZED
C                 TRAPEZOIDAL DISTRIBUTIONS", METRIKA, VOL. 58,
C                 ISSUE 1, JULY 2003.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-975-2855
C     ORIGINAL VERSION--JUNE      2003. 
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DCDF
      DOUBLE PRECISION DX
      DOUBLE PRECISION DA
      DOUBLE PRECISION DB
      DOUBLE PRECISION DC
      DOUBLE PRECISION DD
      DOUBLE PRECISION DALPHA
      DOUBLE PRECISION DNU1
      DOUBLE PRECISION DNU3
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DTERM2
      DOUBLE PRECISION DTERM3
      DOUBLE PRECISION DTERM4
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C---------------------------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(A.GT.B .OR. B.GT.C .OR. C.GT.D)THEN
        WRITE(ICOUT,12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,13)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,14)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,16)A,B,C,D
        CALL DPWRST('XXX','BUG ')
        CDF=0.0
        GOTO9000
      ENDIF
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,22)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,23)ALPHA
        CALL DPWRST('XXX','BUG ')
        CDF=0.0
        GOTO9000
      ENDIF
      IF(ANU1.LE.0.0)THEN
        WRITE(ICOUT,32)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,33)ANU1
        CALL DPWRST('XXX','BUG ')
        CDF=0.0
        GOTO9000
      ENDIF
      IF(ANU3.LE.0.0)THEN
        WRITE(ICOUT,42)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,43)ANU3
        CALL DPWRST('XXX','BUG ')
        CDF=0.0
        GOTO9000
      ENDIF
   12 FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALIZED TRAPEZOID DISTRIBUTION,')
   13 FORMAT(
     1'      THE FOUR SHAPE PARAMETERS (A, B, C, D) MUST SATISFY')
   14 FORMAT(
     1'         A <= B <= C <= D')
   16 FORMAT(
     1'      A, B, C, D = ',4E15.7)
   22 FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALIZED TRAPEZOID DISTRIBUTION,')
   23 FORMAT(
     1'      THE ALPHA SHAPE PARAMETER MUST BE > 0.  ALPHA = ',E15.7)
   32 FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALIZED TRAPEZOID DISTRIBUTION,')
   33 FORMAT(
     1'      THE NU1 SHAPE PARAMETER MUST BE > 0.  NU1 = ',E15.7)
   42 FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALIZED TRAPEZOID DISTRIBUTION,')
   43 FORMAT(
     1'      THE NU3 SHAPE PARAMETER MUST BE > 0.  NU3 = ',E15.7)
C
C-----START POINT-----------------------------------------------------
C
      IF(X.LT.A)THEN
        CDF=0.0
        GOTO9000
      ELSEIF(X.GE.D)THEN
        CDF=1.0
        GOTO9000
      ENDIF
C
      DX=DBLE(X)
      DA=DBLE(A)
      DB=DBLE(B)
      DC=DBLE(C)
      DD=DBLE(D)
      DNU1=DBLE(ANU1)
      DNU3=DBLE(ANU3)
      DALPHA=DBLE(ALPHA)
      DTERM2=2.0D0*DALPHA*(DB-DA)*DNU3 +
     1       (DALPHA+1.0D0)*(DC-DB)*DNU1*DNU3 +
     1       2.0D0*(DD-DC)*DNU1
C
      IF(A.LE.X .AND. X.LT.B)THEN
        DTERM1=2.0D0*DALPHA*(DB-DA)*DNU3
        DTERM3=((DX-DA)/(DB-DA))**DNU1
        DCDF=(DTERM1/DTERM2)*DTERM3
      ELSEIF(B.LE.X .AND. X.LT.C)THEN
        DTERM1=2.0D0*DALPHA*(DB-DA)*DNU3
        DTERM3=2.0D0*(DX-DB)*DNU1*DNU3
        DTERM4=1.0D0+(DALPHA-1.0D0)*(2.0D0*DC-DB-DX)/(2.0D0*(DC-DB))
        DCDF=(DTERM1 + DTERM3*DTERM4)/DTERM2
      ELSEIF(C.LE.X .AND. X.LT.D)THEN
        DTERM1=2.0D0*(DD-DC)*DNU1
        DTERM3=((DD-DX)/(DD-DC))**DNU3
        DCDF=1.0D0 - (DTERM1/DTERM2)*DTERM3
      ENDIF
      CDF=REAL(DCDF)
C
 9000 CONTINUE
      RETURN
      END 
      SUBROUTINE GTRPDF(X,A,B,C,D,ANU1,ANU3,ALPHA,PDF)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
C              FUNCTION VALUE FOR THE GENERALIZED TRAPEZOID
C              DISTRIBUTION.
C              THIS DISTRIBUTION HAS THE FOLLOWING PDF FUNCTION:
C              f(X,A,B,C,D,N1,N2,ALPHA)
C              = [2*ALPHA*NU1*NU3/
C              (2*ALPHA*(B-A)*NU3+(ALPHA+1)*(C-B)*NU1*NU3+2*(D-C)*NU1)]
C              *((X-A)/(B-A))**(NU1-1)
C                                                     A <= X <  B
C              = [2*NU1*NU3/
C              (2*ALPHA*(B-A)*NU3+(ALPHA+1)*(C-B)*NU1*NU3+2*(D-C)*NU1)]
C              *{(ALPHA-1)*(C-X)/(C-B)+1}
C                                                     B <= X <  C
C              = [2*NU1*NU3/
C              (2*ALPHA*(B-A)*NU3+(ALPHA+1)*(C-B)*NU1*NU3+2*(D-C)*NU1)]
C              *((D-X)/(D-C))**(NU3-1)
C                               = U*((D-X)/(D-C))     C <= X <  D
C                               = 0                   X < A, X >= D
C              WHERE
C                  A <= B <= C <= D, NU1, NU3, ALPHA > 0
C              THIS DISTRIBUTION MODELS A "GROWTH PHASE",
C              A "STABLE PHASE", AND A "DECAY PHASE".
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
C                                WHICH THE PROBABILITY DENSITY
C                                FUNCTION IS TO BE EVALUATED.
C                     --A      = THE SINGLE PRECISION SHAPE PARAMETER
C                       B      = THE SINGLE PRECISION SHAPE PARAMETER
C                       C      = THE SINGLE PRECISION SHAPE PARAMETER
C                       D      = THE SINGLE PRECISION SHAPE PARAMETER
C                       ANU1   = THE SINGLE PRECISION SHAPE PARAMETER
C                       ANU3   = THE SINGLE PRECISION SHAPE PARAMETER
C                       ALPHA  = THE SINGLE PRECISION SHAPE PARAMETER
C     OUTPUT ARGUMENTS--PDF    = THE SINGLE PRECISION PROBABILITY
C                                DENSITY FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY
C             FUNCTION VALUE PDF.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--X SHOULD BE BETWEEN A AND D, INCLUSIVELY.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--J. RENE VAN DORP AND SAMIEL KOTZ, "GENERALIZED
C                 TRAPEZOIDAL DISTRIBUTIONS", METRIKA, VOL. 58,
C                 ISSUE 1, JULY 2003.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-975-2855
C     ORIGINAL VERSION--JUNE      2003. 
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DPDF
      DOUBLE PRECISION DX
      DOUBLE PRECISION DA
      DOUBLE PRECISION DB
      DOUBLE PRECISION DC
      DOUBLE PRECISION DD
      DOUBLE PRECISION DALPHA
      DOUBLE PRECISION DNU1
      DOUBLE PRECISION DNU3
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DTERM2
      DOUBLE PRECISION DTERM3
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C---------------------------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(A.GT.B .OR. B.GT.C .OR. C.GT.D)THEN
        WRITE(ICOUT,12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,13)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,14)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,16)A,B,C,D
        CALL DPWRST('XXX','BUG ')
        PDF=0.0
        GOTO9000
      ENDIF
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,22)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,23)ALPHA
        CALL DPWRST('XXX','BUG ')
        PDF=0.0
        GOTO9000
      ENDIF
      IF(ANU1.LE.0.0)THEN
        WRITE(ICOUT,32)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,33)ANU1
        CALL DPWRST('XXX','BUG ')
        PDF=0.0
        GOTO9000
      ENDIF
      IF(ANU3.LE.0.0)THEN
        WRITE(ICOUT,42)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,43)ANU3
        CALL DPWRST('XXX','BUG ')
        PDF=0.0
        GOTO9000
      ENDIF
   12 FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALZIED TRAPEZOID DISTRIBUTION,')
   13 FORMAT(
     1'      THE FOUR SHAPE PARAMETERS (A, B, C, D) MUST SATISFY')
   14 FORMAT(
     1'         A <= B <= C <= D')
   16 FORMAT(
     1'      A, B, C, D = ',4E15.7)
   22 FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALIZED TRAPEZOID DISTRIBUTION,')
   23 FORMAT(
     1'      THE ALPHA SHAPE PARAMETER MUST BE > 0.  ALPHA = ',E15.7)
   32 FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALIZED TRAPEZOID DISTRIBUTION,')
   33 FORMAT(
     1'      THE NU1 SHAPE PARAMETER MUST BE > 0.  NU1 = ',E15.7)
   42 FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALIZED TRAPEZOID DISTRIBUTION,')
   43 FORMAT(
     1'      THE NU3 SHAPE PARAMETER MUST BE > 0.  NU3 = ',E15.7)
C
C-----START POINT-----------------------------------------------------
C
      IF(X.LT.A .OR. X.GE.D)THEN
        PDF=0.0
        GOTO9000
      ENDIF
C
      DX=DBLE(X)
      DA=DBLE(A)
      DB=DBLE(B)
      DC=DBLE(C)
      DD=DBLE(D)
      DNU1=DBLE(ANU1)
      DNU3=DBLE(ANU3)
      DALPHA=DBLE(ALPHA)
      DTERM1=2.0D0*DNU1*DNU3
      DTERM2=2.0D0*DALPHA*(DB-DA)*DNU3 +
     1       (DALPHA+1.0D0)*(DC-DB)*DNU1*DNU3 +
     1       2.0D0*(DD-DC)*DNU1
      DTERM3=DTERM1/DTERM2
C
      IF(A.LE.X .AND. X.LT.B)THEN
        IF(A.EQ.X .AND. ANU1.LE.1.0)THEN
          WRITE(ICOUT,132)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,133)ANU1
          CALL DPWRST('XXX','BUG ')
          PDF=0.0
          GOTO9000
        ENDIF
  132 FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALIZED TRAPEZOID DISTRIBUTION,')
  133 FORMAT(
     1'      WHEN X = A AND NU1 <= 1, THE PDF IS UNDEFINED.')
        DPDF=DALPHA*DTERM3*((DX-DA)/(DB-DA))**(DNU1-1.0D0)
      ELSEIF(B.LE.X .AND. X.LT.C)THEN
        DPDF=DTERM3*((DALPHA-1.0D0)*(DC-DX)/(DC-DB) + 1.0D0)
      ELSEIF(C.LE.X .AND. X.LT.D)THEN
        IF(D.EQ.X .AND. ANU3.LE.1.0)THEN
          WRITE(ICOUT,232)
          CALL DPWRST('XXX','BUG ')
          WRITE(ICOUT,233)ANU1
          CALL DPWRST('XXX','BUG ')
          PDF=0.0
          GOTO9000
        ENDIF
  232 FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALIZED TRAPEZOID DISTRIBUTION,')
  233 FORMAT(
     1'      WHEN X = D AND NU3 <= 1, THE PDF IS UNDEFINED.')
        DPDF=DTERM3*((DD-DX)/(DD-DC))**(DNU3-1.0D0)
      ENDIF
      PDF=REAL(DPDF)
C
 9000 CONTINUE
      RETURN
      END 
      SUBROUTINE GTRPPF(P,A,B,C,D,ANU1,ANU3,ALPHA,PPF)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PERCENT POINT
C              FUNCTION VALUE FOR THE GENERALZIED TRAPEZOID
C              DISTRIBUTION.
C              THIS DISTRIBUTION HAS THE FOLLOWING CDF FUNCTION:
C              F(X,A,B,C,D,N1,N2,ALPHA)
C              = 0                                    X < A
C              = [2*ALPHA*(B-A)*NU3/
C              (2*ALPHA*(B-A)*NU3+(ALPHA+1)*(C-B)*NU1*NU3+2*(D-C)*NU1)]
C              *((X-A)/(B-A))**NU1
C                                                     A <= X <  B
C              = [2*ALPHA*(B-A)*NU3 + 2*(X-B)*NU1*NU3*
C              {1 + (ALPHA-1)*(2*C-B-X)/(2*(C-B)}]/
C              [(2*ALPHA*(B-A)*NU3+(ALPHA+1)*(C-B)*NU1*NU3+2*(D-C)*NU1)]
C              *{(ALPHA-1)*(C-X)/(C-B)+1}
C                                                     B <= X <  C
C              = 1 -
C              [2*(D-C)*NU1]/
C              (2*ALPHA*(B-A)*NU3+(ALPHA+1)*(C-B)*NU1*NU3+2*(D-C)*NU1)]
C              *((D-X)/(D-C))**NU3
C                                                     C <= X <  D
C              = 1                                    X >= D
C              WHERE
C                  A <= B <= C <= D, NU1, NU3, ALPHA > 0
C              THE ALGORITHM FOR THE PPF IS TO COMPUTE THE CDF AT
C              X = A, X = B, X = C, AND X = D TO FIND THE APPROPRIATE
C              INTERVAL FOR P.  THEN INVERT THE APPROPRIATE EQUATION
C              ABOVE TO FIND THE PPF VALUE.  FOR THE INTERVAL FOR
C              B < X < C, USE A BISECTION METHOD (ALGEBRA FOR
C              INVERSION GETS A BIT MESSY).
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
C                                WHICH THE PROBABILITY DENSITY
C                                FUNCTION IS TO BE EVALUATED.
C                     --A      = THE SINGLE PRECISION SHAPE PARAMETER
C                       B      = THE SINGLE PRECISION SHAPE PARAMETER
C                       C      = THE SINGLE PRECISION SHAPE PARAMETER
C                       D      = THE SINGLE PRECISION SHAPE PARAMETER
C                       ANU1   = THE SINGLE PRECISION SHAPE PARAMETER
C                       ANU3   = THE SINGLE PRECISION SHAPE PARAMETER
C                       ALPHA  = THE SINGLE PRECISION SHAPE PARAMETER
C     OUTPUT ARGUMENTS--PPF    = THE SINGLE PRECISION PERCENT POINT
C                                FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION PERCENT POINT FUNCTION VALUE PPF.
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. 
C     RESTRICTIONS--P SHOULD BE BETWEEN 0 AND 1, INCLUSIVELY.
C     OTHER DATAPAC   SUBROUTINES NEEDED--NONE.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN. 
C     REFERENCES--J. RENE VAN DORP AND SAMIEL KOTZ, "GENERALIZED
C                 TRAPEZOIDAL DISTRIBUTIONS", METRIKA, VOL. 58,
C                 ISSUE 1, JULY 2003.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING LABORATORY (205.03)
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE:  301-975-2855
C     ORIGINAL VERSION--JUNE      2003. 
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DPPF
      DOUBLE PRECISION DP
      DOUBLE PRECISION DA
      DOUBLE PRECISION DB
      DOUBLE PRECISION DC
      DOUBLE PRECISION DD
      DOUBLE PRECISION DALPHA
      DOUBLE PRECISION DNU1
      DOUBLE PRECISION DNU3
      DOUBLE PRECISION DTERM1
      DOUBLE PRECISION DTERM2
      DOUBLE PRECISION DTERM3
      DOUBLE PRECISION DTERM4
      DOUBLE PRECISION DCDF
      DOUBLE PRECISION DCDFL
      DOUBLE PRECISION DCDFR
      DOUBLE PRECISION DXINC
      DOUBLE PRECISION DXL
      DOUBLE PRECISION DXR
      DOUBLE PRECISION DFXL
      DOUBLE PRECISION DFXR
      DOUBLE PRECISION DP1
      DOUBLE PRECISION DFCS
      DOUBLE PRECISION DXRML
      DOUBLE PRECISION DSIG
      DOUBLE PRECISION DEPS
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
      DATA DEPS /0.0000001/
      DATA DSIG /1.0D-7/
      DATA DZERO /0./
      DATA MAXIT /2000/
C
C---------------------------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(P.LT.0.0 .OR. P.GT.1.0)THEN
        WRITE(ICOUT,22)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,23)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,26)P
        CALL DPWRST('XXX','BUG ')
        PPF=0.0
        GOTO9000
      ENDIF
C
      IF(A.GE.B .OR. B.GE.C .OR. C.GE.D)THEN
        WRITE(ICOUT,12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,13)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,14)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,16)A,B,C,D
        CALL DPWRST('XXX','BUG ')
        PPF=0.0
        GOTO9000
      ENDIF
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,22)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,23)ALPHA
        CALL DPWRST('XXX','BUG ')
        PPF=0.0
        GOTO9000
      ENDIF
      IF(ANU1.LE.0.0)THEN
        WRITE(ICOUT,32)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,33)ANU1
        CALL DPWRST('XXX','BUG ')
        PPF=0.0
        GOTO9000
      ENDIF
      IF(ANU3.LE.0.0)THEN
        WRITE(ICOUT,42)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,43)ANU3
        CALL DPWRST('XXX','BUG ')
        PPF=0.0
        GOTO9000
      ENDIF
C
   12 FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALZIED TRAPEZOID DISTRIBUTION,')
   13 FORMAT(
     1'      THE FOUR SHAPE PARAMETERS (A, B, C, D) MUST SATISFY')
   14 FORMAT(
     1'         A < B < C < D')
   16 FORMAT(
     1'      A, B, C, D = ',4E15.7)
   22 FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALZIED TRAPEZOID PERCENT,')
   23 FORMAT(
     1'      POINT FUNCTION THE VALUE OF THE INPUT ARGUMENT IS ',
     1'OUTSIDE THE ALLOWABLE (0,1) INTERVAL.')
   26 FORMAT(
     1'      VALUE OF INPUT ARGUMENT = ',E15.7)
   32 FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALIZED TRAPEZOID DISTRIBUTION,')
   33 FORMAT(
     1'      THE NU1 SHAPE PARAMETER MUST BE > 0.  NU1 = ',E15.7)
   42 FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALIZED TRAPEZOID DISTRIBUTION,')
   43 FORMAT(
     1'      THE NU3 SHAPE PARAMETER MUST BE > 0.  NU3 = ',E15.7)
C
C-----START POINT-----------------------------------------------------
C
      P1=0.0
      CALL GTRCDF(B,A,B,C,D,ANU1,ANU3,ALPHA,P2)
      CALL GTRCDF(C,A,B,C,D,ANU1,ANU3,ALPHA,P3)
      P4=1.0
C
      IF(P.EQ.0.0)THEN
        PPF=A
        GOTO9000
      ELSEIF(P.EQ.1.0)THEN
        PPF=D
        GOTO9000
      ELSEIF(P.EQ.P2)THEN
        PPF=B
        GOTO9000
      ELSEIF(P.EQ.P3)THEN
        PPF=C
        GOTO9000
      ENDIF
C
      DP=DBLE(P)
      DALPHA=DBLE(ALPHA)
      DNU1=DBLE(ANU1)
      DNU3=DBLE(ANU3)
      DA=DBLE(A)
      DB=DBLE(B)
      DC=DBLE(C)
      DD=DBLE(D)
      DTERM2=2.0D0*DALPHA*(DB-DA)*DNU3 +
     1       (DALPHA+1.0D0)*(DC-DB)*DNU1*DNU3 +
     1       2.0D0*(DD-DC)*DNU1
C
      IF(P.GE.P1 .AND. P.LE.P2)THEN
        DTERM1=2.0D0*DALPHA*(DB-DA)*DNU3
        DPPF=(DB-DA)*((DTERM2/DTERM1)*DP)**(1.0D0/DNU1) + DA
      ELSEIF(P.GE.P2 .AND. P.LE.P3)THEN
        DXL=DB
        DXR=DC
C
C       BISECTION METHOD
C
        IC = 0
        DFXL = -DP
        DFXR = 1.0D0 - DP
  105   CONTINUE
          DX = (DXL+DXR)*0.5D0
C
C         GTRCDF FOR B < X < C CASE
C
          DTERM1=2.0D0*DALPHA*(DB-DA)*DNU3
          DTERM3=2.0D0*(DX-DB)*DNU1*DNU3
          DTERM4=1.0D0+(DALPHA-1.0D0)*(2.0D0*DC-DB-DX)/(2.0D0*(DC-DB))
          DCDF=(DTERM1 + DTERM3*DTERM4)/DTERM2
C
          DP1=DCDF
          DPPF=DX
          PPF=REAL(DPPF)
          DFCS = DP1 - DP
          IF(DFCS*DFXL.GT.0.0D0)GOTO110
          DXR = DX
          DFXR = DFCS 
          GOTO115
  110     CONTINUE
          DXL = DX
          DFXL = DFCS
  115     CONTINUE
          DXRML = DXR - DXL
          IF(DXRML.LE.DSIG .AND. DABS(DFCS).LE.DEPS)GOTO9000
          IC = IC + 1
          IF(IC.LE.MAXIT)GOTO105
          WRITE(ICOUT,130)
          CALL DPWRST('XXX','BUG ')
  130     FORMAT(
     1    '***** FATAL ERROR--GENERALIZED TRAPEZOID PPF ROUTINE DID ',
     1    'NOT CONVERGE.')
        GOTO9000
C
      ELSEIF(P.GE.P3 .AND. P.LE.P4)THEN
        DTERM1=2.0D0*(DD-DC)*DNU1
        DPPF=DD - (DD-DC)*((1.0D0-DP)*(DTERM2/DTERM1))**(1.0D0/DNU3)
      ENDIF
      PPF=REAL(DPPF)
C
 9000 CONTINUE
      RETURN
      END 
      SUBROUTINE GTRRAN(N,A,B,C,D,ANU1,ANU3,ALPHA,ISEED,X)
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE GENERALIZED TRAPEZOID DISTRIBUTION
C              THIS DISTRIBUTION HAS THE FOLLOWING PDF FUNCTION:
C              f(X,A,B,C,D,N1,N2,ALPHA)
C              = [2*ALPHA*NU1*NU3/
C              (2*ALPHA*(B-A)*NU3+(ALPHA+1)*(C-B)*NU1*NU3+2*(D-C)*NU1)]
C              *((X-A)/(B-A))**(NU1-1)
C                                                     A <= X <  B
C              = [2*NU1*NU3/
C              (2*ALPHA*(B-A)*NU3+(ALPHA+1)*(C-B)*NU1*NU3+2*(D-C)*NU1)]
C              *{(ALPHA-1)*(C-X)/(C-B)+1}
C                                                     B <= X <  C
C              = [2*NU1*NU3/
C              (2*ALPHA*(B-A)*NU3+(ALPHA+1)*(C-B)*NU1*NU3+2*(D-C)*NU1)]
C              *((D-X)/(D-C))**(NU3-1)
C                               = U*((D-X)/(D-C))     C <= X <  D
C                               = 0                   X < A, X >= D
C              WHERE
C                  A <= B <= C <= D, NU1, NU3, ALPHA > 0
C              THIS DISTRIBUTION MODELS THE SIMPLEST CASE OF 
C              A "GROWTH PHASE", A "STABLE PHASE", AND A "DECAY PHASE".
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
C                                (OF DIMENSION AT LEAST N)
C                                INTO WHICH THE GENERATED
C                                RANDOM SAMPLE WILL BE PLACED.
C                     --A      = THE SINGLE PRECISION SHAPE PARAMETER
C                       B      = THE SINGLE PRECISION SHAPE PARAMETER
C                       C      = THE SINGLE PRECISION SHAPE PARAMETER
C                       D      = THE SINGLE PRECISION SHAPE PARAMETER
C                       ANU1   = THE SINGLE PRECISION SHAPE PARAMETER
C                       ANU3   = THE SINGLE PRECISION SHAPE PARAMETER
C                       ALPHA  = THE SINGLE PRECISION SHAPE PARAMETER
C     OUTPUT--A RANDOM SAMPLE OF SIZE N
C             FROM THE GENERALIZED TRAPEZOID DISTRIBUTION
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C     OTHER DATAPAC   SUBROUTINES NEEDED--UNIRAN, GTRPPF
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--J. RENE VAN DORP AND SAMIEL KOTZ, "GENERALIZED
C                 GENERALIZED TRAPEZOIDAL DISTRIBUTIONS", METRIKA, VOL. 58,
C                 ISSUE 1, JULY 2003.
C               --TOCHER, THE ART OF SIMULATION,
C                 1963, PAGES 14-15.
C               --HAMMERSLEY AND HANDSCOMB, MONTE CARLO METHODS,
C                 1964, PAGE 36.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 CENTER FOR APPLIED MATHEMATICS
C                 NATIONAL BUREAU OF STANDARDS
C                 WASHINGTON, D. C. 20234
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL BUREAU OF STANDARDS.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2003.6
C     ORIGINAL VERSION--JUNE      2003.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)THEN
        WRITE(ICOUT, 5)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,47)N
        CALL DPWRST('XXX','BUG ')
        GOTO9000
      ENDIF
    5 FORMAT('***** FATAL ERROR--THE REQUESTED NUMBER OF GENERALIZED',
     1' TRAPEZOID RADOM NUMBERS IS NON-POSITIVE *****')
   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8,' *****')
      IF(A.GE.B .OR. B.GE.C .OR. C.GE.D)THEN
        WRITE(ICOUT,12)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,13)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,14)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,16)A,B,C,D
        CALL DPWRST('XXX','BUG ')
        PDF=0.0
        GOTO9000
      ENDIF
   12 FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALIZED TRAPEZOID DISTRIBUTION,')
   13 FORMAT(
     1'      THE FOUR SHAPE PARAMETERS (A, B, C, D) MUST SATISFY')
   14 FORMAT(
     1'         A < B < C < D')
   16 FORMAT(
     1'      A, B, C, D = ',4E15.7)
      IF(ALPHA.LE.0.0)THEN
        WRITE(ICOUT,22)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,23)ALPHA
        CALL DPWRST('XXX','BUG ')
        PDF=0.0
        GOTO9000
      ENDIF
      IF(ANU1.LE.0.0)THEN
        WRITE(ICOUT,32)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,33)ANU1
        CALL DPWRST('XXX','BUG ')
        PDF=0.0
        GOTO9000
      ENDIF
      IF(ANU3.LE.0.0)THEN
        WRITE(ICOUT,42)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,43)ANU3
        CALL DPWRST('XXX','BUG ')
        PDF=0.0
        GOTO9000
      ENDIF
   22 FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALIZED TRAPEZOID DISTRIBUTION,')
   23 FORMAT(
     1'      THE ALPHA SHAPE PARAMETER MUST BE > 0.  ALPHA = ',E15.7)
   32 FORMAT(
     1'***** FATAL ERROR--FOR THE GEnERALIZED TRAPEZOID DISTRIBUTION,')
   33 FORMAT(
     1'      THE NU1 SHAPE PARAMETER MUST BE > 0.  NU1 = ',E15.7)
   42 FORMAT(
     1'***** FATAL ERROR--FOR THE GENERALIZED TRAPEZOID DISTRIBUTION,')
   43 FORMAT(
     1'      THE NU3 SHAPE PARAMETER MUST BE > 0.  NU3 = ',E15.7)
C
C
C     GENERATE N UNIFORM (0,1) RANDOM NUMBERS;
C
      CALL UNIRAN(N,ISEED,X)
C
C     GENERATE N GENERALIZED TRAPEZOID RANDOM NUMBERS
C     USING THE PERCENT POINT FUNCTION TRANSFORMATION METHOD.
C
      DO100I=1,N
      P=X(I)
      CALL GTRPPF(P,A,B,C,D,ANU1,ANU3,ALPHA,PPF)
      X(I)=PPF
  100 CONTINUE
C
 9000 CONTINUE
      RETURN
      END
      SUBROUTINE GVECT(X,Y,N,
     1XTEMP,YTEMP,TATEMP,NTEMP,NTRACE,
     1IBUGG3,ISUBRO,IERROR)
C
C     PURPOSE--XX
C
C     WRITTEN BY--DAVID W. BEHRINGER NOAA/AOML (MIAMI).
C                 AS PART OF NOAA'S CONCX V.3   MARCH 1988.
C     ORIGINAL VERSION (IN DATAPLOT)--AUGUST    1988.
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IBUGG3
      CHARACTER*4 ISUBRO
      CHARACTER*4 IERROR
C
      DIMENSION X(*)
      DIMENSION Y(*)
C
      DIMENSION XTEMP(*)
      DIMENSION YTEMP(*)
      DIMENSION TATEMP(*)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
      IF(IBUGG3.EQ.'ON'.OR.ISUBRO.EQ.'VECT')GOTO1010
      GOTO1019
 1010 CONTINUE
      WRITE(ICOUT,999)
  999 FORMAT(1X)
      CALL DPWRST('XXX','BUG ')
      WRITE(ICOUT,1011)N
 1011 FORMAT('FROM GVECT--N = ',I8)
      CALL DPWRST('XXX','BUG ')
      DO1015I=1,N
      WRITE(ICOUT,1016)I,X(I),Y(I)
 1016 FORMAT('            I,X(I),Y(I) = ',I8,2F10.5)
      CALL DPWRST('XXX','BUG ')
 1015 CONTINUE
 1019 CONTINUE
C
      NTRACE=NTRACE+1
      DO1100I=1,N
      NTEMP=NTEMP+1
      XTEMP(NTEMP)=X(I)
      YTEMP(NTEMP)=Y(I)
      TATEMP(NTEMP)=NTRACE
 1100 CONTINUE
C
      RETURN
      END
      SUBROUTINE GWAPDF(X,A,B,C,PDF)
C
C     PURPOSE--THIS SUBROUTINE COMPUTES THE PROBABILITY DENSITY
C              FUNCTION VALUE FOR THE DISCRETE GENERALIZED WARING
C              DISTRIBUTION WITH SHAPE PARAMETERS A, B, AND C.
C              THIS DISTRIBUTION IS DEFINED FOR ALL INTEGER X >= 0.
C              THE PROBABILITY DENSITY FUNCTION IS:
C              P(X,A,B,C)=G(A+C)*G(B+C)*(A)n(B)n/
C                         G(A+B+C)*G(C)*X!*(A+B+C)n    X = 0, 1, 2, ...
C              WHERE G IS THE GAMMA FUNCTION AND (A)n IS
C              POCHHAMMER'S SYMBOL.  THE ABOVE DEFINTION IS FROM
C              DEVROYE. JOHNSON, KOTZ, AND KEMP GIVE A DEFINITION
C              BASED ON BINOMIAL COEFFICIENTS.
C     INPUT  ARGUMENTS--X      = THE SINGLE PRECISION VALUE AT
C                                WHICH THE PROBABILITY DENSITY
C                                FUNCTION IS TO BE EVALUATED.
C                                X SHOULD BE NON-NEGATIVE.
C                     --A      = THE FIRST SHAPE PARAMETER
C                     --B      = THE SECOND SHAPE PARAMETER
C                     --C      = THE THIRD SHAPE PARAMETER
C     OUTPUT ARGUMENTS--PDF    = THE SINGLE PRECISION DENSITY
C                                FUNCTION VALUE.
C     OUTPUT--THE SINGLE PRECISION PROBABILITY DENSITY
C             FUNCTION VALUE
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--X SHOULD BE A NON-NEGATIVE INTEGER
C                 --A, B, AND C > 0
C     MODE OF INTERNAL OPERATIONS--DOUBLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--JOHNSON, KOTZ, AND KEMP, "DISCRETE UNIVARIATE
C                 DISTRIBUTIONS", SECOND EDITION, 1992, WILEY,
C                 PP. 242-244.
C               --LUC DEVROYE, "RANDOM VARIATE GENERATION FOR THE
C                 DIGAMMA AND TRIGAMMA DISTRIBUTIONS", JOURNAL OF
C                 STATISTICAL COMPUTATION AND SIMULATION", VOL. 43,
C                 1992, PP. 197-216.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERESBURG, MD 20899-8980
C                 PHONE--301-975-2855
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C               EXCEPTION--HOLLERITH STRINGS IN FORMAT STATEMENTS
C                          DENOTED BY QUOTES RATHER THAN NH.
C     VERSION NUMBER--2004/4
C     ORIGINAL VERSION--APRIL     2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DOUBLE PRECISION DTERM1, DTERM2, DTERM3, DTERM4, DTERM5
      DOUBLE PRECISION DTERM6, DTERM7, DTERM8, DTERM9
      DOUBLE PRECISION DNUM, DENOM
      DOUBLE PRECISION DX, DA, DB, DC
      DOUBLE PRECISION DPDF
      DOUBLE PRECISION DLNGAM
      DOUBLE PRECISION DPOCH
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(A.LE.0.0)THEN
        WRITE(ICOUT,5)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)A
        CALL DPWRST('XXX','BUG ')
        PDF=0.0
        GOTO9999
      ENDIF
      IF(B.LE.0.0)THEN
        WRITE(ICOUT,15)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)B
        CALL DPWRST('XXX','BUG ')
        PDF=0.0
        GOTO9999
      ENDIF
      IF(C.LE.0.0)THEN
        WRITE(ICOUT,25)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)C
        CALL DPWRST('XXX','BUG ')
        PDF=0.0
        GOTO9999
      ENDIF
C
      IX=X+0.5
      IF(IX.LT.0)THEN
        WRITE(ICOUT,4)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)X
        CALL DPWRST('XXX','BUG ')
        PDF=0.0
        GOTO9999
      ENDIF
C
    4 FORMAT('***** ERROR--THE FIRST INPUT ARGUMENT ',
     1'TO THE GWAPDF SUBROUTINE IS LESS THAN 0')
    5 FORMAT('***** ERROR--THE SECOND INPUT ARGUMENT ',
     1'TO THE GWAPDF SUBROUTINE IS NON-POSITIVE.')
   15 FORMAT('***** ERROR--THE THIRD INPUT ARGUMENT ',
     1'TO THE GWAPDF SUBROUTINE IS NON-POSITIVE.')
   25 FORMAT('***** ERROR--THE FOURTH INPUT ARGUMENT ',
     1'TO THE GWAPDF SUBROUTINE IS NON-POSITIVE.')
   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8,' *****')
C
   90 CONTINUE
C
      DX=DBLE(IX)
      DA=DBLE(A)
      DB=DBLE(B)
      DC=DBLE(C)
C
      DTERM1=DLNGAM(DA+DC)
      DTERM2=DLNGAM(DB+DC)
      DTERM3=DLOG(DPOCH(DA,DX))
      DTERM4=DLOG(DPOCH(DB,DX))
      DTERM5=DLNGAM(DA+DB+DC)
      DTERM6=DLNGAM(DC)
      DTERM7=DLNGAM(DX+1.0)
      DTERM8=DLOG(DPOCH(DA+DB+DC,DX))
      DNUM=DTERM1+DTERM2+DTERM3+DTERM4
      DENOM=DTERM5+DTERM6+DTERM7+DTERM8
      DTERM9=DNUM-DENOM
      DPDF=DEXP(DTERM9)
C
      PDF=REAL(DPDF)
C
 9999 CONTINUE
      RETURN
      END
      SUBROUTINE GWARAN(N,A,B,C,ISEED,X)
C
C     PURPOSE--THIS SUBROUTINE GENERATES A RANDOM SAMPLE OF SIZE N
C              FROM THE GENERALIZED WARING DISTRIBUTION
C              WITH SINGLE PRECISION SHAPE PARAMETERS A, B, C.
C              THIS DISTRIBUTION IS DEFINED FOR ALL INTEGER X >= 0.
C              THE PROBABILITY DENSITY FUNCTION IS:
C                 P(X,A,B,C)=G(A+C)*G(B+C)*(a)n*(b)n/
C                            [G(A+B+C)*G(C)*X!*(a+b+c)n  X=0, 1, 2, ...
C                            A, B, C > 0
C                       =P*GAMMA(P+1)*GAMMA(X+1)/GAMMA(X+P+2)
C              ALGORITHM FOR RANDOM NUMBERS IS GIVEN BY DEVROYE,
C              "RANDOM VARIATE GENERATION FOR THE DIGAMMA AND
C              TRIGAMMA DISTRIBUTIONS", xxx.
C     INPUT  ARGUMENTS--N      = THE DESIRED INTEGER NUMBER
C                                OF RANDOM NUMBERS TO BE
C                                GENERATED.
C                     --A      = THE SINGLE PRECISION VALUE
C                                OF THE FIRST SHAPE PARAMETER FOR THE
C                                GENERALIZED WARING DISTRIBUTION.
C                     --B      = THE SINGLE PRECISION VALUE
C                                OF THE SECOND SHAPE PARAMETER FOR THE
C                                GENERALIZED WARING DISTRIBUTION.
C                     --C      = THE SINGLE PRECISION VALUE
C                                OF THE THIRD SHAPE PARAMETER FOR THE
C                                GENERALIZED WARING DISTRIBUTION.
C     OUTPUT ARGUMENTS--X      = A SINGLE PRECISION VECTOR
C                                (OF DIMENSION AT LEAST N)
C                                INTO WHICH THE GENERATED
C                                RANDOM SAMPLE WILL BE PLACED.
C     OUTPUT--A RANDOM SAMPLE OF SIZE N
C             FROM THE GENERALIZED WARING DISTRIBUTION
C     PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS.
C     RESTRICTIONS--THERE IS NO RESTRICTION ON THE MAXIMUM VALUE
C                   OF N FOR THIS SUBROUTINE.
C                 --A, B, C SHOULD BE > 0
C     OTHER DATAPAC   SUBROUTINES NEEDED--GAMRAN, POIRAN.
C     FORTRAN LIBRARY SUBROUTINES NEEDED--NONE.
C     MODE OF INTERNAL OPERATIONS--SINGLE PRECISION.
C     LANGUAGE--ANSI FORTRAN (1977)
C     REFERENCES--LUC DEVROYE, "RANDOM VARIATE GENERATION FOR THE
C                 DIGAMMA AND TRIGAMMA DISTRIBUTIONS", JOURNAL OF
C                 STATISITCAL COMPUTATION AND SIMULATION", VOL. 43,
C                 PP. 197-216, 1992.
C     WRITTEN BY--JAMES J. FILLIBEN
C                 STATISTICAL ENGINEERING DIVISION
C                 INFORMATION TECHNOLOGY LABORATORY
C                 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY
C                 GAITHERSBURG, MD 20899-8980
C                 PHONE--301-975-2899
C     NOTE--DATAPLOT IS A REGISTERED TRADEMARK
C           OF THE NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY.
C           THIS SUBROUTINE MAY NOT BE COPIED, EXTRACTED,
C           MODIFIED, OR OTHERWISE USED IN A CONTEXT
C           OUTSIDE OF THE DATAPLOT LANGUAGE/SYSTEM.
C     LANGUAGE--ANSI FORTRAN (1977)
C     VERSION NUMBER--2004/4
C     ORIGINAL VERSION--APRIL     2004.
C
C-----CHARACTER STATEMENTS FOR NON-COMMON VARIABLES-------------------
C
C---------------------------------------------------------------------
C
      DIMENSION X(*)
      DIMENSION U(2)
C
C---------------------------------------------------------------------
C
      CHARACTER*4 IFEEDB
      CHARACTER*4 IPRINT
      CHARACTER*240 ICOUT
C
      COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW
      COMMON /PRINT/IFEEDB,IPRINT
      COMMON /TEXTOU/ICOUT,NCOUT,ILOUT
C
C-----START POINT-----------------------------------------------------
C
C     CHECK THE INPUT ARGUMENTS FOR ERRORS
C
      IF(N.LT.1)THEN
        WRITE(ICOUT,5)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,47)N
        CALL DPWRST('XXX','BUG ')
        GOTO9999
      ENDIF
      IF(A.LE.0.0)THEN
        WRITE(ICOUT,15)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)A
        CALL DPWRST('XXX','BUG ')
        PDF=0.0
        GOTO9999
      ENDIF
      IF(B.LE.0.0)THEN
        WRITE(ICOUT,15)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)B
        CALL DPWRST('XXX','BUG ')
        PDF=0.0
        GOTO9999
      ENDIF
      IF(C.LE.0.0)THEN
        WRITE(ICOUT,15)
        CALL DPWRST('XXX','BUG ')
        WRITE(ICOUT,46)C
        CALL DPWRST('XXX','BUG ')
        PDF=0.0
        GOTO9999
      ENDIF
C
    5 FORMAT('***** ERROR--NUMBER OF GENERALIZED WARING RANDOM ',
     1'NUMBERS REQUESTED IS LESS THAN 1')
   15 FORMAT('***** ERROR--THE FIRST SHAPE PARAMETER FOR THE ',
     1       'GENERALIZED WARING DISTRIBUTION IS <= 0')
   16 FORMAT('***** ERROR--THE SECOND SHAPE PARAMETER FOR THE ',
     1       'GENERALIZED WARING DISTRIBUTION IS <= 0')
   17 FORMAT('***** ERROR--THE THIRD SHAPE PARAMETER FOR THE ',
     1       'GENERALIZED WARING DISTRIBUTION IS <= 0')
   46 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',E15.8)
   47 FORMAT('***** THE VALUE OF THE ARGUMENT IS ',I8)
C
C     GENERATE N GENERALIZED WARING  RANDOM NUMBERS
C
C     ALGORITHM:
C       1. GENERATE THREE GAMMA RANDOM NUMBERS WITH SHAPE PARAMETERS
C          A, B, AND C (SCALE PARAMETER = 1).
C       2. GAMMA(A)*GAMMA(B)/GAMMA(C) = LAMBDA
C       3. GENERATE A POISSON RANDOM NUMBER WITH SHAPE PARAMETER
C          LAMBDA
C
      NTEMP=1
      DO100I=1,N
        CALL GAMRAN(NTEMP,A,ISEED,U)
        U1=U(1)
        CALL GAMRAN(NTEMP,B,ISEED,U)
        U2=U(1)
        CALL GAMRAN(NTEMP,C,ISEED,U)
        U3=U(1)
        ALAMB=U1*U2/U3
        CALL POIRAN(NTEMP,ALAMB,ISEED,U)
        X(I)=U(1)
  100 CONTINUE
C
 9999 CONTINUE
      RETURN
      END
